Hi,
Give this a go and let me know.
Code:
(defun c:Test (/ int sel lwp spc ent ins pts lst rtn hgt str )
;;----------------------------------------------------;;
;; Author : Tharwat Al Choufi ;;
;; website: https://autolispprograms.wordpress.com ;;
;;----------------------------------------------------;;
(and
(or (tblsearch "BLOCK" "Point")
(alert "Attributed Block Name < Point > was not found !")
)
(setq spc (getvar 'CTAB))
(or
(setq int -1
sel (ssget "_X"
(list '(0 . "INSERT")
'(66 . 1)
'(2 . "point")
(cons 410 spc)
)
)
)
(alert
(strcat
"No Attributed Block Name < Point > was not found inserted in this space < "
spc
" > !"
)
)
)
(princ "\nSelect Polyline to get numbers & area : ")
(or (setq lwp (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
(alert "Invalid object or nothing selected. Try again")
)
(or (foreach itm (entget (ssname lwp 0))
(and (= (car itm) 10)
(setq pts (cons (append (cdr itm) '(0.0)) pts))
)
)
t
)
(or
(while (setq int (1+ int)
ent (ssname sel int)
)
(setq ins (cdr (assoc 10 (entget ent))))
(vl-some
'(lambda (q)
(and
(equal q ins 1e-2)
(vl-some
'(lambda (at)
(and
(= (vla-get-tagstring at) "POINT")
(/= "" (setq rtn (vla-get-textstring at)))
(numberp (setq rtn (atoi (vla-get-textstring at)))
)
(setq lst (cons rtn lst))
)
)
(vlax-invoke
(vlax-ename->vla-object ent)
'GetAttributes
)
)
)
)
pts
)
)
t
)
(setq str ""
lst (vl-sort lst '<)
)
(foreach itm lst
(setq str (strcat str (itoa itm) " - "))
)
(setq str (strcat (vl-string-right-trim "- " str)
" = "
(rtos (vlax-curve-getarea (ssname lwp 0)) 2 2)
" sq.m."
)
)
(or (and (/= spc "Model")
(setq hgt 2.5)
)
(or (initget 6)
(setq hgt (getdist "\nSpecify text height : "))
)
)
(setq ins (getpoint "\nSpecify insertion point for Mtext : "))
(entmake (list '(0 . "MTEXT")
'(100 . "AcDbEntity")
'(100 . "AcDbMText")
(cons 7 (getvar 'TEXTSTYLE))
(cons 10 ins)
(cons 1 str)
(cons 40 hgt)
)
)
)
(princ)
) (vl-load-com)