;;; =========================================================================== ;;; Routine Name: SOLBND (Auto-Shrinkwrap by Color) ;;; Description: Groups selected solids/hatches by color, generates an overall ;;; boundary using Civil 3D's Shrinkwrap, and places it on a newly ;;; created matching color layer. Fixed for Civil 3D selection bug. ;;; =========================================================================== (vl-load-com) (defun c:SOLBND ( / ss colMap layProps i ent ed lay c62 c420 R G B rgbStr targetLay laySuffix layColorCmd mapEntry grp layName ents lCmd ssCol lastEnt oldLay oldCmd) (setq oldLay (getvar "CLAYER") oldCmd (getvar "CMDECHO")) (setvar "CMDECHO" 0) (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (princ "\nSelect SOLIDS, HATCHES, or POLYLINES to group and shrinkwrap: ") ;; Filter allows standard filled geometry types (if (setq ss (ssget '((0 . "SOLID,HATCH,LWPOLYLINE,POLYLINE,REGION,MPOLYGON")))) (progn (setq colMap '() layProps '() i 0) ;; --- PASS 1: Group Entities by Color --- (repeat (sslength ss) (setq ent (ssname ss i) ed (entget ent) c62 (cdr (assoc 62 ed)) c420 (cdr (assoc 420 ed)) lay (cdr (assoc 8 ed))) ;; Determine the absolute color of the entity (cond ;; 1. TrueColor (RGB) (c420 (setq R (lsh c420 -16) G (logand (lsh c420 -8) 255) B (logand c420 255) rgbStr (strcat (itoa R) "," (itoa G) "," (itoa B)) targetLay (strcat "BNDY_RGB_" (itoa R) "-" (itoa G) "-" (itoa B)) layColorCmd (list "_c" "_t" rgbStr)) ) ;; 2. Standard AutoCAD Color Index (ACI) (t (if (or (null c62) (= c62 256) (= c62 0)) ;; If ByLayer, fetch the layer's actual color (setq c62 (abs (cdr (assoc 62 (tblsearch "LAYER" lay))))) ) ;; Translate standard colors to nice names (setq laySuffix (itoa c62)) (cond ((= c62 1) (setq laySuffix "RED")) ((= c62 2) (setq laySuffix "YELLOW")) ((= c62 3) (setq laySuffix "GREEN")) ((= c62 4) (setq laySuffix "CYAN")) ((= c62 5) (setq laySuffix "BLUE")) ((= c62 6) (setq laySuffix "MAGENTA")) ((= c62 7) (setq laySuffix "WHITE")) ) (setq targetLay (strcat "BNDY_" laySuffix) layColorCmd (list "_c" (itoa c62))) ) ) ;; Map the entity to its color group (setq mapEntry (assoc targetLay colMap)) (if mapEntry (setq colMap (subst (append mapEntry (list ent)) mapEntry colMap)) (progn (setq colMap (append colMap (list (list targetLay ent)))) (setq layProps (append layProps (list (cons targetLay layColorCmd)))) ) ) (setq i (1+ i)) ) ;; --- PASS 2: Generate Boundaries --- ;; CRITICAL FIX: Clear the active grips/selection from the user's initial ssget ;; so Civil 3D doesn't incorrectly absorb everything into the first shrinkwrap. (sssetfirst nil) (foreach grp colMap (setq layName (car grp) ents (cdr grp) lCmd (cdr (assoc layName layProps))) ;; Create the new layer with the correct color (or unlock it if it exists) (if (not (tblsearch "LAYER" layName)) (if (= (length lCmd) 2) (command "_.-layer" "_m" layName (nth 0 lCmd) (nth 1 lCmd) "" "") (command "_.-layer" "_m" layName (nth 0 lCmd) (nth 1 lCmd) (nth 2 lCmd) "" "") ) (command "_.-layer" "_t" layName "_u" layName "_on" layName "") ) ;; Set current layer so the shrinkwrap lands exactly on it (setvar "CLAYER" layName) ;; Build a temporary selection set for this specific color (setq ssCol (ssadd)) (foreach e ents (ssadd e ssCol)) ;; Track the last entity to grab the newly created boundary (setq lastEnt (entlast)) ;; CRITICAL FIX: Force AutoCAD to store this specific color group as the "Previous" selection (command "_.SELECT" ssCol "") ;; Execute Civil 3D Linework Shrinkwrap targeting ONLY the Previous selection (vl-cmdf "_.LINEWORKSHRINKWRAP" "_P" "") ;; Safely clear out command pipe if Civil 3D pauses (while (> (getvar "CMDACTIVE") 0) (command "") ) ;; Ensure the newly created Shrinkwrap boundary is forced to "ByLayer" color (while (setq lastEnt (entnext lastEnt)) (if (vlax-write-enabled-p (vlax-ename->vla-object lastEnt)) (progn (vla-put-Layer (vlax-ename->vla-object lastEnt) layName) (vla-put-Color (vlax-ename->vla-object lastEnt) 256) ) ) ) ) (princ (strcat "\nSuccessfully generated boundaries for " (itoa (length colMap)) " color groups.")) ) (princ "\nNo valid solids or hatches selected.") ) ;; Restore original states (sssetfirst nil) (setvar "CLAYER" oldLay) (setvar "CMDECHO" oldCmd) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (princ) ) (princ "\nAuto-Shrinkwrap by Color loaded. Type SOLBND to run.") (princ)