TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Shade on April 10, 2006, 03:08:21 PM

Title: Xref command reactor
Post by: Shade on April 10, 2006, 03:08:21 PM

This is my first attempted at a command reactor and I used the Afralisp example as a guide.
Unfortunetly I can quite figure out why it does not work.
Here is the code;

Code: [Select]

(vl-load-com)
(vlr-command-reactor Nil '((:vlr-commandWillStart . XrefStart)))
(vlr-command-reactor Nil '((:vlr-commandEnded . XrefEnd)))
(vlr-command-reactor Nil '((:vlr-commandCancelled . XrefCancel)))
(vlr-command-reactor Nil '((:vlr-commandFailed . XrefFail)))


(Defun XrefStart (CALL DATA / BGN CHK LYR)
  (setq PLYR (getvar 'CLAYER)
LYR (tblsearch "LAYER" "Xref")
CHK (member "Xref" LYR)
BGN (nth 0 DATA)
  )
  (if (= CHK Nil)(command "_.Layer" "M" "Xref" ""));if
  (cond ((= BGN "Xref")(setvar "CLAYER" "Xref"));
((= BGN "XAttach")(setvar "CLAYER" "Xref"));
  );
  (princ);
);defun

(Defun XrefEnd (CALL DATA / EXT)
  (setq EXT (nth 0 DATA))
  (cond ((= EXT "Xref")(setvar "CLAYER" PLYR));
((= EXT "XAttach")(setvar "CLAYER" PLYR));
  );
  (princ)
);Defun

(Defun XrefCancel (CALL DATA / CNL)
  (setq CNL (nth 0 DATA)) 
  (cond ((= EXT "Xref")(setvar "CLAYER" PLYR));
((= EXT "XAttach")(setvar "CLAYER" PLYR));
  );
  (princ) 
);Defun
 
(Defun XrefFail (CALL DATA / FLD)
  (setq FLD (nth 0 DATA))
  (cond ((= FLD "Xref")(setvar "CLAYER" PLYR));
((= FLD "XAttach")(setvar "CLAYER" PLYR));
  );
  (princ) 
);Defun
Obviously, I have lots to learn still.  :-(
Any help would be appreciated...
 :mrgreen:

Title: Re: Xref command reactor
Post by: T.Willey on April 10, 2006, 03:12:42 PM

First thing I noticed, is that you can not call commands in the reactor call back funtions.  So to make your layer, you will have to use entmake, or ActiveX controls.

Title: Re: Xref command reactor
Post by: LE on April 10, 2006, 04:16:22 PM

If you have a pre-2004 autocad, don't use setvar, also vlisp reactors are intended to be use with activex extensions only, do not mix entmake's even if they appear to work without any problem.

hth.

We have several samples around here in the swamp, some of interest maybe in the show your stuff...

Title: Re: Xref command reactor
Post by: Serge J. Gianolla on April 10, 2006, 04:17:37 PM

Haven't tested your code, but see the format you have here (getvar 'CLAYER), if you are on 2004 or higher you have to adapt for setvar too.

Title: Re: Xref command reactor
Post by: Andrea on April 10, 2006, 06:29:21 PM

is better if you call your command name before
(see below)

Code: [Select]

(vl-load-com)
(vlr-command-reactor Nil '((:vlr-commandWillStart . XrefStart)))
(vlr-command-reactor Nil '((:vlr-commandEnded . XrefEnd)))
(vlr-command-reactor Nil '((:vlr-commandCancelled . XrefCancel)))
(vlr-command-reactor Nil '((:vlr-commandFailed . XrefFail)))


(Defun XrefStart (CALL DATA / BGN )
  (setq BGN (nth 0 DATA))
  (cond       
    ((= BGN "XREF") (do this...))
    ((= BGN "ATTACH") (do this...))

    ;;   etc...

))
same thing for XrefEnd, XrefCancel and XrefFail.
Also, I suggest to remove your Reactor at the Fail and Cancel options.

 :wink:

Title: Re: Xref command reactor
Post by: Shade on April 11, 2006, 10:47:13 AM

Thanks all for the help so far....
I revised the code and now have the xrefstart command reactor working (I think) but for some reason it passes the wrong data to the XrefEnd command reactor.
I have figured out that the PLYR variable starts out as the currentlayer name then for somereason it changes to "Xref". Therefore when XrefEnd runs, it sets the wrong layer.
Why does this happen?  :-(

Code: [Select]

(Defun XrefStart (CALL DATA / BGN CHK LYR)
  (setq BGN (nth 0 DATA)
        PLYR (getvar "CLAYER")
LYR (tblsearch "LAYER" "Xref")
CHK (member "Xref" LYR)
  )
  (princ PLYR)
  (if (= CHK Nil)(ADDLAYER "Xref"));if
  (cond ((= BGN "XREF")(setvar "CLAYER" "Xref"));
((= BGN "XATTACH")(setvar "CLAYER" "Xref"));
  );
  (princ);
);defun

(Defun XrefEnd (CALL DATA );/ EXT)
  (setq EXT (nth 0 DATA))
  (cond ((= EXT "XREF")(setvar "CLAYER" PLYR));
((= EXT "XATTACH")(setvar "CLAYER" PLYR));
  );
  (princ)
);Defun

Title: Re: Xref command reactor
Post by: GDF on April 11, 2006, 11:32:14 AM

Shade

Here is what I use...maybe it will be usefull for you.

Gary

Title: Re: Xref command reactor
Post by: Shade on April 11, 2006, 11:45:18 AM

Thanks Gary, I will look into it.  :-D

Title: Re: Xref command reactor
Post by: Shade on April 26, 2006, 12:42:48 PM

I started with Gary's code as a base for my command reactors, but something is going wrong. The layer will not switch back to current the layer before the command was executed, when the command has either ended, or been canceled. Where am I going wrong?

Code: [Select]

;Reactors
(defun AutoLyrCmD ()
  (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:CMD))) 
)

;Editor Reactor.
(defun ARCH:CMD (CALL CALLBACK / COMLAYLST)
;;; List of corrusponding commands layers  color linetype plottable
  (setq COMLAYLST
         (list
              (list "XREF" "Xref" 7 "continuous" :vlax-true)
      (list "DIM" "Dim" 1 "continuous" :vlax-true)
      (list "MTEXT" "Notes" 9 "continuous" :vlax-true)
      (list "TEXT" "Notes" 9 "continuous" :vlax-true)
      (list "DTEXT" "Notes" 9 "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))
        ) )       
    ) );progn, if
  ) 
)

;;; 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")) 
  ;;(vlr-editor-reactor nil '((:vlr-commandwillstart . ARCH:CMD)))
);


(defun endCommand (calling-reactor endCommandInfo / thecommandend)
  (setq thecommandend (nth 0 endCommandInfo))
  (cond   
    ((= thecommandend "XREF") (setvar "CLAYER" OldLayer))
    ((= thecommandend "DIM") (setvar "CLAYER" OldLayer))
    ((= thecommandend "MTEXT") (setvar "CLAYER" OldLayer))
    ((= thecommandend "TEXT") (setvar "CLAYER" OldLayer))
    ((= thecommandend "DTEXT") (setvar "CLAYER" OldLayer))
  )
)


(defun cancelCommand (calling-reactor cancelCommandInfo / thecommandcancel)               
  (setq thecommandcancel (nth 0 cancelCommandInfo))
  (cond   
    ((= thecommandcancel "XREF") (setvar "CLAYER" OldLayer))
    ((= thecommandcancel "DIM") (setvar "CLAYER" OldLayer))
    ((= thecommandcancel "MTEXT") (setvar "CLAYER" OldLayer))
    ((= thecommandcancel "TEXT") (setvar "CLAYER" OldLayer))
    ((= thecommandcancel "DTEXT") (setvar "CLAYER" OldLayer))
  ) 
)
(AutoLyrCmd)
(princ)
Any help would be greatly appreciated...
 :mrgreen: