AUTOAREA.LSP

AUTOAREA.LSP

Anonymous
Not applicable
1,362 Views
7 Replies
Message 1 of 8

AUTOAREA.LSP

Anonymous
Not applicable

Can anyone plase make this work in AutoCAD Map3D 2015 release?
It has worked fine in all previous versions of AutoCAD Map3D (prior to 2015).

 

 


;;This program will calculate the area of irregular polygons
;;by picking an area inside the polygon.

(defun C:AUTOAREA (/ ar en n num pt ss1)
   (if (not "acadapp.exp")(xload "acadapp.exp"))
   (setq n 0)
   (setq ss1 (ssadd))
   (while (setq pt (getpoint "\nSelect internal point:"))
      (bpoly pt) ;;ADS function
      (setq ss1 (ssadd (entlast) ss1))
   );;while
   (setq num (sslength ss1))
   (command ".area" "a" "e")
   (while (/= num n)
      (setq en (ssname ss1 n))
      (command en)
      (setq n (1+ n))
   );;while
   (command "" "")
   (command "erase" ss1 "")
   (command "redraw")
   (princ "\nThe area of the polygon in hectares is: ")
   (princ (cvunit (setq ar (getvar "AREA")) "SQ METER" "HECTARE"))
   (princ "\nThe area of the polygon in acres is: ")
   (princ (cvunit (setq ar (getvar "AREA")) "SQ METER" "ACRE"))

   (setq ss nil)
   (prin1)
 );;end autoarea.lsp

0 Likes
Accepted solutions (1)
1,363 Views
7 Replies
Replies (7)
Message 2 of 8

paullimapa
Mentor
Mentor

The problem is with AutoCAD 2015's BPoly function which goes into an endless loop instead of ending properly like previous versions.

BPoly does work properly for AutoCAD 2016 if you want to install this version instead of dealing with the BPoly bug in 2015.

Or as KentCooper has already provided a solution for this by using the Boundary command instead of relying on the BPoly function:

http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/batch-generate-closed-polylines/m-p/2...

 

So you can revise your routine and use Boundary instead of BPoly:

;;This program will calculate the area of irregular polygons
;;by picking an area inside the polygon.

(defun C:AUTOAREA (/ ar en n num pt ss1)
   (setq n 0)
   (setq ss1 (ssadd))
   (while (setq pt (getpoint "\nSelect internal point:"))
      (command"_.Boundary" pt "") ;;use Boundary instead of BPoly:
      (setq ss1 (ssadd (entlast) ss1))
   );;while
   (setq num (sslength ss1))
   (command ".area" "a" "e")
   (while (/= num n)
      (setq en (ssname ss1 n))
      (command en)
      (setq n (1+ n))
   );;while
   (command "" "")
   (command "erase" ss1 "")
   (command "redraw")
   (princ "\nThe area of the polygon in hectares is: ")
   (princ (cvunit (setq ar (getvar "AREA")) "SQ METER" "HECTARE"))
   (princ "\nThe area of the polygon in acres is: ")
   (princ (cvunit (setq ar (getvar "AREA")) "SQ METER" "ACRE"))

   (setq ss nil)
   (prin1)
 );;end autoarea.lsp

 

 


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
Message 3 of 8

Anonymous
Not applicable

It works again!
Thank you very much!!!

 

This LISP routine is very useful to us but it does have some other issues. If it's not too much work maybe you could fix another bug:
This routine creates a closed polyline (to get the area) and then deletes it. However if it fails to create a closed polyline (no closed boundary) it will delete something else that is not supposed to be deleted.
Is this an easy fix?


But either way, thank you for making it work again!

 

0 Likes
Message 4 of 8

paullimapa
Mentor
Mentor

This revised code should take care of the problem when a closed boundary pline is not created:

;;This program will calculate the area of irregular polygons
;;by picking an area inside the polygon.

(defun C:AUTOAREA (/ ar e0 e1 en n num pt ss1)
  (setq e0 (entlast)) ; get original last entity
  (setq n 0)
  (setq ss1 (ssadd))
  (while (not pt)
    (setq pt (getpoint "\nSelect internal point:"))
    (command"_.Boundary" pt "") ;;use Boundary instead of BPoly
    (setq e1 (entlast)) ; get new last entity
    (if (not(eq e0 e1)) ; chk if new boundary was created
     (progn
      (setq ss1 (ssadd (entlast) ss1))
     ); progn
    (progn
     (princ"\nNo Boundary Created...try again...")
     (setq pt nil)
    ); progn
   ) ;if
  );;while
  (setq num (sslength ss1))
  (command "_.Area" "_A" "_E")
  (while (/= num n)
   (setq en (ssname ss1 n))
   (command en)
   (setq n (1+ n))
  );;while
  (command "" "")
  (command "_.Erase" ss1 "")
  (command "_.Redraw")
  (princ "\nThe area of the polygon in hectares is: ")
  (princ (cvunit (setq ar (getvar "AREA")) "SQ METER" "HECTARE"))
  (princ "\nThe area of the polygon in acres is: ")
  (princ (cvunit (setq ar (getvar "AREA")) "SQ METER" "ACRE"))
  (prin1)
);;end autoarea.lsp

 

 

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales |Exchange App Store


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes
Message 5 of 8

Anonymous
Not applicable

Thanks again!

That works great now, but it doesn't allow me to pick multiple areas like the old one did. Is that also possible along with this new fix?

0 Likes
Message 6 of 8

paullimapa
Mentor
Mentor
Accepted solution

Ok, got you...

;;This program will calculate the area of irregular polygons
;;by picking an area inside the polygon.

(defun C:AUTOAREA (/ ar e0 e1 en n num pt ss1)
  (setq e0 (entlast)) ; get original last entity
  (setq n 0)
  (setq ss1 (ssadd))
  (while (setq pt (getpoint "\nSelect internal point:"))
   (command"_.Boundary" pt "") ;;use Boundary instead of BPoly:
   (setq e1 (entlast)) ; get new last entity
   (if (not(eq e0 e1)) ; chk if new boundary was created
    (progn
     (setq ss1 (ssadd (entlast) ss1))
    ); progn
   )
  );;while
  (setq num (sslength ss1))
  (command "_.Area" "_A" "_E")
  (while (/= num n)
   (setq en (ssname ss1 n))
   (command en)
   (setq n (1+ n))
  );;while
  (command "" "")
  (command "_.Erase" ss1 "")
  (command "_.Redraw")
  (princ "\nThe area of the polygon in hectares is: ")
  (princ (cvunit (setq ar (getvar "AREA")) "SQ METER" "HECTARE"))
  (princ "\nThe area of the polygon in acres is: ")
  (princ (cvunit (setq ar (getvar "AREA")) "SQ METER" "ACRE"))
  (prin1)
);;end autoarea.lsp

 

 

 

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales |Exchange App Store


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
Message 7 of 8

Anonymous
Not applicable

Perfect.

Thanks a lot!

0 Likes
Message 8 of 8

paullimapa
Mentor
Mentor

glad that finally worked out for you...cheers...

 

 

Area Object Link | Attribute Modifier | Dwg Setup | Feet-Inch Calculator
Layer Apps | List on Steroids | VP Zoom Scales |Exchange App Store


Paul Li
IT Specialist
@The Office
Apps & Publications | Video Demos
0 Likes