Try this:
;Puts text with objects area in it unless it is 0.00*------Many thanks to the SWAMP.ORG for all the help
(defun c:rat (/ *error* u-clayer getboundingbox llc urc s1 index ent obj bbox mpt obj_area txt deltext a n)
(setq a 0)
(command ".undo" "begin")
(command ".style" "arial" "arial" "" "" "" "" "" "")
(prompt "\nARIAL is now the current text style")
(princ)
(vl-load-com)
;_____________________________
;Error function
;_____________________________
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function cancelled" "quit / exit abort" "")
)
)
(princ (strcat "\nError: " msg))
) ; if
(setvar 'clayer u-clayer)
(princ)
) ;end error function
;_____________________________
;Get User Variables
;_____________________________
(setq u-clayer (getvar 'clayer))
(if (tblsearch "layer" "area")
(command "-layer" "thaw" "area" "on" "area" "")
(princ "\n Layer 'area' Created")
)
(command ".-layer" "m" "area" "")
(defun getboundingbox (obj / minpt maxpt)
(vla-getboundingbox obj 'minpt 'maxpt)
(mapcar 'vlax-safearray->list (list minpt maxpt))
(setq llc (vlax-safearray->list minpt)
urc (vlax-safearray->list maxpt)
)
(list llc urc)
)
(if (setq sl (ssget '((0 . "LWPOLYLINE,CIRCLE,REGION,POLYLINE,ELLIPSE,SPLINE"))
)
)
(progn
(setq index -1)
(while (< (setq index (1+ index)) (sslength sl))
(setq ent (ssname sl index))
(setq obj (vlax-ename->vla-object ent))
(setq bbox (getboundingbox obj)
llc (car bbox)
urc (cadr bbox)
mpt (list (/ (+ (car llc) (car urc)) 2) (/ (+ (cadr llc) (cadr urc)) 2))
)
(setq obj_area (vlax-get-property obj 'area))
(setq txt (strcat (rtos obj_area)))
(command "text" "j" "mc" mpt (* (getvar "dimscale") 0.15) "0" txt)
(princ)
)
)
)
(setq deltext (setq s1 (ssget "x"'((0 . "Text")(8 . "area")(1 . "0.00*")))))
(command ".erase" deltext "")
(princ)
(*error* "")
(setvar 'clayer u-clayer)
(princ (strcat (itoa index) " entities processed..."))
(progn
(setq n (1- (sslength sl)))
(while (>= n 0)
(command "_.area" "_o" (ssname sl n))
(setq a (+ a (getvar "area"))
n (1- n)
)
)
(prompt (strcat "\n The TOTAL AREA of " (itoa index) " processed items = "
"\n" (rtos (/ a 1) 2 3)" sq. ft."
"\n" (rtos (/ a 43560) 2 3)" acres"
"\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
"\n" (rtos (/ a 144) 2 3)" - this number converted sq. inches to sq. feet (architectural units)"
"\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
"\n" "Be aware that unclosed polylines and splines"
"\n" "have an area too and will be accounted for if selected..."
)
)
(alert (strcat "\n The TOTAL AREA of " (itoa index) " processed items = "
"\n" (rtos (/ a 1) 2 3)" sq. ft."
"\n" (rtos (/ a 43560) 2 3)" acres"
"\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
"\n" (rtos (/ a 144) 2 3)" - this number converted sq. inches to sq. feet (architectural units)"
"\n~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
"\n" "Be aware that unclosed polylines and splines"
"\n" "have an area too and will be accounted for if selected..."
)
)
)
(princ)
(command ".undo" "end")
(princ)
)