lisp tính trung bình các đoạn thẳng,các số được chọn ( lệnh tbs và snn)

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/topic/38453-yeu-cau-viet-lisp-tinh-chieu-dai-trung-binh-cua-nhieu-doan-thang/


(defun add_mline ()

 (foreach e_record_sub e_record

   (cond ((= 10 (car e_record_sub))

  (setq pt1   (cdr e_record_sub)

mline_len 0.0

  )

 )

 ((= 11 (car e_record_sub))

  (setq pt2   (cdr e_record_sub)

mline_len (+ mline_len (distance pt2 pt1))

pt1   pt2

  )

 )

   )

 )

 (setq tot_len (+ tot_len mline_len))

 (ssdel e_name ss)

)



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

(grtext -1 "Free from cadviet.com @ketxu")

(setq k (getvar "dimlfac"))

 (setq tot_len 0.0)

 (setq ss (ssget))

 (setq len (sslength ss))

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

   )

 )

(setq tot_len (* k tot_len))

(setq tbinh (/ tot_len len))

 (alert (rtos tbinh 2 2))

)


(defun c:snn ()
(prompt "\nChon text de tinh trung binh cong:")
(setq ss (ssget '((0 . "TEXT")))
sl (sslength ss)
kqua 0
)
(while (and ss (> (sslength ss) 0))
(setq
kqua (+ kqua
(atof (cdr (assoc 1 (entget (setq ent (ssname ss 0))))))
)
)
(ssdel ent ss)
)
(setq kqua (rtos (/ kqua sl) 2 2))
(if (/= (substr kqua 1 1) "-") (setq kqua (strcat "+" kqua)))
(princ kqua)

(setq obj (vlax-ename->vla-object
(car (entsel "\nChon text de ghi ket qua:"))
)
)
(vla-put-TextString obj kqua)
)

Tôi đang dùng lisp này đối với text :

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/13750-lisp-t%C3%ADnh-gi%C3%A1-tr%E1%BB%8B-trung-b%C3%ACnh-c%E1%BB%A7a-c%C3%A1c-text/
;;ham tao text
(defun mktext (point height string justify layer textstyle mau / lst)
(setq lst (list '(0 . "TEXT")
(cons 10 point)
(cons 40 height)
(cons 1 string)
(cons 8 layer)
(cons 7 textstyle)
(cons 62 mau)
)
justify (strcase justify))
(cond ((= justify "L") (setq Lst (append Lst (list (cons 72 0) (cons 11 point)))))
((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))
((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))
((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))
)
(entmakex Lst)
) ;end mktext
;;;;
(defun C:tbcc(/ c tong oldob oldos txtstr realk mastyle malayer xtext num gstyle glayer tam tong tbc p ss)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq ss (ssget '((0 . "TEXT") (1 . "~*@*"))))
(setq c 0 tong 0)
(if (/= ss nil)
(while (< c (sslength ss))
(setq oldob (entget (ssname ss c)))
(setq txtstr (assoc 1 oldob))
(setq realk (assoc 40 oldob))
(setq mastyle (assoc 7 oldob))
(setq malayer (assoc 8 oldob))
(if (/= txtstr nil)
(progn
(setq ctext (cdr realk))
(setq num (cdr txtstr))
(setq gstyle (cdr mastyle))
(setq glayer (cdr malayer))
(setq tam (atof num))
(setq tong (+ tong tam))
(setq tbc (/ tong (sslength ss)))
);progn
);if
(setq c (1+ c))
);while
);if
(setq p (getpoint "\nNhap vi tri xuat ket qua: "))
(if (= tbc 0)
(mktext p ctext (rtos tbc 2 0) "L" glayer gstyle 1)
(mktext p ctext (rtos tbc 2 3) "L" glayer gstyle 1)
)
(setvar "cmdecho" 1)
(setvar "osmode" oldos)
(princ)
)
(prompt "ten lenh : tbcc")


Nguồn bài viết : https://www.cadviet.com/forum/topic/13750-lisp-t%C3%ADnh-gi%C3%A1-tr%E1%BB%8B-trung-b%C3%ACnh-c%E1%BB%A7a-c%C3%A1c-text/