Code Red > AutoLISP (Vanilla / Visual)
Xref Reactor Revisted!
(1/1)
Shade:
I have previously posted about this topic, and I am having the same problem, in that the reactor will not switch the layer back to its previous state before I executed the xref command. I have tried using the provided examples to no avail.
Refer to...
http://www.theswamp.org/index.php?topic=19056.msg231515#msg231515
http://www.theswamp.org/index.php?topic=9537.msg122497#msg122497
I would like to now if one could reverse the xref reactor, so that the code read like this.
--- Code: ---[b]Pseudo Code:[/b]
If command is not "XREF" switch layer to "0".
If command is xref switch to "Xref Layer"
--- End code ---
I have several other layer reactor for various other commands and they all work great thanks to all the help I received here.
I appreciate all the help, but I am still fishing for more.
:mrgreen:
CAB:
Shade,
I am still testing this code but you can give it a go.
You will be using the last layer group in the code so comment out any command you don't want a layer set for.
I plan to move the layers into a text file.
Find this "CAB2.lin" and change it to your line file if you have one or to "" if you don't.
--- Code: --- (setq *al_LayUpdt* nil
LtFname "CAB2.lin")
--- End code ---
--- Code: ---;; Vlr_AutoLayer.lsp by CAB 01.28.2008
;; Sets the correct layer for certain commands.
;; 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_AutoLayer")(c:Vlr_AutoLayer)
;; to your acaddoc.lsp or another autoloading lisp routine.
;; REVISIONS
;; 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 *al_user* to use different layers per user
;; NOTE: set var *al_LayPrefix* to add a prefix to the layer name used
(defun C:AutoLayerOn () (Vlr_AutoLayer t))
(defun C:AutoLayerOff () (Vlr_AutoLayer nil))
(defun Vlr_AutoLayer (mode)
(vl-load-com)
(cond
(mode
;; 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 . AlStartCommand)))))
(or *vlr-CE
(setq *vlr-CE (vlr-command-reactor nil '((:vlr-commandEnded . AlEndCommand)))))
(or *vlr-CC
(setq *vlr-CC (vlr-command-reactor nil '((:vlr-commandCancelled . AlCancelCommand)))))
(print "AutoLayer is ON!")
)
;; Turn the reactors off
(t
(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))
(print "AutoLayer is OFF!")
)
)
(princ)
)
(defun AlStartCommand (Call CallBack / CmdLayerList LyrDat LtFname)
;; current layer restored on exit of command
(setq *Currentlayers* (cons (getvar "CLAYER") *Currentlayers*))
;; Examples of Command vs Layer
;; List of corresponding to (command layerName color# linetype plottable plotstyle)
;; LineType "" = "continuous"
;; plottable for STB DWGs, nil or :vlax-false or missing = NoPlot
;; T or :vlax-true = Plot
;; NOTE command names must be in Upper Case
;; NOTE: set var *al_user* to use different layers per user
(cond
((and *al_user*(= (type *al_user*) 'STR)(= (strcase *al_user*) "DAN"))
(setq *al_LayUpdt* t
LtFname nil) ; Second LineType File to Search
(setq CmdLayerList
(list ; (command layerName color# linetype plottable)
(list "DIMANGULAR" "I_ANNO-DIMS" 14 "" :vlax-true)
(list "DIMBASELINE" "I_ANNO-DIMS" 14 "" :vlax-true)
(list "DIMCENTER" "I_ANNO-DIMS" 14 "" :vlax-true)
(list "DIMCONTINUE" "I_ANNO-DIMS" 14 "" :vlax-true)
(list "DIMDIAMETER" "I_ANNO-DIMS" 14 "" :vlax-true)
(list "DIMLINEAR" "I_ANNO-DIMS" 14 "" :vlax-true)
(list "DIMRADIUS" "I_ANNO-DIMS" 14 "" :vlax-true)
(list "QDIM" "I_ANNO-DIMS" 14 "" :vlax-true)
(list "LEADER" "I_ANNO-NOTE" 11 "" :vlax-true)
(list "QLEADER" "I_ANNO-NOTE" 11 "" :vlax-true)
(list "DTEXT" "I_ANNO-NOTE" 11 "" :vlax-true)
(list "MTEXT" "I_ANNO-NOTE" 11 "" :vlax-true)
(list "TEXT" "I_ANNO-NOTE" 11 "" :vlax-true)
(list "BHATCH" "I-FIXT-7" 8 "" :vlax-true)
(list "HATCH" "I-FIXT-7" 8 "" :vlax-true)
(list "MVIEW" "Z-VIEWPORT" 7 "" :vlax-false)
; Add your own command layer lists here....
)
)
)
((and *al_user*(= (type *al_user*) 'STR)(= (strcase *al_user*) "Future Use"))
(setq CmdLayerList '())
)
((and *usermode*(= (type *usermode*) 'STR)(= (strcase *usermode*) "CAB"))
(setq *al_LayUpdt* nil
LtFname "CAB2.lin")
(or *al_LayPrefix* (setq *al_LayPrefix* ""))
(setq CmdLayerList
(list ; (command layerName color# linetype plottable plotstyle)
;(list "3DFACE"
;(list "ARC" "Arc" 5 "" t "Light")
(list "BHATCH" "A-HATCH" 8 "" t "Light")
;(list "BOX"
(list "CIRCLE" "Circle" 5 "" t "Light")
;(list "CONE"
;(list "CYLINDER"
(list "DIMALIGNED" "S-DIM" 5 "" t "Light")
(list "DIMANGULAR" "S-DIM" 5 "" t "Light")
(list "DIMBASELINE" "S-DIM" 5 "" t "Light")
(list "DIMCENTER" "S-DIM" 5 "" t "Light")
(list "DIMCONTINUE" "S-DIM" 5 "" t "Light")
(list "DIMDIAMETER" "S-DIM" 5 "" t "Light")
(list "DIMLINEAR" "S-DIM" 5 "" t "Light")
(list "DIMORDINATE" "S-DIM" 5 "" t "Light")
(list "DIMRADIUS" "S-DIM" 5 "" t "Light")
(list "DONUT" "Pline" 5 "" t "Light")
(list "DTEXT" "A-TEXT" 2 "" t "Light")
(list "ELLIPSE" "Ellipse" 5 "" t "Light")
(list "HATCH" "A-HATCH" 8 "" t "Light")
(list "LEADER" "A-DIM" 5 "" t "Light")
(list "LINE" "Line" 5 "" t "Medium")
(list "MTEXT" "A-TEXT" 2 "" t "Light")
(list "MVIEW" "A-VIEWPORT" 7 "" nil "Light")
;(list "OBLIQUE"
(list "PLINE" "Pline" 5 "" t "Medium")
(list "POINT" "A-POINTS" 7 "" t "Medium")
(list "POLYGON" "Pline" 5 "" t "Light")
(list "QDIM" "S-DIM" 5 "" t "Light")
(list "QLEADER" "A-DIM" 5 "" t "Light")
(list "RAY" "Ray" 5 "" t "Light")
(list "RECTANG" "Pline" 5 "" t "Light")
;(list "REGION"
(list "REVCLOUD" "A-REVCLOUD" 7 "" t "Light")
;(list "SOLID"
;(list "SPHERE"
(list "SPLINE" "Spline" 7 "" t "Light")
(list "TABLE" "A-TABLE" 2 "" t "Light")
(list "TEXT" "A-TEXT" 2 "" t "Light")
;(list "TOLERANCE"
;(list "TORUS"
;(list "WEDGE"
(list "XLINE" "A-CONST-LINES" 9 "" t "Light")
(list "XREF" "Xref" 7 "" t)
;; Add your own command layer lists here....
)
)
)
(t ; default Layer Group
(setq *al_LayUpdt* nil
LtFname "CAB2.lin")
(setq CmdLayerList
(list ; (command layerName color# linetype plottable plotstyle)
;(list "3DFACE"
;(list "ARC" "Arc" 5 "" t "Light")
(list "BHATCH" "A-HATCH" 8 "" t "Light")
;(list "BOX"
(list "CIRCLE" "Circle" 5 "" t "Light")
;(list "CONE"
;(list "CYLINDER"
(list "DIMALIGNED" "S-DIM" 5 "" t "Light")
(list "DIMANGULAR" "S-DIM" 5 "" t "Light")
(list "DIMBASELINE" "S-DIM" 5 "" t "Light")
(list "DIMCENTER" "S-DIM" 5 "" t "Light")
(list "DIMCONTINUE" "S-DIM" 5 "" t "Light")
(list "DIMDIAMETER" "S-DIM" 5 "" t "Light")
(list "DIMLINEAR" "S-DIM" 5 "" t "Light")
(list "DIMORDINATE" "S-DIM" 5 "" t "Light")
(list "DIMRADIUS" "S-DIM" 5 "" t "Light")
(list "DONUT" "Pline" 5 "" t "Light")
(list "DTEXT" "A-TEXT" 2 "" t "Light")
(list "ELLIPSE" "Ellipse" 5 "" t "Light")
(list "HATCH" "A-HATCH" 8 "" t "Light")
(list "LEADER" "A-DIM" 5 "" t "Light")
(list "LINE" "Line" 5 "" t "Medium")
(list "MTEXT" "A-TEXT" 2 "" t "Light")
(list "MVIEW" "A-VIEWPORT" 7 "" nil "Light")
;(list "OBLIQUE"
(list "PLINE" "Pline" 5 "" t "Medium")
(list "POINT" "A-POINTS" 7 "" t "Medium")
(list "POLYGON" "Pline" 5 "" t "Light")
(list "QDIM" "S-DIM" 5 "" t "Light")
(list "QLEADER" "A-DIM" 5 "" t "Light")
(list "RAY" "Ray" 5 "" t "Light")
(list "RECTANG" "Pline" 5 "" t "Light")
;(list "REGION"
(list "REVCLOUD" "A-REVCLOUD" 7 "" t "Light")
;(list "SOLID"
;(list "SPHERE"
(list "SPLINE" "Spline" 7 "" t "Light")
(list "TABLE" "A-TABLE" 2 "" t "Light")
(list "TEXT" "A-TEXT" 2 "" t "Light")
;(list "TOLERANCE"
;(list "TORUS"
;(list "WEDGE"
(list "XLINE" "A-CONST-LINES" 9 "" t "Light")
(list "XREF" "Xref" 7 "" t)
;; Add your own command layer lists here....
)
)
)
)
;; Find the Command
(if (setq LyrDat (assoc (strcase (car CallBack)) CmdLayerList))
;; make or update layer, then make current
(if (MakeLayer (cdr LyrDat))
(vla-put-activelayer
(vla-get-activedocument (vlax-get-acad-object))
(vlax-ename->vla-object (tblobjname "LAYER" (cadr LyrDat)))
)
)
)
(princ)
)
;; Make layers using activeX
;; return t if sucessful else nil
(defun MakeLayer (DataLst / LayName LayColor LineType LayPlot PltSty LayObj LayObjLst
LineTypeSOBJ fn result NewLay)
(mapcar '(lambda (x y)(set (read x) y))
'("LayName" "LayColor" "LineType" "LayPlot" "PltSty") DataLst)
(or *DOC* (setq *DOC* (vla-get-activedocument (vlax-get-acad-object))))
(and *al_LayPrefix* (setq LayName (strcat *al_LayPrefix* LayName)))
(setq LayObjLst (vla-get-layers *DOC*))
(if (tblobjname "layer" LayName) ; layer exist
(setq LayObj (vla-item LayObjLst LayName))
(setq LayObj (vl-catch-all-apply 'vla-add (list LayObjLst LayName))
NewLay t)
)
;;(setq LayObj (vla-item LayObjLst LayName))
(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 *al_LayUpdt*) ; ok to update layer color, plot, LineType
;; ****************************************************************
(progn
(if (or (null LineType) (= LineType ""))
(setq LineType "continuous")
)
(if (tblobjname "ltype" LineType)
(vla-put-linetype LayObj LineType)
(progn
(setq LineTypeSOBJ (vla-get-linetypes *DOC*))
(if (and LtFname (/= LtFname "")
(setq fn (findfile LtFname)))
(vl-catch-all-apply '(lambda ( ) (vla-load LineTypeSOBJ LineType 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 LineTypeSOBJ LineType fn)
(setq result t) ; true only if load susceded
))
)
(vlax-release-object LineTypeSOBJ)
(and result (vla-put-linetype LayObj LineType))
)
)
(if (and PltSty (/= PltSty ""))
(vl-catch-all-apply '(lambda(lay) (vla-put-plotstylename LayObj PltSty)))
)
;; ****************************************************************
(vla-put-color LayObj LayColor)
(vla-put-plottable LayObj (cond ((null LayPlot):vlax-false)
((= LayPlot t):vlax-true)
(LayPlot)))
)
) ; end if (or NewLay *al_LayUpdt*)
t
)
)
)
(defun RestoreCurrentLayer()
(if *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 AlEndCommand (Call CallBack)
(RestoreCurrentLayer)
)
;; Restore curent layer
(defun AlCancelCommand (Call CallBack)
(RestoreCurrentLayer)
)
(princ)
;---------------=< E N D O F F I L E >=------------------
--- End code ---
Shade:
Thanks CAB, I will look at what you got and adapt it.
What I have seen it looks like a nice piece of code: :mrgreen:
Navigation
[0] Message Index
Go to full version