Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
2 replies to this topic

#1 mitalead_kirk

mitalead_kirk

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 24 September 2015 - 02:25 PM

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.c..._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)
)


  • -2

#2 Tr.CongSon

Tr.CongSon

    biết lệnh array

  • Members
  • PipPipPip
  • 183 Bài viết
Điểm đánh giá: 40 (tàm tạm)

Đã gửi 24 September 2015 - 04:49 PM

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 !


  • 1

#3 mitalead_kirk

mitalead_kirk

    biết pan

  • Members
  • Pip
  • 7 Bài viết
Điểm đánh giá: -2 (bình thường)

Đã gửi 24 September 2015 - 04:58 PM

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


  • 0