Đến nội dung


Hình ảnh
- - - - -

Lisp thay đổi độ cao node của PL-DONE


  • Please log in to reply
8 replies to this topic

#1 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 04 September 2009 - 04:40 PM

Tuynh:
Mình đưa file lên đây
http://www.cadviet.c...iles/2/2d3d.dwg
đường 2d poline có cao độ là 10, đường 3d poline có cao độ khác nhau tại các điểm point, bạn có lisp nào mà khi pick vào đường
2d poline thì tại các điểm point hiện cao độ cho mình nhập theo ý muốn và đường 2d poline chuyển thành 3d poline.

Chào Tuynh, lisp sau đây, yêu cầu Bạn pick các node của polyline sẽ biến 2D polyline thành 3D polyline. Sau đó bạn tiếp tục thay đổi độ cao các node của 3d polyline
;;; Lisp thay doi do cao cac node cua POLYLINE
;;; copyright by Thiep 7/2009
;;; yeu cau: cai dat day du Expresstools
;;;--------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;---------------------
(defun SAVE_MODE ()
(command "UCS" "W" "")
(setq OLD_OSMODE (getvar "OSMODE")
OLD_CECOLOR (getvar "CECOLOR")
OLD_AUTOSNAP (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
)
(setvar "cmdecho" 0)
(setvar "plinegen" 1)

)
(defun RESTORE ()
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(setvar "CECOLOR" OLD_CECOLOR)
(setvar "cmdecho" 1)
)
;;;--------------------------
;;;----------------------------------------
(defun 3DPoly (Lp *ModelSpace* / PntArr)
(setq PntArr (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length Lp)))
)
)
(vlax-safearray-fill PntArr Lp)
(vla-Add3Dpoly *ModelSpace* PntArr)
)
;;;-----------------------------------
(vl-load-com)
(defun c:3dp (/ ActDoc *Model* wp lwp Obj n pn pcl Pe lstP Elev lt lstN)
(SAVE_MODE)
(setvar "osmode" 1)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
)
(while (setq pn (getpoint "\nPick a point on Polyine: "))
(setq lwp (ssname (ssget pn) 0))
(redraw lwp 3)
(setq heinode (getreal "\nEnter height of node: ")
obj (vlax-ename->vla-object lwp)
lstP (ACET-GEOM-VERTEX-LIST lwp)
)
(if (eq (dxf 0 lwp) "LWPOLYLINE")
(progn
(setq Elev (vla-get-Elevation obj))
(setq lstN nil)
(foreach lt lstP
(if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
(setq lt (list (car lt) (cadr lt) heinode))
(setq lt (list (car lt) (cadr lt) Elev))
)
(setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
)
(progn
(setq lstP (ACET-GEOM-VERTEX-LIST lwp))
(setq lstN nil)
(foreach lt lstP
(if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
(setq lt (list (car lt) (cadr lt) heinode))
)
(setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
)
)
)
(RESTORE)
(princ "\nChuc cac ban vui ve! Thiep")
(princ)
)

Tuy nhiên, nếu bạn thay đổi 1 polyline có hàng 100 node thì nên dùng cách khác nhanh hơn: Dùng bảng kê tọa độ trong Excel đổi qua đuôi *.csv, sau đó xây dựng 1 3D polyline theo 1 lisp khác.
  • 1

#2 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 07 September 2009 - 10:31 AM

Tuynh:
Mình đưa file lên đây
http://www.cadviet.c...iles/2/2d3d.dwg
đường 2d poline có cao độ là 10, đường 3d poline có cao độ khác nhau tại các điểm point, bạn có lisp nào mà khi pick vào đường
2d poline thì tại các điểm point hiện cao độ cho mình nhập theo ý muốn và đường 2d poline chuyển thành 3d poline.

Chào Tuynh, lisp sau đây, yêu cầu Bạn pick các node của polyline sẽ biến 2D polyline thành 3D polyline. Sau đó bạn tiếp tục thay đổi độ cao các node của 3d polyline

;;; Lisp thay doi do cao cac node cua POLYLINE
;;; copyright by Thiep 7/2009
;;; yeu cau: cai dat day du Expresstools
;;;--------------------------
(defun DXF (code en) (cdr (assoc code (entget en))))
;;;---------------------
(defun SAVE_MODE ()
(command "UCS" "W" "")
(setq OLD_OSMODE (getvar "OSMODE")
OLD_CECOLOR (getvar "CECOLOR")
OLD_AUTOSNAP (getvar "AUTOSNAP")
OLD_ORTHOMODE (getvar "ORTHOMODE")
)
(setvar "cmdecho" 0)
(setvar "plinegen" 1)

)
(defun RESTORE ()
(setvar "osmode" OLD_OSMODE)
(setvar "AUTOSNAP" OLD_AUTOSNAP)
(setvar "ORTHOMODE" OLD_ORTHOMODE)
(setvar "CECOLOR" OLD_CECOLOR)
(setvar "cmdecho" 1)
)
;;;--------------------------
;;;----------------------------------------
(defun 3DPoly (Lp *ModelSpace* / PntArr)
(setq PntArr (vlax-make-safearray
vlax-vbDouble
(cons 0 (1- (length Lp)))
)
)
(vlax-safearray-fill PntArr Lp)
(vla-Add3Dpoly *ModelSpace* PntArr)
)
;;;-----------------------------------
(vl-load-com)
(defun c:3dp (/ ActDoc *Model* wp lwp Obj n pn pcl Pe lstP Elev lt lstN)
(SAVE_MODE)
(setvar "osmode" 1)
(setq ActDoc (vla-get-ActiveDocument (vlax-get-acad-object))
*Model* (vla-get-ModelSpace ActDoc)
)
(while (setq pn (getpoint "\nPick a point on Polyine: "))
(setq lwp (ssname (ssget pn) 0))
(redraw lwp 3)
(setq heinode (getreal "\nEnter height of node: ")
obj (vlax-ename->vla-object lwp)
lstP (ACET-GEOM-VERTEX-LIST lwp)
)
(if (eq (dxf 0 lwp) "LWPOLYLINE")
(progn
(setq Elev (vla-get-Elevation obj))
(setq lstN nil)
(foreach lt lstP
(if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
(setq lt (list (car lt) (cadr lt) heinode))
(setq lt (list (car lt) (cadr lt) Elev))
)
(setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
)
(progn
(setq lstP (ACET-GEOM-VERTEX-LIST lwp))
(setq lstN nil)
(foreach lt lstP
(if (and (eq (car lt) (car pn)) (eq (cadr lt) (cadr pn)))
(setq lt (list (car lt) (cadr lt) heinode))
)
(setq lstN (append lt lstN))
)
(vla-update (3DPoly lstN *Model*))
(vla-delete obj)
)
)
)
(RESTORE)
(princ "\nChuc cac ban vui ve! Thiep")
(princ)
)

Tuy nhiên, nếu bạn thay đổi 1 polyline có hàng 100 node thì nên dùng cách khác nhanh hơn: Dùng bảng kê tọa độ trong Excel đổi qua đuôi *.csv, sau đó xây dựng 1 3D polyline theo 1 lisp khác.


  • 1

#3 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 07 September 2009 - 10:43 AM

Chào bạn Thiep minh rất vui khi bạn viết cho mình một Lisp thay doi do cao cac node cua POLYLINE, đúng như bạn nói đường polyline của mình có tới vài trục các node làm như thế quả là lâu thật, theo ý bạn thì phải chuyển toạ độ ra excell và xây dựng một lisp khác là như thế nào bạn có thể hướng dẫn chi tiết hơn được không. Nhân tiện cho mình hỏi là lisp trên bạn có thể sửa được là khi Pick a point on Polyine: thì các node tự động chuyển đến để ta có thể thêm cao độ vào các node và nếu các node hiện lên cao độ dạng text thì càng tốt lúc đầu là 0.00 sau đó tuỳ người dùng chỉnh sửa. Rất cảm ơn bạn.
  • 1

#4 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 07 September 2009 - 11:08 AM

Chào bạn Thiep minh rất vui khi bạn viết cho mình một Lisp thay doi do cao cac node cua POLYLINE, đúng như bạn nói đường polyline của mình có tới vài trục các node làm như thế quả là lâu thật, theo ý bạn thì phải chuyển toạ độ ra excell và xây dựng một lisp khác là như thế nào bạn có thể hướng dẫn chi tiết hơn được không. Nhân tiện cho mình hỏi là lisp trên bạn có thể sửa được là khi Pick a point on Polyine: thì các node tự động chuyển đến để ta có thể thêm cao độ vào các node và nếu các node hiện lên cao độ dạng text thì càng tốt lúc đầu là 0.00 sau đó tuỳ người dùng chỉnh sửa. Rất cảm ơn bạn.

Chào Tuynh,
Bạn hãy tạo 1 ví dụ bảng excel chứa dữ liệu, gồm n cột, trong đó phải có 4 cột: tên node, X, Y, Z. Dữ liệu có hàng chục điểm như bạn nói hoặc nhiều hơn nữa. Upload lên, và Thiep sẽ gửi cho bạn 1 lisp tạo đường 3Dpolyline.
Còn ý tưởng 2: có phải bạn muốn nói thêm node trên polyline không? chứ các node tự động chuyển đến là sao?
Chỉ thêm text độ cao tại vị trí thêm node trên polyline hay thêm text toàn bộ các node của polyline?
  • 0

#5 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 07 September 2009 - 01:16 PM

bạn có thể sửa được là khi Pick a point on Polyine: thì các node tự động chuyển đến để ta có thể thêm cao độ vào các node và nếu các node hiện lên cao độ dạng text thì càng tốt lúc đầu là 0.00 sau đó tuỳ người dùng chỉnh sửa. Rất cảm ơn bạn.

Lisp này viết theo ý của bạn. Hy vọng bạn hài lòng :

(defun c:2d3d(/ curve pre i p lstdiem z lstpoint x xo)
(vl-load-com)
(setvar "orthomode" 0)
(setvar "cmdecho" 0)
(setq curve (car(entsel "\n Pick chon POlyline 2D hoac Polyline 3D :")))
(setq pre (vlax-curve-getEndParam curve) i 0 lstdiem '() lstpoint '())

(while (<= i pre)
(setq p (vlax-curve-getPointAtParam curve i))
(setq lstdiem (append lstdiem (list p)))
(setq i (1+ i))
)

(setq i 0)
(foreach x lstdiem
(setq xo (caddr x))
(setq z (getdist x (strcat "\n Nhap cao do cho diem nay <" (rtos xo 2 2) "> : ") ))
(setq lstpoint (append lstpoint (list(list (car x) (cadr x) z))))
(setq i (1+ i))
)

(command "3dpoly"
(foreach x lstpoint (command x)))
(entdel curve)
(princ)
)

  • 0

#6 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 07 September 2009 - 03:26 PM

Lisp này viết theo ý của bạn. Hy vọng bạn hài lòng :


(defun c:2d3d(/ curve pre i p lstdiem z lstpoint x xo)
(vl-load-com)
(setvar "orthomode" 0)
(setvar "cmdecho" 0)
(setq curve (car(entsel "\n Pick chon POlyline 2D hoac Polyline 3D :")))
(setq pre (vlax-curve-getEndParam curve) i 0 lstdiem '() lstpoint '())

(while (<= i pre)
(setq p (vlax-curve-getPointAtParam curve i))
(setq lstdiem (append lstdiem (list p)))
(setq i (1+ i))
)

(setq i 0)
(foreach x lstdiem
(setq xo (caddr x))
(setq z (getdist x (strcat "\n Nhap cao do cho diem nay <" (rtos xo 2 2) "> : ") ))
(setq lstpoint (append lstpoint (list(list (car x) (cadr x) z))))
(setq i (1+ i))
)

(command "3dpoly"
(foreach x lstpoint (command x)))
(entdel curve)
(princ)
)


  • 0

#7 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 07 September 2009 - 03:34 PM

Cám ơn bạn Tuệ Lisp cũng hay nhưng đến node cuối thì bị lỗi
; error: bad argument type: numberp: nil
nhưng ý mình là như này:
Đây là file http://www.cadviet.c.../drawing1_3.dwg
  • 0

#8 Tuynh

Tuynh

    biết vẽ arc

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

Đã gửi 07 September 2009 - 03:49 PM

Mình gửi cho Bạn Thiep file số liệu http://www.cadviet.c...s/2/so_lieu.txt bạn hướng dẫn mình được không.
còn ý mình là như này
đây là file
http://www.cadviet.c.../drawing1_4.dwg
  • 0

#9 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 07 September 2009 - 04:34 PM

Mình gửi cho Bạn Thiep file số liệu http://www.cadviet.c...s/2/so_lieu.txt bạn hướng dẫn mình được không.

Chào Tuynh
Mạn phép bác Hoành cho phép Tue_NV chỉnh lại Code của bác để giúp cho bạn Tuynh
@Tuynh : Chạy Lisp sau -> Chọn File txt của bạn -> sẽ được kết quả

(defun c:imppnt ( / fn fid strht vt n x y z lis cao)
(defun pos (sub st / l1 l2 index)
(setq index 1
l1 (strlen sub)
l2 (strlen st)
)
(while
(and (<= (+ index l1 -1) l2) (/= sub (substr st index l1)))
(setq index (1+ index))
)
(if (= sub (substr st index l1))
index
nil
)
)
(princ "\neiPoint © 2007 Cadviet.com")
(setq fn (getfiled "Ten tep de nhap toa do x y z"
(getvar "dwgprefix")
"txt"
2
)
fid (open fn "r")
lis nil
)

(while (setq strht (read-line fid))
(setq strht (strcat strht "\t\t\t"))
(if (/= strht " ")
(progn
(setq
vt (pos "\t" strht)
n (atof (substr strht 1 (1- vt)))
strht (substr strht (1+ vt))
vt (pos "\t" strht)
x (atof (substr strht 1 (1- vt)))
strht (substr strht (1+ vt))
vt (pos "\t" strht)
y (atof (substr strht 1 (1- vt)))
strht (substr strht (1+ vt))
vt (pos "\t" strht)
z (atof (substr strht 1 (1- vt)))
)
(setq lis (append lis (list(list n x y z))))


)
)
)
(close fid)

(Command "3dpoly")
(foreach x lis (command (cdr x)))
(command "")
(setq cao (getdist "\n Chon chieu cao chu :"))
(foreach x lis (wtxt (rtos (car x) 2 0) (cdr x) 0 cao))

)
;
(defun wtxt (txt p ang h / sty)
(setq sty (getvar "textstyle"))
(entmake (list (cons 0 "TEXT") (cons 7 sty)
(cons 1 txt) (cons 10 p) (cons 11 p)
(cons 72 2) (cons 73 2) (cons 50 ang)
(cons 40 h) (cons 41 0.8))
)
)

Có gì chưa được hãy post lên đây. Tue_NV sẽ chỉnh lại giúp bạn
  • 1