Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

Calculate area in Meter Square

Anonymous

Calculate area in Meter Square

Anonymous
Not applicable
‎10-26-2016 02:39 AM 
This lisp is used to Calculate the area of an object in square feet.

1. Please Edit it to calculate in Square meter.
2. Please Edit it to calculate for multiple objects.


;;; AreaText.LSP ver 3.0
;;; Command name is AT
;;; Select a polyline and where to place the text
;;; Sample result: 2888.89 SQ. FT.
;;; As this is a FIELD it is updated based on the FIELDEVAL
;;; or the settings found in the OPTIONS dialog box

;;; By Jimmy Bergmark
;;; Copyright (C) 2007-2010 JTB World, All Rights Reserved
;;; Website: www.jtbworld.com
;;; E-mail: info@jtbworld.com
;;; 2007-09-05 - First release
;;; 2009-08-02 - Updated to work in both modelspace and paperspace
;;; 2010-10-29 - Updated to work also on 64-bit AutoCAD

;;; Uses TEXTSIZE for the text height

(defun Get-ObjectIDx64 (obj / util)
  (setq util (vla-get-Utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
  (if (= (type obj) 'VLA-OBJECT)
    (if (> (vl-string-search "x64" (getvar "platform")) 0)
      (vlax-invoke-method util "GetObjectIdString" obj :vlax-False)
      (rtos (vla-get-objectid obj) 2 0)
    )
  )
)

(defun c:AT (/ entObject entObjectID InsertionPoint ad)
  (vl-load-com)
  (setq entObject (vlax-ename->vla-object(car (entsel)))
        entObjectID (Get-ObjectIDx64 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 "
  entObjectID
  ">%).Area \\f \"%pr2%lu2%ct4%qf1 SQ. FT.\">%"
  ))
)

 

 

 

 

 

 

 

Report
Reply
Report
Accepted solutions (1)
Solution 1
7,060 Views
13 Replies
Replies (13)

ВeekeeCZ
Consultant
Consultant
‎10-26-2016 03:07 AM

You can try this one... from my archive..

 

Spoiler
(defun c:PLArea  (/ acsp ss e ptList ID StrField txt p)
  (vl-load-com)
  (command "_.undo" "_be")
  (setq  acsp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (if (setq ss (ssget ;(progn
			;(initget 1 "Y N")
                        ;(setq ans (getkword "\nProcess All Polylines [Yes/No]: "))
			;(if (eq "Y" ans)
			  ;"_X"
			  ":L";))
		      '((0 . "*POLYLINE")			
                        ;(8 . "A-AREA-BDRY")
                        (-4 . "&")
                        (70 . 1)(410 . "Model"))))
    (repeat (sslength ss)
            (setq e     (ssname ss 0)
                  sum   '(0 0)
                  verts (cdr (assoc 90 (entget e))))
            (setq ptList
                       (mapcar 'cdr
                               (vl-remove-if-not
                                     '(lambda (x) (= (car x) 10))
                                     (entget e))))
            (foreach x ptList (setq sum (mapcar '+ x sum)))
            (setq ID (itoa (vla-get-objectid (vlax-ename->vla-object e))))
            (setq StrField
                       (strcat "%<\\AcObjProp Object(%<\\_ObjId "
			       ID
			       ">%).Area \\f \"%lu2\">%"))
            (vla-put-AttachmentPoint
                  (setq txt (vla-addMText
                                  acsp
                                  (setq p (vlax-3d-point
                                                   (mapcar '/ sum
                                                         (list verts
                                                               verts))))
                                  0  StrField))
                  acAttachmentPointMiddleCenter)
            (vla-put-InsertionPoint txt p)
            (ssdel e ss)
            )(princ "\0 Objects found:"))
  (command "_.undo" "_e")
  (princ)
)

Just be careful if you have some more complex shapes (typically "C" shape) -- label may be outside the closed area.

Report
0 Likes

Anonymous
Not applicable
in reply to ВeekeeCZ
‎10-26-2016 03:30 AM

Yes,

This is what i wanted exactly, Thanks

Can you add Unit "m2" For me in this lisp?

Report
0 Likes

ВeekeeCZ
Consultant
Consultant
in reply to Anonymous
‎10-26-2016 04:32 AM
@Anonymous wrote:

Yes,

This is what i wanted exactly, Thanks

Can you add Unit "m2" For me in this lisp?

ok...

 

Spoiler
(defun c:PLArea  (/ acsp ss e ptList ID StrField txt p)
  (vl-load-com)
  (command "_.undo" "_be")
  (setq  acsp (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
  (if (setq ss (ssget ;(progn
			;(initget 1 "Y N")
                        ;(setq ans (getkword "\nProcess All Polylines [Yes/No]: "))
			;(if (eq "Y" ans)
			  ;"_X"
			  ":L";))
		      '((0 . "*POLYLINE")			
                        ;(8 . "A-AREA-BDRY")
                        (-4 . "&")
                        (70 . 1)(410 . "Model"))))
    (repeat (sslength ss)
            (setq e     (ssname ss 0)
                  sum   '(0 0)
                  verts (cdr (assoc 90 (entget e))))
            (setq ptList
                       (mapcar 'cdr
                               (vl-remove-if-not
                                     '(lambda (x) (= (car x) 10))
                                     (entget e))))
            (foreach x ptList (setq sum (mapcar '+ x sum)))
            (setq ID (itoa (vla-get-objectid (vlax-ename->vla-object e))))
            (setq StrField
                       (strcat "%<\\AcObjProp Object(%<\\_ObjId "
			       ID
			       ">%).Area \\f \"%lu2\">%"
                               "m2"))
            (vla-put-AttachmentPoint
                  (setq txt (vla-addMText
                                  acsp
                                  (setq p (vlax-3d-point
                                                   (mapcar '/ sum
                                                         (list verts
                                                               verts))))
                                  0  StrField))
                  acAttachmentPointMiddleCenter)
            (vla-put-InsertionPoint txt p)
            (ssdel e ss)
            )(princ "\0 Objects found:"))
  (command "_.undo" "_e")
  (princ)
)

 

Report
0 Likes

Anonymous
Not applicable
in reply to ВeekeeCZ
‎10-26-2016 05:09 AM

It is not working on circles.

Report
0 Likes

Kent1Cooper
Consultant
Consultant
in reply to Anonymous
‎10-26-2016 07:20 AM
@Anonymous wrote:

It is not working on circles.

It's not written to do that.  Curiously, your original code describes itself as only for Polylines, but in fact works on other entity types, too [even Lines! -- it puts 0.00 in for the area].

 

Here is one that reports in square meters.  But it also says it's just for Polylines.  Maybe you can easily take the part of it that determines the text content and transfer that into your code in Post 1 [and change the description in that, to not be in terms of only Polylines].

Kent Cooper, AIA
Report
0 Likes

ВeekeeCZ
Consultant
Consultant
in reply to Anonymous
‎10-26-2016 08:20 AM
@Anonymous wrote:

It is not working on circles.

Spoiler
(vl-load-com)

(defun c:PLArea  (/ adoc acsp ss e ptList ID StrField txt p)
  
  (setq  acsp (vla-get-modelspace (setq adoc (vla-get-activedocument (vlax-get-acad-object)))))
  (vla-startundomark adoc)
  (if (setq ss (ssget ;(progn
			;(initget 1 "Y N")
                        ;(setq ans (getkword "\nProcess All Polylines [Yes/No]: "))
			;(if (eq "Y" ans)
			  ;"_X"
			  ":L";))
		      '((-4 . "<OR")
                        	(0 . "CIRCLE")
                        	(-4 . "<AND")
                        		(0 . "*POLYLINE")
                        		(-4 . "&")
                        		(70 . 1)
                        	(-4 . "AND>")
                        (-4 . "OR>")	
                        )))
    (repeat (sslength ss)
            (setq e     (ssname ss 0)
                  sum   '(0 0)
                  verts (cond ((cdr (assoc 90 (entget e))))
                              (1)))
            (setq ptList (mapcar 'cdr
                                 (vl-remove-if-not
                                   '(lambda (x)
                                      (= (car x) 10))
                                   (entget e))))
            (foreach x ptList (setq sum (mapcar '+ x sum)))
            (setq ID (itoa (vla-get-objectid (vlax-ename->vla-object e))))
            (setq StrField (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                   ID
                                   ">%).Area \\f \"%lu2\">%"
                                   "m2"))
            (vla-put-AttachmentPoint
                  (setq txt (vla-addMText
                                  acsp
                                  (setq p (vlax-3d-point
                                                   (mapcar '/ sum
                                                         (list verts
                                                               verts))))
                                  0  StrField))
                  acAttachmentPointMiddleCenter)
            (vla-put-InsertionPoint txt p)
            (ssdel e ss)
            )
    (princ "\n0 Objects found:"))
  (vla-endundomark adoc)
  (princ)
)
Report
0 Likes

gpcattaneo
Advocate
Advocate
in reply to ВeekeeCZ
‎10-26-2016 01:15 PM
Accepted solution
@ВeekeeCZ wrote:

 Just be careful if you have some more complex shapes (typically "C" shape) -- label may be outside the closed area.

Try this...

 

 576A.gif

A2.lsp
Report

ВeekeeCZ
Consultant
Consultant
in reply to gpcattaneo
‎10-26-2016 02:00 PM

@gpcattaneo, I must admit I'm impressed!! Nice solution!

 

 

-- haven't dig into algorithm much -- do you somehow test if a text is really inside?

 

I tried a little test... not really hard, these are the only shapes I've drawn... 

 

http://autode.sk/2dXLZB5

Report
0 Likes

F.Camargo
Advisor
Advisor
in reply to gpcattaneo
‎10-28-2016 03:48 AM
@gpcattaneo wrote:
@ВeekeeCZ wrote:

 Just be careful if you have some more complex shapes (typically "C" shape) -- label may be outside the closed area.

Try this...

 

 576A.gif

Fantastic, Gian!!

 

It will be better if the texts were as a field. Smiley Happy

 

Fabricio

 

Report
0 Likes

gpcattaneo
Advocate
Advocate
in reply to ВeekeeCZ
‎11-01-2016 09:46 AM

Thanks Smiley Happy

 

@ВeekeeCZ

Increase the value of "step1" on very narrow polygons.

                    

@F.Camargo

The field version...

A2.lsp
Report

F.Camargo
Advisor
Advisor
in reply to gpcattaneo
‎11-01-2016 02:04 PM
Just amazing Gian!!
Thank you
Report
0 Likes

Anonymous
Not applicable
‎07-31-2017 07:58 AM

 I tried this lisp it is very useful to me 

but..why the result values are too big

how can  I reduce the size of this lisp text

Report
0 Likes

gpcattaneo
Advocate
Advocate
in reply to Anonymous
‎07-31-2017 08:38 AM

Change the TEXTSIZE system variable.

Report
0 Likes
Report a website issue