;;; Program calculate properties of 3D Solid objects (Volume and Weight) as function of material current density
;;; Saved from http://www.cadtutor.net/forum/showthread.php?50892-lisp-to-calculate-mass/page2

(defun c:sp ( / den idx key obj sel vol )
(setq key "LMac\\solprop-density")
(if (or (setq den (getdensity key))
(setq den (setdensity key))
)
(while
(progn
(setvar 'errno 0)
(initget "Multiple Density Exit")
(princ (strcat "\nCurrent density: " (rtos den 2) " kg/m\U+00B3"))
(setq sel (entsel "\nSelect edge of solid object [Multiple/Density/Exit]: "))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (or (null sel) (= "Exit" sel))
nil
)
( (= "Density" sel)
(setq den (setdensity key))
)
( (= "Multiple" sel)
(if (setq sel (ssget '((0 . "3DSOLID"))))
(showdensity den
(repeat (setq idx (sslength sel))
(setq vol
(+ (cond (vol) (0.0))
(vla-get-volume (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
)
)
)
)
)
)
( (not (vlax-property-available-p (setq obj (vlax-ename->vla-object (car sel))) 'volume))
(princ "\nSelected object does not have Volume property.")
)
( (showdensity den (vla-get-volume obj)))
)
)
)
)
(princ)
)
(defun showdensity ( den vol )
(setq vol (/ vol 1e9))
(prompt
(strcat
"\nProperties for a solid object at " (rtos den 2 2) " kg/m\U+00B3 :"
"Volume = " (rtos vol 2 2) " m\U+00B3"
"Weight = " (rtos (* den vol) 2 2) " kg"
)
)
)
(defun getdensity ( key / den )
(if (and (setq den (getenv key))
(setq den (distof den 2))
(< 0 den)
)
den
)
)
(defun setdensity ( key / def tmp )
(initget 6)
(if (setq def (getdensity key)
tmp (cond ((getreal (strcat "\nSpecify density (kg/m\U+00B3)" (if def (strcat " : ") ": ")))) (def))
)
(setenv key (rtos tmp 2))
)
tmp
)
(vl-load-com) (princ)
(c:sp)

Advertisements