TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started 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;
(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:
-
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.
-
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...
-
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.
-
is better if you call your command name before
(see below)
(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:
-
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? :-(
(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
-
Shade
Here is what I use...maybe it will be usefull for you.
Gary
-
Thanks Gary, I will look into it. :-D
-
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?
;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: