[Nhờ Chỉnh Sửa] Lisp Đo Chiều Dài Và Ghi Text

[mitalead_kirk 3]

Mình đã tìm được lisp tính tổng chiều dài bằng cách pick liên tục nhiều điểm. Nhưng mình không muốn thay thế text mà ghi thành text mới theo stype có sẵn. Chiều dài được để ở giữa "L = .... m". Cảm ơn mọi người giúp đỡ.
http://www.cadviet.com/upfiles/5/146380_tinhtong_1.lsp

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/64116-yeu-cau-lisp-do-tong-khoang-cach-ab-cd-nam-tren-2-duong-pline-khac-nhau/
(defun c:tinhtong (/ L p1 p2 ll s1 olay)
(vl-load-com)
(setq olay (getvar "clayer"))
(setvar "clayer" "defpoints")
(setvar "cmdecho" 0)
(setq p1 (getpoint "chon diem")
L 0
ll (list p1))
(while (setq p2 (getpoint p1 "chon diem"))
(setq L ( + L (distance p1 p2)))
(setq ll (append ll (list p2)))
(setq p1 p2))
(acet-pline-make (list ll))
L
(entmod(subst (cons 1 (rtos L 2 2)) (assoc 1 (setq dt(entget(car(entsel "chontext"))))) dt))
(initget 1 "Y N")
(setq s1 (strcase(getkword "Co Xoa bo PL vua tao[Y,N]")))
(if (or (= s1 "")(= s1 "Y")) (entdel (entlast)))
(setvar "clayer" olay)
(setvar "cmdecho" 1)
)

[Tr.CongSon 42]

Mình đã tìm được lisp tính tổng chiều dài bằng cách pick liên tục nhiều điểm. Nhưng mình không muốn thay thế text mà ghi thành text mới theo stype có sẵn. Chiều dài được để ở giữa "L = .... m". Cảm ơn mọi người giúp đỡ.

 

Không biết cái "Stype" của anh kiểu gì  nên tạm sửa lại như vậy ^^

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from

;;; http://www.cadviet.com/forum/topic/150157-nha-cha-nh-sa-a-lisp-o-chia-u-da-i-va-ghi-text/

;; free lisp from cadviet.com

 

;;; this lisp was downloaded from

;;; http://www.cadviet.com/forum/topic/64116-yeu-cau-lisp-do-tong-khoang-cach-ab-cd-nam-tren-2-duong-pline-khac-nhau/

 

(defun c:tinhtong (/ L epline p1 p2 ll s1 olay)

(vl-load-com)

(setvar "cmdecho" 0)

(setq olay (getvar "clayer"))

 

(if (not (tblsearch "Layer" "Defpoints"))

(progn

(entmakex (list (cons 0 "POINT")

(cons 8 "Defpoints")

(cons 10 '(0.0 0.0 0.0))

)

)

(entdel (entlast))

)

)

(setvar "clayer" "defpoints")

 

(setq p1 (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m: ")

 

L 0

 

ll (list p1)

)

 

(while (setq p2 (getpoint p1 "\nCh\U+1ECDn \U+0111i\U+1EC3m: "))

 

(setq L (+ L (distance p1 p2)))

 

(setq ll (append ll (list p2)))

 

(setq p1 p2)

)

(acet-pline-make (list ll))

(setq epline (entlast))

(defun wtxt (txt p / sty d h)

(setq

sty (getvar "textstyle")

d (tblsearch "style" sty)

h (cdr (assoc 40 d))

)

(entmake (list (cons 0 "TEXT")

(cons 7 sty)

(cons 1 txt)

(cons 10 p)

(if (> h 0)

(cons 40 h)

(assoc 40 d)

)

(assoc 41 d)

)

)

)

(wtxt (strcat "L =" (rtos L 2 2) "m") (getpoint "\nCh\U+1ECDn \U+0111i\U+1EC3m ch\U+00E8n Text: "))

(initget 1 "Y N")

(setq s1 (strcase (getkword "\nC\U+00F3 x\U+00F3a b\U+1ECF Pline v\U+1EEBa t\U+1EA1o kh\U+00F4ng? [Y,N]")))

(if (or (= s1 "") (= s1 "Y"))

(entdel epline)

)

(setvar "clayer" olay)

(setvar "cmdecho" 1)

(princ)

)

 

Chúc vui !

[mitalead_kirk 3]

Quá ngon. Cảm ơn nhiều nha.... :wub: