Cumulative area of 3D faces?

[rjohnson42]

I'm using the lsp routine below to determine the area of a single 3d face. However, the "surface" I have is composed of multiple 3D faces. I'm not very familiar with ACAD's 3D tools, but I can't seem to combine the faces into one surface... So, I was hoping to use a lsp routine mentioned above cumulatively. It was written by Bill Gilliss and is shown below.

 

Thanks for any help,

 

Robert

 

;| FACEAREA.lsp
returns the area of a 3dface regardless of orientation or current UCS.
If the point has four points which are not co-planar, returns the
combined areas of the two triangular faces joined by an edge assumed
to be from the 3dface's first and third corner points.

Because 3Dfaces often adjoin, the desired face can be selected by any
method including Window and Window Polygon, and will be highlghted to
confirm selection before its area is calculated. If more than one object,
a non-3Dface object, or no object is selected, the routine will exit
with an error message.

by Bill Gilliss
bill at realerthanreal dot com
Comments and suggestions always welcome.

No warranty, either expressed or implied, is made as to the fitness of
this information for any particular purpose.   All materials are to be
considered 'as-is' and use thereof should be considered as at your own
risk.

v 1.0  2010-03-02 - original release in response to newsgroup request
|;

(defun c:faceArea.lsp ( / myerror olderror 
                         ss en ed p1 p2 p3 p4 area3p fArea)

;;------- subroutines --------
(defun myerror (msg)
 (setvar 'cmdecho *cmdecho)
 (setq *error* olderror)
 )
 
(defun area3p (p1 p2 p3 / a b c s)
(setq
   a (distance p1 p2)
   b (distance p2 p3)
   c (distance p3 p1)
   s (* 0.5 (+ a b c))
)
(sqrt
   (*
       s
       (- s a)
       (- s b)
       (- s c)
   )
)
)

;;=========== main routine ===============
 (setq olderror *error*)
 (setq *error* myerror)
 (setq *cmdecho (getvar 'cmdecho)) (setvar 'cmdecho 0)
 
 (prompt "\nSelect a single 3D face: ")
 (command "._select" pause) ;;to be able to preview selection
 (setq ss (ssget "P"))
 (cond
     ( (and (= (sslength ss) 1)
            (= "3DFACE" (cdr (assoc 0 (entget (ssname ss 0)))))
            )
       (setq en (ssname ss 0)
             ed (entget en)
             p1 (cdr (assoc 10 ed))
             p2 (cdr (assoc 11 ed))
             p3 (cdr (assoc 12 ed))
             p4 (cdr (assoc 13 ed))
             )
       (setq fArea (+ (area3p p1 p2 p3) (area3p p3 p4 p1)))
       (princ "\nArea: ") (princ fArea) (princ)
       )

     ( (and (= (sslength ss) 1)
             (not (= "3DFACE" (cdr (assoc 0 (entget (ssname ss 0))))))
             )
       (princ "Not a 3Dface.")
       )
       
     ( (not ss)
         (princ "Nothing selected.")
         )
         
     ( (> (sslength ss) 1)
       (princ "Too many objects selected.")
       )
     );cond
     
 (myerror) ;; cleanup
 (princ)
);defun

(defun c:3fa ()
 (c:facearea)
)

(princ "FACEAREA loaded. Type FACEAREA or 3FA to run.")


(princ)
 

[BIGAL]

Pretty easy to fix need a ssget "X" selects all 3dfaces filter (0 . "3DFACE")

 

(setq ss (ssget "X" '((0 . "3DFACE"))))

 

Then need a while to loop through the 3dfaces and keep adding area's up (setq area (+ area farea))

 

also (ssname ss x) where x is the a counter to retrieve each entity and (ssdel ssname ss x)) to remove and keep looping.

 

Bit busy right nowelse would do

[BIGAL]

haven't forgotten testing now

Done

like all good disclaimers check results please also add back in original Authors details

 

(defun c:faceArea.lsp ( / myerror olderror 
                         ss en ed p1 p2 p3 p4 area3p fArea)
;;------- subroutines --------

(defun area3p (p1 p2 p3 / a b c s)
(setq
   a (distance p1 p2)
   b (distance p2 p3)
   c (distance p3 p1)
   s (* 0.5 (+ a b c))
)
(sqrt
   (*
       s
       (- s a)
       (- s b)
       (- s c)
   )
)
)
;;=========== main routine ===============

(setq x 0)
(setq totarea 0.0) 
(setq ss (ssget "X" '((0 . "3DFACE"))))
(setq y  (sslength ss))  
       
(If   (=  ss nil)
(progn 
 (Getstring  "\nNo 3d faces . Press any key when ready ")
 (exit)
)
)
(setq y  (sslength ss))  
(repeat y
       (setq en (ssname ss x)
             ed (entget en)
             p1 (cdr (assoc 10 ed))
             p2 (cdr (assoc 11 ed))
             p3 (cdr (assoc 12 ed))
             p4 (cdr (assoc 13 ed))
             )
       (setq fArea (+ (area3p p1 p2 p3) (area3p p3 p4 p1)))
       (setq totarea (+ totarea farea))
       (princ "\nArea: ") (princ totArea) (princ)
          
     (setq x (+ x 1))
) ; repeat
)  ;defun
(defun c:3fa ()
 (c:facearea)
)
(princ "FACEAREA loaded. Type FACEAREA or 3FA to run.")

(princ)

Edited August 26, 2011 by BIGAL