Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
thiep

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

Bởi thiep , trong AutoLisp

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

thiep    367

thiep
Đã đăng

Tuynh:

Mình đưa file lên đây

http://www.cadviet.com/upfiles/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.

  • 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

Tuynh    1

Tuynh
Đã đăng
Tuynh:

Mình đưa file lên đây

http://www.cadviet.com/upfiles/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.

  • 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

Tuynh    1

Tuynh
Đã đăng

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.

  • 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

thiep    367

thiep
Đã đăng
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?

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

Tue_NV    3915

Tue_NV
Đã đăng
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 ((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  : ") ))
(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)
)

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

Tuynh    1

Tuynh
Đã đăng
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)
)

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

Tue_NV    3915

Tue_NV
Đã đăng
Mình gửi cho Bạn Thiep file số liệu http://www.cadviet.com/upfiles/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 (       (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

  • 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

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×