PDA

View Full Version : Area of multiple objects


chad.beussink
2007-10-03, 10:25 PM
Please help. I want to be able to use a single command to add the areas of several objects.

This is what I have to do currently:

AREA, ADD, OBJECT, select each object individually by clicking on it.

What I want to do:

AREA, ADD, OBJECT, use a window to select all the objects.

I tried using a window, but it will not accept the command. Is there a better way? Is there a lisp routine that would work here?

Again, please help.

Thanks,
Chad

T.Willey
2007-10-03, 10:47 PM
If they are plines, then they have an area property, so try....

(defun c:GetMArea (/ ss TArea ent)

(setq TArea 0)
(if (setq ss (ssget '((0 . "*OLYLINE"))))
(while (setq ent (ssname ss 0))
(setq TArea
(+
TArea
(vla-get-Area
(vlax-ename->vla-object ent)
)
)
)
(ssdel ent ss)
)
)
TArea
)

Will return in whatever units the drawing is in, so if you draw in inches, but what it in feet, then divide the amount by 144.0.

CAB2k
2007-10-04, 02:56 PM
Here is one I did a while back:
http://www.theswamp.org/index.php?topic=1303.0
P.S. You must be a memeber to see the post.

Avatart
2007-10-04, 03:13 PM
Does it work if you select the entities first then run the command? I haven't tried this, but it may work.

chad.beussink
2007-10-04, 03:25 PM
Attn CAB2K

I tried looking at your link, but I am not a member. Can you copy in paste in this thread for me?

Thanks,
Chad

CAB2k
2007-10-04, 03:58 PM
This is a "Pick Each Entity" one at a time routine.
;;; AreaPrt.lsp by Charles Alan Butler
;;; Copyright 2005
;;; by Precision Drafting & Design All Rights Reserved.
;;; Contact at ab2draft@TampaBay.rr.com
;;;
;;; Version 3.0 April 2, 2004
;;; Version 3.1 February 26, 2005
;;; Added support for other unit systems
;;; Version 3.2 revised CADaver 03/25/2005
;;; Added acres to text display
;;; Version 3.3 04/04/2005
;;; Added SQ.Meters for print out
;;;
;;; DESCRIPTION
;;; Print the Area of POLYLINE LWPOLYLINE CIRCLE ELLIPSE
;;; SPLINE REGION 3DSOLID
;;; Uses current layer & text style
;;; Warning appears if polyline is not closed or object
;;; is a spline or 3dSolid
;;;
;;; Limitations :
;;;
;;; Command Line Usage
;;; Command: AreaPrt
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;; ;
;;; You are hereby granted permission to use, copy and modify this ;
;;; software without charge, provided you do so exclusively for ;
;;; your own use or for use by others in your organization in the ;
;;; performance of their normal duties, and provided further that ;
;;; the above copyright notice appears in all copies and both that ;
;;; copyright notice and the limited warranty and restricted rights ;
;;; notice appear in all supporting documentation. ;

(defun c:areaprt (/ area oklist en txt obtyp dwg_style styledata dwg_ht
imper Units# *error*)
;; error function
(defun *error* (msg)
(if
(not
(member
msg
'("console break" "Function canceled" "quit / exit abort" "")
)
)
(princ (strcat "\nError: " msg))
) ; if
;; reset variables below
(setvar "CMDECHO" usercmd)
(princ)
) ;
;;end error function

;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
;; Start of Routine
;; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
(setq usercmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq area 0
oklist (list "POLYLINE" "LWPOLYLINE" "CIRCLE" "ELLIPSE"
"SPLINE" "REGION" "3DSOLID")
)
(setq units# (getvar "LUNITS"))
(setq imper (= (getvar "MEASUREMENT") 0)); English units
(while (/= area nil) ; loop until area set to nil
;; next loop until user presses enter or select object
(while (and (null (setq en (entsel "\nPick Area Boundary...")))
(= (getvar "errno") 7)
)
(prompt "\nMissed, Try again or Enter to exit.")
) ; end while
(if (setq en (car en)) ; true if enter was not pressed
(if (member (setq obtyp (cdr (assoc 0 (entget en)))) oklist)
(progn ; object type is in list, ok to proceed
(prompt (strcat "\n" obtyp " is the object type selected."))
(vl-cmdf "area" "o" en)
(setq area (getvar "AREA"))
(if (and imper (member units# '(3 4)))
(setq txt (strcat ; revised CADaver 03/25/2005
(rtos (/ area 144.0) 2 2) " Sq Ft = "
(rtos (cvunit area "sq in" "acres") 2 3) " Acres")
)
(setq txt (strcat (rtos area) " Sq. Meters"))
)


;; Check if the drawing height is set to 0:
(setq dwg_style (getvar "textstyle"))
(setq styledata (tblsearch "style" dwg_style))
(setq dwg_ht (cdr (assoc 40 styledata)))
(if (setq pt (getpoint "\nPick Text Location..."))
(if (= dwg_ht 0)
(command "text" pt "" "0" txt)
;; ELSE do this
(command "text" pt "0" txt)
) ; endif
(setq area nil) ; exit routine
)
(cond
((and (member obtyp '("POLYLINE" "LWPOLYLINE"))
(null (eq 1 (logand 1 (cdr (assoc 70 (entget en)))))))
(setq elst (entget en))
(setq coords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) elst)))
(if (equal (car coords) (car(reverse coords)))
(alert "\nWarning, Pline is not closed but start & end are equal.")
(alert "\nWarning, Pline is not closed.\nStart & End point are NOT equal.")
)
)
((= obtyp "SPLINE")
(alert "\n\tWarning, object is a Spline.\t\t")
)
((= obtyp "3DSOLID")
(alert (strcat "\n\tWarning, object is a 3dSolid.\t\t"
"\n\tArea is total for all surfaces."))
)
) ; end cond stmt
) ; end progn
(prompt (strcat "\n" obtyp " is not a valid object, Try again."))
) ; endif
(setq area nil) ; exit routine
) ; endif
) ; end while
(*error* ""); do housekeeping
(princ)
)
(prompt "\nArea Print Loaded, Enter AreaPrt to run.")
(princ)

chad.beussink
2007-10-04, 05:26 PM
Everyone, thanks for the help. I actually did a search on this topic and found the following lisp routine. Seems to work really well. I would like to give credit to Tee Square Graphics for this.

;;POLYAREA.LSP - (c) 1997-2001 Tee Square Graphics
;;
;; Calculates the area of one or more closed polylines and
;; displays the result in an AutoCAD Alert Window.
;;
(defun c:polyarea (/ a ss n du)
(setq a 0
;du (getvar "dimunit")
ss (ssget '((0 . "*POLYLINE")))
)
(if ss
(progn
(setq n (1- (sslength ss)))
(while (>= n 0)
(command "_.area" "_o" (ssname ss n))
(setq a (+ a (getvar "area"))
n (1- n)
)
)
(alert
(strcat "The total area of the selected\nobject(s) is "
;(if (or (= du 3) (= du 4) (= du 6))
(strcat
(rtos a 2 2)
" Square Inches,\nor\n "
(rtos (/ a 144.0) 2 3)
" Square Feet, \nor\n "
(rtos (cvunit a "sq in" "acres") 2 3)
" Acres"
)
;)
)
)
)
(alert "\nNo Polylines selected!")
)
(princ)
)
(alert
(strcat "POLYAREA.LSP (c) 1997-2001 Tee Square Graphics"
"\n\n Type POLYAREA to start"
)
)
(princ)

RobertB
2007-10-04, 06:50 PM
This is a "Pick Each Entity" one at a time routine.
;;; AreaPrt.lsp by Charles Alan Butler
;;; Copyright 2005
;;; by Precision Drafting & Design All Rights Reserved.
;;; Contact at ab2draft@TampaBay.rr.com
...
(defun c:areaprt (/ area oklist en txt obtyp dwg_style styledata dwg_ht
imper Units#)
;; error function
(defun *error* (msg)
You've got a bad error handler there. You need to localize the error handler, because you are overwriting any existing one with this code.

CAB2k
2007-10-04, 08:06 PM
Oops, good catch there Robert.
I revised the code.
Thanks.