Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
ductrunggtvt

Nhờ Sửa Lisp Tính Tổng Chiều Dài Đối Tượng

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

Hiện tại mình đang có lisp tính tổng chiều dài đối tượng line, Pline, tính xong thay thế giá trị vào 1 dtext đã có.

Bây giờ mình muốn tính chiều dài xong CỘNG và THAY THẾ vào dtext đã có. nhờ mọi người giúp đỡ

;----------------------------TG-tinh tong chieu dai doi tuong----------------------------------
(defun C:tg (/ tot_len ss e_name e_record e_type)
(princ "\nCADViet.com (c) 2007")
(setq tot_len 0.0)
(setq ss (ssget))
(if (null ss)
(exit))
(while (> (sslength ss) 0)
(setq e_name (ssname ss 0))
(setq e_record (entget e_name))
(setq e_type (cdr (assoc '0 e_record)))
(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
(command "lengthen" e_name "")
(setq tot_len (+ tot_len (getvar "PERIMETER")))
(ssdel e_name ss)
)
((wcmatch e_type "MLINE") (add_mline))
(e_type (ssdel e_name ss))
)
)
(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))
(setq tt (rtos tot_len 2 2))
(setq en (car (entsel "\nChon text thay so : ")))
(setq elst (entget en))
(setq elst (subst (cons 1 tt) (assoc 1 elst) elst))
;(setq elst (subst (cons 1 (strcat "L= " tt)) (assoc 1 elst) elst))
(setq elst (append elst '((62 . 4))));7 trang
(prin1 elst)
(entmod elst)
(princ)
)
(princ "\ntg - free lisp from www.cadviet.com")
(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

Đã sửa lại theo yêu cầu của bạn! Chúc vui vẻ!

 

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/166250-nho-sua-lisp-tinh-tong-chieu-dai-doi-tuong/
;----------------------------TG-tinh tong chieu dai doi tuong----------------------------------

(defun C:tg (/ tot_len ss e_name e_record e_type)

(princ "\nCADViet.com (c) 2007")

(setq tot_len 0.0)

(setq ss (ssget))

(if (null ss)

(exit))

(while (> (sslength ss) 0)

(setq e_name (ssname ss 0))

(setq e_record (entget e_name))

(setq e_type (cdr (assoc '0 e_record)))

(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")

(command "lengthen" e_name "")

(setq tot_len (+ tot_len (getvar "PERIMETER")))

(ssdel e_name ss)

)

((wcmatch e_type "MLINE") (add_mline))

(e_type (ssdel e_name ss))

)

)

(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))

(setq en (car (entsel "\nChon text thay so : ")))

(setq elst (entget en))

(setq gt (atof (cdr (assoc 1 elst))))

(setq tot_len (+ tot_len gt))

(setq tt (rtos tot_len 2 2))

(setq elst (subst (cons 1 tt) (assoc 1 elst) elst))

;(setq elst (subst (cons 1 (strcat "L= " tt)) (assoc 1 elst) elst))

(setq elst (append elst '((62 . 4))));7 trang

(prin1 elst)

(entmod elst)

(princ)

)

(princ "\ntg - free lisp from www.cadviet.com")

(princ)

;
  • 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

Đã sửa lại theo yêu cầu của bạn! Chúc vui vẻ!

 

;; free lisp from cadviet.com

;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/166250-nho-sua-lisp-tinh-tong-chieu-dai-doi-tuong/

;----------------------------TG-tinh tong chieu dai doi tuong----------------------------------

 

(defun C:tg (/ tot_len ss e_name e_record e_type)

 

(princ "\nCADViet.com (c) 2007")

 

(setq tot_len 0.0)

 

(setq ss (ssget))

 

(if (null ss)

 

(exit))

 

(while (> (sslength ss) 0)

 

(setq e_name (ssname ss 0))

 

(setq e_record (entget e_name))

 

(setq e_type (cdr (assoc '0 e_record)))

 

(cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")

 

(command "lengthen" e_name "")

 

(setq tot_len (+ tot_len (getvar "PERIMETER")))

 

(ssdel e_name ss)

 

)

 

((wcmatch e_type "MLINE") (add_mline))

 

(e_type (ssdel e_name ss))

 

)

 

)

 

(prompt (strcat "\nTotal length is: " (rtos tot_len 2 2)))

 

(setq en (car (entsel "\nChon text thay so : ")))

 

(setq elst (entget en))

 

(setq gt (atof (cdr (assoc 1 elst))))

 

(setq tot_len (+ tot_len gt))

 

(setq tt (rtos tot_len 2 2))

 

(setq elst (subst (cons 1 tt) (assoc 1 elst) elst))

 

;(setq elst (subst (cons 1 (strcat "L= " tt)) (assoc 1 elst) elst))

 

(setq elst (append elst '((62 . 4))));7 trang

 

(prin1 elst)

 

(entmod elst)

 

(princ)

 

)

 

(princ "\ntg - free lisp from www.cadviet.com")

 

(princ)

 

;

Cảm ơn bạn rất nhiều, đã sử dụng rất ok

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  

×