Polygon area LISP needs editing

Hello all, this is my first post so I hope I don't screw this up. My company uses a LISP routine to calculate areas of polygons in our drawings.

;; local defun
;; get center of closed object
(defun getcenter (obj / acsp cen rgn)
(setq acsp (vla-get-modelspace
     (vla-get-activedocument
       (vlax-get-acad-object)))
       rgn (car (vlax-invoke acsp 'Addregion (list obj)))
     cen (vlax-get rgn 'Centroid)
)
(vla-delete rgn)
cen
)
;; main part
;; label [plines w]/area field in sq. meters
(defun c:a3 (/ acsp adoc axss cpt ins ss txt mtxtobj)
 (vl-load-com)  
 (or adoc
     (setq adoc (vla-get-activedocument
    (vlax-get-acad-object)
  )
     )
 )
 (or acsp
     (setq acsp (vla-get-modelspace
    adoc
  )
     )
 )
 (if
 (setq ss (ssget (list (cons 0 "*POLYLINE,*CONTOUR"))))
 (progn
 (setq axss (vla-get-activeselectionset adoc))
 ;; iterate through the active selection set collection
 (vlax-for obj axss
        ; get a curve center
        (setq cpt (trans (getcenter obj) 0 1))  
 (setq txt
 ; displayed in meters to 3 decimal place: 
;;;  (strcat "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] "
;;;   (itoa (vlax-get obj 'ObjectID))
;;;   ">%).Area [url="file://\\f"]\\f[/url] \"%lu2%pr3%ps[, m2]%ct8[1e-006]\">%"
;;;  )
;;;  ; displayed in engineering to 2 decimal place: 
;;;        (strcat "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] "
;;;   (itoa (vlax-get obj 'ObjectID))
;;;   ">%).Area [url="file://\\f"]\\f[/url] \"%pr0%lu2%ct4%qf1\">%");<--pr2 means 2 decimal places, change to your suit
 ; displayed in engineering to 2 decimal place with addition SQ. FT.:
       (strcat "%<[url="file://\\AcObjProp"]\\AcObjProp[/url] Object(%<[url="file://\\_ObjId"]\\_ObjId[/url] "
  (itoa (vlax-get obj 'ObjectID))
  ">%).Area [url="file://\\f"]\\f[/url] \"%pr0%lu2%ct4%qf1 SQ. FT.\">%")
 )
; add mtext object to model space
(setq mtxtobj (vlax-invoke
       acsp 'AddMText
         cpt ;insertion point
       0.0 ; mtext width, optional = 0
 txt ;string (field value)
       ))
; change mtext height accordingly to current dimension style text height:
(vlax-put mtxtobj 'Height (getvar "dimtxt")); change (getvar "dimtxt") on text height you need
; set justifying to middle center
(vlax-put  mtxtobj  'AttachmentPoint acAttachmentPointMiddleCenter)  
      )      
    )
 )
    (vla-regen adoc acactiveviewport)
 (princ)
)
(princ "\n   Type A3 to label objects with area field")
(princ)

I have no idea where this code came from because it was here long before I was. Anyway, I do have some programming knowledge, but I'm having trouble figureing out what is going on here. What I'd like this routine to do is to lable an area at 1/4 of the actual area. That is, if the polygon is 100 sq. ft., I'd like the label to read "25 SQ. FT." Any ideas? Thanks for any help.

Imcgill2,

Welcome to Cadtutor.

In looking at the posted code the area is retrieved using a "Field Expression". The expression is stored in the txt variable. I don't see a way that you are able to retrieve the actual area to manipulate while still using this field expression method. Then again I am pretty rusty when it comes to using field expressions. There are, on the other hand, other ways to achieve what you are trying to do without using the field expressions.

I hope that this helps.

regards,

Hippe013

Welcome to CADTutor - and don't worry, you haven't screwed up

Give this a try:

(defun c:a3 ( / _center acdoc acspc acsel mObj ) (vl-load-com) ;; Lee Mac 2011

 (defun _center ( space obj / reg cen )
   (setq reg (car (vlax-invoke space 'addregion (list obj)))
         cen (vlax-get reg 'centroid)
   )
   (vla-delete reg)
   cen
 )

 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
 )

 (if (ssget '((0 . "*POLYLINE,*CONTOUR")))
   (progn
     (vlax-for obj (setq acsel (vla-get-ActiveSelectionSet acdoc))
       (setq mObj
         (vlax-invoke acspc 'AddMText (setq pt (trans (_center acspc obj) 1 0)) 0.0
           (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
             (itoa (vla-get-objectid obj)) ">%).Area \\f \"%lu2%pr0%ps[, SQ. FT.]%ct8[0.001736111111111111]\">%"
           )
         )
       )
       (vla-put-height mObj (getvar 'DIMTXT))
       (vla-put-attachmentpoint mObj acAttachmentPointMiddleCenter)
       (vlax-put mObj 'InsertionPoint pt)
     )
     (vla-delete acsel)
   )
 )

 (princ)
)

I've also fixed a few other things relating to changes in UCS etc.

Lee,

I was wondering if you had any sort of reference or could point to an area that explained the field expressions and how they are used.

regards,

Hippe013

I was wondering if you had any sort of reference or could point to an area that explained the field expressions and how they are used.

Hi Hippe,

I usually just use the Field command: I create the field I wish to use and take note of the field expression at the bottom of the dialog - it is usually clear how the various elements fit together after a bit of experimenting.

Lee

Wouldn't this be what he would need to decrease square footage by 1/4?

(defun c:a3 (/ _center acdoc acspc acsel mObj)
 (vl-load-com)

 (defun _center (space obj / reg cen)
   (setq reg (car (vlax-invoke space 'addregion (list obj)))
         cen (vlax-get reg 'centroid)
   )
   (vla-delete reg)
   cen
 )

 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       acspc (vlax-get-property
               acdoc
               (if (= 1 (getvar 'CVPORT))
                 'Paperspace
                 'Modelspace
               )
             )
 )

 (if (ssget '((0 . "*POLYLINE,*CONTOUR")))
   (progn
     (vlax-for obj (setq acsel (vla-get-ActiveSelectionSet acdoc))
       (setq mObj
              (vlax-invoke
                acspc
                'AddMText
                (setq pt (trans (_center acspc obj) 1 0))
                0.0
                (strcat "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId "
                        (itoa (vla-get-objectid obj))
                        ">%).Area \\f \"%lu2%pr0\">% / 4.) \\f \"%lu2%pr0%ps[, SQ FT.]\">%"
                )
              )
       )
       (vla-put-height mObj (getvar 'DIMTXT))
       (vla-put-attachmentpoint mObj acAttachmentPointMiddleCenter)
       (vlax-put mObj 'InsertionPoint pt)
     )
     (vla-delete acsel)
   )
 )

 (princ)
)

I suppose that would work as well - I just used a conversion factor instead of an expression.

I suppose that would work as well - I just used a conversion factor instead of an expression.

I was wondering what you were doing. I couldn't get yours to work.

Wouldn't this be what he would need to decrease square footage by 1/4?

 

(defun c:a3 (/ _center acdoc acspc acsel mObj)
 (vl-load-com)

 (defun _center (space obj / reg cen)
   (setq reg (car (vlax-invoke space 'addregion (list obj)))
         cen (vlax-get reg 'centroid)
   )
   (vla-delete reg)
   cen
 )

 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))
       acspc (vlax-get-property
               acdoc
               (if (= 1 (getvar 'CVPORT))
                 'Paperspace
                 'Modelspace
               )
             )
 )

 (if (ssget '((0 . "*POLYLINE,*CONTOUR")))
   (progn
     (vlax-for obj (setq acsel (vla-get-ActiveSelectionSet acdoc))
       (setq mObj
              (vlax-invoke
                acspc
                'AddMText
                (setq pt (trans (_center acspc obj) 1 0))
                0.0
                (strcat "%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId "
                        (itoa (vla-get-objectid obj))
                        ">%).Area \\f \"%lu2%pr0\">% / 4.) \\f \"%lu2%pr0%ps[, SQ FT.]\">%"
                )
              )
       )
       (vla-put-height mObj (getvar 'DIMTXT))
       (vla-put-attachmentpoint mObj acAttachmentPointMiddleCenter)
       (vlax-put mObj 'InsertionPoint pt)
     )
     (vla-delete acsel)
   )
 )

 (princ)
)

How to edit it to Sq m & Hectares togather at one time.

Hello,

Is it possible to have the same code giving the area in 2 decimals?

Thanks