Change the fonction c:are with this
(defun c:are ( / doc space ss n en obj objname pt ptlst enlst olden lst newen chlst sum sumlen val
sp ep cplst area len cdn mp v sa xp yp pt arlst chlst L1 L2 a b txtobj cnt table)
(vl-load-com)
(setq doc (vla-get-activedocument(vlax-get-acad-object)))
(setq space (if (= (getvar "cvport") 1)(vla-get-paperspace doc)(vla-get-modelspace doc)))
(if (not (setq ss (ssget '((0 . "line,lwpolyline,circle,ellipse,region"))))) (exit))
(setq $sn (memory "decimal point" 2 $sn))
(setq $tsz (memory "textsize" 10 $tsz))
(setq n 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (setq en (ssname ss n))))
(setq objname (vla-get-objectname obj))
(if (equal objname "AcDbLine")
(progn
(setq pt (list (vlax-get obj 'startpoint) (vlax-get obj 'endpoint)))
(setq ptlst (append ptlst (list pt)))
(setq enlst (cons en enlst))
)
)
(setq n (1+ n))
)
(if enlst
(progn
(foreach x enlst (setq ss (ssdel x ss)))
(setq olden (getenlst nil))
(foreach x (connectlst ptlst)
(if (equal (distance (car x) (last x)) 0 0.1)
(progn
(setq lst (apply 'append (mapcar '(lambda (z) (list (car z) (cadr z))) x)))
(vla-addlightweightpolyline space (vlax-make-variant (vlax-safearray-fill
(vlax-make-safearray vlax-vbdouble (cons 0 (- (length lst) 1))) lst)))
)
)
)
(setq newen (getenlst nil))
(setq chlst (makelst olden newen))
(foreach x chlst (setq ss (ssadd x ss)))
)
)
(setq n 0 sum 0 sumlen 0 val (/ 2.0 3.0))
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss n)))
(setq objname (vla-get-objectname obj))
(if (equal objname "AcDbPolyline")
(progn
(setq sp (vlax-curve-getstartpoint obj) ep (vlax-curve-getendpoint obj) cplst nil)
(if (equal (distance sp ep) 0 0.1) (vla-put-closed obj :vlax-true))
(if (vlax-curve-isclosed obj)
(progn
(setq area (rtos (* (vla-get-area obj) 0.000001) 2 $sn))
(setq len (rtos (* (vla-get-length obj) 0.001) 2 $sn))
(setq cdn (append (cdr (divlst (vlax-get obj 'coordinates) 2)) (list sp)))
(foreach x cdn
(setq mp (polar sp (angle sp x) (/ (distance sp x) 2)))
(setq v (/ (- (* (car sp) (cadr x)) (* (cadr sp) (car x))) 2))
(setq cplst (append cplst (list (list (car mp) (cadr mp) v))) sp x)
)
(setq sa (apply '+ (mapcar '(lambda (x) (caddr x)) cplst)))
(setq xp (apply '+ (mapcar '(lambda (x) (* (car x) (/ (* (caddr x) val) sa))) cplst)))
(setq yp (apply '+ (mapcar '(lambda (x) (* (cadr x) (/ (* (caddr x) val) sa))) cplst)))
(setq pt (list xp yp))
(setq arlst (append arlst (list (list pt area len))))
)
)
)
(progn
(setq area (rtos (* (vla-get-area obj) 0.000001) 2 $sn))
(setq len (rtos (* (vla-get-length obj) 0.000001) 2 $sn))
(if (equal objname "AcDbRegion")
(setq pt (append (vlax-get obj 'centroid) (list 0.0)))
(setq pt (vlax-get obj 'center))
)
(setq arlst (append arlst (list (list pt area len))))
)
)
(setq n (1+ n))
)
(if chlst (foreach x chlst (vla-delete (vlax-ename->vla-object x))))
(setq arlst(vl-sort arlst (function(lambda (a b)(> (cadar a)(cadar b))))))
(setq L2 nil)
(while arlst
(setq a(car arlst)arlst(cdr arlst))
(foreach x arlst
(if (equal (cadar a)(cadar x) 1e-04)
(setq L1(cons x L1))
(setq b(cons x b))
)
)
(setq L1(cons a L1))
(setq L1(vl-sort L1 (function(lambda (a b)(< (caar a)(caar b))))))
(setq L2(append L2 L1))
(setq arlst (reverse b))
(setq b nil)
(setq L1 nil)
)
(setq n 1)
(foreach x L2
(setq pt (vlax-3d-point (car x)))
;(setq txtobj (vla-addtext space (strcat (rtos n) " : " (cadr x)) pt $tsz)) ;no number (strcat (rtos n) " : " (cadr x)) ¢¡ (cadr x); ¿øº»
(setq txtobj (vla-addtext space (strcat (rtos n 2 0) ") area(M2) : " (cadr x)) pt $tsz)) ;no number (strcat (rtos n) " : " (cadr x)) ¢¡ (cadr x)
(vla-put-alignment txtobj 4)
(vla-put-textalignmentpoint txtobj pt)
(vla-update txtobj)
(setq txtobj (vla-addtext space (strcat (rtos n 2 0) ") length(M) : " (caddr x)) (vlax-3d-point (polar (car x) (- (* 0.5 pi)) (* 1.5 $tsz))) $tsz))
(vla-put-alignment txtobj 4)
(vla-put-textalignmentpoint txtobj (vlax-3d-point (polar (car x) (- (* 0.5 pi)) (* 1.5 $tsz))))
(vla-update txtobj)
(setq n (1+ n))
)
(if (not (equal (setq sum (rtos (apply '+ (mapcar '(lambda (x) (atof (cadr x))) L2)) 2 $sn)) "0"))
(progn
(setq sumlen (rtos (apply '+ (mapcar '(lambda (x) (atof (caddr x))) L2)) 2 $sn))
(setq cnt (length L2) n 2)
(if (setq pt (getpoint "\n>> table point :"))
(progn
(setq table (vla-addtable space (vlax-3d-point pt) (+ cnt 3) 3 (* $tsz 2) (* $tsz 10)))
(vla-settext table 0 0 "Area Table")
(vla-settext table 1 0 "No.")
(vla-settext table 1 1 "(M2)")
(vla-settext table 1 2 "(M)")
(vla-settext table (+ cnt 2) 0 "Total")
(vla-settext table (+ cnt 2) 1 sum)
(vla-settext table (+ cnt 2) 2 sumlen)
(foreach x L2
(vla-settext table n 0 (itoa (- n 1)))
(vla-settext table n 1 (cadr x))
(vla-settext table n 2 (caddr x))
(setq n (1+ n))
)
(setq n 0)
(repeat (+ cnt 3)
(vla-setcelltextheight table n 0 $tsz)
(vla-setcellalignment table n 0 5)
(vla-setcelltextheight table n 1 $tsz)
(vla-setcellalignment table n 1 5)
(vla-setcelltextheight table n 2 $tsz)
(vla-setcellalignment table n 2 5)
(setq n (1+ n))
)
(vla-setcolumnwidth table 0 (* $tsz 6))
)
)
)
)
(princ)
)
