lisp to calculate area by picking on poly line boundary given result by meter square

[wrha]

is there lisp to calculate area by picking on poly line boundary given result by meter square , in addition if we entry the depth to take volume .

 

thanks

[dlanorh]

Below is lisp to display a closed polyline area. It is currently set up to work in drawings in millimetres. Change the ardiv variable to 1 if drawing is in metres

 

(vl-load-com)
(defun c:parea (/ *error* m2 doc amode aprec ardiv ent obj oar)

   (defun *error* ( msg ) 
       (if (and doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark doc))
   (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nError : " msg)))
       (princ)
 );end_defun_*error*

   (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
         m2 (strcat "m" (chr 178))        ;;<= <= SET AREA UNITS TO m + superscript 2 (metres squared) 
         amode 2                                                                                            ; <= <= rtos mode 2 = decimal
         aprec 2                                                                                            ; <= <= rtos precision 2 = 2 decimal places
         ardiv 1000000                                                                                ; <= <= divisor 1000000 = conversion factor sq mm to sq m SET TO 1 if drawing in metres 
   );end_setq
 
   (vla-startundomark doc)
 (while (setq ent (entsel "\nSelect Areas Closed Polyline : "))      
   (cond ( (not ent) 
           (alert "Nothing Selected..Try again")
         );end_Nothing selected condition
                            
         ( (not (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
           (alert "Not a Polyline")
           (setq ent nil)           
         );end_Not a Polyline condition
                       
         ( (not (= (vla-get-closed (setq obj (vlax-ename->vla-object (car ent)))) :vlax-true))
           (alert "Not a Closed Polyline")
           (setq ent nil)
         );end_Not a Closed Polyline condition
         (t
           (setq obj (vlax-ename->vla-object (car ent)))
           (setq oar (rtos (/ (vla-get-area obj) ardiv) amode aprec))    ; converts area in sq mm to sq m (divide by 1000000) precision 2 decimal places (rtos number mode precision) mode 2 is decimal 
           (princ (strcat "\nArea = " oar m2))
         );end_true  
       );end_cond
   )end_while
 (if (= 8 (logand 8 (getvar 'UNDOCTL))) (vla-endundomark doc))
);end_defun

[Lee Mac]

Below is lisp to display a closed polyline area.

 

FWIW, a few points of constructive criticism -

(vla-startundomark doc)

Since the program is not performing any changes to the drawing database, I think the creation of an Undo Group is unnecessary.

  (while (setq ent (entsel "\nSelect Areas Closed Polyline : "))      
   (cond ( (not ent) 
           (alert "Nothing Selected..Try again")
          );end_Nothing selected condition

This first condition will never be evaluated since, if ent is null, the test expression for the while loop will not be validated and the enclosed expressions not evaluated.

                             
         ( (not (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
           (alert "Not a Polyline")
           (setq ent nil)           
          );end_Not a Polyline condition

Note that 3D Polylines do not have an ActiveX area property.

          ( (not (= (vla-get-closed (setq obj (vlax-ename->vla-object (car ent)))) :vlax-true))

A minor point, but (not (= :vlax-true ... )) is essentially equivalent to (= :vlax-false ... )

[Jef!]

Lee well resumed my thought, I would add few further points...

 

The undo mark is useless, and since it is the only time you change a variable (undoctl), by removing it you could remove the *error* trapping as well, unless you want to keep the exit quietly behavior. Note: if you remove the undo, you don't need the doc variable anymore.

 

also here

( (not (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
           (alert "Not a Polyline")
           (setq ent nil)           
         )

The setq ent nil part isn't necessary since the next thing that will be evaluated will be the while's "(setq ent (entsel "\nSelect Areas Closed Polyline : "))". The same apply to the setq ent nil within the "if the pline is not closed" condition.

 

Furthermore, in your conditionnal to look if the pline is opened, you bind the vla-object to the variable obj, which you don't reuse on your T condition. You may remove the (setq obj (vlax-ename->vla-object (car ent))) from the T condition as it is already bound to the var obj in the evaluation of the preceding condition.

 

Basically that does the same job

(vl-load-com)
(defun c:parea (/ *error* m2 obj amode aprec ardiv ent oar)

   (setq m2 (strcat "m" (chr 178))        ;;<= <= SET AREA UNITS TO m + superscript 2 (metres squared) 
         amode 2                          ; <= <= rtos mode 2 = decimal
         aprec 2                          ; <= <= rtos precision 2 = 2 decimal places
         ardiv 1000000                    ; <= <= divisor 1000000 = conversion factor sq mm to sq m SET TO 1 if drawing in metres 
   );end_setq
 
 (while (setq ent (entsel "\nSelect Areas Closed Polyline : "))      
   (cond ( (not (wcmatch (cdr (assoc 0 (entget (car ent)))) "*POLYLINE"))
           (alert "Not a Polyline")
         );end_Not a Polyline condition
         ( (= (vla-get-closed (setq obj (vlax-ename->vla-object (car ent)))) :vlax-false)
           (alert "Not a Closed Polyline")
         );end_Not a Closed Polyline condition
         (t
           (setq oar (rtos (/ (vla-get-area obj) ardiv) amode aprec))    ; converts area in sq mm to sq m (divide by 1000000) precision 2 decimal places (rtos number mode precision) mode 2 is decimal 
           (princ (strcat "\nArea = " oar m2))
         );end_true  
       );end_cond
   )end_while
)

 

is there lisp to calculate area by picking on poly line boundary given result by meter square , in addition if we entry the depth to take volume.

That lisp isnt very far from doing that, maybe you could give it a try, post what you have, and if you are stuck we'll help you out...

[BIGAL]

Do a bit more searching there is an area labeller I think by Gile that does a para centroid for the text placement ie in middle of the object. Lee you did not mention your version of this request ?

[Lee Mac]

Lee you did not mention your version of this request ?

 

 

Indeed, any of the following programs could be configured to perform as required:

 

Areas to Field

Area Field to Attribute

Area Label

Total Area