;;; --------------------------------------------------------------------------- ;;; LayerPilot.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; AUTOMATIC LAYER SWITCHING BY COMMAND ;;; ;;; LayerPilot watches every command you start and silently switches the ;;; current layer to whichever layer that command's output belongs on. Start ;;; the TEXT command and you land on the TEXT layer; start DIMLINEAR and you ;;; land on DIMENSIONS; finish the command and your original layer comes ;;; straight back. You never touch the layer dropdown again, and drawings ;;; stop accumulating text on the dimension layer. ;;; ;;; Beyond the layer itself, LayerPilot can also force object properties ;;; (colour, linetype, lineweight, transparency) back to ByLayer for the ;;; duration of the command, so a stray "current colour = red" setting can ;;; no longer contaminate new geometry. ;;; ;;; It also handles external references: attach an xref and the inserted ;;; INSERT entity is moved onto a layer named after the xref itself ;;; (e.g. "XREF-SITEPLAN"), keeping xrefs independently controllable. ;;; ;;; --------------------------------------------------------------------------- ;;; HOW IT WORKS ;;; ;;; The program is driven entirely by reactors -- event callbacks that ;;; AutoCAD fires as commands begin and end. Two reactors are used: ;;; ;;; * A COMMAND reactor, which fires for built-in AutoCAD commands. ;;; * A LISP reactor, which fires for AutoLISP-defined commands. This is ;;; needed because a custom command such as C:MYTEXT never reaches the ;;; command reactor under its own name. ;;; ;;; On :vlr-commandWillStart / :vlr-lispWillStart the program: ;;; 1. Normalises the reported command name. ;;; 2. Scans the settings table for the first wildcard pattern that ;;; matches it. ;;; 3. Creates the target layer if it does not yet exist. ;;; 4. PUSHES the current layer and the current property system variables ;;; onto stacks, then applies the new ones. ;;; ;;; On :vlr-commandEnded / Cancelled / Failed (and the LISP equivalents) it ;;; POPS those stacks and restores what was saved. ;;; ;;; Stacks, not single variables, are used because commands nest: a LISP ;;; command may internally call LINE, which may be transparently interrupted ;;; by ZOOM. Each "will start" pushes and each "ended" pops, so restoration ;;; always unwinds in the correct order no matter how deep the nesting goes. ;;; ;;; --------------------------------------------------------------------------- ;;; WHY THE STATE VARIABLES ARE GLOBAL ;;; ;;; Reactor callbacks are invoked by AutoCAD long after the command that ;;; created the reactor has returned. There is no enclosing function whose ;;; local variables the callbacks could see, so the saved-layer stack, the ;;; saved-variable stack and the settings tables MUST live at global scope. ;;; Every one of them is namespaced with a "*LayerPilot:...*" prefix so it ;;; cannot collide with anything else loaded in the drawing. ;;; ;;; --------------------------------------------------------------------------- ;;; CONFIGURING IT ;;; ;;; Everything you are expected to change lives in the SETTINGS block below, ;;; between the two banner lines. Nothing below that block needs editing. ;;; ;;; --------------------------------------------------------------------------- ;;; LAYERPILOTON - start automatic layer switching ;;; LAYERPILOTOFF - stop automatic layer switching ;;; LAYERPILOTECHO - toggle command-name echoing, used to discover the ;;; exact name of a command you want to add to the table ;;; --------------------------------------------------------------------------- ;;; The program enables itself automatically whenever a drawing is opened, ;;; by appending to the S::STARTUP function (see the very bottom of the file). ;;; --------------------------------------------------------------------------- (vl-load-com) ;;; =========================================================================== ;;; S E T T I N G S ;;; =========================================================================== (setq ;;; --------------------------------------------------------------------------- ;;; COMMAND-TO-LAYER TABLE ;;; --------------------------------------------------------------------------- ;;; Each row says "when a command matching this pattern starts, switch to ;;; this layer". Rows are tested top to bottom and the FIRST match wins, so ;;; put specific patterns above general ones. ;;; ;;; 1 COMMAND PATTERN Full command name, not an alias. Case-insensitive. ;;; Standard AutoCAD wildcards are allowed: ;;; * any sequence of characters ;;; ? any single character ;;; [DM] any one character from the set ;;; , separates alternatives ;;; e.g. "[DM]TEXT,TEXT" catches TEXT, DTEXT and MTEXT. ;;; e.g. "DIM*" catches every command starting "DIM". ;;; ;;; 2 LAYER NAME Layer to make current. Created if absent. ;;; ;;; The remaining columns are applied only when the layer has to be ;;; created (or always, if FORCE PROPERTIES below is set to T): ;;; ;;; 3 DESCRIPTION Free text shown in the Layer Properties Manager. ;;; Use "" for none. ;;; 4 COLOUR ACI colour index, 1 to 255. ;;; 5 LINETYPE Linetype name. If it is not already loaded in the ;;; drawing the program searches every .lin file on ;;; the support path and loads it. Falls back to ;;; "Continuous" if it cannot be found. ;;; 6 LINEWEIGHT Millimetres x 100 (so 0.25mm is 25, 2.11mm is 211). ;;; Use -3 for "Default". ;;; 7 PLOT FLAG 1 = layer plots, 0 = layer does not plot. ;;; 8 PLOT STYLE Named plot style, for STB drawings only. Use nil ;;; for CTB drawings or for the default plot style. ;;; --------------------------------------------------------------------------- *LayerPilot:Table* '( ;; Command Pattern Layer Name Description Colour Linetype Weight Plot Style ;; ---------------- ------------- --------------------- ------ ------------- ------ ---- ----- ("[DM]TEXT,TEXT" "TEXT" "Text Layer" 2 "Continuous" -3 1 nil ) ("DIM*,*LEADER" "DIMENSIONS" "Dimension Layer" 3 "Continuous" -3 1 nil ) ("*VPORT*" "DEFPOINTS" "" 7 "Continuous" -3 0 nil ) ("XLINE" "XLINE" "Construction Lines" 12 "HIDDEN" 0 0 nil ) ) ;;; --------------------------------------------------------------------------- ;;; FORCE PROPERTIES ON EXISTING LAYERS [ t / nil ] ;;; --------------------------------------------------------------------------- ;;; nil - layers listed above are created with the given properties, but if ;;; a layer of that name already exists it is left exactly as it is. ;;; This is the safe setting and the recommended one. ;;; ;;; t - every triggered layer is overwritten to match the table above on ;;; every single command. Use this only when you are enforcing a ;;; drawing standard and want deviations corrected automatically. ;;; --------------------------------------------------------------------------- *LayerPilot:ForceProps* nil ;;; --------------------------------------------------------------------------- ;;; SYSTEM VARIABLES TO OVERRIDE DURING A TRIGGERED COMMAND ;;; --------------------------------------------------------------------------- ;;; Each row is (variable-name value). The variable is set to that value ;;; while a matched command runs, and put back to whatever it was as soon ;;; as the command ends. ;;; ;;; The defaults below force new objects to inherit colour, linetype, ;;; lineweight and transparency from their layer, which is what makes ;;; layer-driven drawing standards actually hold. Variables that do not ;;; exist in the running AutoCAD version are dropped automatically, so this ;;; list is safe across releases. ;;; ;;; Delete every row if you do not want any variables touched. ;;; --------------------------------------------------------------------------- *LayerPilot:SysVars* '( ;; Variable Value ;; ---------------- --------- (cecolor "bylayer") (celtype "bylayer") (celweight -1 ) ;; -1 means ByLayer (cetransparency -1 ) ;; -1 means ByLayer ) ;;; --------------------------------------------------------------------------- ;;; XREF LAYER RULE ;;; --------------------------------------------------------------------------- ;;; When an xref is attached, move the resulting INSERT onto its own layer ;;; named so each xref can be frozen, dimmed ;;; or colour-controlled independently of the rest of the drawing. ;;; ;;; The first two items are the prefix and suffix (use "" for none). The ;;; remaining items are the same layer properties as columns 3-8 of the ;;; command table above. ;;; ;;; Set this to nil to leave xrefs on whatever layer is current. ;;; --------------------------------------------------------------------------- *LayerPilot:XrefRule* ;; Prefix Suffix Description Colour Linetype Weight Plot Style ;; -------- ------- ------------- ------ ------------- ------ ---- ----- '("XREF-" "" "XRef Layer" 250 "Continuous" -3 1 nil ) ;;; --------------------------------------------------------------------------- ;;; TRIGGER ON COMMANDS CALLED FROM INSIDE AUTOLISP [ t / nil ] ;;; --------------------------------------------------------------------------- ;;; nil - only the AutoLISP command you typed can trigger a layer change. ;;; Commands that the program itself issues internally are ignored, ;;; so a routine that deliberately manages its own layers is not ;;; fought with. This is the recommended setting. ;;; ;;; t - every command issued from inside an AutoLISP program can also ;;; trigger a layer change. ;;; --------------------------------------------------------------------------- *LayerPilot:LispCommands* nil ;;; --------------------------------------------------------------------------- ;;; ECHO COMMAND NAMES [ t / nil ] ;;; --------------------------------------------------------------------------- ;;; When T, every command name seen is printed at the command line. Turn it ;;; on temporarily (or use the LAYERPILOTECHO command) when you need to find ;;; out the exact internal name of a command so you can add it to the table. ;;; --------------------------------------------------------------------------- *LayerPilot:Echo* nil ) ;;; =========================================================================== ;;; E N D O F S E T T I N G S ;;; =========================================================================== ;;; --------------------------------------------------------------------------- ;;; Runtime state -- must be global, see the note in the header. ;;; ;;; *LayerPilot:LayerStack* saved current-layer names, innermost first ;;; *LayerPilot:VarStack* saved system variable values, innermost first ;;; *LayerPilot:LispFlag* T while a LISP command is running, used to ;;; suppress nested triggers ;;; *LayerPilot:LastEnt* last entity in the database before an xref ;;; attach, so new entities can be identified ;;; --------------------------------------------------------------------------- (setq *LayerPilot:LayerStack* nil *LayerPilot:VarStack* nil *LayerPilot:LispFlag* nil *LayerPilot:LastEnt* nil ) ;;; --------------------------------------------------------------------------- ;;; Commands that must never trigger a layer change. ;;; ;;; U and UNDO are excluded because changing the layer during an undo would ;;; itself become part of the undo stream. NUDGE and 3DORBITTRANSPARENT are ;;; transparent commands that fire constantly. SETVAR is excluded because ;;; this program calls SETVAR itself and would otherwise recurse. ;;; --------------------------------------------------------------------------- (setq *LayerPilot:Ignore* "U,UNDO,NUDGE,3DORBITTRANSPARENT,SETVAR") ;;; --------------------------------------------------------------------------- ;;; Normalise the system variable table. ;;; ;;; The settings table is authored as a readable list of pairs: ;;; ((cecolor "bylayer") (celtype "bylayer") ...) ;;; ;;; but the code needs two parallel lists so that both of these work in one ;;; call each: ;;; (mapcar 'getvar names) <- read them all ;;; (apply 'mapcar (cons 'setvar table)) <- write them all ;;; ;;; Transposing the pairs gives exactly that: ;;; (("cecolor" "celtype" ...) ("bylayer" "bylayer" ...)) ;;; ;;; Rows naming a system variable that does not exist in this AutoCAD ;;; version are removed first, so an older or newer release simply skips ;;; the variables it does not have instead of erroring. ;;; --------------------------------------------------------------------------- (if *LayerPilot:SysVars* (setq *LayerPilot:SysVars* (apply 'mapcar (cons 'list (vl-remove-if-not '(lambda ( row ) (getvar (car row))) *LayerPilot:SysVars* ) ) ) ) ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:Enable ;;; ;;; Switches the whole mechanism on or off. ;;; ;;; It always removes any reactors this program previously created before ;;; doing anything else. Reactors are identified by the tag string stored ;;; in their data slot, so reloading the file can never leave duplicate ;;; reactors behind -- a classic cause of layers changing twice, or of ;;; restoration popping the wrong value off the stack. ;;; ;;; The stacks are cleared on every toggle so that switching off mid-command ;;; and back on again cannot leave stale entries behind. ;;; ;;; on - T to enable, nil to disable ;;; --------------------------------------------------------------------------- (defun LayerPilot:Enable ( on / grp obj ) ;; Remove our own reactors, leaving anyone else's untouched. (foreach grp (vlr-reactors :vlr-command-reactor :vlr-lisp-reactor) (foreach obj (cdr grp) (if (= "LayerPilot" (vlr-data obj)) (vlr-remove obj) ) ) ) ;; Discard any half-unwound state from a previous session. (setq *LayerPilot:LayerStack* nil *LayerPilot:VarStack* nil *LayerPilot:LispFlag* nil *LayerPilot:LastEnt* nil ) (if on (progn ;; Built-in AutoCAD commands. (vlr-command-reactor "LayerPilot" '( (:vlr-commandwillstart . LayerPilot:Push) (:vlr-commandended . LayerPilot:Pop ) (:vlr-commandcancelled . LayerPilot:Pop ) (:vlr-commandfailed . LayerPilot:Pop ) ) ) ;; AutoLISP-defined commands, which the command reactor cannot see. (vlr-lisp-reactor "LayerPilot" '( (:vlr-lispwillstart . LayerPilot:Push) (:vlr-lispended . LayerPilot:Pop ) (:vlr-lispcancelled . LayerPilot:Pop ) ) ) (princ "\nLayerPilot enabled.") ) (princ "\nLayerPilot disabled.") ) (princ) ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:CleanName ;;; ;;; The LISP reactor reports AutoLISP commands wrapped in their defun form, ;;; for example "(C:MYTEXT)". Strip that wrapper so the name can be matched ;;; against the settings table the same way a native command name is. ;;; ;;; str - raw name as reported by the reactor ;;; ;;; Returns the bare command name. ;;; --------------------------------------------------------------------------- (defun LayerPilot:CleanName ( str ) (if (wcmatch str "(C:*)") (substr str 4 (- (strlen str) 4)) ;; drop the leading "(C:" and trailing ")" str ) ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:Push [ reactor callback ] ;;; ;;; Fired as a command is about to start. Decides whether this command is ;;; one we care about and, if so, saves the current state and applies the ;;; new layer and property settings. ;;; ;;; obj - the reactor object (unused, supplied by AutoCAD) ;;; arg - callback data; its first element is the command name ;;; --------------------------------------------------------------------------- (defun LayerPilot:Push ( obj arg / def row ) (if (and ;; Skip commands issued from inside a LISP routine unless the ;; user has explicitly asked for those to count too. (or *LayerPilot:LispCommands* (not *LayerPilot:LispFlag*)) (setq arg (car arg)) (setq arg (LayerPilot:CleanName (strcase arg))) (not (wcmatch arg *LayerPilot:Ignore*)) ) (progn ;; Remember whether we are now inside a LISP command, so that ;; commands it issues internally can be recognised as nested. (setq *LayerPilot:LispFlag* (= ':vlr-lispwillstart (vlr-current-reaction-name))) (if (and ;; First table row whose pattern matches this command. (setq row (cdar (vl-member-if '(lambda ( x ) (wcmatch arg (strcase (car x)))) *LayerPilot:Table* ) ) ) ;; Create the layer if needed; returns its table record. (setq def (LayerPilot:MakeLayer row)) ;; Bit 1 of DXF 70 means the layer is frozen. Never make ;; a frozen layer current -- AutoCAD would reject it. (zerop (logand 1 (cdr (assoc 70 def)))) ) (progn ;; Push current state, then apply the new state. (setq *LayerPilot:LayerStack* (cons (getvar 'clayer) *LayerPilot:LayerStack*) *LayerPilot:VarStack* (cons (mapcar 'getvar (car *LayerPilot:SysVars*)) *LayerPilot:VarStack* ) ) (if *LayerPilot:SysVars* (apply 'mapcar (cons 'setvar *LayerPilot:SysVars*)) ) (setvar 'clayer (car row)) ) ) ;; For an xref attach, note where the database currently ends so ;; that anything appended afterwards can be identified as new. (if (and (= 'list (type *LayerPilot:XrefRule*)) (wcmatch arg "XATTACH,CLASSICXREF") ) (setq *LayerPilot:LastEnt* (LayerPilot:LastEntity)) ) (if *LayerPilot:Echo* (print arg)) ) ) (princ) ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:Pop [ reactor callback ] ;;; ;;; Fired when a command ends, is cancelled, or fails. Restores whatever ;;; the matching Push saved, and applies the xref layer rule if an xref was ;;; just attached. ;;; ;;; All three end events share this one handler so that a cancelled or ;;; failed command restores state exactly as a successful one does. Without ;;; that, pressing Escape during a triggered command would strand you on ;;; the wrong layer. ;;; ;;; obj - the reactor object (unused, supplied by AutoCAD) ;;; arg - callback data; its first element is the command name ;;; --------------------------------------------------------------------------- (defun LayerPilot:Pop ( obj arg / def ent lay var ) ;; A LISP command has finished, so we are no longer nested inside one. (if (member (vlr-current-reaction-name) '(:vlr-lispended :vlr-lispcancelled)) (setq *LayerPilot:LispFlag* nil) ) (if (and (or *LayerPilot:LispCommands* (not *LayerPilot:LispFlag*)) (or (null (car arg)) (not (wcmatch (strcase (car arg)) *LayerPilot:Ignore*)) ) ) (progn ;; ---- restore the layer -------------------------------------- (if (= 'list (type *LayerPilot:LayerStack*)) (setq lay (car *LayerPilot:LayerStack*) *LayerPilot:LayerStack* (cdr *LayerPilot:LayerStack*) ) (setq *LayerPilot:LayerStack* nil) ) ;; Only restore if the layer still exists and is not frozen -- ;; the command may well have deleted or frozen it. (if (and (= 'str (type lay)) (setq def (tblsearch "layer" lay)) (zerop (logand 1 (cdr (assoc 70 def)))) ) (setvar 'clayer lay) ) ;; ---- restore the system variables --------------------------- (if (= 'list (type *LayerPilot:VarStack*)) (setq var (car *LayerPilot:VarStack*) *LayerPilot:VarStack* (cdr *LayerPilot:VarStack*) ) (setq *LayerPilot:VarStack* nil) ) (if (= 'list (type var)) (mapcar 'setvar (car *LayerPilot:SysVars*) var) ) ;; ---- apply the xref layer rule ------------------------------ ;; Walk every entity added since Push recorded the end of the ;; database and move any xref INSERT onto its own layer. (if (and (car arg) (= 'list (type *LayerPilot:XrefRule*)) (wcmatch (strcase (car arg)) "XATTACH,CLASSICXREF") (if (= 'ename (type (setq ent *LayerPilot:LastEnt*))) (setq ent (entnext ent)) ;; first entity after the mark (setq ent (entnext)) ;; database was empty: start at the top ) ) (while ent (LayerPilot:XrefLayer ent *LayerPilot:XrefRule*) (setq ent (entnext ent)) ) ) (setq *LayerPilot:LastEnt* nil) ) ) (princ) ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:XrefLayer ;;; ;;; If the given entity is an xref insertion, build its layer name from the ;;; xref name and move it there. ;;; ;;; ent - entity name to test ;;; rule - the xref rule list: (prefix suffix description colour ...) ;;; --------------------------------------------------------------------------- (defun LayerPilot:XrefLayer ( ent rule / enx lay obj xrf ) (if (and (setq enx (entget ent)) (= "INSERT" (cdr (assoc 0 enx))) (setq xrf (cdr (assoc 2 enx)) ;; block name lay (strcat (car rule) xrf (cadr rule)) ;; prefix + name + suffix ) ;; Bit 4 of DXF 70 on the block record means "this is an xref". ;; Ordinary blocks are left alone. (= 4 (logand 4 (cdr (assoc 70 (tblsearch "block" xrf))))) ;; Reuse the standard layer builder, feeding it the generated ;; name plus the property columns from the rule. (LayerPilot:MakeLayer (cons lay (cddr rule))) (setq obj (vlax-ename->vla-object ent)) (vlax-write-enabled-p obj) ;; not on a locked layer ) (vla-put-layer obj lay) ) ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:LastEntity ;;; ;;; Returns the very last entity in the drawing database. ;;; ;;; (entlast) alone is not enough: it returns the last top-level entity, but ;;; an attributed block or a polyline with vertices has sub-entities after ;;; it. Walking (entnext) to exhaustion finds the true end, so that "added ;;; after this point" comparisons are reliable. ;;; --------------------------------------------------------------------------- (defun LayerPilot:LastEntity ( / ent nxt ) (if (setq ent (entlast)) (while (setq nxt (entnext ent)) (setq ent nxt)) ) ent ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:MakeLayer ;;; ;;; Ensures a layer exists with the requested properties. ;;; ;;; If the layer is already present and FORCE PROPERTIES is off, the layer ;;; is left completely untouched and its existing definition is returned. ;;; Otherwise the layer is created with entmake, or updated with entmod if ;;; it already exists. ;;; ;;; Every property is range-checked before use, so a typo in the settings ;;; table degrades to a sensible default rather than aborting the command ;;; the user was trying to run. ;;; ;;; row - (name description colour linetype lineweight plot plotstyle) ;;; ;;; Returns the layer's table record, or nil if it could not be made. ;;; --------------------------------------------------------------------------- (defun LayerPilot:MakeLayer ( row / def ) (if (or *LayerPilot:ForceProps* (not (setq def (tblsearch "layer" (car row))))) (apply '(lambda ( lay des col ltp lwt plt pst / dic ent lst ) (setq lst (vl-list* '(000 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(070 . 0) ;; on, thawed, unlocked (cons 002 lay) (cons 062 (if (< 0 col 256) col 7)) ;; 7 = white/black default (cons 006 (if (LayerPilot:LoadLinetype ltp) ltp "Continuous")) (cons 370 (if (or (= -3 lwt) (<= 0 lwt 211)) lwt -3)) (cons 290 plt) (append ;; Named plot style, STB drawings only. PSTYLEMODE ;; is 0 for STB and 1 for CTB; a CTB drawing has ;; no plot style dictionary to point at. (if (and (= 'str (type pst)) (zerop (getvar 'pstylemode)) (setq dic (dictsearch (namedobjdict) "acad_plotstylename")) (setq dic (dictsearch (cdr (assoc -1 dic)) pst)) ) (list (cons 390 (cdr (assoc -1 dic)))) ) ;; The layer description is not a native DXF ;; field; AutoCAD stores it as extended data ;; under the AcAecLayerStandard application, ;; which must be registered before use. (if (and des (/= "" des)) (progn (regapp "AcAecLayerStandard") (list (list -3 (list "AcAecLayerStandard" '(1000 . "") (cons 1000 des) ) ) ) ) ) ) ) ) ;; Update in place if the layer exists, otherwise create it. (if (setq ent (tblobjname "layer" lay)) (entmod (cons (cons -1 ent) lst)) (entmake lst) ) (tblsearch "layer" lay) ) row ) def ) ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:LoadLinetype ;;; ;;; Returns the linetype name if it is available in the drawing, loading it ;;; from a .lin file first if necessary; nil if it cannot be found anywhere. ;;; ;;; Scanning the support path for .lin files is slow, and the answer never ;;; changes within a session. So on its first call this function REDEFINES ;;; ITSELF, baking the discovered file list into its own body as a literal. ;;; Every later call runs the cheap cached version. ;;; ;;; The standard library file matching the drawing's own unit system is ;;; skipped, because AutoCAD searches it automatically. Loading a metric ;;; linetype into an imperial drawing (or the reverse) produces dashes at ;;; wildly wrong scales, so the mismatched file is the one deliberately ;;; excluded. ;;; ;;; ltp - linetype name to find ;;; --------------------------------------------------------------------------- (defun LayerPilot:LoadLinetype ( ltp ) (eval (list 'defun 'LayerPilot:LoadLinetype '( ltp ) (list 'cond '( (tblsearch "ltype" ltp) ltp) (list (list 'vl-some (list 'quote (list 'lambda '( lin ) ;; vla-load throws if the linetype is not in ;; this particular file, so each attempt is ;; caught and the search simply moves on. (list 'vl-catch-all-apply ''vla-load (list 'list (vla-get-linetypes (vla-get-activedocument (vlax-get-acad-object)) ) 'ltp 'lin ) ) '(tblsearch "ltype" ltp) ) ) (list 'quote (vl-remove-if '(lambda ( x ) (member (strcase x t) (if (zerop (getvar 'measurement)) '("acadiso.lin" "iso.lin") ;; metric files, skipped in imperial drawings '("acad.lin" "default.lin") ;; imperial files, skipped in metric drawings ) ) ) ;; Every .lin file on every support path directory. (apply 'append (mapcar '(lambda ( dir ) (vl-directory-files dir "*.lin" 1)) (vl-remove "" (LayerPilot:Split (getenv "ACAD") ";")) ) ) ) ) ) 'ltp ) ) ) ) (LayerPilot:LoadLinetype ltp) ) ;;; --------------------------------------------------------------------------- ;;; LayerPilot:Split ;;; ;;; Splits a delimited string into a list of substrings. Used to break the ;;; semicolon-separated ACAD support path environment variable into ;;; individual directories. ;;; ;;; str - string to split ;;; del - delimiter string ;;; --------------------------------------------------------------------------- (defun LayerPilot:Split ( str del / pos ) (if (setq pos (vl-string-search del str)) (cons (substr str 1 pos) (LayerPilot:Split (substr str (+ pos 1 (strlen del))) del) ) (list str) ) ) ;;; --------------------------------------------------------------------------- ;;; LAYERPILOTON / LAYERPILOTOFF ;;; ;;; Manual on and off switches. No undo group and no system variable saving ;;; is needed here: these commands only add or remove reactors and change ;;; nothing in the drawing database. ;;; --------------------------------------------------------------------------- (defun c:LayerPilotOn ( / *error* ) (defun *error* ( msg ) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** LAYERPILOTON error: " msg " **")) ) (princ) ) (LayerPilot:Enable t) (princ) ) (defun c:LayerPilotOff ( / *error* ) (defun *error* ( msg ) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** LAYERPILOTOFF error: " msg " **")) ) (princ) ) (LayerPilot:Enable nil) (princ) ) ;;; --------------------------------------------------------------------------- ;;; LAYERPILOTECHO ;;; ;;; Toggles printing of every command name seen. Run this, then run the ;;; command you want to automate, and read the exact name off the command ;;; line to paste into the settings table above. ;;; --------------------------------------------------------------------------- (defun c:LayerPilotEcho ( / *error* ) (defun *error* ( msg ) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** LAYERPILOTECHO error: " msg " **")) ) (princ) ) (setq *LayerPilot:Echo* (not *LayerPilot:Echo*)) (princ (if *LayerPilot:Echo* "\nLayerPilot command echo ON - run a command to see its internal name." "\nLayerPilot command echo OFF." ) ) (princ) ) ;;; --------------------------------------------------------------------------- ;;; AUTOMATIC STARTUP ;;; ;;; Reactors do not survive from one drawing to the next, so LayerPilot must ;;; re-enable itself every time a drawing is opened. S::STARTUP is the ;;; standard hook AutoCAD calls once a new or opened drawing is ready. ;;; ;;; Other utilities may already have defined S::STARTUP, so this appends to ;;; it rather than replacing it, and checks first that the call is not ;;; already present -- otherwise reloading this file would stack up ;;; duplicate calls. defun-q is used because S::STARTUP must remain a plain ;;; inspectable list for that append to be possible. ;;; ;;; The whole block runs inside an anonymous lambda so that no temporary ;;; symbols are left defined in the drawing. ;;; --------------------------------------------------------------------------- ( (lambda ( ) (if (= 'list (type s::startup)) (if (not (member '(LayerPilot:Enable t) s::startup)) (setq s::startup (append s::startup '((LayerPilot:Enable t)))) ) (defun-q s::startup nil (LayerPilot:Enable t)) ) (princ) ) ) ;;; --------------------------------------------------------------------------- ;;; Enable immediately on load, and announce the commands. ;;; --------------------------------------------------------------------------- (LayerPilot:Enable t) (princ "\nLayerPilot loaded. Type LAYERPILOTON / LAYERPILOTOFF to toggle, LAYERPILOTECHO to identify commands.") (princ) ;;; --------------------------------------------------------------------------- ;;; End of file ;;; ---------------------------------------------------------------------------