Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
minhtu2004

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

Các bài được khuyến nghị

-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.com/upfiles/3/35974_yeu_cau.dwg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

-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!

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Đâ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µm nµy ®Æt ®Çu ch­¬ng tr×nh.
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
;----- Hµm nµy ®Æt cuèi ch­¬ng tr×nh.
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
;----- Hµm nµy xö lý khi cã lçi x·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))

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

-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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

-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.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Đã 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.com/?kxm1haqed71jd16

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

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µm nµy ®Æt ®Çu ch­¬ng tr×nh.
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
;----- Hµm nµy ®Æt cuèi ch­¬ng tr×nh.
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
;----- Hµm nµy xö lý khi cã lçi x·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))

  • Vote tăng 2

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Đâ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µm nµy ®Æt ®Çu ch­¬ng tr×nh.
(defun BAT_DAU()
(setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(setq err *error* *error* KHI_LOI))
;----- Hµm nµy ®Æt cuèi ch­¬ng tr×nh.
(defun KET_THUC()
(acet-sysvar-restore)
(vla-EndUndoMark AcDoc)
(setq *error* err))
;----- Hµm nµy xö lý khi cã lçi x·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

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×