Jump to content

Looking for a LISP - area and perimeter


simbamat

Recommended Posts

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 by simbamat
Link to comment
Share on other sites

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 by Costinbos77
Link to comment
Share on other sites

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"

Link to comment
Share on other sites

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 by Costinbos77
Link to comment
Share on other sites

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 by Costinbos77
Link to comment
Share on other sites

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

 

 

If the rectangle is tilted, rotated or irregular ?

Rectangle.jpg

Link to comment
Share on other sites

You have right. It is complicated.

 

But I usualy use object like this:

areaperm-example.jpg

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

Thanks!

Link to comment
Share on other sites

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 by Costinbos77
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...