I seemed to have stumbled on to the solution. It seems this lisp has gotten around quite a bit and has already been fixed on another Forum. Since I didn't see any post relating to this lisp on these forums I'll not delete it.
Also in my haste, I neglected to post the authors who created the lisp. Anyway here is the lisp in it's entirety:
Code:
; Modified by CAB 01.25.2008
; Modified by CAB 04.25.2008 ; bug fix
; Sets the correct layer for certain commands.
; VLR_COMMAND.lsp courtesy Peter Jamtgaard 2003
; Vlr Command is a function that will switch the active layer in a drawing.
; The reactor checks the command that is starting and if it recognizes it
; it will switch to a specified layer. If the layer doesn't exist it will
; create it with the color, linetype, and plottable setting provided.
; To load and run this program add the lines (load "vlr_command")(c:vlr_command)
; to your acaddoc.lsp or another autoloading lisp routine.
; CAB added error trap for layer creator
; added layer restore at command exit
;; added code to test loaded status
;; added code to turn reactors Off & back On again
;; added code for different layers per user or task
;; NOTE: set var *user* to use different layers per user
;; Fixed bug in end & cancel command layer reset
(defun C:ALON ()
(vl-load-com)
;; Load only once, if already loaded reactivate it if inactive
(and *vlr-CWS (not (vlr-added-p *vlr-CWS)) (vlr-add *vlr-CWS))
(and *vlr-CE (not (vlr-added-p *vlr-CE)) (vlr-add *vlr-CE))
(and *vlr-CC (not (vlr-added-p *vlr-CC)) (vlr-add *vlr-CC))
(or *vlr-CWS
(setq *vlr-CWS (vlr-command-reactor nil '((:vlr-commandwillstart . StartCommand)))))
(or *vlr-CE
(setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))))
(or *vlr-CC
(setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))))
(princ "\nLayer Reactor ON")
(princ)
)
;; Turn the reactors off
(defun C:ALOFF ()
(and *vlr-CWS (vlr-added-p *vlr-CWS) (vlr-remove *vlr-CWS))
(and *vlr-CE (vlr-added-p *vlr-CE) (vlr-remove *vlr-CE))
(and *vlr-CC (vlr-added-p *vlr-CC) (vlr-remove *vlr-CC))
(princ "\nLayer Reactor OFF")
(princ)
)
(defun StartCommand (CALL CALLBACK / COMLAYLST)
;; Examples of Command vs Layer
;; List of corresponding command layerName color linetype plottable
;; NOTE command names must be in Upper Case
;; NOTE: set var *user* to use different layers per user
(setq COMLAYLST (list
(list "DIMANGULAR" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMALIGNED" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMBASELINE" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMCENTER" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMCONTINUE" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMDIAMETER" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMLINEAR" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMRADIUS" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "QDIM" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIM" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMARC" "Dim-Dimensions" 7 "continuous" :vlax-true)
(list "DIMORDINATE" "Dim-Ordinate" 7 "continuous" :vlax-true)
(list "BREAKLINE" "Breakline" 7 "continuous" :vlax-true)
(list "MLEADER" "Dim-Leaders" 7 "continuous" :vlax-true)
(list "LEADER" "Dim-Leaders" 7 "continuous" :vlax-true)
(list "QLEADER" "Dim-Leaders" 7 "continuous" :vlax-true)
(list "DTEXT" "Texts" 7 "continuous" :vlax-true)
(list "MTEXT" "Texts" 7 "continuous" :vlax-true)
(list "TEXT" "Texts" 7 "continuous" :vlax-true)
(list "ARCTEXT" "Texts" 7 "continuous" :vlax-true)
(list "BHATCH" "Hatch" 7 "continuous" :vlax-true)
(list "HATCH" "Hatch" 7 "continuous" :vlax-true)
(list "-HATCH" "Hatch" 7 "continuous" :vlax-true)
(list "INSERT" "Blocks" 7 "continuous" :vlax-true)
(list "-INSERT" "Blocks" 7 "continuous" :vlax-true)
(list "REVCLOUD" "Revision" 1 "continuous" :vlax-true)
(list "TABLE" "Table" 7 "continuous" :vlax-true)
(list "LATERAL" "Lateral" 92 "Dashed2" :vlax-true)
(list "DIAGONAL" "Diagonal" 1 "continuous" :vlax-true)
(list "MVIEW" "Viewport" 1 "continuous" :vlax-false)
(list "_IMAGEATTACH" "Stamp" 7 "continuous" :vlax-true)
(list "IMAGEATTACH" "Stamp" 7 "continuous" :vlax-true)
; Add your own command layer lists here....
)
)
;; Find the Command
(if (setq N (assoc (strcase (car CALLBACK)) COMLAYLST))
(progn
;; save current layer, restore on exit of command
(setq *Currentlayers* (cons (getvar "CLAYER") *Currentlayers*))
;; make or update layer, then make current
(if (make_layers (cadr N) (caddr N) (cadddr N) (car (cddddr N)))
(vla-put-activelayer
(vla-get-activedocument (vlax-get-acad-object))
(vlax-ename->vla-object (tblobjname "LAYER" (cadr N)))
)
)
)
;; flag current layer so it is NOT restored on exit of command
(setq *Currentlayers* (cons nil *Currentlayers*))
)
(princ)
)
;; Make layers using activeX
;; return t if sucessful else nil
(defun MAKE_LAYERS (LAY_NAM COLOR LTYPE PLOTL / LAYOBJ LAYSOBJ LTYPESOBJ fn result LtFname NewLay)
(or *DOC* (setq *DOC* (vla-get-activedocument (vlax-get-acad-object))))
(setq LAYSOBJ (vla-get-layers *DOC*))
(if (tblobjname "layer" LAY_NAM) ; layer exist
(setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
(setq LAYOBJ (vl-catch-all-apply 'vla-add (list LAYSOBJ LAY_NAM))
NewLay t)
)
;;(setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
(if (vl-catch-all-error-p LAYOBJ)
(not (print (vl-catch-all-error-message LAYOBJ)))
(progn
(if (= (strcase (vla-get-name LAYOBJ)) (strcase (getvar "clayer")))
(progn ; can not change current layer so make something else current
;; what if "0" is frozen?
;; need to thaw it then restore old layer, and freeze if thawed.
(setvar "clayer" "0")
)
)
(vla-put-lock LAYOBJ :vlax-false)
(vla-put-layeron LAYOBJ :vlax-true)
(vla-put-freeze LAYOBJ :vlax-false)
(if (or NewLay *LayUpdt*) ; ok to update layer color, plot, LineType
;; ****************************************************************
(progn
(if (tblobjname "ltype" LTYPE)
(vla-put-linetype LAYOBJ LTYPE)
(progn
(setq LTYPESOBJ (vla-get-linetypes *DOC*))
(if (and LtFname (/= LtFname "")
(setq fn (findfile LtFname)))
(vl-catch-all-apply '(lambda ( ) (vla-load LTYPESOBJ LTYPE fn)
(setq result t) ; true only if load susceded
))
)
(if (and (not result)
(setq fn (findfile (if (zerop (getvar "measurement")) "acad.lin" "acadiso.lin"))))
(vl-catch-all-apply '(lambda ( ) (vla-load LTYPESOBJ LTYPE fn)
(setq result t) ; true only if load susceded
))
)
(vlax-release-object LTYPESOBJ)
(and result (vla-put-linetype LAYOBJ LTYPE))
)
)
;; ****************************************************************
(vla-put-color LAYOBJ COLOR)
(vla-put-plottable LAYOBJ PLOTL)
)
) ; end if (or NewLay *LayUpdt*)
t
)
)
)
;; Restore curent layer
(defun endCommand (CALL CALLBACK)
(if *Currentlayers*
(if (car *Currentlayers*)
(progn
(vla-put-lock
(vla-item
(vla-get-layers
(vla-get-activedocument (vlax-get-acad-object)))
(car *Currentlayers*)
)
:vlax-false
)
(setvar "CLAYER" (car *Currentlayers*))
)
)
)
(setq *Currentlayers* (cdr *Currentlayers*))
)
;; Restore curent layer
(defun cancelCommand (CALL CALLBACK)
(if *Currentlayers*
(if (car *Currentlayers*)
(progn
(vla-put-lock
(vla-item
(vla-get-layers
(vla-get-activedocument (vlax-get-acad-object)))
(car *Currentlayers*)
)
:vlax-false
)
(setvar "CLAYER" (car *Currentlayers*))
)
)
)
(setq *Currentlayers* (cdr *Currentlayers*))
)
(princ)
;------------------<The End>--------------------------
--------------------------------------------------------------------------------
Autolayer Lisp
Reply With Quote
