Measuring area enclosed by a polyline

I can think at two ways: a solid hatch and regions.

Is it possible to make it write the area inside each closed polyline ?

If its possible within 1 hour from posting id be great. (deadlines)

This Lisp routine works fine for me.

After loaded, typ LA and pick internal point.

Area2 writes the area in squared meters.

Area3 writes the area in squared feet.

//Tobias

Area2.lsp

Area3.lsp

What about the AREA command? On the Inquiry toolbar... or under Tools/Inquiry/Area. Gives the circumference also.

Of course, I am in 2002, so maybe there's a better way now....

What about the AREA command? On the Inquiry toolbar... or under Tools/Inquiry/Area. Gives the circumference also.

 

Of course, I am in 2002, so maybe there's a better way now....

You are so right Crazy J.

But ezealor asked "Is it possible to make it write the area inside each closed polyline ?"

And that is what these lisp routines does.:wink:

See the picture.

//Tobias

Another, simpler:

(defun c:lta (/ *error* text ent pt)
 (vl-load-com)

 (defun *error* (msg)
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 
 (defun text (pt str)
   (entmakex (list (cons 0 "TEXT")
                   (cons 10 pt) (cons 40 (getvar 'TEXTSIZE))
                   (cons 1 str))))
 
 (while (setq ent (car (entsel)))

   (if (vl-catch-all-error-p
         (setq area (vl-catch-all-apply
                      (function vlax-curve-getArea) (list ent))))

     (princ "\n** Invalid Object **")
     (if (setq pt (getpoint "\nSelect Point for Text: "))
       (text pt (rtos area)))))
 
 (princ))

 

Great Lee!

Much easier. No messing around with layers an regions as the others that I had.

I know you are busy, but can you add so it writes the area in squared meters?

Im using this often so it would be great! If you got the time.....

//Tobias

Hey Tobias,

It will currently write it in whatever units you have set - not sure what conversion factor to use.

But assuming you are using 'mm'

(defun c:lta (/ *error* text ent pt)
 (vl-load-com)

 (defun *error* (msg)
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 
 (defun text (pt str)
   (entmakex (list (cons 0 "TEXT")
                   (cons 10 pt) (cons 40 (getvar 'TEXTSIZE))
                   (cons 1 str))))
 
 (while (setq ent (car (entsel)))

   (if (vl-catch-all-error-p
         (setq area (vl-catch-all-apply
                      (function vlax-curve-getArea) (list ent))))

     (princ "\n** Invalid Object **")
     (if (setq pt (getpoint "\nSelect Point for Text: "))
       (text pt (rtos (/ area 1000000.))))))
 
 (princ))

PS> Your other codes had the syntax 'la' this is also the alias for "Layer", it is not good practice to overwrite aliases in this way :wink:

I'm going to jump into this thread with not quite a hijack but a related question about this prog that I found to place area text in the drawing...

--------------------------------------------------------------------

;;; AreaText.LSP ver 2.0

;;; Select a polyline and where to place the text

;;; Sample result: 2888.89 SQ. FT.

;;; 2007-09-05 - First release

;;; 2009-08-02 - Updated to work in both modelspace and paperspace

;;; Uses TEXTSIZE for the text height

(defun c:AT (/ entObject entObjectID InsertionPoint ad)

(vl-load-com)

(setq entObject (vlax-ename->vla-object(car (entsel)))

entObjectID (vla-get-objectid entObject)

InsertionPoint (vlax-3D-Point (getpoint "Select point: "))

ad (vla-get-ActiveDocument (vlax-get-acad-object))

)

(vla-addMText (if (= 1 (vla-get-activespace ad))

(vla-get-modelspace ad)

(if (= (vla-get-mspace ad) :vlax-true)

(vla-get-modelspace ad)

(vla-get-paperspace ad)

)

)

InsertionPoint 0.0 (strcat

"%\\AcObjProp Object(%\\_ObjId "

(rtos entObjectID 2 0)

">%).Area \\f \"%pr2%lu2%ct4%qf1 SQ. FT.\">%"

))

)

-----------------------------------------------------

I'm running Acad2009 and my drawing units is set to feet. I placed a 100 x 100 box in the drawing in model space and kicked off the lisp... AT.

Invariably I get 69.44 sq ft. This value is obviously incorrect but is what one gets by dividing 10,000 by 144. (12x12) There has to be something going on here that I'm unaware of.

using this lisp found in this thread does return 10000, but I lack the insight to append the value with SF (square feet) or to do the same math to spit out A (acers).

--------------------------------------------------------------------

(defun c:lta (/ *error* text ent pt)

(vl-load-com)

(defun *error* (msg)

(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")

(princ (strcat "\n** Error: " msg " **")))

(princ))

(defun text (pt str)

(entmakex (list (cons 0 "TEXT")

(cons 10 pt) (cons 40 (getvar 'TEXTSIZE))

(cons 1 str))))

(while (setq ent (car (entsel)))

(if (vl-catch-all-error-p

(setq area (vl-catch-all-apply

(function vlax-curve-getArea) (list ent))))

(princ "\n** Invalid Object **")

(if (setq pt (getpoint "\nSelect Point for Text: "))

(text pt (rtos area)))))

(princ))

To append "SF" units, do this:

change the line:

(text pt (rtos area)))))

-to-

(text pt (strcat (rtos area) " SF"))))))

For acres it would take a little more to revise code to give user option of SF vs ACRES

Thanks, CarlB. The math would be SF / (or is it \?) 43560 or SF x 0.000022957

I just don't know how to work that in for the acres.

Anyone have a thought on how the two lisps that I had produce different values?

d

Thanks, CarlB. The math would be SF / (or is it \?) 43560 or SF x 0.000022957

 

I just don't know how to work that in for the acres.

 

Anyone have a thought on how the two lisps that I had produce different values?

 

d

It would be "/"

The code you posted that used a field had the units set to Architectural, so it could be there was a conversion taking place.

If you still want to use a field for this try this:

(defun c:lta  (/ *error* spc ent obj pt uFlag)
 (vl-load-com)
 
 (defun *error*  (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))
       
       spc  (if (zerop (vla-get-ActiveSpace *doc))
              (vla-get-PaperSpace *doc)
              (vla-get-ModelSpace *doc)))

 (while (setq ent (car (entsel)))
   
   (if (and (vlax-property-available-p
              (setq obj (vlax-ename->vla-object ent)) 'Area)
            (setq pt (getpoint "\nPick Point for Field: ")))
     (progn
       (setq uFlag (not (vla-StartUndoMark *doc)))

       (vla-AddMText spc (vlax-3D-point pt) 0.
         (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                 (itoa (vla-get-ObjectId obj)) ">%).Area \\f \"%lu6%qf1\">%"))

       (setq uFlag (vla-EndUndoMark *doc)))

     (princ "\n** Invalid Object Selected **")))

 (princ))

Or with " SF" suffix:

(defun c:lta  (/ *error* spc ent obj pt uFlag)
 (vl-load-com)
 
 (defun *error*  (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))
       
       spc  (if (zerop (vla-get-ActiveSpace *doc))
              (vla-get-PaperSpace *doc)
              (vla-get-ModelSpace *doc)))

 (while (setq ent (car (entsel)))
   
   (if (and (vlax-property-available-p
              (setq obj (vlax-ename->vla-object ent)) 'Area)
            (setq pt (getpoint "\nPick Point for Field: ")))
     (progn
       (setq uFlag (not (vla-StartUndoMark *doc)))

       (vla-AddMText spc (vlax-3D-point pt) 0.
         (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                 (itoa (vla-get-ObjectId obj))
                 ">%).Area \\f \"%lu6%qf1%ps[, SF]\">%"))

       (setq uFlag (vla-EndUndoMark *doc)))

     (princ "\n** Invalid Object Selected **")))

 (princ))

Acres:

(defun c:lta  (/ *error* spc ent obj pt uFlag)
 (vl-load-com)
 
 (defun *error*  (msg)
   (and uFlag (vla-EndUndomark *doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument
                            (vlax-get-acad-object))))
       
       spc  (if (zerop (vla-get-ActiveSpace *doc))
              (vla-get-PaperSpace *doc)
              (vla-get-ModelSpace *doc)))

 (while (setq ent (car (entsel)))
   
   (if (and (vlax-property-available-p
              (setq obj (vlax-ename->vla-object ent)) 'Area)
            (setq pt (getpoint "\nPick Point for Field: ")))
     (progn
       (setq uFlag (not (vla-StartUndoMark *doc)))

       (vla-AddMText spc (vlax-3D-point pt) 0.
         (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                 (itoa (vla-get-ObjectId obj))
                 ">%).Area \\f \"%lu6%qf1%ps[, Acres]%ct8[0.0000229568411]\">%"))

       (setq uFlag (vla-EndUndoMark *doc)))

     (princ "\n** Invalid Object Selected **")))

 (princ))

type LI or List at the command line and it will show the area.

type LI or List at the command line and it will show the area.

Unfortunately the OP wanted one that was cummulative. LI doesn't cut it.

LeeMac, I did some googling and tripped over a solution that allowed me to "see" how the FIELD thing worked. However, when I attempted to plug in the string that I generated I got errors. Formating or content I don't know. I'll try your suggestions.

If the FIELD solution integrated an architectural unit setting then that must have been the reason for the odd area value returned.

Thanks all for the help on my area/text questions...

I now return you to the OP!

In AutoCAD 2008 it has it listed in the properties, geometry section. You could also try the AREA command and select the polyline.