;;; --------------------------------------------------------------------------- ;;; PartWeight.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; WEIGHT OF A FLAT PART, FROM ITS OUTLINE ;;; ;;; PURPOSE ;;; Works out what a cut plate part will weigh: select its outline, give a ;;; thickness and a material, and it reports the area, the volume and the ;;; weight. Select several outlines and it totals them. ;;; ;;; This is the number that goes on a cutting list, prices a job, and decides ;;; whether two people can lift it. ;;; ;;; THE IMPROVEMENT THAT MATTERS ;;; The routine this replaces asked you to TYPE the area in. That meant working ;;; it out somewhere else first, which is both the slow part and the part that ;;; goes wrong. Here the area is measured straight off the geometry you have ;;; already drawn. ;;; ;;; Holes and cut-outs are handled the way a fabricator thinks about them: ;;; select the outline first, then the holes, and the holes are SUBTRACTED. A ;;; plate with a big central opening weighs what is left, not what it started ;;; as. ;;; ;;; UNITS ;;; Ask it whether the drawing is in inches or millimetres and it does the rest: ;;; ;;; Inches area in square inches, weight in pounds ;;; Millimetres area in square millimetres, weight in kilograms ;;; ;;; Densities are held once in pounds per cubic inch and converted for metric ;;; by the exact factor 27.6799, which is how many grams per cubic centimetre ;;; there are in a pound per cubic inch. Holding one table and converting is ;;; what stops the two sets of figures drifting apart. ;;; ;;; PARTWEIGHT - weigh a flat part from its outline ;;; --------------------------------------------------------------------------- (vl-load-com) ;;; --------------------------------------------------------------------------- ;;; MATERIALS ;;; ;;; Density in pounds per cubic inch. Multiply by 27.6799 for grams per cubic ;;; centimetre, which is the same number a metric table would quote - mild steel ;;; comes out at 7.84, aluminium at 2.70, as expected. ;;; --------------------------------------------------------------------------- (setq PartWeight:LB_TO_GCM3 27.6799) (setq PartWeight:Materials '(("Steel" . 0.28330) ; mild steel ("Stainless" . 0.28900) ; 304 / 316 ("Aluminium" . 0.09750) ; 6061 ("Brass" . 0.30700) ("Copper" . 0.32300) ("CastIron" . 0.26000) ("Titanium" . 0.16300) ("Acrylic" . 0.04300) )) (defun PartWeight:Density ( name / hit ) (if (setq hit (assoc name PartWeight:Materials)) (cdr hit))) ;;; --------------------------------------------------------------------------- ;;; SESSION MEMORY ;;; --------------------------------------------------------------------------- (if (null *PartWeight:Prefs*) (setq *PartWeight:Prefs* (list (cons "MATERIAL" "Steel") (cons "THICK" 0.25) (cons "UNITS" "Inches") ; Inches | Millimetres (cons "CUSTOM" 0.2833) ; custom density, lb/in3 ) ) ) (defun PartWeight:Get ( key ) (cdr (assoc key *PartWeight:Prefs*))) (defun PartWeight:Put ( key val ) (setq *PartWeight:Prefs* (cons (cons key val) (vl-remove-if '(lambda (p) (= (car p) key)) *PartWeight:Prefs*))) val ) ;;; --------------------------------------------------------------------------- ;;; AREA ;;; ;;; Sums the enclosed area of everything selected. Only closed curves have a ;;; meaningful area, so anything open is counted and reported rather than ;;; silently contributing zero - an open outline is nearly always a drawing ;;; error, and finding out from the weight being wrong is expensive. ;;; ;;; Returns ( total-area counted skipped ). ;;; --------------------------------------------------------------------------- (defun PartWeight:Area ( ss / i ent obj total counted skipped a closed ) (setq i 0 total 0.0 counted 0 skipped 0) (repeat (sslength ss) (setq ent (ssname ss i) obj (vlax-ename->vla-object ent) i (1+ i)) ;; A circle or an ellipse is closed by definition and carries no Closed ;; property to test; everything else has to say so. (setq closed (cond ((member (vla-get-objectname obj) '("AcDbCircle" "AcDbEllipse")) t) ((vlax-property-available-p obj 'Closed) (= :vlax-true (vla-get-closed obj))) (t nil))) (if closed (progn (setq a (vl-catch-all-apply '(lambda ( ) (vla-get-area obj)))) (if (vl-catch-all-error-p a) (setq skipped (1+ skipped)) (setq total (+ total a) counted (1+ counted)))) (setq skipped (1+ skipped)))) (list total counted skipped) ) ;;; Ask for a selection and return its area, or nil. (defun PartWeight:Pick ( prompt / ss r ) (princ (strcat "\n" prompt)) (if (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE,SPLINE,REGION")))) (progn (setq r (PartWeight:Area ss)) (if (> (caddr r) 0) (princ (strcat "\n " (itoa (caddr r)) " object(s) ignored - not closed, so they have no area."))) (if (> (cadr r) 0) (progn (princ (strcat "\n " (itoa (cadr r)) " closed outline(s), area " (rtos (car r) 2 4))) (car r)))))) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:PARTWEIGHT ( / *error* vars vals opt metric gross holes net thick mat density volume weight areaUnit volUnit wtUnit v pt height ) (setq vars '("CMDECHO" "OSMODE" "CLAYER") vals (mapcar 'getvar vars)) (defun PartWeight:Restore ( ) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End")) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (PartWeight:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** PARTWEIGHT error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) ;; --- settings ----------------------------------------------------------- (initget "Inches Millimetres") (setq opt (getkword (strcat "\nDrawing units [Inches/Millimetres] <" (PartWeight:Get "UNITS") ">: "))) (if opt (PartWeight:Put "UNITS" opt)) (setq metric (= (PartWeight:Get "UNITS") "Millimetres")) (initget "Steel Stainless Aluminium Brass Copper CastIron Titanium Acrylic Other") (setq opt (getkword (strcat "\nMaterial [Steel/Stainless/Aluminium/Brass/Copper/" "CastIron/Titanium/Acrylic/Other] <" (PartWeight:Get "MATERIAL") ">: "))) (if opt (PartWeight:Put "MATERIAL" opt)) (setq mat (PartWeight:Get "MATERIAL")) (if (= mat "Other") (progn (initget 6) (setq v (getreal (strcat "\nDensity in " (if metric "g/cm3" "lb/in3") " <" (rtos (if metric (* (PartWeight:Get "CUSTOM") PartWeight:LB_TO_GCM3) (PartWeight:Get "CUSTOM")) 2 4) ">: "))) ;; Stored internally in lb/in3 whatever the user typed, so the one ;; table stays the single source of truth. (if v (PartWeight:Put "CUSTOM" (if metric (/ v PartWeight:LB_TO_GCM3) v))) (setq density (PartWeight:Get "CUSTOM"))) (setq density (PartWeight:Density mat))) (initget 6) (setq v (getdist (strcat "\nMaterial thickness <" (rtos (PartWeight:Get "THICK") 2 4) ">: "))) (if v (PartWeight:Put "THICK" v)) (setq thick (PartWeight:Get "THICK")) ;; --- geometry ----------------------------------------------------------- (setq gross (PartWeight:Pick "Select the OUTLINE of the part:")) (if (null gross) (princ "\nNo closed outline selected - nothing to weigh.") (progn (initget "Yes No") (setq opt (getkword "\nSubtract holes or cut-outs [Yes/No] : ")) (setq holes (if (= opt "Yes") (PartWeight:Pick "Select the HOLES to subtract:") nil)) (if (null holes) (setq holes 0.0)) (setq net (- gross holes)) (cond ((<= net 0.0) (princ "\n** The holes are as large as the outline - nothing left to weigh. **")) (t ;; Volume in the drawing's own units, then weight. (setq volume (* net thick)) (if metric ;; mm3 x g/cm3 / 1e6 = kg. The 1e6 is 1000 mm3 per cm3 ;; times 1000 g per kg. (setq weight (/ (* volume (* density PartWeight:LB_TO_GCM3)) 1000000.0) areaUnit "mm2" volUnit "mm3" wtUnit "kg") (setq weight (* volume density) areaUnit "in2" volUnit "in3" wtUnit "lb")) (textscr) (princ "\n\n===========================================") (princ "\n PART WEIGHT") (princ "\n===========================================") (princ (strcat "\n Material " mat " (" (rtos (if metric (* density PartWeight:LB_TO_GCM3) density) 2 4) (if metric " g/cm3)" " lb/in3)"))) (princ (strcat "\n Thickness " (rtos thick 2 4))) (princ (strcat "\n Gross area " (rtos gross 2 4) " " areaUnit)) (if (> holes 0.0) (progn (princ (strcat "\n Less holes " (rtos holes 2 4) " " areaUnit)) (princ (strcat "\n Net area " (rtos net 2 4) " " areaUnit)))) (princ (strcat "\n Volume " (rtos volume 2 4) " " volUnit)) (princ "\n -----------------------------------------") (princ (strcat "\n WEIGHT " (rtos weight 2 3) " " wtUnit)) (princ "\n===========================================\n") ;; Offer to stamp it on the drawing, which is where it is ;; wanted often enough to be worth asking. (initget "Yes No") (setq opt (getkword "\nPlace the weight as text on the drawing [Yes/No] : ")) (if (= opt "Yes") (progn (graphscr) (setq pt (getpoint "\nText point: ")) (if pt (progn (setvar "OSMODE" 0) (setq height (* (getvar "DIMSCALE") (getvar "DIMTXT"))) (if (<= height 0.0) (setq height 0.125)) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler ;; unless the routine says up front that it will use one. Restore does, ;; to close this undo group. The declaring call is absent on older ;; releases, so it is wrapped rather than tested for. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") (command "_.TEXT" pt height 0 (strcat (strcase mat) " " (rtos thick 2 3) " THK - " (rtos weight 2 2) " " (strcase wtUnit))))))) ) ) ) ) (PartWeight:Restore) (princ) ) (princ)