;;; --------------------------------------------------------------------------- ;;; WhereUsed.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; FIND WHAT IS STILL USING A LAYER, STYLE, LINETYPE OR BLOCK ;;; ;;; PURPOSE ;;; Answers the question PURGE never will: "why can I not get rid of this?" ;;; ;;; You try to purge a layer, a text style, a linetype or a block, AutoCAD ;;; refuses, and nothing on screen appears to be using it. This finds what is, ;;; and tells you exactly where. ;;; ;;; WHERE IT LOOKS ;;; Every block definition in the drawing, model space and every paper space ;;; layout included - they are all block definitions underneath, so one sweep ;;; of the block table covers the lot. That catches the usual culprit: a stray ;;; object on the layer inside a block nobody has opened for years. ;;; ;;; Then the references that are NOT objects at all, and which are what ;;; normally defeats people: ;;; ;;; - a LINETYPE assigned to a LAYER definition, even one with nothing on it ;;; - a TEXT STYLE named by a DIMENSION STYLE as its text font ;;; - a BLOCK named by a DIMENSION STYLE as a custom arrowhead ;;; - anything that happens to be the CURRENT layer, style, linetype or ;;; dimension style, which alone is enough to block a purge ;;; ;;; None of those show up when you look at the drawing, which is exactly why ;;; they are so annoying. ;;; ;;; WHAT WAS FIXED ;;; - The Linetype and Style options crashed. The scan compared the wanted ;;; name against a DXF group read straight off each entity, and neither ;;; group 6 nor group 7 is present on most objects - linetype is omitted ;;; when it is BYLAYER, and text style only appears on text. Comparing a ;;; string with the resulting nil is a bad argument type, so the search ;;; stopped on the first ordinary line it met. Only Layer and Block ever ;;; worked. ;;; - It stopped at the FIRST match inside each block, so it could say a block ;;; used something but never how much of it there was. ;;; - It looked only inside block definitions, and not at the table entries ;;; that reference each other - which is where the hard cases live. ;;; - It defined a global function called GET. Anything else in the session ;;; that defined or expected its own GET would collide with it. ;;; - It computed the mline style dictionary once at load time into a global, ;;; so a drawing opened later in the session was searched against the wrong ;;; dictionary. ;;; - Progress was reported by printing a block name then backspacing over it ;;; with a global character counter, which left the tail of the longest name ;;; on screen whenever a shorter one followed. ;;; ;;; WHEREUSED - find every reference to a named item ;;; --------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------- ;;; SUPPORT ;;; --------------------------------------------------------------------------- ;;; A DXF group's value, or nil. The point of wrapping this is that a missing ;;; group must come back as nil and be handled, never compared. (defun WhereUsed:Dxf ( code data ) (cdr (assoc code data))) ;;; Resolve an object handle to the name it carries. Used to follow a dimension ;;; style's pointers to its text style and arrowhead blocks, which are stored as ;;; handles rather than names. (defun WhereUsed:HandleName ( h / e ) (if (and h (setq e (handent h))) (WhereUsed:Dxf 2 (entget e))) ) ;;; Does this entity reference the wanted item? KIND says which sort of thing we ;;; are looking for; the group examined and the test differ for each. (defun WhereUsed:Hits ( data kind name / v ) (cond ((= kind "Layer") (and (setq v (WhereUsed:Dxf 8 data)) (= (strcase v) name))) ;; Group 6 is absent when the linetype is BYLAYER, which is the normal ;; case - hence the test for nil before comparing. ((= kind "Linetype") (and (setq v (WhereUsed:Dxf 6 data)) (= (strcase v) name))) ;; Group 7 only exists on text, attributes and attribute definitions. ((= kind "Style") (and (setq v (WhereUsed:Dxf 7 data)) (= (strcase v) name))) ;; Only a genuine INSERT counts. A DIMENSION also carries group 2, but ;; it names the anonymous *D block holding the dimension's own geometry, ;; which is not a reference to a user block. ((= kind "Block") (and (= "INSERT" (WhereUsed:Dxf 0 data)) (setq v (WhereUsed:Dxf 2 data)) (= (strcase v) name))) ((= kind "Dimstyle") (and (member (WhereUsed:Dxf 0 data) '("DIMENSION" "LEADER" "TOLERANCE")) (setq v (WhereUsed:Dxf 3 data)) (= (strcase v) name))) ) ) ;;; Does the named item exist? (defun WhereUsed:Exists ( kind name / tbl ) (setq tbl (cdr (assoc kind '(("Layer" . "LAYER") ("Linetype" . "LTYPE") ("Style" . "STYLE") ("Block" . "BLOCK") ("Dimstyle" . "DIMSTYLE"))))) (tblsearch tbl name) ) ;;; A readable name for where something was found. Model and paper space are ;;; block definitions with reserved names, and saying so would confuse. (defun WhereUsed:Place ( blockname ) (cond ((wcmatch (strcase blockname) "`*MODEL_SPACE*") "model space") ((wcmatch (strcase blockname) "`*PAPER_SPACE*") "a paper space layout") ((wcmatch blockname "`**") (strcat "anonymous block " blockname)) (t (strcat "block " blockname))) ) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:WHEREUSED ( / *error* vars vals kind name blk bname e data hits total places indirect v cur dsname dsdata lay ltname n ) (setq vars '("CMDECHO") vals (mapcar 'getvar vars)) (defun WhereUsed:Restore ( ) (mapcar 'setvar vars vals) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (WhereUsed:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** WHEREUSED error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) ;; Nothing is drawn or changed, so there is no undo group to open. This is a ;; read-only report. (initget "Layer Linetype Style Block Dimstyle") (setq kind (getkword "\nWhat to look for [Layer/Linetype/Style/Block/Dimstyle] : ")) (if (null kind) (setq kind "Layer")) (setq name (strcase (getstring t (strcat "\nName of the " (strcase kind t) " to trace: ")))) (cond ((= "" name) (princ "\nNothing to look for.")) ((not (WhereUsed:Exists kind name)) (princ (strcat "\nThere is no " (strcase kind t) " called \"" name "\" in this drawing."))) (t (princ (strcat "\nScanning every block definition for " (strcase kind t) " \"" name "\"...")) ;; --- direct object references --------------------------------- ;; Walking the block table reaches model space, every layout and ;; every block definition, because all of them are blocks. (setq total 0 places nil blk nil) (while (setq blk (tblnext "BLOCK" (null blk))) (setq bname (WhereUsed:Dxf 2 blk) e (WhereUsed:Dxf -2 blk) hits 0) (while e (setq data (entget e)) (if (WhereUsed:Hits data kind name) (setq hits (1+ hits))) ;; Attributes hang off an INSERT and carry their own layer ;; and style, so they have to be examined too. (setq e (entnext e))) (if (> hits 0) (setq places (cons (cons bname hits) places) total (+ total hits)))) ;; --- references that are not objects --------------------------- (setq indirect nil) ;; A linetype assigned to a layer definition holds it, even if the ;; layer is empty. (if (= kind "Linetype") (progn (setq lay nil) (while (setq lay (tblnext "LAYER" (null lay))) (if (and (setq v (WhereUsed:Dxf 6 lay)) (= (strcase v) name)) (setq indirect (cons (strcat "layer \"" (WhereUsed:Dxf 2 lay) "\" is set to this linetype") indirect)))))) ;; Dimension styles point at a text style and up to four arrowhead ;; blocks, by handle rather than by name. (if (member kind '("Style" "Block")) (progn (setq dsname nil) (while (setq dsname (tblnext "DIMSTYLE" (null dsname))) ;; TBLNEXT gives the abbreviated record; the handle ;; pointers only appear on the full object, which has to ;; be fetched separately. Older drawings may not have one. (setq v (tblobjname "DIMSTYLE" (WhereUsed:Dxf 2 dsname)) dsdata (if v (entget v))) (foreach pair '((340 . "text style") (342 . "arrowhead") (343 . "first arrowhead") (344 . "second arrowhead") (341 . "leader arrowhead")) (setq v (WhereUsed:HandleName (WhereUsed:Dxf (car pair) dsdata))) (if (and v (= (strcase v) name) (or (and (= kind "Style") (= 340 (car pair))) (and (= kind "Block") (/= 340 (car pair))))) (setq indirect (cons (strcat "dimension style \"" (WhereUsed:Dxf 2 dsname) "\" uses it as its " (cdr pair)) indirect))))))) ;; Whatever is current cannot be purged, full stop. (setq cur (cond ((= kind "Layer") (getvar "CLAYER")) ((= kind "Linetype") (getvar "CELTYPE")) ((= kind "Style") (getvar "TEXTSTYLE")) ((= kind "Dimstyle") (getvar "DIMSTYLE")) (t nil))) (if (and cur (= (strcase cur) name)) (setq indirect (cons (strcat "it is the CURRENT " (strcase kind t) " - that alone prevents a purge") indirect))) ;; --- the report ------------------------------------------------- (princ (strcat "\n\n" (strcase kind) " \"" name "\"")) (if (null places) (princ "\n No objects anywhere in the drawing use it.") (progn (princ (strcat "\n " (itoa total) " object" (if (= total 1) "" "s") " in " (itoa (length places)) " place" (if (= 1 (length places)) "" "s") ":")) (foreach p (reverse places) (princ (strcat "\n " (itoa (cdr p)) " in " (WhereUsed:Place (car p))))))) (if indirect (progn (princ "\n Held by something other than an object:") (foreach s (reverse indirect) (princ (strcat "\n " s))))) (if (and (null places) (null indirect)) (princ (strcat "\n Nothing is using it - PURGE should remove it." "\n If it will not, run PURGE twice: removing one" "\n item can release another.")) (princ "\n\n Clear the above and it will purge.")) ) ) (WhereUsed:Restore) (princ) ) (princ)