Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
2 replies to this topic

#1 ductrunggtvt

ductrunggtvt

    biết zoom

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

Đã gửi 10 October 2016 - 05:11 PM

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


  • 0

#2 hainguyen2014

hainguyen2014

    biết vẽ arc

  • Members
  • PipPip
  • 43 Bài viết
Điểm đánh giá: 12 (tàm tạm)

Đã gửi 10 October 2016 - 09:42 PM

Đã 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)

;


  • 1

#3 ductrunggtvt

ductrunggtvt

    biết zoom

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

Đã gửi 11 October 2016 - 08:46 AM

Đã 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


  • 0