[编程交流] 计算固体质量，包括

(defun c:vol (/ ss vol bset |cmdecho|)
 (vl-load-com)
 (SETQ |cmdecho| (GETVAR "cmdecho"))
 (SETVAR "cmdecho" 1)
 (COMMAND "undo" "begin")
 (c:ExplodeAllBlocks)
 (COMMAND "undo" "end")
 (if (setq ss (ssget '((0 . "3DSOLID"))))
   (progn
     (setq vol
       (apply '+
         (vl-remove-if
           'vl-catch-all-error-p
             (mapcar
               (function
                 (lambda (x)
                   (vl-catch-all-apply
                     'vla-get-volume (list x))))
               (mapcar 'vlax-ename->vla-object
                 (vl-remove-if 'listp
                   (mapcar 'cadr (ssnamex ss))))))))
     (command "undo" "")(princ (strcat "\n<< Total Volume = " (rtos vol 2 2) " >>"))
     (setq volume (rtos vol 2 2)) ))
    (setq massa (* 0.00782 vol)))
  (PRINC (strcat "\n<<mass:" (rtos (/ massa 1000) 2 2) " kg >>"))
 (princ)
 (SETVAR "cmdecho" |cmdecho|)
 )

(defun c:ExplodeAllBlocks ( / *error* _StartUndo _EndUndo doc locked ss )
 (vl-load-com)
 ;; © Lee Mac 2010
 ;; Error Handler
 (defun *error* ( msg )
   (if locked
     (mapcar
       (function
         (lambda ( l )
           (vl-catch-all-apply 'vla-put-lock (list l :vlax-true))
         )
       )
       locked
     )
   )
   (if doc (_EndUndo doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )
 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )
 ;; Start an Undo Mark
 (_StartUndo
   (setq doc
     (vla-get-ActiveDocument
       (vlax-get-acad-object)
     )
   )
 )
 ;; Unlock all Layers
 (vlax-for l (vla-get-layers doc)
   (if (eq :vlax-true (vla-get-lock l))
     (progn
       (vla-put-lock l :vlax-false)
       (setq locked (cons l locked))
     )
   )
 )
 ;; Now lets explode 'em
 (if (ssget "_X" '((0 . "INSERT")))
   (progn
     (vlax-for obj (setq ss (vla-get-ActiveSelectionSet doc))
       (if (vl-catch-all-error-p
             (vl-catch-all-apply 'vla-Explode (list obj))
           )
         (princ (strcat "\n** Unable to Explode Block: " (vla-get-name obj) " **"))
         (vla-delete obj)
       )
     )
     (vla-delete ss)
   )
 )  
 ;; ReLock the Layers
 (mapcar
   (function
     (lambda ( l ) (vla-put-lock l :vlax-true))
   )
   locked
 )
 ;; End the Undo mark
 (_EndUndo doc)
 
 ;; Exit Cleanly
 (princ)
)

(vl-load-com)
(setq *mass-fact* 0.00782)
;; Command to calculate the volume of selected objects
(defun c:vol (/ vol:calc vol:calc-block blst sum ss item)
 ;; Helper function to calculate a single entity's volume
 (defun vol:calc (eo / val)
   (cond
     ((eq (vla-get-ObjectName eo) "AcDbBlockReference")
      (vol:calc-block (vla-get-EffectiveName eo))
     )
     ((not (vl-catch-all-error-p (setq val (vl-catch-all-apply 'vla-get-Volume (list eo))))) val)
     (t 0.0)
   )
 )
 ;; Helper function to calculate the volume contained within a block definition
 (defun vol:calc-block (name / blk item sum)
   (setq sum 0.0)
   (if (setq blk (assoc name blst))
     (setq sum (cdr blk))
     (if (not (vl-catch-all-error-p (setq blk (vl-catch-all-apply 'vla-Item (list *BlocksCollection* name))))
         )
       (progn
         (vlax-for item blk
           (setq sum (+ sum (vol:calc item)))
         )
         (setq blst (cons (cons name sum) blst))
       )
     )
   )
   sum
 )
 ;; Initialize variables
 (setq sum 0.0)
 (or *ActiveDocument* (setq *ActiveDocument* (vla-get-ActiveDocument (vlax-get-acad-object))))
 (or *BlocksCollection* (setq *BlocksCollection* (vla-get-Blocks *ActiveDocument*)))
 ;; Step through a selection set, adding the volume of each item to a sum
 (princ "\nSelect entities to calculate volume from: ")
 (if (and (setq ss (ssget '((0 . "3DSOLID,INSERT"))))
          (not (vl-catch-all-error-p
                 (setq ss (vl-catch-all-apply 'vla-get-ActiveSelectionSet (list *ActiveDocument*)))
               )
          )
     )
   (vlax-for item ss
     (setq sum (+ sum (vol:calc item)))
   )
 )
 (princ (strcat "\n<< Total Volume = " (rtos (/ sum (expt 1000.0 3)) 2 3) " m³ >>"))
 (princ
   (strcat "\n<< Mass @" (rtos *mass-fact*) " = " (rtos (/ (* *mass-fact* sum) 1000.0) 2 2) " kg >>")
 )
 (princ)
)

(defun c:vol (/ ss vol bset |cmdecho|)
 (setq density 0.00782)
 (vl-load-com)
 (SETQ |cmdecho| (GETVAR "cmdecho"))
 (SETVAR "cmdecho" 0)
 (COMMAND "undo" "begin")
 (c:ExplodeAllBlocks)
 (COMMAND "undo" "end")
 (if (setq ss (ssget '((0 . "3DSOLID"))))
   (progn
     (setq vol
       (apply '+
         (vl-remove-if
           'vl-catch-all-error-p
             (mapcar
               (function
                 (lambda (x)
                   (vl-catch-all-apply
                     'vla-get-volume (list x))))
               (mapcar 'vlax-ename->vla-object
                 (vl-remove-if 'listp
                   (mapcar 'cadr (ssnamex ss))))))))
     (command "undo" "")
     (setq volume (rtos vol 2 2)) ))
    (setq massa (* density vol))
 (princ (strcat "\n<< Total Volume = " (rtos (/ vol (expt 1000.0 3)) 2 4) " m³ >>"))
 (PRINC (strcat "\n<< Mass @" (rtos (* density 1000000) 2 2) " kg/m^3 = " (rtos (/ massa 1000) 2 2) " kg >>"))
 (princ)
 (SETVAR "cmdecho" |cmdecho|)
 )