[编程交流] 3D面的累积面积？

;| 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)
 

(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)