Looking for a LISP - area and perimeter

April 16, 2014

Hello Everyone,

I'm new on forum.

I search for a very simple LISP which inserts (on centre in object or bottom, no matter) text with AREA and PERIMETER from RECTANGULAR or closed LINES.

e.g. area - "1,23 m2" and perimeter - "2,45 m"

Best when I can select more objects and than for the all selected the text will be written.

And this function for the two parameter should be writen together. Not that I must first use one command than second.

The font height should be possible to change.

Precission should be: 0,001m or 0,01m.

Could anyone help me?

Sorry for my english

Thanks!

Edited April 16, 2014 by simbamat

April 16, 2014

For 'closed LINES' use first Command: BOUNDARY => PolyLines .

And then try this :

(DEFUN C:AreaPer ( / ar coHt coDec eN i lStrA lStrP p pr pMin pMax osm sel sL strA strP ti uL ) ;  dec hT
(princ "\n   C:AreaPer  :   V  :  17 . 04 . 2014  ;")
(or (vl-Load-Com))
(setVar "CmdEcho" 0)
(setVar "OrthoMode" 0)

(princ "\n   Select Objects : [ Arc, Circle, LwPolyline, PolyLine, ] ;")
(if (setq sel (ssGet '((0 . "Arc,Circle,LwPolyline,PolyLine,SplineX")) ) )
 (progn
  (if (not (numberP hT)) (setq hT 0.1))
  (if (not (numberP dec)) (setq dec 3))
  
  (setq coHt (getString (strcat "\n   Font  Height  :  < Enter = " (RtoS hT 2 3) " >  :  "))
 coDec (getString (strcat "\n   Precission   :  < Enter = " (ItoA dec) " >  :  "))
        osm (getVar "osMode")  uL (getVar "insUnits")
 strA "Area"  lStrA (cons 8 strA)  strP "Perimeter"  lStrP (cons 8 strP)  i -1)

  (if (/= coHt "") (setq hT (AtoF coHt)) )
  (if (/= coDec "") (setq dec (fix (AtoF coDec))) )
; 0 = Unspecified (No units) , 1=Inches , 4=mm , 5= cm ; 6=m ; 7=km.
  (setq ti (car (_VL-Times))
        sL (cond ((= uL 1) 2.54e-2) ; inch
	  ((= uL 2) 0.3048) ; feet
	  ((= uL 3) 1609.344) ; miles
	  ((= uL 4) 1e-3) ; mm
	  ((= uL 5) 1e-2) ; cm
          ((= uL 6) 1.00) ; m
	  ((= uL 7) 1e+3) ; km
                 (T 1.00)
      )) ;_ end of setq
  
  (setVar "osMode" 0)
  (vl-cmdF "_.Layer" "n" "Area,Perimeter" "c" 1 "Area" "c" 5 "Perimeter" "")
  (command "_.Style" "Arial" "Arial" "0" "1" "0" "N" "N") ;_ end of c

  (acet-ui-Progress "Processing : " (ssLength sel))
  (repeat (ssLength sel)
   (setq i (1+ i)  eN (vlax-eName->Vla-Object (ssName sel i)) )
   (if (vlax-Property-Available-P eN "Area")
    (progn
     (setq ar (* (vla-Get-Area eN) sL sL)  tip (substr (vla-Get-ObjectName eN) 5)
    pr (* (cond ((vlax-Property-Available-P eN "Length") (vla-Get-Length eN))
	     ((vlax-Property-Available-P eN "Circumference") (vla-Get-Circumference eN))
	     ((vlax-Property-Available-P eN "ArcLength") (vla-Get-ArcLength eN))
;;;		     ((vlax-Property-Available-P eN "Perimeter") (vla-Get-Perimeter eN))
	     (T 0)
           ) sL)
     ) ; 
     (prinC (strCat "\n  " (ItoA i) " : " tip "  :  Area = " (RtoS ar 2 dec) "  m²  ;  Perimeter = " (RtoS pr 2 dec) " m ;"))
     (vla-GetBoundingBox eN 'pMin 'pMax)
     (setq p (mapcar '/ (mapcar '+ (vlax-SafeArray->List pMin) (vlax-SafeArray->List pMax)) '(2. 2. 2.))  )
     
     (entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrA '(7 . "Arial") '(72 . 4) '(10 0 0 0) (cons 1 (strcat "A = " (RtoS ar 2 dec) " m²")) (cons 11 p) ) )
     (entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrp '(7 . "Arial") '(72 . 4) '(10 0 0 0) (cons 1 (strcat "P = " (RtoS pr 2 dec) " m")) (cons 11 (mapcar '- p (list 0 hT 0))) ) )
  
   )) ; if
   (acet-ui-Progress -1)
  ) ; r
  (acet-ui-Progress)
  
  (setVar "osMode" osm)

)) ; if

;;; (setVar "cLayer" "0")
(princ (strCat "\n   Objects  :  " (ItoA i) "  ;    Time  :  " (RtoS (/ (- (car (_VL-Times)) ti) 1000.) 2 2) " s  ;"))
(princ "\n   C:AreaPer  :  END  ;")
(setVar "CmdEcho" 1)
(princ)
)

Edited April 17, 2014 by Costinbos77

April 17, 2014

Thanks very much!

Ist possible to change the scale?

e.g. I'm drawing in "mm", then use the LISP and it shows: "1000000 m2", it should be: "1 m2"

April 17, 2014

I modified the program.

Units of length must be set with the command: units ,

because their value is taken from the AutoCAD variable : (getVar "insUnits")

Edited April 17, 2014 by Costinbos77

April 17, 2014

Thanks! Thanks! Thanks!

How can I change the font color?

How to change the position of text?

April 18, 2014

1 . This creates layers ; Find it :

(vl-cmdF "_.Layer" "n" "Area,Perimeter" "c" [color="red"]1[/color] "Area" "c" [color="blue"]5[/color] "Perimeter" "")

1 = red ;

5 = blue ;

Put what colors you like.

2 .

How to change the position of text?

Surface texts are inserted in the middle? Where do you put them? Attach a DWG example.

Or mode tag = justify ( middle left, center, middle , bottom right ) ?

Edited April 18, 2014 by Costinbos77

April 18, 2014

Example in "Paint":

April 18, 2014

It is possible, but more complicated. How do with circles or arcs of a circle?

If the rectangle is tilted, rotated or irregular ?

April 19, 2014

You have right. It is complicated.

But I usualy use object like this:

Its possible to make second version of the LISP for me?

Thanks!

April 19, 2014

If you insist, look:

(defun C:AreaPer ( / ar coHt coDec coTP eN hT2 i lStrA lStrP lTa p pr pMin pMax osm sel sL strA strP tD ti tO uL ) ;  dec hT
(princ "\n   C:AreaPer  :   V  :  17 . 04 . 2014  ;")
(or (vl-Load-Com))
(setVar "CmdEcho" 0)
(setVar "OrthoMode" 0)

(princ "\n   Select Objects : [ Arc, Circle, LwPolyline, PolyLine, ] ;")
(if (setq sel (ssGet '((0 . "Arc,Circle,LwPolyline,PolyLine,SplineX")) ) )
 (progn
  (if (not (numberP hT)) (setq hT 1.)) ; Real
  (if (not (numberP dec)) (setq dec 3)) ; Integer
  
  (setq coHt (getString (strcat "\n   Font  Height  :  < Enter = " (RtoS hT 2 3) " >  :  "))
 coDec (getString (strcat "\n   Precission   :  < Enter = " (ItoA dec) " >  :  "))
 coTP (getString (strcat "\n   Text Position   :  Any = Center  ;   <  Enter =  Right  >  :  "))
        osm (getVar "osMode")  uL (getVar "insUnits")
 strA "Area"  lStrA (cons 8 strA)  strP "Perimeter"  lStrP (cons 8 strP)  i -1)

  (if (/= coHt "") (setq hT (AtoF coHt)) )
  (if (/= coDec "") (setq dec (fix (AtoF coDec))) )
; 0 = Unspecified (No units) , 1=Inches , 4=mm , 5= cm ; 6=m ; 7=km.
  (setq ti (car (_VL-Times))  hT2 (* hT 2.) ) ;_ end of setq
  
  (cond ((= uL 0) (setq sL 1.00  tO "Unitless"))
 ((= uL 1) (setq sL 2.54e-2  tO "Inch"))
 ((= uL 2) (setq sL 0.3048  tO "Feet"))
 ((= uL 3) (setq sL 1609.344  tO "Miles"))
 ((= uL 4) (setq sL 1e-3  tO "mm"))
 ((= uL 5) (setq sL 1e-2  tO "cm"))
 ((= uL 6) (setq sL 1.00  tO "m"))
 ((= uL 7) (setq sL 1e+3  tO "Km"))
        (T (setq sL 1.00  tO "Any"))
  ) ;_ end of c
  (alert (strCat "DWG  Length  Units  is  :\n\n  " (ItoA uL) "  =  " tO "  ;\n\n  Factor  =  " (RtoS sL 2 9) "  !"))
  (setVar "osMode" 0)
  (vl-cmdF "_.Layer" "n" "Area,Perimeter" "c" 1 "Area" "c" 5 "Perimeter" "")
  (command "_.Style" "Arial" "Arial" "0" "1" "0" "N" "N") ;_ end of c

  (acet-ui-Progress "Processing : " (ssLength sel))
  (repeat (ssLength sel)
   (setq i (1+ i)  eN (vlax-eName->Vla-Object (ssName sel i)) )
   (if (vlax-Property-Available-P eN "Area")
    (progn
     (setq ar (* (vla-Get-Area eN) sL sL)  tip (substr (vla-Get-ObjectName eN) 5)
    pr (* (cond ((vlax-Property-Available-P eN "Length") (vla-Get-Length eN))
	     ((vlax-Property-Available-P eN "Circumference") (vla-Get-Circumference eN))
	     ((vlax-Property-Available-P eN "ArcLength") (vla-Get-ArcLength eN))
;;;		     ((vlax-Property-Available-P eN "Perimeter") (vla-Get-Perimeter eN))
	     (T 0)
           ) sL)
     ) ; 
     (prinC (strCat "\n  " (ItoA i) " : " tip "  :  Area = " (RtoS ar 2 dec) "  m²  ;  Perimeter = " (RtoS pr 2 dec) " m ;"))
     (vla-GetBoundingBox eN 'pMin 'pMax)
     (setq pMin (vlax-SafeArray->List pMin)  pMax (vlax-SafeArray->List pMax)
    lTa (cons 1 (strcat "A = " (RtoS ar 2 dec) " m²")) )
     
     (if (= coTP "")
      (setq tD (textBox (list lTa (cons 40 hT) '(50 . 0) '(7 . "Arial"))  ) ; (caar td)
     p (list (- (car pMax) (caadr td)) (+ (cadr pMin) hT2))  )
      (setq p (mapcar '/ (mapcar '+ pMin pMax) '(2. 2. 2.))  )
     ) ; if
     
     (entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrA '(7 . "Arial") '(72 . 4) '(10 0 0 0) lTa (cons 11 (mapcar '+ p (list 0 hT2 0))) ) )
     (entMake (list '(0 . "Text") (cons 40 hT) '(50 . 0) lStrp '(7 . "Arial") '(72 . 4) '(10 0 0 0) (cons 1 (strcat "P = " (RtoS pr 2 dec) " m")) (cons 11 p) ) )
  
   )) ; if
   (acet-ui-Progress -1)
  ) ; r
  (acet-ui-Progress)
  
  (setVar "osMode" osm)

)) ; if

;;; (setVar "cLayer" "0")
(princ (strCat "\n   Objects  :  " (ItoA i) "  ;    Time  :  " (RtoS (/ (- (car (_VL-Times)) ti) 1000.) 2 2) " s  ;"))
(princ "\n   C:AreaPer  :  END  ;")
(setVar "CmdEcho" 1)
(princ)
)

From what I've seen, you do not know AutoLisp. It would be good and you learn this programming language, is easy and very useful.

While working with AutoCAD, you always need programs to help you work.

PS :

Today I leave on vacation in the country for at least one week and I don't have internet there. So we hear after Easter vacation .

Edited April 19, 2014 by Costinbos77

April 19, 2014

Thanks!

Happy Easter!

April 19, 2014

Thanks for the greeting.

Download the program again because I brought something useful.

Search these:

  (if (not (numberP hT)) (setq hT [color="red"]1.[/color])) ; Real
  (if (not (numberP dec)) (setq dec [color="red"]3[/color])) ; Integer

and put the values that you consider the most common.

Sign In

Looking for a LISP - area and perimeter

Recommended Posts

simbamat

Costinbos77

simbamat

Costinbos77

simbamat

Costinbos77

simbamat

Costinbos77

simbamat

Costinbos77

simbamat

Costinbos77

Join the conversation

Tutorials

Forums

Activity