Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu]Lisp vẽ spline qua các điểm.


  • Please log in to reply
8 replies to this topic

#1 minhtu2004

minhtu2004

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 219 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 02 December 2011 - 04:47 PM

-Nhu cầu công việc mình cần 1 lisp vẽ 1 đường spline đi qua các điểm đầu của đoạn thẳng như file cad mình đính kèm.
Đầu tiên: nhập lệnh lisp
chọn bao các điểm của đoạn thẳng( từ trái qua phải)
chọn điểm bắt đầu (từ trái qua phải)
kết thúc lệnh được đường Spline như File.
-Mong diễn đàn giúp đỡ.
http://www.cadviet.c...974_yeu_cau.dwg
  • 0

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#2 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5453 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 02 December 2011 - 04:51 PM

-Nhu cầu công việc mình cần 1 lisp vẽ 1 đường spline đi qua các điểm đầu của đoạn thẳng như file cad mình đính kèm.
Đầu tiên: nhập lệnh lisp
chọn bao các điểm của đoạn thẳng( từ trái qua phải)
chọn điểm bắt đầu (từ trái qua phải)
kết thúc lệnh được đường Spline như File.
-Mong diễn đàn giúp đỡ.
-File cad:http://www.cadviet.com/upfiles/3/35974_yeu_cau.dwg


Bạn upload file lại đi!
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#3 minhtu2004

minhtu2004

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 219 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 02 December 2011 - 04:54 PM

http://www.cadviet.c..._yeu_cau_1.dwg.
  • 0

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5453 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 02 December 2011 - 05:32 PM

http://www.cadviet.c..._yeu_cau_1.dwg.


Đây bạn!
P/S (18h36' 02-12-2011): Đã bổ sung cho bạn 2 cách chọn lựa: vẽ bằng Spline và bằng LWpolyline

;Doan Van Ha - CADViet.com 02-12-2011
;Noi cac dau mut cua cac Line (thang dung) thanh duong Pline/Spline.
(defun C:HA( / lst lstpt kwrd)
(vl-load-com)
(BAT_DAU)
(princ "\nChon cac duong Line...")
(setq lst (acet-ss-to-list (ssget (list (cons 0 "LINE")))))
(initget "P S")
(setq kwrd (getkword "\nChon kieu duong ve [Pline/Spline] <Pline>: "))
(if (null kwrd) (setq kwrd "P"))
(setq lst (vl-sort lst '(lambda (x y) (<
(car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y))))))))
(foreach n lst
(if
(> (cadr (cdr (assoc 10 (entget n)))) (cadr (cdr (assoc 11 (entget n)))))
(setq lstpt (cons (cdr (assoc 10 (entget n))) lstpt))
(setq lstpt (cons (cdr (assoc 11 (entget n))) lstpt))))
(setq lstpt (reverse lstpt))
(if (= kwrd "S")
(progn
(setq lst (list '(0 . "SPLINE")' (100 . "AcDbEntity") '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length lstpt))))
(foreach p lstpt (setq lst (append lst (list (cons 11 p)))))
(entmake lst))
(progn
(setq lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lstpt)) (cons 70 0)))
(foreach p lstpt (setq lst (append lst (list (cons 10 p)))))
(entmake lst)))
(KET_THUC)
(princ))
;----- H&#181;m n&#181;y &#174;&#198;t &#174;&#199;u ch&#173;&#172;ng tr&#215;nh.
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
;----- H&#181;m n&#181;y &#174;&#198;t cu&#232;i ch&#173;&#172;ng tr&#215;nh.
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
;----- H&#181;m n&#181;y x&#246; l&#253; khi c&#227; l&#231;i x&#183;y ra.
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))

  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 minhtu2004

minhtu2004

    biết lệnh chamfer

  • Members
  • PipPipPipPip
  • 219 Bài viết
Điểm đánh giá: 34 (tàm tạm)

Đã gửi 02 December 2011 - 05:39 PM

-Cám ơn bạn đã nhiệt. Lisp chạy rất OK. Đổi lại thành Pline được không bạn nếu khó khăn và mất thời gian thì thôi vậy. Cám ơn bạn nhiều.
  • 0

-Nhận thực hiện bản vẽ 3D bằng revit.
-Liên hệ: 01664793290.


#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5453 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 02 December 2011 - 06:33 PM

-Cám ơn bạn đã nhiệt. Lisp chạy rất OK. Đổi lại thành Pline được không bạn nếu khó khăn và mất thời gian thì thôi vậy. Cám ơn bạn nhiều.


Đã bổ sung cho bạn 2 cách chọn lựa: vẽ bằng Spline và bằng LWpolyline. Đường link cũ để đỡ tốn đất.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#7 draftsman38751

draftsman38751

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 02 December 2011 - 07:09 PM


Đã bổ sung cho bạn 2 cách chọn lựa: vẽ bằng Spline và bằng LWpolyline. Đường link cũ để đỡ tốn đất.


Bác DoanvanHa oi!Bác có thể mở rộng hơn cho lisp này được ko ạh!Bác xem file yêu cầu của em nhé!Lisp sẽ nối các đường line(hoặc polyline) từ trên xuống.
Đánh tên lệnh:
Yêu cầu chọn các đối tượng(chọn ngẫu nhiên hay chọn từ trên xuống hay chọn từ dưới lên)
Hỏi chọn vẽ bằng Spline hay bằng LWpolyline
Hỏi chọn bên trái hay bên phải
Kết thúc lệnh!
Thanks bác nhìu!Mong bác quan tâm giúp đỡ!

http://www.mediafire...kxm1haqed71jd16
  • 0

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5453 Bài viết
Điểm đánh giá: 2625 (tuyệt vời)

Đã gửi 02 December 2011 - 08:29 PM


Bác DoanvanHa oi!Bác có thể mở rộng hơn cho lisp này được ko ạh!Bác xem file yêu cầu của em nhé!Lisp sẽ nối các đường line(hoặc polyline) từ trên xuống.
Đánh tên lệnh:
Yêu cầu chọn các đối tượng(chọn ngẫu nhiên hay chọn từ trên xuống hay chọn từ dưới lên)
Hỏi chọn vẽ bằng Spline hay bằng LWpolyline
Hỏi chọn bên trái hay bên phải
Kết thúc lệnh!
Thanks bác nhìu!Mong bác quan tâm giúp đỡ!

http://www.mediafire...kxm1haqed71jd16


Đây bạn!

;Doan Van Ha - CADViet.com 02-12-2011
;Noi cac dau mut cua cac Line/Pline (nam ngang) thanh duong Pline/Spline.
(defun C:HA( / lst lstptt lstptp kwrd1 kwrd2)
(vl-load-com)
(BAT_DAU)
(princ "\nChon cac duong Line...")
(setq lst (acet-ss-to-list (ssget (list (cons 0 "LINE,LWPOLYLINE")))))
(initget "P S")
(setq kwrd1 (getkword "\nChon kieu duong ve [Pline/Spline] <Pline>: "))
(if (null kwrd1) (setq kwrd1 "P"))
(initget "T P")
(setq kwrd2 (getkword "\nChon phia ve [Trai/Phai] <Phai>: "))
(if (null kwrd2) (setq kwrd2 "P"))
(setq lst (vl-sort lst '(lambda (x y) (<
(cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y))))))))
(foreach n lst
(if (< (car (car (acet-geom-object-end-points (entget n)))) (car (cadr (acet-geom-object-end-points (entget n)))))
(setq lstptt (cons (car (acet-geom-object-end-points (entget n))) lstptt)
lstptp (cons (cadr (acet-geom-object-end-points (entget n))) lstptp))
(setq lstptt (cons (cadr (acet-geom-object-end-points (entget n))) lstptt)
lstptp (cons (car (acet-geom-object-end-points (entget n))) lstptp))))
(cond
((and (= kwrd1 "S") (= kwrd2 "T"))
(setq lst (list '(0 . "SPLINE")' (100 . "AcDbEntity") '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length lstptt))))
(foreach p lstptt (setq lst (append lst (list (cons 11 p)))))
(entmake lst))
((and (= kwrd1 "S") (= kwrd2 "P"))
(setq lst (list '(0 . "SPLINE")' (100 . "AcDbEntity") '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length lstptp))))
(foreach p lstptp (setq lst (append lst (list (cons 11 p)))))
(entmake lst))
((and (= kwrd1 "P") (= kwrd2 "T"))
(setq lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lstptt)) (cons 70 0)))
(foreach p lstptt (setq lst (append lst (list (cons 10 p)))))
(entmake lst))
((and (= kwrd1 "P") (= kwrd2 "P"))
(setq lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lstptp)) (cons 70 0)))
(foreach p lstptp (setq lst (append lst (list (cons 10 p)))))
(entmake lst)))
(KET_THUC)
(princ))
;----- H&#181;m n&#181;y &#174;&#198;t &#174;&#199;u ch&#173;&#172;ng tr&#215;nh.
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
;----- H&#181;m n&#181;y &#174;&#198;t cu&#232;i ch&#173;&#172;ng tr&#215;nh.
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
;----- H&#181;m n&#181;y x&#246; l&#253; khi c&#227; l&#231;i x&#183;y ra.
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))

  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#9 draftsman38751

draftsman38751

    biết zoom

  • Members
  • Pip
  • 16 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 02 December 2011 - 09:00 PM


Đây bạn!


;Doan Van Ha - CADViet.com 02-12-2011
;Noi cac dau mut cua cac Line/Pline (nam ngang) thanh duong Pline/Spline.
(defun C:HA( / lst lstptt lstptp kwrd1 kwrd2)
(vl-load-com)
(BAT_DAU)
(princ "\nChon cac duong Line...")
(setq lst (acet-ss-to-list (ssget (list (cons 0 "LINE,LWPOLYLINE")))))
(initget "P S")
(setq kwrd1 (getkword "\nChon kieu duong ve [Pline/Spline] <Pline>: "))
(if (null kwrd1) (setq kwrd1 "P"))
(initget "T P")
(setq kwrd2 (getkword "\nChon phia ve [Trai/Phai] <Phai>: "))
(if (null kwrd2) (setq kwrd2 "P"))
(setq lst (vl-sort lst '(lambda (x y) (<
(cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y))))))))
(foreach n lst
(if (< (car (car (acet-geom-object-end-points (entget n)))) (car (cadr (acet-geom-object-end-points (entget n)))))
(setq lstptt (cons (car (acet-geom-object-end-points (entget n))) lstptt)
lstptp (cons (cadr (acet-geom-object-end-points (entget n))) lstptp))
(setq lstptt (cons (cadr (acet-geom-object-end-points (entget n))) lstptt)
lstptp (cons (car (acet-geom-object-end-points (entget n))) lstptp))))
(cond
((and (= kwrd1 "S") (= kwrd2 "T"))
(setq lst (list '(0 . "SPLINE")' (100 . "AcDbEntity") '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length lstptt))))
(foreach p lstptt (setq lst (append lst (list (cons 11 p)))))
(entmake lst))
((and (= kwrd1 "S") (= kwrd2 "P"))
(setq lst (list '(0 . "SPLINE")' (100 . "AcDbEntity") '(100 . "AcDbSpline") (cons 71 3) (cons 74 (length lstptp))))
(foreach p lstptp (setq lst (append lst (list (cons 11 p)))))
(entmake lst))
((and (= kwrd1 "P") (= kwrd2 "T"))
(setq lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lstptt)) (cons 70 0)))
(foreach p lstptt (setq lst (append lst (list (cons 10 p)))))
(entmake lst))
((and (= kwrd1 "P") (= kwrd2 "P"))
(setq lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lstptp)) (cons 70 0)))
(foreach p lstptp (setq lst (append lst (list (cons 10 p)))))
(entmake lst)))
(KET_THUC)
(princ))
;----- H&#181;m n&#181;y &#174;&#198;t &#174;&#199;u ch&#173;&#172;ng tr&#215;nh.
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
;----- H&#181;m n&#181;y &#174;&#198;t cu&#232;i ch&#173;&#172;ng tr&#215;nh.
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
;----- H&#181;m n&#181;y x&#246; l&#253; khi c&#227; l&#231;i x&#183;y ra.
(defun KHI_LOI(msg)
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(redraw)
(command "u")
(princ (strcat "\n" msg ", Reset System Variables\n"))
(setq *error* err))


Ok rùi!Thanks bác nha!Chúc bác 1 ngày dzui dxze
  • 0