Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
Nókìa8800

Em muốn viết một Lisp để chuyển Spline thành Pline

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

Chào các anh, chị!

 

Em đang dùng Nova, có 1 file bình đồ mà đường đồng mức lại là Spline mới bực mình.

Em định viết 1 lisp để chuyển nó thành pline, tất nhiên là không thể trơn như Spline nhưng với khoảng điểm nhỏ thì vẫn có thể chấp nhận được. Em mới viết đến đây nhưng ko làm sao viết tiếp được, anh chị nào giúp em với

 

(defun c:ddm ()
 (if (= i nil)(setq i 0.50))
 (setq kc (getreal (strcat "\nKhoang chia <" (rtos i 2 2) "> :")))
 (if kc (setq i kc)(setq kc i))
 (setq ent (entsel "\nChon duong Spline:"))
 (while (/= (cdr (assoc 0 (entget (car ent))) "SPLINE"))
(princ "\nPhai chon duong SPLINE!")
(setq ent (entsel "\nChon duong Spline:"))
)
 (command ".measure" ent kc)
 (setq ss (ssadd))
 (setq ss (ssget "p"))
 (setq j 0)
 (setq diem nil)
 (while (< j (sslength ss))
(setq p (cdr (assoc 10 (entget (ssname ss j)))))
(setq diem (append diem (list p))
  j (1+ j))
)
 (command ".erase" "p" "")
 (setq j 0)

 

tiếp theo là dùng tập hợp điểm trong biến "diem" để vẽ đường pline, và đồng thời trật tự của nó phải như đường spline.

 

Cảm ơn các anh chị trước!

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
Em đang dùng Nova, có 1 file bình đồ mà đường đồng mức lại là Spline mới bực mình.

Em định viết 1 lisp để chuyển nó thành pline, tất nhiên là không thể trơn như Spline nhưng với khoảng điểm nhỏ thì vẫn có thể chấp nhận được...

Mình hiểu thủ thuật của bạn, chỉ cần dùng lệnh pline như dưới đây là OK. Tuy nhiên, cách làm như vậy không hay lắm. Phải "nhờ vả" các lệnh của AutoCAD như measure, divide... để lấy toạ độ điểm là việc làm bất đắc dĩ, khi không còn cách nào khác.

Bạn dùng thử trình sau. Tất cả các dòng code mình đều có comment. Nếu còn lơ mơ thì lật Help ra xem, thường họ có kèm ví dụ, đọc là hiểu ngay.

Cái "đinh" của chương trình dưới là dùng họ function vlax-curve-xxxx để xử lý. Cái này hay lắm, dùng cho cả line, pline, spline, circle, arc...

Về cách dùng command, bạn đọc code chắc là hiểu chứ? Bản chất của vấn đề là bạn có thể "chen ngang" các biểu thức lisp nhưng vẫn không huỷ bỏ quá trình đang thực hiện dở dang của command (giống như phương thức transparent vậy).

Có gì vướng mắc bạn cứ nêu, mình sẽ giải thích thêm.

 

(defun C:S2P( / d1 e ps pe d d2 oldos p2 ans)
;;;Convert Spline to Pline
(if (not d0) (setq d0 0.50)) ;;;Init dividual distance, global variable
(setq d1 (getreal (strcat "\nLength of 1 segment <" (rtos d0 2 2) ">:"))) ;;;Input distance
(if d1 (setq d0 d1) (setq d1 d0)) ;;;Reset or get distance
(vl-load-com) ;;;Load Visual LISP extensions before use vlax-xxxx functions
(setq
   e (car (entsel "\nSelect spline:")) ;;;Spline entity
   ps (vlax-curve-getStartPoint e) ;;;Start point
   pe (vlax-curve-getEndPoint e) ;;;End point
   d (vlax-curve-getDistAtPoint e pe) ;;;Length of spline e
   d2 d1 ;;;Init variable distance
   oldos (getvar "osmode") ;;;Save osmode
)
(setvar "osmode" 0) ;;;Disable osmode
(command "pline") ;;;Call pline command
(command ps) ;;;Start point
(while (<= d2 d) ;;;While not over end point pe
   (setq p2 (vlax-curve-getPointAtDist e d2)) ;;;Variable point at d2 = length along spline
   (command p2) ;;;Continue pline command from current point to p2
   (setq d2 (+ d2 d1)) ;;;Increment distance d2 by d1
)
(command pe) ;;;Pline command to end point pe
(command "") ;;;Finish pline command
(initget "Y N") ;;;Init key words
(setq ans (getkword "\nErase original spline :")) ;;;Get answer from user
(if (= ans "Y") (command "erase" e "")) ;;;Erase spline if ans = "yes"
(setvar "osmode" oldos) ;;;Reset osmode
(princ) ;;;Silent quit
)

  • Vote tăng 1

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
Mình hiểu thủ thuật của bạn, chỉ cần dùng lệnh pline như dưới đây là OK. Tuy nhiên, cách làm như vậy không hay lắm. Phải "nhờ vả" các lệnh của AutoCAD như measure, divide... để lấy toạ độ điểm là việc làm bất đắc dĩ, khi không còn cách nào khác.

Bạn dùng thử trình sau. Tất cả các dòng code mình đều có comment. Nếu còn lơ mơ thì lật Help ra xem, thường họ có kèm ví dụ, đọc là hiểu ngay.

Cái "đinh" của chương trình dưới là dùng họ function vlax-curve-xxxx để xử lý. Cái này hay lắm, dùng cho cả line, pline, spline, circle, arc...

Về cách dùng command, bạn đọc code chắc là hiểu chứ? Bản chất của vấn đề là bạn có thể "chen ngang" các biểu thức lisp nhưng vẫn không huỷ bỏ quá trình đang thực hiện dở dang của command (giống như phương thức transparent vậy).

Có gì vướng mắc bạn cứ nêu, mình sẽ giải thích thêm.

 

(defun C:S2P( / d1 e ps pe d d2 oldos p2 ans)
;;;Convert Spline to Pline
(if (not d0) (setq d0 0.50)) ;;;Init dividual distance, global variable
(setq d1 (getreal (strcat "\nLength of 1 segment <" (rtos d0 2 2) ">:"))) ;;;Input distance
(if d1 (setq d0 d1) (setq d1 d0)) ;;;Reset or get distance
(vl-load-com) ;;;Load Visual LISP extensions before use vlax-xxxx functions
(setq
   e (car (entsel "\nSelect spline:")) ;;;Spline entity
   ps (vlax-curve-getStartPoint e) ;;;Start point
   pe (vlax-curve-getEndPoint e) ;;;End point
   d (vlax-curve-getDistAtPoint e pe) ;;;Length of spline e
   d2 d1 ;;;Init variable distance
   oldos (getvar "osmode") ;;;Save osmode
)
(setvar "osmode" 0) ;;;Disable osmode
(command "pline") ;;;Call pline command
(command ps) ;;;Start point
(while (<= d2 d) ;;;While not over end point pe
   (setq p2 (vlax-curve-getPointAtDist e d2)) ;;;Variable point at d2 = length along spline
   (command p2) ;;;Continue pline command from current point to p2
   (setq d2 (+ d2 d1)) ;;;Increment distance d2 by d1
)
(command pe) ;;;Pline command to end point pe
(command "") ;;;Finish pline command
(initget "Y N") ;;;Init key words
(setq ans (getkword "\nErase original spline <N>:")) ;;;Get answer from user
(if (= ans "Y") (command "erase" e "")) ;;;Erase spline if ans = "yes"
(setvar "osmode" oldos) ;;;Reset osmode
(princ) ;;;Silent quit
)

Anh ssg ơi,

Thế nếu đối tượng chọn không phải là spline mà là arc hay circle thì phải làm thế nào ạ?

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
Anh ssg ơi,

Thế nếu đối tượng chọn không phải là spline mà là arc hay circle thì phải làm thế nào ạ?

Chương trình vẫn áp dụng được cho arc (bạn cứ thử khắc biết). Riêng circle thì xử lý khác một chút (nhưng circle có nhu cầu không?)

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

(Defun C:S2P (/ ss pt# cmdecho osmode clayer count ent lay lng pt-list cnt)
 (vl-load-com)
 (setq ss    (ssget '((0 . "spline")))
   pt#    (getint "Enter number of segments <100>:")
   cmdecho    (getvar "cmdecho")
   osmode    (getvar "osmode")
   clayer    (getvar "clayer")
   count     0                    ;spline counter
 );end setq
 (if(null pt#)(setq pt# 100))
 (setvar "cmdecho" 0)
 (command ".undo" "begin")                ;begin undo group
 (setvar "osmode" 0)
 (repeat(sslength ss)                    ;repeat for each spline
   (setq ent    (vlax-ename->vla-object (ssname ss count));change spline to vla-object
     lay    (vlax-get-property ent "layer")        ;spline's layer
     lng    (vlax-curve-getDistAtPoint ent(vlax-curve-getEndPoint ent));length of spline
     pt-list(list(vlax-curve-getStartPoint ent))    ;coords for start of spline
     cnt     1.0                    ;segment counter
   );end setq
   (repeat pt#                        ;repeat for each segment
     (setq pt-list(cons(vlax-curve-getPointAtDist ent (* lng(/ cnt pt#)))pt-list));add segment's point to pt-list
     (setq cnt(1+ cnt))                ;counter to next segment
   );end segment repeat
   (setq cnt 0)                    ;pline counter
   (setvar "clayer" lay)                ;match spline's layer
   (command ".pline"                    ;start "pline" command
        (repeat(length pt-list)            ;repeat for each point
          (command(nth cnt pt-list))        ;enter current point
          (setq cnt(1+ cnt))            ;counter to next point
          ""                    ;return value to close "pline" command
        );end point repeat
   );end command
   (setq count(1+ count))                ;counter to next spline
 );end spline repeat
 (command ".erase" ss "")
 (setvar "osmode" osmode)
 (setvar "clayer" clayer)
 (command ".undo" "end")                ;end of undo group
 (setvar "cmdecho" cmdecho)
 (princ)                        ;exit quietly
)

Các bác thử dùng lisp này xem có được không

  • Vote tăng 1

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

Chương trình hoàn chỉnh, "chơi" được hàng loạt đối tượng là Line, Pline, Spline, Arc, Circle và Ellipse, với chú giải chi tiết cho từng dòng code:

 

;;;***********************************************************
;;;CONVERT TO PLINES PROGRAM WITH FULL COMMENTS!
;;;Convert all objects: Line, Pline, Spline, Arc, Circle, Ellipse_
;;;to Plines. Length of 1 segment is specified by user
;;;Copy code, Paste to Notepad, Save as *.lsp
;;;Call Appload command, Select *.lsp then Type C2P to run...
;;;Happy New Year 2008!
;;;Written by ssg - January 2008 - www.cadviet.com 
;;;***********************************************************


;;;-------------------------------------------------------------
(defun makepl ( e d1 / ps pe d d2 p2) ;;;Make pline along curve e. Length of 1 segment = d1
(vl-load-com) ;;;Load Visual LISP extensions before use vlax-xxxx functions
(setq
   ps (vlax-curve-getStartPoint e) ;;;Start point
   pe (vlax-curve-getEndPoint e) ;;;End point
   d (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) ;;;Length of curve e
   d2 d1 ;;;Init variable distance
)
(command "pline") ;;;Call pline command
(command ps) ;;;Start point
(while (<= d2 d) ;;;While not over end point pe
   (setq p2 (vlax-curve-getPointAtDist e d2)) ;;;Variable point at d2 = length along curve
   (command p2) ;;;Continue pline command from current point to p2
   (setq d2 (+ d2 d1)) ;;;Increase distance d2 by d1
) ;;;End while
(command pe "") ;;;Pline to pe and finish command
)
;;;-------------------------------------------------------------
(defun C:C2P( / d1 ss oldos i e ans) ;;;Convert to Plines
(if (not d0) (setq d0 0.5)) ;;;Init dividual distance, global variable
(setq d1 (getreal (strcat "\nLength of 1 segment <" (rtos d0) ">:"))) ;;;Input distance
(if d1 (setq d0 d1) (setq d1 d0)) ;;;Reset or get distance
(setq
   ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))) ;;;Selection set
   oldos (getvar "osmode") ;;;Save osmode
   i 0 ;;;Init counter
)
(setvar "osmode" 0) ;;;Disable osmode
(repeat (sslength ss) ;;;Repeat for all entities in ss
   (setq e (ssname ss i)) ;;;Set e for entity with ordinal i in selection set ss
   (makepl e d1) ;;;Use makepl function. Make pline along e
   (setq i (1+ i)) ;;;Increase counter
)
(initget "Y N") ;;;Init keywords
(setq ans (getkword "\nDelete source objects? [Yes/No] :")) ;;;Get answer from user
(if (= ans "Y") (command "erase" ss "")) ;;;Erase source objects if ans = "y" or "Y"
(setvar "osmode" oldos) ;;;Reset osmode
(princ) ;;;Silent quit
)
;;;-------------------------------------------------------------

  • 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 các anh! Tiện đây các anh cho em hỏi các lệnh vl, vla, vlax mình có thể học ở đâu vậy? Và làm sao để biết tác dụng của các lệnh đó?

Từ nhiều nguồn: sách vở, bạn bè, internet... và theo mình, có 3 nguồn rất quan trọng (mức độ theo thứ tự sau):

1) Developer Help của AutoCAD. Với mỗi function họ đều ghi rõ công dụng, kiểu đối số, kiểu và giá trị return, kèm theo ví dụ cụ thể. Bạn có thể copy cú pháp của nó và paste trực tiếp vào dòng Command: của Acad, thử thay đổi các đối số và tự chiêm nghiệm kết quả. Bạn phải luyện khả năng đọc và thực hành theo Help mới có thể đi sâu và xa hơn trong cái món lập trình này.

Mẹo nhỏ: bạn có thể lặp lại các biểu thức lisp (cũng như các lệnh Acad) tại dòng command bằng cách dùng các phím mũi tên lên, xuống. Sau đó có thể sửa đổi, bổ sung theo ý đồ thử nghiệm, không cần phải gõ lại, tiết kiệm được khá nhiều thời gian.

2) Các bài thực hành của chính bạn. Chỉ có qua thực hành mới rèn được kỹ năng và hiểu sâu sắc hơn kiến thức thu lượm được

3) Các chương trình lisp đã post lên, cũng như các ý kiến trao đổi và phân tích tại CadViet

 

Chúc bạn đạt được nhiều kết quả như ý!

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
Chương trình hoàn chỉnh, "chơi" được hàng loạt đối tượng là Line, Pline, Spline, Arc, Circle và Ellipse, với chú giải chi tiết cho từng dòng code:

 

Cái này của bác SSG quả là chơi được tất cả các dạng ARC, SPLINE... và rất hay; nhưng bác SSG ơi SPLINE, ARC, CIRCLE, ELLIPSE thì kết quả là ổn còn nếu với PLINE vẽ theo dạng gấp khúc và với "khoảng chia" user đặt lớn lớn 1 chút thì tôi thấy sao ấy (ở các đoạn gãy khúc). Tôi upload file mẫu lên đây để bác xem nhé (chổ tôi khoanh tron).

http://www.cadviet.com/upfiles/Drawing1.dwg

Có thể loại bỏ điều đó không.

hì hì dùng cái này của SSG trong đo đạc để băm tim tuyến sau đó đi cắm mốc thì quá hay.

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ái này của bác SSG quả là chơi được tất cả các dạng ARC, SPLINE... và rất hay; nhưng bác SSG ơi SPLINE, ARC, CIRCLE, ELLIPSE thì kết quả là ổn còn nếu với PLINE vẽ theo dạng gấp khúc và với "khoảng chia" user đặt lớn lớn 1 chút thì tôi thấy sao ấy (ở các đoạn gãy khúc). Tôi upload file mẫu lên đây để bác xem nhé (chổ tôi khoanh tron).

http://www.cadviet.com/upfiles/Drawing1.dwg

Có thể loại bỏ điều đó không.

hì hì dùng cái này của SSG trong đo đạc để băm tim tuyến sau đó đi cắm mốc thì quá hay.

Chương trình hoạt động như sau: Bắt đầu từ điểm start của curve (thuật ngữ chỉ chung cho line, pline, spline, arc...), đo các đoạn liên tiếp nhau (dọc theo biên dạng của curve) bằng đúng khoảng chia (kc) do người dùng nhập, nối các điểm lại bằng pline.

Hiện tượng mà bạn "thấy sao ấy" là do chiều dài của các segment trong pline gốc của bạn không chia hết cho kc. Khi đến điểm gấp khúc, nó không quan tâm đến điểm đặc biệt này và vẫn "vô tư" đo tiếp cho đúng bằng kc (bạn kiểm tra lại kích thước sẽ thấy rõ).

Tóm lại là chương trình vẫn chạy đúng trong mọi trường hợp theo yêu cầu của bạn nokia. Chỉ có điều là không hợp với mục đích sử dụng của bạn thô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

Chương trình hoàn chỉnh, "chơi" được hàng loạt đối tượng là Line, Pline, Spline, Arc, Circle và Ellipse, với chú giải chi tiết cho từng dòng code:

 

;;;***********************************************************
;;;CONVERT TO PLINES PROGRAM WITH FULL COMMENTS!
;;;Convert all objects: Line, Pline, Spline, Arc, Circle, Ellipse_
;;;to Plines. Length of 1 segment is specified by user
;;;Copy code, Paste to Notepad, Save as *.lsp
;;;Call Appload command, Select *.lsp then Type C2P to run...
;;;Happy New Year 2008!
;;;Written by ssg - January 2008 - www.cadviet.com
;;;***********************************************************


;;;-------------------------------------------------------------
(defun makepl ( e d1 / ps pe d d2 p2) ;;;Make pline along curve e. Length of 1 segment = d1
(vl-load-com) ;;;Load Visual LISP extensions before use vlax-xxxx functions
(setq
ps (vlax-curve-getStartPoint e) ;;;Start point
pe (vlax-curve-getEndPoint e) ;;;End point
d (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e)) ;;;Length of curve e
d2 d1 ;;;Init variable distance
)
(command "pline") ;;;Call pline command
(command ps) ;;;Start point
(while (<= d2 d) ;;;While not over end point pe
(setq p2 (vlax-curve-getPointAtDist e d2)) ;;;Variable point at d2 = length along curve
(command p2) ;;;Continue pline command from current point to p2
(setq d2 (+ d2 d1)) ;;;Increase distance d2 by d1
) ;;;End while
(command pe "") ;;;Pline to pe and finish command
)
;;;-------------------------------------------------------------
(defun C:C2P( / d1 ss oldos i e ans) ;;;Convert to Plines
(if (not d0) (setq d0 0.5)) ;;;Init dividual distance, global variable
(setq d1 (getreal (strcat "\nLength of 1 segment <" (rtos d0) ">:"))) ;;;Input distance
(if d1 (setq d0 d1) (setq d1 d0)) ;;;Reset or get distance
(setq
ss (ssget '((0 . "LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))) ;;;Selection set
oldos (getvar "osmode") ;;;Save osmode
i 0 ;;;Init counter
)
(setvar "osmode" 0) ;;;Disable osmode
(repeat (sslength ss) ;;;Repeat for all entities in ss
(setq e (ssname ss i)) ;;;Set e for entity with ordinal i in selection set ss
(makepl e d1) ;;;Use makepl function. Make pline along e
(setq i (1+ i)) ;;;Increase counter
)
(initget "Y N") ;;;Init keywords
(setq ans (getkword "\nDelete source objects? [Yes/No] :")) ;;;Get answer from user
(if (= ans "Y") (command "erase" ss "")) ;;;Erase source objects if ans = "y" or "Y"
(setvar "osmode" oldos) ;;;Reset osmode
(princ) ;;;Silent quit
)
;;;-------------------------------------------------------------

mình dùng lisp này thì khi kết thúc lệnh đối tượng "đích" bị mất luôn.http://www.cadviet.com/upfiles/5/108637_library_cad.dwg

kết thúc lệnh chọn yes thì mất luôn đối tượng gốc, chọn no thì chỉ có đối tượng gốc, đối tượng đích thì k có.

ai giải thích giùm mình vớ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

mình dùng lisp này thì khi kết thúc lệnh đối tượng "đích" bị mất luôn.http://www.cadviet.com/upfiles/5/108637_library_cad.dwg

kết thúc lệnh chọn yes thì mất luôn đối tượng gốc, chọn no thì chỉ có đối tượng gốc, đối tượng đích thì k có.

ai giải thích giùm mình với.

Bạn thêm vào Lisp 2 dòng in đậm màu đỏ :) :

(defun C:C2P( / d1 ss oldos i e ans) ;;;Convert to Plines

(command "ucs" "w")

...................................

(command "ucs" "p")

(setvar "osmode" oldos) ;;;Reset osmode

(princ) ;;;Silent quit

)

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  

×