TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Shade on September 25, 2007, 10:35:54 AM

Title: Xref Reactor
Post by: Shade on September 25, 2007, 10:35:54 AM
At one time I had help writing the following Reactor lisp, for the Xref command
(Lisp; Automatically set the current layer to 'Xref' when the xref command is invoked).
I believe at one time the reactor work perfectly, and when the xref command ended the current layer was reset to the layer before xref was executed.
Now for some reason the reactor does not reset the current layer back to the layer before the reactor was initiated.
I believe this stared to occur when Autocad changes the xref command back in version 2007.
So my reactor doesn't work the way I would like it to (ie reset layer when done).
Any help would be appreciated, and thank in advance.....

Code: [Select]
;Reactors
(defun CmDXref ()
  (vl-load-com)
  (vlr-command-reactor nil '((:vlr-commandWillStart . startCommandxref))) 
  (vlr-command-reactor nil '((:vlr-commandEnded . endCommandxref)))
  (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommandxref)))
  (vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COMXREF1))) 
)

;Editor Reactor.
(defun ARCH:COMXREF1 (CALL CALLBACK / COMLAYLST)
;;; List of corrusponding commands layers  color linetype plottable
  (setq COMLAYLST
         (list
              (list "XREF" "Xref" 7 "continuous" :vlax-true)
  )      ) 
  (foreach
         N COMLAYLST
    (if (= (strcase (car CALLBACK)) (strcase (car N)))
      (progn
        (make_layers
          (cadr N)
          (caddr N)
          (cadddr N)
          (car (cddddr N))
        )
        (setq n1 n)
        (vla-put-activelayer
          (vla-get-activedocument
            (vlax-get-acad-object)
          )
          (vlax-ename->vla-object
            (tblobjname "LAYER" (cadr N))
          )
        )
      )
    )
  ) 
)

;;; Make layers using activeX
(defun MAKE_LAYERS (LAY_NAM COLOR LTYPE PLOTL / LAYOBJ LAYSOBJ LTYPESOBJ)
  (setq CDWGOBJ (vla-get-activedocument
                  (vlax-get-acad-object)
                )
        LAYSOBJ (vla-get-layers CDWGOBJ)
  )
  (if (not (tblobjname "layer" LAY_NAM))
    (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-add (list LAYSOBJ LAY_NAM))
    )
  )
  (setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
  (if (not (tblobjname "ltype" LTYPE))
    (progn
      (setq LTYPESOBJ (vla-get-linetypes CDWGOBJ))
      (vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
      (vlax-release-object LTYPESOBJ)
    )
  )
  (vla-put-layeron LAYOBJ :vlax-true)
  (if (/= (strcase (vla-get-name LAYOBJ)) (strcase (getvar "clayer")))
    (vla-put-freeze LAYOBJ :vlax-false)
  )
  (vla-put-lock LAYOBJ :vlax-false)
  (vla-put-color LAYOBJ COLOR)
  (vla-put-linetype LAYOBJ LTYPE)
  (vla-put-plottable LAYOBJ PLOTL) 
)



;Kenny Ramage @ afralisp.com
(defun startCommandxref (calling-reactor startCommandxrefInfo / thecommandstart)       
  (setq OldLayer (getvar "CLAYER")) 
  ;;(vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COMXREF1)))
)


(defun endCommandxref (calling-reactor endCommandxrefInfo / thecommandendxref)
  (setq thecommandendxref (nth 0 endCommandxrefInfo))
  (cond   
    ((= thecommandendxref "XREF") (setvar "CLAYER" OldLayer))
  )
)


(defun cancelCommandxref (calling-reactor cancelCommandxrefInfo / thecommandcancelxref)               
  (setq thecommandcancelxref (nth 0 cancelCommandxrefInfo))
  (cond   
    ((= thecommandcancelxref "XREF") (setvar "CLAYER" OldLayer))
  ) 
)
(CmdXref)
(princ)
Title: Re: Xref Reactor
Post by: GDF on September 25, 2007, 10:40:48 AM
Code: [Select]
Here is what I use...

[ode]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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.

(defun VLR_COMMANDXREF-IT ()
  (vl-load-com)
  (vlr-command-reactor nil '((:vlr-commandWillStart . startCommandxref))) 
  (vlr-command-reactor nil '((:vlr-commandEnded . endCommandxref)))
  (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommandxref)))
  (vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COMXREF1))) 
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:COMXREF1 (CALL CALLBACK / COMLAYLST)
;;; List of corrusponding      commands layers  color linetype     plottable
  (setq COMLAYLST
         (list
              (list "XREF" "0-XREF" 7 "continuous" :vlax-true)
         )
  )
  (foreach
         N COMLAYLST
    (if (= (strcase (car CALLBACK)) (strcase (car N)))
      (progn
        (make_layers
          (cadr N)
          (caddr N)
          (cadddr N)
          (car (cddddr N))
        )
        (setq n1 n)
        (vla-put-activelayer
          (vla-get-activedocument
            (vlax-get-acad-object)
          )
          (vlax-ename->vla-object
            (tblobjname "LAYER" (cadr N))
          )
        )
      )
    )
  ) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Make layers using activeX
(defun MAKE_LAYERS (LAY_NAM COLOR LTYPE PLOTL / LAYOBJ LAYSOBJ LTYPESOBJ)
  (setq CDWGOBJ (vla-get-activedocument
                  (vlax-get-acad-object)
                )
        LAYSOBJ (vla-get-layers CDWGOBJ)
  )
  (if (not (tblobjname "layer" LAY_NAM))
    (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-add (list LAYSOBJ LAY_NAM))
    )
  )
  (setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
  (if (not (tblobjname "ltype" LTYPE))
    (progn
      (setq LTYPESOBJ (vla-get-linetypes CDWGOBJ))
      (vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
      (vlax-release-object LTYPESOBJ)
    )
  )
  (vla-put-layeron LAYOBJ :vlax-true)
  (if (/= (strcase (vla-get-name LAYOBJ)) (strcase (getvar "clayer")))
    (vla-put-freeze LAYOBJ :vlax-false)
  )
  (vla-put-lock LAYOBJ :vlax-false)
  (vla-put-color LAYOBJ COLOR)
  (vla-put-linetype LAYOBJ LTYPE)
  (vla-put-plottable LAYOBJ PLOTL) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Kenny Ramage @ afralisp.com
(defun startCommandxref (calling-reactor
                     startCommandxrefInfo
                     /
                     thecommandstart
                    )       
  (setq OldLayer (getvar "CLAYER")) 
  ;;(vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COMXREF1)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun endCommandxref (calling-reactor
                   endCommandxrefInfo
                   /
                   thecommandendxref
                  )
  (setq thecommandendxref (nth 0 endCommandxrefInfo))
  (cond   
    ((= thecommandendxref "XREF") (setvar "CLAYER" OldLayer))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cancelCommandxref (calling-reactor
                      cancelCommandxrefInfo
                      /
                      thecommandcancelxref
                     )               
  (setq thecommandcancelxref (nth 0 cancelCommandxrefInfo))
  (cond   
    ((= thecommandcancelxref "XREF") (setvar "CLAYER" OldLayer))
  ) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(VLR_COMMANDXREF-IT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)

Gary
Title: Re: Xref Reactor
Post by: T.Willey on September 25, 2007, 12:25:07 PM
Here is one I wrote that you can use, just change it so it will put the xref on the layer desired. (http://www.theswamp.org/index.php?topic=15557.0)  Only fired when attaching an xref.
Title: Re: Xref Reactor
Post by: GDF on September 25, 2007, 12:39:35 PM
or for controlling multiply commands...

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ARCH:OLDLAYER Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;|
Also, be aware that returning to the previous layer with OldLayer
where OldLayer is a symbol for the layer that we are going to return to,
is often cause for an error; AutoCAD rejects that very often.
A safe way to return to the previous layer is this:
(if (/= (getvar "clayer") OldLayer)
    (vla-setvariable (vla-get-activedocument (vlax-get-acad-object))
"clayer" OldLayer)
)
BY Alfredo Medina
alfmedina@hotmail.com
|;
(defun ARCH:OldLayer  ()
  (if (/= (getvar "clayer") OldLayer)
    (vla-setvariable
      (vla-get-activedocument (vlax-get-acad-object))
      "clayer"
      OldLayer)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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.

(defun VLR_COMMAND-IT () 
  (vl-load-com)
  (vlr-command-reactor nil '((:vlr-commandWillStart . startCommand))) 
  (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))
  (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))
  (vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COM1))) 
)
(princ "\n*** ------ Layer Reactor Activated. ------ ***")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:COM1 (CALL CALLBACK / COMLAYLST)
;;; List of corrusponding      commands layers  color linetype     plottable
  (setq COMLAYLST
         (list (list "DIMANGULAR" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMBASELINE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMCENTER" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMCONTINUE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMDIAMETER" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMLINEAR" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMORDINATE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMRADIUS" "A-DIMS" 30 "continuous" :vlax-true)
               (list "QDIM" "A-DIMS" 30 "continuous" :vlax-true)

               (list "LEADER" "A-NOTE" 2 "continuous" :vlax-true)
               (list "QLEADER" "A-NOTE" 2 "continuous" :vlax-true)

               (list "DTEXT" "A-NOTE" 2 "continuous" :vlax-true)
               (list "MTEXT" "A-NOTE" 2 "continuous" :vlax-true)
               ;;(list "TEXT" "A-NOTE" 2 "continuous" :vlax-true)

               ;;(list "BHATCH" "A-PATT" 9 "continuous" :vlax-true)
               ;;(list "HATCH" "A-PATT" 9 "continuous" :vlax-true)

               (list "POINT" "X-PNTS" 4 "continuous" :vlax-true)

               (list "XLINE" "X-LINE" 8 "continuous" :vlax-true)
               (list "XREF" "0-XREF" 7 "continuous" :vlax-true)
               ;;(list "INSERT" "0-INSERT" 7 "continuous" :vlax-true)
         )
  )
  (foreach
         N COMLAYLST
    (if (= (strcase (car CALLBACK)) (strcase (car N)))
      (progn
        (make_layers
          (cadr N)
          (caddr N)
          (cadddr N)
          (car (cddddr N))
        )
        (setq n1 n)
        (vla-put-activelayer
          (vla-get-activedocument
            (vlax-get-acad-object)
          )
          (vlax-ename->vla-object
            (tblobjname "LAYER" (cadr N))
          )
        )
      )
    )
  ) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Make layers using activeX
(defun MAKE_LAYERS (LAY_NAM COLOR LTYPE PLOTL / LAYOBJ LAYSOBJ LTYPESOBJ)
  (setq CDWGOBJ (vla-get-activedocument
                  (vlax-get-acad-object)
                )
        LAYSOBJ (vla-get-layers CDWGOBJ)
  )
  (if (not (tblobjname "layer" LAY_NAM))
    (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-add (list LAYSOBJ LAY_NAM))
    )
  )
  (setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
  (if (not (tblobjname "ltype" LTYPE))
    (progn
      (setq LTYPESOBJ (vla-get-linetypes CDWGOBJ))
      (vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
      (vlax-release-object LTYPESOBJ)
    )
  )
  (vla-put-layeron LAYOBJ :vlax-true)
  (if (/= (strcase (vla-get-name LAYOBJ)) (strcase (getvar "clayer")))
    (vla-put-freeze LAYOBJ :vlax-false)
  )
  (vla-put-lock LAYOBJ :vlax-false)
  (vla-put-color LAYOBJ COLOR)
  (vla-put-linetype LAYOBJ LTYPE)
  (vla-put-plottable LAYOBJ PLOTL) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Kenny Ramage @ afralisp.com
(defun startCommand (calling-reactor
                     startcommandInfo
                     /
                     thecommandstart
                    )       
  (setq OldLayer (getvar "CLAYER")) 
  (setq OldLayern OldLayer)

  ;;(vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COM1)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun endCommand (calling-reactor
                   endcommandInfo
                   /
                   thecommandend
                  )
  (setq thecommandend (nth 0 endcommandInfo))
  (cond
    ((= thecommandend "DIMANGULAR") (ARCH:OldLayer))
    ((= thecommandend "DIMBASELINE") (ARCH:OldLayer))
    ((= thecommandend "DIMCENTER") (ARCH:OldLayer))
    ((= thecommandend "DIMCONTINUE") (ARCH:OldLayer))
    ((= thecommandend "DIMDIAMETER") (ARCH:OldLayer))
    ((= thecommandend "DIMLINEAR") (ARCH:OldLayer))
    ((= thecommandend "DIMORDINATE") (ARCH:OldLayer))
    ((= thecommandend "DIMRADIUS") (ARCH:OldLayer))
    ((= thecommandend "QDIM") (ARCH:OldLayer))

    ((= thecommandend "LEADER") (ARCH:OldLayer))
    ((= thecommandend "QLEADER") (ARCH:OldLayer))

    ((= thecommandend "DTEXT") (ARCH:OldLayer))
    ((= thecommandend "MTEXT") (ARCH:OldLayer))
    ;;((= thecommandend "TEXT") (ARCH:OldLayer))

    ;;((= thecommandend "BHATCH") (ARCH:OldLayer))
    ;;((= thecommandend "HATCH") (ARCH:OldLayer))

    ((= thecommandend "POINT") (ARCH:OldLayer))

    ((= thecommandend "XLINE") (ARCH:OldLayer))
    ((= thecommandend "XREF") (ARCH:OldLayer))
    ;;((= thecommandend "INSERT") (ARCH:OldLayer))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cancelCommand (calling-reactor
                      cancelcommandInfo
                      /
                      thecommandcancel
                     )
  (setq thecommandcancel (nth 0 cancelcommandInfo))
  (cond
    ((= thecommandcancel "DIMANGULAR") (ARCH:OldLayer))
    ((= thecommandcancel "DIMBASELINE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMCENTER") (ARCH:OldLayer))
    ((= thecommandcancel "DIMCONTINUE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMDIAMETER") (ARCH:OldLayer))
    ((= thecommandcancel "DIMLINEAR") (ARCH:OldLayer))
    ((= thecommandcancel "DIMORDINATE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMRADIUS") (ARCH:OldLayer))
    ((= thecommandcancel "QDIM") (ARCH:OldLayer))

    ((= thecommandcancel "LEADER") (ARCH:OldLayer))
    ((= thecommandcancel "QLEADER") (ARCH:OldLayer))

    ((= thecommandcancel "DTEXT") (ARCH:OldLayer))
    ((= thecommandcancel "MTEXT") (ARCH:OldLayer))
    ;;((= thecommandcancel "TEXT") (ARCH:OldLayer))

    ;;((= thecommandcancel "BHATCH") (ARCH:OldLayer))
    ;;((= thecommandcancel "HATCH") (ARCH:OldLayer))

    ((= thecommandcancel "POINT") (ARCH:OldLayer))

    ((= thecommandcancel "XLINE") (ARCH:OldLayer))
    ((= thecommandcancel "XREF") (ARCH:OldLayer))
  )   
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(VLR_COMMAND-IT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)

Gary
Title: Re: Xref Reactor
Post by: Shade on September 25, 2007, 04:10:35 PM
Thanks mate I will give it a go!
Title: Re: Xref Reactor
Post by: Krushert on August 25, 2011, 03:06:10 PM
or for controlling multiply commands...

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ARCH:OLDLAYER Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;|
Also, be aware that returning to the previous layer with OldLayer
where OldLayer is a symbol for the layer that we are going to return to,
is often cause for an error; AutoCAD rejects that very often.
A safe way to return to the previous layer is this:
(if (/= (getvar "clayer") OldLayer)
    (vla-setvariable (vla-get-activedocument (vlax-get-acad-object))
"clayer" OldLayer)
)
BY Alfredo Medina
alfmedina@hotmail.com
|;
(defun ARCH:OldLayer  ()
  (if (/= (getvar "clayer") OldLayer)
    (vla-setvariable
      (vla-get-activedocument (vlax-get-acad-object))
      "clayer"
      OldLayer)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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.

(defun VLR_COMMAND-IT () 
  (vl-load-com)
  (vlr-command-reactor nil '((:vlr-commandWillStart . startCommand))) 
  (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))
  (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))
  (vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COM1))) 
)
(princ "\n*** ------ Layer Reactor Activated. ------ ***")

[b]< snip>[/b]


Gary
How I this reactor is not firing.  The file is loading due to princ statement.
Title: Re: Xref Reactor
Post by: Krushert on August 26, 2011, 07:27:25 AM
^^ **Nice post above Ted - NOT**  :cry:

Okay the file is loading, and the reactor will fire and do it thing when I fire the xline but will not fire when I call the xref command. 

Any ideas?
Title: Re: Xref Reactor
Post by: Krushert on August 26, 2011, 07:59:21 AM
Figured it out.  The command call is no longer "XREF", it is "XATTACH". 

The updated code is here.

Code: [Select]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ARCH:OLDLAYER Function ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;|
Also, be aware that returning to the previous layer with OldLayer
where OldLayer is a symbol for the layer that we are going to return to,
is often cause for an error; AutoCAD rejects that very often.
A safe way to return to the previous layer is this:
(if (/= (getvar "clayer") OldLayer)
    (vla-setvariable (vla-get-activedocument (vlax-get-acad-object))
"clayer" OldLayer)
)
BY Alfredo Medina
alfmedina@hotmail.com
|;
(defun ARCH:OldLayer  ()
  (if (/= (getvar "clayer") OldLayer)
    (vla-setvariable
      (vla-get-activedocument (vlax-get-acad-object))
      "clayer"
      OldLayer)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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.

(defun VLR_COMMAND-IT () 
  (vl-load-com)
  (vlr-command-reactor nil '((:vlr-commandWillStart . startCommand))) 
  (vlr-command-reactor nil '((:vlr-commandEnded . endCommand)))
  (vlr-command-reactor nil '((:vlr-commandCancelled . cancelCommand)))
  (vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COM1))) 
)
(princ "\n*** ------ Layer Reactor Activated. ------ ***")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ARCH:COM1 (CALL CALLBACK / COMLAYLST)
;;; List of corrusponding      commands layers  color linetype     plottable
  (setq COMLAYLST
         (list (list "DIMANGULAR" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMBASELINE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMCENTER" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMCONTINUE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMDIAMETER" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMLINEAR" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMORDINATE" "A-DIMS" 30 "continuous" :vlax-true)
               (list "DIMRADIUS" "A-DIMS" 30 "continuous" :vlax-true)
               (list "QDIM" "A-DIMS" 30 "continuous" :vlax-true)

               (list "LEADER" "A-NOTE" 2 "continuous" :vlax-true)
               (list "QLEADER" "A-NOTE" 2 "continuous" :vlax-true)

               (list "DTEXT" "A-NOTE" 2 "continuous" :vlax-true)
               (list "MTEXT" "A-NOTE" 2 "continuous" :vlax-true)
               ;;(list "TEXT" "A-NOTE" 2 "continuous" :vlax-true)

               ;;(list "BHATCH" "A-PATT" 9 "continuous" :vlax-true)
               ;;(list "HATCH" "A-PATT" 9 "continuous" :vlax-true)

               (list "POINT" "X-PNTS" 4 "continuous" :vlax-true)

               (list "XLINE" "X-LINE" 8 "continuous" :vlax-true)
               (list "XATTACH" "0-XREF" 7 "continuous" :vlax-true)
               ;;(list "INSERT" "0-INSERT" 7 "continuous" :vlax-true)
         )
  )
  (foreach
         N COMLAYLST
    (if (= (strcase (car CALLBACK)) (strcase (car N)))
      (progn
        (make_layers
          (cadr N)
          (caddr N)
          (cadddr N)
          (car (cddddr N))
        )
        (setq n1 n)
        (vla-put-activelayer
          (vla-get-activedocument
            (vlax-get-acad-object)
          )
          (vlax-ename->vla-object
            (tblobjname "LAYER" (cadr N))
          )
        )
      )
    )
  ) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Make layers using activeX
(defun MAKE_LAYERS (LAY_NAM COLOR LTYPE PLOTL / LAYOBJ LAYSOBJ LTYPESOBJ)
  (setq CDWGOBJ (vla-get-activedocument
                  (vlax-get-acad-object)
                )
        LAYSOBJ (vla-get-layers CDWGOBJ)
  )
  (if (not (tblobjname "layer" LAY_NAM))
    (vl-catch-all-error-p
      (vl-catch-all-apply 'vla-add (list LAYSOBJ LAY_NAM))
    )
  )
  (setq LAYOBJ (vla-item LAYSOBJ LAY_NAM))
  (if (not (tblobjname "ltype" LTYPE))
    (progn
      (setq LTYPESOBJ (vla-get-linetypes CDWGOBJ))
      (vla-load LTYPESOBJ LTYPE (findfile "acad.lin"))
      (vlax-release-object LTYPESOBJ)
    )
  )
  (vla-put-layeron LAYOBJ :vlax-true)
  (if (/= (strcase (vla-get-name LAYOBJ)) (strcase (getvar "clayer")))
    (vla-put-freeze LAYOBJ :vlax-false)
  )
  (vla-put-lock LAYOBJ :vlax-false)
  (vla-put-color LAYOBJ COLOR)
  (vla-put-linetype LAYOBJ LTYPE)
  (vla-put-plottable LAYOBJ PLOTL) 
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Kenny Ramage @ afralisp.com
(defun startCommand (calling-reactor
                     startcommandInfo
                     /
                     thecommandstart
                    )       
  (setq OldLayer (getvar "CLAYER")) 
  (setq OldLayern OldLayer)

  ;;(vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:COM1)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun endCommand (calling-reactor
                   endcommandInfo
                   /
                   thecommandend
                  )
  (setq thecommandend (nth 0 endcommandInfo))
  (cond
    ((= thecommandend "DIMANGULAR") (ARCH:OldLayer))
    ((= thecommandend "DIMBASELINE") (ARCH:OldLayer))
    ((= thecommandend "DIMCENTER") (ARCH:OldLayer))
    ((= thecommandend "DIMCONTINUE") (ARCH:OldLayer))
    ((= thecommandend "DIMDIAMETER") (ARCH:OldLayer))
    ((= thecommandend "DIMLINEAR") (ARCH:OldLayer))
    ((= thecommandend "DIMORDINATE") (ARCH:OldLayer))
    ((= thecommandend "DIMRADIUS") (ARCH:OldLayer))
    ((= thecommandend "QDIM") (ARCH:OldLayer))

    ((= thecommandend "LEADER") (ARCH:OldLayer))
    ((= thecommandend "QLEADER") (ARCH:OldLayer))

    ((= thecommandend "DTEXT") (ARCH:OldLayer))
    ((= thecommandend "MTEXT") (ARCH:OldLayer))
    ;;((= thecommandend "TEXT") (ARCH:OldLayer))

    ;;((= thecommandend "BHATCH") (ARCH:OldLayer))
    ;;((= thecommandend "HATCH") (ARCH:OldLayer))

    ((= thecommandend "POINT") (ARCH:OldLayer))

    ((= thecommandend "XLINE") (ARCH:OldLayer))
    ((= thecommandend "XATTACH") (ARCH:OldLayer))
    ;;((= thecommandend "INSERT") (ARCH:OldLayer))
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun cancelCommand (calling-reactor
                      cancelcommandInfo
                      /
                      thecommandcancel
                     )
  (setq thecommandcancel (nth 0 cancelcommandInfo))
  (cond
    ((= thecommandcancel "DIMANGULAR") (ARCH:OldLayer))
    ((= thecommandcancel "DIMBASELINE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMCENTER") (ARCH:OldLayer))
    ((= thecommandcancel "DIMCONTINUE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMDIAMETER") (ARCH:OldLayer))
    ((= thecommandcancel "DIMLINEAR") (ARCH:OldLayer))
    ((= thecommandcancel "DIMORDINATE") (ARCH:OldLayer))
    ((= thecommandcancel "DIMRADIUS") (ARCH:OldLayer))
    ((= thecommandcancel "QDIM") (ARCH:OldLayer))

    ((= thecommandcancel "LEADER") (ARCH:OldLayer))
    ((= thecommandcancel "QLEADER") (ARCH:OldLayer))

    ((= thecommandcancel "DTEXT") (ARCH:OldLayer))
    ((= thecommandcancel "MTEXT") (ARCH:OldLayer))
    ;;((= thecommandcancel "TEXT") (ARCH:OldLayer))

    ;;((= thecommandcancel "BHATCH") (ARCH:OldLayer))
    ;;((= thecommandcancel "HATCH") (ARCH:OldLayer))

    ((= thecommandcancel "POINT") (ARCH:OldLayer))

    ((= thecommandcancel "XLINE") (ARCH:OldLayer))
    ((= thecommandcancel "XATTACH") (ARCH:OldLayer))
  )   
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(VLR_COMMAND-IT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
Title: Re: Xref Reactor
Post by: BlackBox on August 26, 2011, 10:21:11 AM
Krush - In the VLR_COMMAND-IT function, you should check to see if the reactor(s) exist before constructing them, in order to avoid multiple instances (which can cause major issues).  :wink:

Sample:

Code: [Select]
(cond
    (*Reactor_CommandStarted*)
    ((setq *Reactor_CommandStarted*
            (vlr-command-reactor
              nil
              '((:vlr-commandwillstart . Callback:CommandStarted))))))

** You don't need to use COND, this is just my preference.
Title: Re: Xref Reactor
Post by: BlackBox on August 26, 2011, 10:41:03 AM
Also, you can use the same callback function in lieu of ENDCOMMAND and CANCELCOMMAND callbacks. You can even simplify your callback function, for example:

Replace this:

Code: [Select]
(cond
  ((= thecommandend "DIMANGULAR") (ARCH:OldLayer))
  ((= thecommandend "DIMBASELINE") (ARCH:OldLayer))
  ((= thecommandend "DIMCENTER") (ARCH:OldLayer))
  ((= thecommandend "DIMCONTINUE") (ARCH:OldLayer))
  ((= thecommandend "DIMDIAMETER") (ARCH:OldLayer))
  ((= thecommandend "DIMLINEAR") (ARCH:OldLayer))
  ((= thecommandend "DIMORDINATE") (ARCH:OldLayer))
  ((= thecommandend "DIMRADIUS") (ARCH:OldLayer))
  ((= thecommandend "QDIM") (ARCH:OldLayer))

  ((= thecommandend "LEADER") (ARCH:OldLayer))
  ((= thecommandend "QLEADER") (ARCH:OldLayer))

  ((= thecommandend "DTEXT") (ARCH:OldLayer))
  ((= thecommandend "MTEXT") (ARCH:OldLayer))
  ;;((= thecommandend "TEXT") (ARCH:OldLayer))

  ;;((= thecommandend "BHATCH") (ARCH:OldLayer))
  ;;((= thecommandend "HATCH") (ARCH:OldLayer))

  ((= thecommandend "POINT") (ARCH:OldLayer))

  ((= thecommandend "XLINE") (ARCH:OldLayer))
  ((= thecommandend "XATTACH") (ARCH:OldLayer))
  ;;((= thecommandend "INSERT") (ARCH:OldLayer))
  )

... With this:

Code: [Select]
(if (vl-position
      thecommandend
      '("DIMANGULAR" "DIMBASELINE" "DIMCENTER" "DIMCONTINUE"
        "DIMDIAMETER" "DIMLINEAR" "DIMORDINATE" "DIMRADIUS" "QDIM"
        "LEADER" "QLEADER" "DTEXT" "MTEXT" "POINT" "XLINE" "XATTACH"))
  (ARCH:OldLayer))

... Or, made even simpler:

Code: [Select]
(if (wcmatch thecommandend "*DIM*,*LEADER,POINT,*TEXT,*XREF,*XATTACH")
  (ARCH:OldLayer))

** Note - VL-POSITION is faster than WCMATCH **

Now, if you are not wanting to execute the same function for each of the commands listed above, or perhaps certain commands require additional action, then consider this:

Code: [Select]
(defun Callback:CommandEnded  (Rea Cmd)
  (cond ((wcmatch (setq Cmd (strcase (car Cmd))) "*DIM*")
         (ARCH:OldLayer)
         ;;<- DIM specific actions
         )
        ((vl-position Cmd '("LEADER" "QLEADER"))
         (ARCH:OldLayer)
         ;;<- LEADER specific actions
         )
        ((vl-position Cmd '("POINT"))
         (ARCH:OldLayer)
         ;;<- POINT specific actions
         )
        ((vl-position Cmd '("MTEXT" "TEXT"))
         (ARCH:OldLayer)
         ;;<- MTEXT,TEXT specific actions
         )
        ((wcmatch Cmd "*XREF,*XATTACH")
         (ARCH:OldLayer)
         ;;<- XREF specific actions
         )
        )
  (princ))

HTH
Title: Re: Xref Reactor
Post by: Krushert on August 29, 2011, 08:57:06 PM
Krush - In the VLR_COMMAND-IT function, you should check to see if the reactor(s) exist before constructing them, in order to avoid multiple instances (which can cause major issues).  :wink:

Sample:

Code: [Select]
(cond
    (*Reactor_CommandStarted*)
    ((setq *Reactor_CommandStarted*
            (vlr-command-reactor
              nil
              '((:vlr-commandwillstart . Callback:CommandStarted))))))

** You don't need to use COND, this is just my preference.

Okay where do I put this code into the code that I am using?  I am drawing a blank on this one.   :cry:
Title: Re: Xref Reactor
Post by: BlackBox on August 30, 2011, 12:02:38 AM
Krush - In the VLR_COMMAND-IT function, you should check to see if the reactor(s) exist before constructing them, in order to avoid multiple instances (which can cause major issues).  :wink:

Sample:

Code: [Select]
(cond
    (*Reactor_CommandStarted*)
    ((setq *Reactor_CommandStarted*
            (vlr-command-reactor
              nil
              '((:vlr-commandwillstart . Callback:CommandStarted))))))

** You don't need to use COND, this is just my preference.

Okay where do I put this code into the code that I am using?  I am drawing a blank on this one.   :cry:

Right here; let me know if you need more clarification (posting from my iPhone).
Title: Re: Xref Reactor
Post by: Krushert on August 30, 2011, 07:31:00 AM
Okay I put in the front, I put it in the back and I even replaced the the first line with it but still get the same error and the file stops loading. 

Code: [Select]
AutoCAD Architecture menu utilities ; error: no function definition:
CALLBACK:COMMANDSTARTED

So I went in and replaced this in your code
Code: [Select]
'((:vlr-commandwillstart . Callback:CommandStarted))))))
With this
Code: [Select]
'((:vlr-commandwillstart . startCommand))))))
and all is well.  Well almost.  It started finding issues with my other "set layer before command" codes that were not reactors but just simple code.   :roll:

Thanks for the help.
Title: Re: Xref Reactor
Post by: BlackBox on August 30, 2011, 08:54:07 AM
Sorry I was not more clear, I was providing you an example *structure*, that would allow for the reactor(s) to be constructed only once even if invoked multiple times. This in contrast to the original code you posted which, if called multiple times, would construct multiple instances (wish is not good, if you want to avoid fatal errors).

I'm glad you got it working again.  :wink:
Title: Re: Xref Reactor
Post by: Krushert on August 30, 2011, 10:00:12 AM
No Problem.  The real first time I messed with reactors so I am little slow on the uptake with them.  When I get into situations like this, I have a tendacy to not reinvent the wheel.  Which is good and points with that M.O.   Thanks for the help.
Title: Re: Xref Reactor
Post by: BlackBox on August 30, 2011, 11:24:09 AM
Thanks for the help.

Happy to help, Krushert.  :wink:

Reactors are very useful, but also require adequate planning with regard to callback function(s), etc. Personally, I found it easier to CONDitionally filter for the desired situations, than to try and mitigate all of the undesired situations (if that makes sense?).

In any event, welcome to the world of Reactors! :beer: