lisp to get area and perimeter

lisp to get area and perimeter

S_S_SS
Advocate Advocate
10,844 Views
20 Replies
Message 5 of 21

lisp to get area and perimeter

S_S_SS
Advocate
Advocate

Hello every one
I want a lisp to get area and perimeter and put it inside the objects and make it in meter unit and scale text to 1000 to be clearly displayed 
like that image to clearly explain what i want 
thanks in advance 

02.PNG

0 Likes
Accepted solutions (1)
10,845 Views
20 Replies
Replies (20)
Message 1 of 21

S_S_SS
Advocate
Advocate

hi every one
i want a lisp to get area and perimeter and put it inside the objects and make it in meter unit and scale text to 1000 to be clearly displayed 
like that image to clearly explain what i want 
thanks in advance 

02.PNG

 

0 Likes
Message 2 of 21

ВeekeeCZ
Consultant
Consultant

Sure, there is a great place where you can find what you want. I'll help you with a start, while I can understand that for someone could be difficult to learn how to use google or other search engines, so HERE  you go.

Message 3 of 21

Valentin_CAD
Mentor
Mentor

@S_S_SS ,

 

The file is attached. See how it works from this >>link<<



Select the "Mark as Solution" if my post solves your issue or answers your question.

Seleccione "Marcar como solución" si mi publicación resuelve o responde a su pregunta.


Emilio Valentin

Message 4 of 21

S_S_SS
Advocate
Advocate

thanks sir ...
I want to make unit is meter square for area and meter for perimeter and the result is mm in your lisp 
and i can't put the result text i uploaded video that explain that 
(https://drive.google.com/file/d/1QMRUPCq2HW9-vqNie0GXxtHC2kmF4bXo/view?usp=sharing)
the link of video ... 
thanks in advance 

0 Likes
Message 6 of 21

Kent1Cooper
Consultant
Consultant

@S_S_SS wrote:

....
I want to make unit is meter square for area and meter for perimeter and the result is mm in your lisp 
.... i uploaded video that explain that 
(https://drive.google.com/file/d/1QMRUPCq2HW9-vqNie0GXxtHC2kmF4bXo/view?usp=sharing)
....


There's some problem with that video.

 

Since the routine @Valentin_CAD linked to is a compiled .vlx file, we can't get into it as we could if it were a .lsp file, to put in the conversion between millimeter drawing units and meter-based text content.  But you could Search in the >Customization Forum< for similar routines -- I would guess there are several available, and if one is close, and it's a .lsp file, people here could edit it to do what you want.

 

[And it seems to me that neither of the posts you have marked as Solutions is really a Solution, at least not yet.]

Kent Cooper, AIA
Message 7 of 21

scott_bolton
Advocate
Advocate
Accepted solution

This works for CIRCLEs and LWPOLYLINEs. You can expand for other types. The text height is hardcoded on line 20.

S

(defun c:aaa (/ ent obj bl tr midX midY mid area long txtheight)
  (setq ent (car (entsel))
	obj (vlax-ename->vla-object ent)
	)
  (vla-GetBoundingBox obj 'bl 'tr)
  (setq bl (vlax-safearray->list bl)
	tr (vlax-safearray->list tr)
	midX (/ (+ (car bl) (car tr)) 2.0)
	midY (/ (+ (cadr bl) (cadr tr)) 2.0)
	mid (list midX midY)
	)
  (if (and
	(setq area (vlax-get-property obj 'Area))
	(cond
	  ((= "CIRCLE" (cdr (assoc 0 (entget ent)))) (setq long (vlax-get-property obj 'Circumference)))
	  ((= "LWPOLYLINE" (cdr (assoc 0 (entget ent)))) (setq long (vlax-get-property obj 'Length)))
	  )
	)
    (progn
      (setq txtheight 2)
      (entmake (append
		 '((0 . "MTEXT") (100 . "AcDbEntity") (8 . "0") (100 . "AcDbMText"))
		 (list (cons 10 mid))
		 (list (cons 40 txtheight))
		 '((41 . 1.70502) (46 . 0.0) (71 . 5) (72 . 5))
		 (list (cons 1 (strcat "A=" (rtos area 2 2) "M2\\PPer=" (rtos long 2 2) "M")))
		 '((7 . "ROMANS") (210 0.0 0.0 1.0) (11 1.0 0.0 0.0) (42 . 6.70476) (43 . 10.6667) (50 . 0.0) (73 . 1) (44 . 1.0))
		 )
	       )
      )
    )
  (princ)
  )
Message 8 of 21

Kent1Cooper
Consultant
Consultant

I think an adjustment is needed, since I believe the drawing unit is a millimeter [see "scale text to 1000" in Message 1, and >this<]:

 

....
  (list (cons 1 (strcat "A=" (rtos (/ area 1e6) 2 2) "M2\\PPer=" (rtos (/ long 1e3) 2 2) "M")))
....

 

It could also be accounted for with (cvunit) functions.

Kent Cooper, AIA
Message 9 of 21

scott_bolton
Advocate
Advocate

Ah, yes. Quick and dirty, that's what they call me.

Message 10 of 21

Kent1Cooper
Consultant
Consultant

@Kent1Cooper wrote:

....

....
  (list (cons 1 (strcat "A=" (rtos (/ area 1e6) 2 2) "M2\\PPer=" (rtos (/ long 1e3) 2 2) "M")))
....

....


I would also suggest the further adjustment to make the 2 a superscript:

 

....
  (list (cons 1 (strcat "A= " (rtos (/ area 1e6) 2 2) "M\U+00B2\\PPer= " (rtos (/ long 1e3) 2 2) "M")))
....

 

EDIT:  and furthermore, if you want those spaces after the equal signs, to prevent it from word-wrapping:

....

  '((41 . 0.0) (46 . 0.0) (71 . 5) (72 . 5))

....

Kent Cooper, AIA
Message 11 of 21

S_S_SS
Advocate
Advocate

thanks sir 
it works to me 
but can you scale text size also to 1000 because it appears so small according to my drawings 

Captured.JPG

 and also can you make it like that 

02.JPG

 not that 

01.JPG

 to save more time about making scale of text size or stretching text to be in one line 
and thanks for your effort sir 

0 Likes
Message 12 of 21

Kent1Cooper
Consultant
Consultant

The text height is controlled in this line:

(setq txtheight 2)

That can be any size in drawing units you want, or it could be calculated from something about the drawing [such as the LTSCALE or DIMSCALE System Variable], or it could take whatever the current Text height is [the last used for Text or Mtext].  What would your preferred basis be?

 

The  (41 . 0.0)  in my EDIT of my previous Reply will take care of the word wrapping.

Kent Cooper, AIA
Message 13 of 21

S_S_SS
Advocate
Advocate
" it could be calculated from something about the drawing [such as the LTSCALE or DIMSCALE System Variable]"
Can you explain that sir ??
did you mean that the text height is variable according to the shape size to be suitable to appear on it ??
if it as i understand sure i want it ...

second point can you make area and length as a field and values change if the shape dimension changes ??
0 Likes
Message 14 of 21

JTBWorld
Advisor
Advisor

Here an AutoLISP that can be modified to your needs.

https://jtbworld.com/autocad-areatext-lsp 


Jimmy Bergmark
JTB World - Software development and consulting for CAD and license usage reports
https://jtbworld.com

Message 15 of 21

Kent1Cooper
Consultant
Consultant

@S_S_SS wrote:
" it could be calculated from something about the drawing [such as the LTSCALE or DIMSCALE System Variable]"
Can you explain that sir ??
....

Let's say you want the Text for these labels to be 5mm high on paper when plotted.  If the intended plotting scale is, for example, 1:50, then you would want the model-space Text height to be 5 x 50 = 250mm [the height as if you painted it on the floor of a building].  But you don't want to build any constant number such as 250 into the code as the Text height, because you won't always plot things at the same scale.  Typically you would have the DIMSCALE System Variable set to the number after the colon [the XX in 1:XX scale indication], so that Dimension elements come out at the appropriate size for the plotting scale.  What you should build into the code is the Text height you want on paper multiplied by the DIMSCALE value:

 

(setq txtheight (* 5 (getvar 'dimscale)))

Kent Cooper, AIA
Message 16 of 21

S_S_SS
Advocate
Advocate
okay sir i will use DIMSCALE System Variable i understand it now
can you make area and length as a field and values change if the shape dimension changes ??
0 Likes
Message 17 of 21

Kent1Cooper
Consultant
Consultant

@S_S_SS wrote:
....
can you make area and length as a field and values change if the shape dimension changes ??

I can't, without doing research into definition of Fields [they're a comparative newcomer to AutoCAD, and I don't have a lot of use for them], but maybe someone more familiar with them can.

Kent Cooper, AIA
Message 18 of 21

S_S_SS
Advocate
Advocate
OKAY sir thanks for your effort 
I got this lisp code it make a field text Variable according to any changes of shape  but it get area only without perimeter  and unit of it is feet and also size of text is small according to my scale

;;; AreaText.LSP ver 4.0
;;; Command names are AT, ATC, ATM
;;; AT command: Select a polyline and where to place the text
;;; ATC command: Select a polyline and add the text at the geo center of the selected object
;;; ATM command: Select multiple objects and add the text at the boundary box center
;;; 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-2018 JTB World, All Rights Reserved
;;; Website: https://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
;;; 2018-11-11 - Added command ATC to add the text at the geo center on selected object
;;; Added command ATM to add the text at the bounding box center on selected objects

;;; Uses TEXTSIZE for the text height

;;; rows starting with one or more semicolons are comments
;;; for the area in square feet leave the below row uncommented or modify as needed
(setq jtbfieldformula ">%).Area \\f \"%pr2%lu2%ct4%qf1 SQ. FT.\">%")

;;; for the area in square meters leave the below row uncommented or modify as needed
;(setq jtbfieldformula ">%).Area \\f \"%lu2%pr1%ps[,m²]%ct8[0.001]\">%")

(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)
)
)
)

;;; Select a polyline and where to place the text
(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
jtbfieldformula
)
)
)

;;; Select a polyline and add the text at the geo center of the selected object
(defun c:ATC (/ ent entObject entObjectID InsertionPoint ad mtextobj)
(vl-load-com)
(setq entObject (vlax-ename->vla-object (car (setq ent (entsel))))
entObjectID (Get-ObjectIDx64 entObject)
InsertionPoint (vlax-3D-Point
(trans (osnap (cadr ent) "_gcen") 1 0)
)
ad (vla-get-ActiveDocument (vlax-get-acad-object))
)

(setq mtextobj
(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
jtbfieldformula
)
)
)
(vla-put-AttachmentPoint mtextobj 5)
(vla-put-insertionPoint mtextobj InsertionPoint)
)

;;; Select multiple objects and add the text at the boundary box center
(defun c:ATM (/ ss1 nr tot_area
ent entObject entObjectID InsertionPoint
ad mtextobj minExt maxExt
)
(vl-load-com)
(if (setq ss1 (ssget '((-4 . "<OR")
(0 . "POLYLINE")
(0 . "LWPOLYLINE")
(0 . "CIRCLE")
(0 . "ELLIPSE")
(0 . "SPLINE")
(0 . "REGION")
(-4 . "OR>")
)
)
)
(progn
(setq nr 0)
(setq tot_area 0.0)
(setq en (ssname ss1 nr))
(while en
(setq entObject (vlax-ename->vla-object en)
entObjectID (Get-ObjectIDx64 entObject)
ad (vla-get-ActiveDocument (vlax-get-acad-object))
)
(vla-GetBoundingBox entObject 'minExt 'maxExt)
(setq minExt (vlax-safearray->list minExt)
maxExt (vlax-safearray->list maxExt)
)


(setq
InsertionPoint
(vlax-3D-Point
(list
(/ (+ (car minExt) (car maxExt)) 2)
(/ (+ (cadr minExt) (cadr maxExt)) 2)
(/ (+ (caddr minExt) (caddr maxExt)) 2)
)
)
)


(setq mtextobj
(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
jtbfieldformula
)
)
)
(vla-put-AttachmentPoint mtextobj 5)
(vla-put-insertionPoint mtextobj InsertionPoint)
(command "._area" "_O" en)
(setq tot_area (+ tot_area (getvar "area")))
(setq nr (1+ nr))
(setq en (ssname ss1 nr))
)
(princ "\nTotal Area = ")
(princ tot_area)
)
)
(setq ss1 nil)
(princ)
)

(princ)
0 Likes
Message 19 of 21

Sea-Haven
Mentor
Mentor

Did you look at this

 

;; for the area in square meters leave the below row uncommented or modify as needed
;(setq jtbfieldformula ">%).Area \\f \"%lu2%pr1%ps[,m²]%ct8[0.001]\">%")

Message 20 of 21

thisisnikk
Observer
Observer

Hi. This works like a charm for me. Saves me a lot of time. Thank you for this. Any idea how to set the layer of the MTEXT to the current layer? The layer is automatically set to "0". Any help would be much appreciated. Thank you!