;| SCOOP.lsp - Subtract Copies Of Objects, Please Finally, smart subtraction and separation for single & multiple 3Dsolids, as if DELOBJ=0 applied to Boolean operations. From one set of solids 'A', SCOOP subtracts a second set of solids 'B'. Unlike the regular SUBTRACT command, 1) when more than one object is in the first set, they all remain... - as individual solids.........NOT a single new unioned solid - on their original layers.....NOT the layer of the first one selected - with original materials......NOT the new solid's by-layer material 2) all the objects in 'B' remain... - in place and unchanged.......NOT erased. And unlike the regular SEPARATE command, if you use the option provided here, 3) all the resulting new 'child' solids... - remain on the parent layer...NOT one on the parent layer and the rest on the current layer - and inherit its material.....NOT different by-layer materials. Interface: Command: SCOOP Select solid(s) to subtract FROM. (Solids on locked layers will not be modified.) Select objects: 12 found Select objects: Select solid(s) to BE SUBTRACTED. Select objects: 4 found Select objects: 2 solids on locked layers were not modified. 7 lumpy solid(s) found. Separate them? (Yes or [No]): y Command: Notes: 1) SEPARATE option If SCOOP results in any solids in 'A' having "multiple lumps" i.e., pieces that do not touch, the option to SEPARATE them is offered. Note that choosing "Yes" will SEPARATE solids in 'A' that were lumpy before SCOOP as well as those made lumpy by SCOOP. 2) By-object material assignments When AutoCAD's Boolean subtraction operation (which is what SCOOP uses behind the scenes) is run on solids that have by-object material assignments, it changes their by-object material assignments to by-face material assignments, so some cleanup might be needed in rendering applications. SCOOP does not attempt to identify or alter this behavior. Also, in this case the resulting new faces inherit the material of the solid that was *subtracted* -- very much a pain. SCOOP does not attempt to identify or alter this behavior, either. Call Autodesk, not me. 3) Locked layers - If a solid in 'A' is on a locked layer, nothing will be subtracted from it. - If a solid in 'B' is on a locked layer, a copy will be subtracted. With the regular SUBTRACT command, it would be ignored. 4) Logic - Sets 'A' and 'B' may not have any objects in common; the routine will exit if any objects are selected that are in both sets. Try again. - A solid in 'B' will be subtracted from all of those in 'A' on unlocked layers that it intersects. 5) Performance On a test drawing where 100 solids were subtracted from 100 other solids, resulting in 10,000 possible intersections, plain SUBTRACT took 3.03 seconds, while SCOOP took 2.08 seconds to do the smart subtraction and another 2.40 seconds to do the smart separation. 6) Compatibility Because VL functions are required, SCOOP will not run on pre-2000 versions of AutoCAD. It has been tested with versions ADT 2006, ACA 2008, and ACA 2010. 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. ver 1.0 Jan 28 2010 - initial public release ver 1.1 Feb 03 2010 - layer and material assignments preserved regardless of current layer - SEPARATE option - error-handling - locked-layer and total number reporting ver 1.11 Feb 07 2010 - unlocked layer for temporary objects - greatly optimized for large selection sets - all functions and symbols local ======================================================================= |; (defun c:scoop ( / *cmdecho *clayer olderror ssa ssb ssUnlocked layerForCopies ssUnlocked ssLumpy acadObject acadDocument ) (defun setup () (vl-load-com) (setq acadObject (vlax-get-acad-object)) (setq acadDocument (vlax-get-property acadObject 'ActiveDocument)) (vla-StartUndoMark acadDocument) (setq *cmdecho (getvar 'cmdecho)) (setvar 'cmdecho 0) (setq olderror *error*) (setq *error* myerror) (setq *clayer (getvar 'clayer)) ) (defun myerror (msg) ;; doubles as error-handler and standard cleanup (setq *error* olderror) (setvar 'clayer *clayer) (vla-EndUndoMark acadDocument) (setvar 'cmdecho *cmdecho) (princ) ) ;; need an unlocked unfrozen working layer to create copies on (defun findWorkingLayer ( / lay laystatus flag) (setq lay (tblnext "LAYER" T)) (setq flag nil) ;;set to T when unlocked layer found (while (and lay (not flag)) (setq laystatus (cdr (assoc 70 lay))) (if (or (= laystatus 0) (= laystatus 2)) (setq flag T layerForCopies (cdr (assoc 2 lay))) (setq lay (tblnext "LAYER")) ) ) (if (not flag) (progn (vlr-beep-reaction) (princ "Sorry -- can't SCOOP if all visible layers are locked.") (myerror) (quit) ) ) ) (defun getSolids () (prompt (strcat "\nSelect solid(s) to subtract FROM " "(ones on locked layers will be ignored).\n")) (if (not (and (setq ssa (ssget '((0 . "3DSOLID")))) (progn (prompt "\nSelect solid(s) to BE SUBTRACTED.\n ") (setq ssb (ssget '((0 . "3DSOLID")))) ) ) ) (progn (vlr-beep-reaction) (princ "\nOops -- no solids selected for that group.") (myerror) (quit) ) ) (if (> (sslength (SetIntersect (list ssa ssb))) 0) (progn (vlr-beep-reaction) (princ "\nOops -- sets can not have members in common.") (myerror) (quit) ) ) ) (defun subtractCopies ( / n m enA enB obJA objB lay lockedObj counter total) (setq ssUnlocked (ssadd)) (setq n 0) (setq lockedObj 0) (while (< n (sslength ssa)) (setq enA (ssname ssa n)) (setq objA (vlax-ename->vla-object enA)) (setq lay (cdr (assoc 8 (entget enA)))) (if (= 4 (cdr (assoc 70 (tblsearch "LAYER" lay)))) (setq lockedObj (1+ lockedObj)) (progn (ssadd enA ssUnlocked) ;; remember only these so we can skip ones ;; on locked layers in the SEPARATE routine (setq m 0) (while (< m (sslength ssb)) (setq enB (ssname ssb m)) (if (boundingBoxOverlap enA enB) ;fast check for possible overlap (progn (setq ed (entget enB) old (assoc 8 ed) new (cons 8 layerForCopies) ed (subst new old ed) ) (entmake ed) (setq objB (vlax-ename->vla-object (entlast))) (vla-boolean objA acSubtraction objB) ) ) (setq m (1+ m)) ) ) ) (setq n (1+ n)) );while (if (= lockedObj 1) (princ (strcat "\n1 solid on a locked layer was not modified.\n"))) (if (> lockedObj 1) (princ (strcat "\n" (itoa lockedObj) " solids on locked layers were not modified.\n"))) ) (defun boundingBoxOverlap (A B / Amin Amax Bmin Bmax) ;;by Bill Gilliss (vlax-invoke-method (vlax-ename->vla-object A) "getboundingbox" 'minA 'maxA) (setq Amin (vlax-safearray->list minA) Amax (vlax-safearray->list maxA)) (vlax-invoke-method (vlax-ename->vla-object B) "getboundingbox" 'minB 'maxB) (setq Bmin (vlax-safearray->list minB) Bmax (vlax-safearray->list maxB)) (if ;;if any of these conditions are true, then there is no overlap (or (>= (car Amin) (car Bmax)) ;A entirely to right of B (>= (cadr Amin) (cadr Bmax)) ;A entirely in back of B (>= (caddr Amin) (caddr Bmax)) ;A entirely above B (<= (car Amax) (car Bmin)) ;A entirely to left of B (<= (cadr Amax) (cadr Bmin)) ;A entirely in front of B (<= (caddr Amax) (caddr Bmin)) ;A entirely below B ) nil T ) ) (defun findLumpySolids ( / n en lumps f lin file) ;; by Bill Gilliss ;; There doesn't seem to be VLxx property or method to determine if a ;; 3Dsolid is lumpy or not, so here is a solution suggested by ;; Jason Rhymes and implemented by yours truly. (setq ssLumpy (ssadd)) (setq n 0) (while (< n (sslength ssUnlocked)) (setq en (ssname ssUnlocked n)) (setq file (vl-filename-mktemp "scoop.sat")) (vl-cmdf "export" file en "") (setq lumps 0) (setq f (open file "r")) (while (setq lin (read-line f)) (if (= "lump" (substr lin 1 4)) (setq lumps (1+ lumps)) ) ) (close f) (vl-file-delete file) (if (> lumps 1)(ssadd en ssLumpy)) (setq n (1+ n)) ) ) (defun separateLumpySolids ( / n en) (if (> (sslength ssLumpy) 0) (progn (initget "Yes No") (setq reply (getkword (strcat "\n" (itoa (sslength ssLumpy)) " lumpy solids found. Separate them? (Yes or [No]):"))) (if (= reply "Yes") (progn (setq n 0) (while (< n (sslength ssLumpy)) (setq en (ssname ssLumpy n)) (setvar 'clayer (cdr (assoc 8 (entget en)))) (command "._solidedit" "_body" "_separate" en "_x" "_x") (setq n (1+ n)) ) ) ) ) ) ) (defun SetCopy (setname / n result) ;;by Bill Gilliss (if (= (type setname) 'VLA-OBJECT) (setq setname (Set->AL setname))) (setq result (ssadd)) (setq n 0) (while (< n (sslength setname)) (ssadd (ssname setname n) result) (setq n (1+ n)) ) result ) (defun SetIntersect (setlist / n ct setname result origset ent) ;;by Bill Gilliss (setq origset (setCopy (nth 0 setlist))) ;returns AutoLISP set (setq result origset) (setq n 1) (while (< n (length setlist)) (setq ct 0 result (ssadd) setname (nth n setlist) ) (if (= (type setname) 'VLA-OBJECT) (setq setname (Set->AL setname))) (repeat (sslength setname) (setq ent (ssname setname ct)) (if (ssmemb ent origset) (ssadd ent result) ) (setq ct (1+ ct)) ) (if (= 0 (sslength result)) ;;quit on empty set (setq n (length setlist)) (setq origset result) ) (setq n (1+ n)) ) result ) (setup) ;; initialize enviroment (findWorkingLayer) ;; find name of an unlocked layer for temp solids (getSolids) ;; prompt user for sets 'A' and 'B' (subtractCopies) ;; subtract set 'B' from set 'A' (findLumpySolids) ;; find resulting solids with multiple lumps (separateLumpySolids) ;; offer to separate these (myerror) ;; clean up environment on exit );main defun (princ "\nSCOOP loaded.") (princ)