Topic: AutoLISP Reactor Samples

[nivuahc]

The following was written by Jürg Menzi and is available here.

Code: [Select]

;
; == AcadDoc.lsp ==============================================================
; Content:
; - Reactor function to insert Xrefs always on layer 0
; - Reactor to set hatch object draworder to back
; - Reactor to change crosshair color in paperspace
; - Reactor to change crosshair color if snap is active (currently disabled)
; - Reactor to set vports to a predefined layer
;
; Copyright:
;   ©2005 MENZI ENGINEERING GmbH, Switzerland
; Notes:
;   - None
;
; - Initialize ActiveX support
(vl-load-com)
;
; - Reactors ------------------------------------------------------------------
;
; - If not set, initialize DocManager-Reactor
(or Me:ReaDma
 (setq Me:ReaDma (VLR-DocManager-Reactor
                  nil
                 '(
                   (:VLR-documentToBeDestroyed . MeDocToBeDestroyedCallbacks)
                   (:VLR-documentBecameCurrent . MeDocBecameCurrentCallbacks)
                  )
                 )
 )
)
; - If not set, initialize Command-Reactor
(or Me:ReaCom
 (setq Me:ReaCom (VLR-Command-Reactor
                  nil
                 '(
                   (:VLR-commandWillStart . MeCommandWillStartCallbacks)
                   (:VLR-commandEnded . MeCommandEndedCallbacks)
                   (:VLR-commandCancelled . MeCommandCancelledCallbacks)
                   (:VLR-commandFailed . MeCommandFailedCallbacks)
                  )
                 )
 )
)
; - If not set, initialize SysVar-Reactor
(or Me:ReaSyv
 (setq Me:ReaSyv (VLR-SysVar-Reactor
                  nil
                 '((:VLR-sysVarChanged . MeSysVarChangedCallbacks))
                 )
 )
) 
;
; - Notifications -------------------------------------------------------------
;
; - CommandWillStart notifications
(defun MeCommandWillStartCallbacks (Rea Arg)
 (MeDoCmdWillStartStuff Arg)
 (princ)
)
; - CommandEnded notifications
(defun MeCommandEndedCallbacks (Rea Arg)
 (MeDoCmdEndedStuff Arg)
 (princ)
)
; - CommandCancelled notifications
(defun MeCommandCancelledCallbacks (Rea Arg)
 (MeDoCmdCancelledStuff Arg)
 (princ)
)
; - CommandFailed notifications
(defun MeCommandFailedCallbacks (Rea Arg)
 (MeDoCmdCancelledStuff Arg)
 (princ)
)
; - SysVarChanged notifications
(defun MeSysVarChangedCallbacks (Rea Arg)
;;; (MeChangeCrosshairColorSnap Arg)
 (princ)
)
; - DocBecameCurrent notifications
(defun MeDocBecameCurrentCallbacks (Rea Arg)
 (MeChangeCrosshairColorSpace)
 (princ)
)
; - DocToBeDestroyed notifications
(defun MeDocToBeDestroyedCallbacks (Rea Arg)
 (MeCopyTempFile)
 (MeDoCloseStuff)
 (princ)
)
;
; - Subs ----------------------------------------------------------------------
;
; - Command will start function
(defun MeDoCmdWillStartStuff (Arg / CurCmd)
 (setq CurCmd (strcase (car Arg)))
 (cond
  ((wcmatch CurCmd "XATTACH")
   (setq Me:TmpLay (getvar "CLAYER"))
   (setvar "CLAYER" "0")
  )
  ;;; other command dependent functions
 )
 (princ)
)
; - Command ended function
(defun MeDoCmdEndedStuff (Arg / CurCmd CurEnt CurSet LayNme TmpObj)
 (setq CurCmd (strcase (car Arg)))
 (cond
  ((wcmatch CurCmd "*HATCH")
   (setq TmpObj (vlax-ename->vla-object (entlast)))
   (if (eq (vla-get-ObjectName TmpObj) "AcDbHatch")
    (MeSetDrawOrder (list TmpObj) 'MoveToBottom)
   )
  )
  ((wcmatch CurCmd "LAYOUT_CONTROL,MSPACE,PSPACE,U,UNDO")
   (MeChangeCrosshairColorSpace)
  )
  ((wcmatch CurCmd "*VPORTS,MVIEW")
   (setq LayNme "VportLayer") ;set to your default vport layer name
   (if (tblsearch "LAYER" LayNme)
    (progn
     (setq CurSet (ssget "X" '((0 . "VIEWPORT"))))
     (while (setq CurEnt (ssname CurSet 0))
      (vla-put-layer (vlax-ename->vla-object CurEnt) LayNme)
      (ssdel CurEnt CurSet)
     )
    )
    (alert
     (strcat
      " Viewport Layer '" LayNme
      "' not found - the current Layer is used. "
     )
    )
   )
  )
  ((wcmatch CurCmd "XATTACH")
   (if Me:TmpLay (setvar "CLAYER" Me:TmpLay))
   (setq Me:TmpLay nil)
  )
  ;;; other command dependent functions
 )
 (princ)
)
; - Command cancelled function
(defun MeDoCmdCancelledStuff (Arg / CurCmd TmpObj)
 (setq CurCmd (strcase (car Arg)))
 (cond
  ((wcmatch CurCmd "XATTACH")
   (if Me:TmpLay (setvar "CLAYER" Me:TmpLay))
   (setq Me:TmpLay nil)
  )
  ;;; other command dependent functions
 )
 (princ)
)
; - Copies the temporary file to another extension
(defun MeCopyTempFile ( / SavNme TmpNme)
 (setq TmpNme (getvar "SAVEFILE"))
 (if (not (eq TmpNme) "")
  (progn
   (setq SavNme (strcat
                      (vl-filename-directory TmpNme) "\\"
                      (vl-filename-base TmpNme) ".rgk"
                     )
   )
   (vl-file-copy TmpNme SavNme)
  )
 )
 (princ)
)
; - Reactor cleanup function
(defun MeDoCloseStuff ( / VarLst)
 (setq VarLst (MeGetReaVars))
 (mapcar 'VLR-remove (mapcar 'eval VarLst))
 (mapcar '(lambda (l) (set l nil)) VarLst)
 (princ)
)
; - Collect global reactor variables
(defun MeGetReaVars ( / RetVal)
 (foreach memb (atoms-family 1)
  (if (wcmatch (strcase memb) "ME:REA*")
   (setq RetVal (cons memb RetVal))
  )
 )
 (mapcar 'read RetVal)
)
; - Set entity draw order
(defun MeSetDrawOrder (Obl Mde / AcaDoc ExtDic SrtTbl)
 (setq AcaDoc (vla-get-ActiveDocument (vlax-get-acad-object))
       ExtDic (vla-GetExtensionDictionary (vla-get-ModelSpace AcaDoc))
 )
 (if (vl-catch-all-error-p
      (setq SrtTbl (vl-catch-all-apply
                    'vla-Item (list ExtDic "ACAD_SORTENTS")
                   )
      )
     )
  (setq SrtTbl (vla-AddObject "ACAD_SORTENTS" "AcDbSortentsTable"))
 )
 (vlax-Invoke SrtTbl Mde Obl)
 (princ)
)
; - Set crosshair color on Snap active
(defun MeChangeCrosshairColorSnap (Arg / AcaDsp AcaDoc AcaObj LayBco ModBco)
 (if (vl-position (car Arg) '("SNAPMODE" "CVPORT"))
  (progn
   (setq AcaObj (vlax-get-acad-object)
         AcaDoc (vla-get-ActiveDocument AcaObj)
         AcaDsp (vla-get-Display (vla-get-Preferences AcaObj))
         LayBco (vlax-variant-value
                 (vlax-variant-change-type
                  (vla-get-GraphicsWinLayoutBackgrndColor AcaDsp)
                  vlax-vbLong
                 )
                )
         ModBco (vlax-variant-value
                 (vlax-variant-change-type
                  (vla-get-GraphicsWinModelBackgrndColor AcaDsp)
                  vlax-vbLong
                 )
                )
   )
   ;
   ; Color list:
   ;        0 = Black
   ;      255 = Red
   ;    65535 = Yellow
   ;    65280 = Green
   ; 16776960 = Cyan
   ; 16711680 = Blue
   ; 16711935 = Magenta
   ; 16777215 = White
   ; Set the cursor color to the appropriate value:
   ;
   (if (= (getvar "TILEMODE") 0)
    (vla-put-LayoutCrosshairColor
     AcaDsp
     (if (= (vlax-get (vla-get-ActivePViewport AcaDoc) 'SnapOn) 0)
      (MeInvGreyCol LayBco)
      255 ;Cursor color by Snap on (Layout)
     )
    )
    (vla-put-ModelCrosshairColor
     AcaDsp
     (if (= (getvar "SNAPMODE") 0)
      (MeInvGreyCol ModBco)
      255 ;Cursor color by Snap on (Model)
     )
    )
   )
  )
 )
 (princ)
)
; - Set crosshair color on Paperspace active
(defun MeChangeCrosshairColorSpace ( / AcaDsp AcaObj LayBco)
 (setq AcaObj (vlax-get-acad-object)
       AcaDsp (vla-get-Display (vla-get-Preferences AcaObj))
       LayBco (vlax-variant-value
               (vlax-variant-change-type
                (vla-get-GraphicsWinLayoutBackgrndColor AcaDsp)
                vlax-vbLong
               )
              )
 )
 ;
 ; Color list:
 ;        0 = Black
 ;      255 = Red
 ;    65535 = Yellow
 ;    65280 = Green
 ; 16776960 = Cyan
 ; 16711680 = Blue
 ; 16711935 = Magenta
 ; 16777215 = White
 ; Set the cursor color to the appropriate value:
 ;
 (vla-put-LayoutCrosshairColor
  AcaDsp
  (if (or (= (getvar "TILEMODE") 1) (> (getvar "CVPORT") 1))
   (MeInvGreyCol LayBco)
   16711680 ;Cursor color in Paperspace
  )
 )
 (princ)
)
; - Calculates the inverted contrast color
(defun MeInvGreyCol (Col)
 (boole 6
  (*
   (*
    (/
     (/
      (+ (logand Col 255) (logand (/ Col 256) 255) (logand (/ Col 65536) 255))
      3
     )
     128
    )
    255
   )
   65793
  )
  16777215
 )
)

(princ)
What follows is a series of discussions on this code from a different thread.






What's more cool than "Tres cool"?

Awesome looking stuff, Jürg, thanks!  :kewl:

I've done very little with reactors and I'm trying to wrap my head around :VLR-sysVarChanged and how it can be used to "toggle" LTSCALE.






This is a direct link to the LISP file in question:

http://www.theswamp.org/lilly_pond/juergmenzi/AcadDocMiscReactorSamples.lsp

This is the link that is produced by the index script that Mark uses on the Lilly Pond

http://www.theswamp.org/lilly_pond/index.php?dir=juergmenzi/&file=AcadDocMiscReactorSamples.lsp

If you haven't visited Lilly Pond today and you clicked on that second link, you'd get a warning about the "anti-leech" feature of the script that Mark has turned on. It's to keep people from hotlinking or downloading offsite (i.e. from a different forum).

[Jürg Menzi]

I've done very little with reactors and I'm trying to wrap my head around :VLR-sysVarChanged and how it can be used to "toggle" LTSCALE.

Toggle if P/Mspace changes?

If you haven't visited Lilly Pond today and you clicked on that second link, you'd get a warning about the "anti-leech" feature of the script that Mark has turned on. It's to keep people from hotlinking or downloading offsite (i.e. from a different forum).

Duh... got it...

[nivuahc]

I've done very little with reactors and I'm trying to wrap my head around :VLR-sysVarChanged and how it can be used to "toggle" LTSCALE.

Toggle if P/Mspace changes?

Yes, for example, my LTSCALE in Model space is 96 (or 128 or 48 or whatever) but, when in Paper space I want it to be 1. When clicking into a viewport for edits I want it to revert back to 96 and, just as your cursor color changes when exiting a viewport, revert back to 1 in Paper space. It would go a long way in convincing my users to actually use Paper space for something other than screwing up one of my existing drawings.

If you haven't visited Lilly Pond today and you clicked on that second link, you'd get a warning about the "anti-leech" feature of the script that Mark has turned on. It's to keep people from hotlinking or downloading offsite (i.e. from a different forum).

Duh... got it...

Don't worry, that one bit me a few times, too, when Mark first put that script in place

[Jürg Menzi]

Yes, for example, my LTSCALE in Model space is 96 (or 128 or 48 or whatever) but, when in Paper space I want it to be 1. When clicking into a viewport for edits I want it to revert back to 96 and, just as your cursor color changes when exiting a viewport, revert back to 1 in Paper space. It would go a long way in convincing my users to actually use Paper space for something other than screwing up one of my existing drawings.

Hmmm... add this one to the AcadDoc.lsp:

Code: [Select]

; - Set LTSCALE space depending
(defun MeChangeLtscale ( / )
 (if (or (= (getvar "TILEMODE") 1) (> (getvar "CVPORT") 1))
  (setvar "LTSCALE" TheValueYouNeedInModelSpace)
  (setvar "LTSCALE" 1) ;Paperspace value
 )
 (princ)
)and add the function to this callback:

Code: [Select]

; - Command ended function
(defun MeDoCmdEndedStuff (Arg / CurCmd CurEnt CurSet LayNme TmpObj)
 (setq CurCmd (strcase (car Arg)))
 (cond
  ((wcmatch CurCmd "*HATCH")
   (setq TmpObj (vlax-ename->vla-object (entlast)))
   (if (eq (vla-get-ObjectName TmpObj) "AcDbHatch")
    (MeSetDrawOrder (list TmpObj) 'MoveToBottom)
   )
  )
  ((wcmatch CurCmd "LAYOUT_CONTROL,MSPACE,PSPACE,U,UNDO")
   (MeChangeCrosshairColorSpace)
   (MeChangeLtscale) ;;;<- Here
  )
  ((wcmatch CurCmd "*VPORTS,MVIEW")
   (setq LayNme "VportLayer") ;set to your default vport layer name
   (if (tblsearch "LAYER" LayNme)
    (progn
     (setq CurSet (ssget "X" '((0 . "VIEWPORT"))))
     (while (setq CurEnt (ssname CurSet 0))
      (vla-put-layer (vlax-ename->vla-object CurEnt) LayNme)
      (ssdel CurEnt CurSet)
     )
    )
    (alert
     (strcat
      " Viewport Layer '" LayNme
      "' not found - the current Layer is used. "
     )
    )
   )
  )
  ((wcmatch CurCmd "XATTACH")
   (if Me:TmpLay (setvar "CLAYER" Me:TmpLay))
   (setq Me:TmpLay nil)
  )
  ;;; other command dependent functions
 )
 (princ)
)

[nivuahc]

Tried it out Jürg, thanks.

Code: [Select]

Command: _.MSPACE ; error: AutoCAD variable setting rejected: "LTSCALE" nil
I'm sure that's because of this

Code: [Select]

(setvar "LTSCALE" TheValueYouNeedInModelSpace)
And that's what I was toying with earlier. Setting a value for that variable. Since it varies on a per drawing basis, it would be difficult to say exactly what it would be. When we setup a drawing to begin drafting, we set the LTSCALE accordingly. I added this to the callback conditions and it seems to do the trick. Quite possibly, though, I've screwed something up.

Code: [Select]

  ((wcmatch CurCmd "LTSCALE")
   (if (/= (getvar "LTSCALE") 1)
     (setq TheValueYouNeedInModelSpace (getvar "LTSCALE"))
     )
   )

[nivuahc]

A couple of problems I thought about on the drive home, re: the code above;

If the variable doesn't already exist it will (should) error. So, for instance, in a drawing that has already been worked on and was saved while in Paper space. The LTSCALE, in that instance, would be 1 and the variable would not be set when switching between Paper space and Model.

The drawing in the example above, the overall "master" LTSCALE would be lost when the drawing was saved. Not any different than the way it is now, but adding the functionality to remember the "master" LTSCALE would be sweet.

I need to dig up that routine I've got from years ago which applied xdata to a zero-length line to store that kind of stuff.

I should also probably split this topic off on it's own.

By the way, Jürg, that functionality you put in there to change the crosshair color, it's one of those things that, once you see it, you wonder why Autodesk didn't include that in AutoCAD in the first place.

[Jürg Menzi]

(...)I should also probably split this topic off on it's own.

Good idea to continue in the lisp forum... Maybe I can help you to find a clean solution.

By the way, Jürg, that functionality you put in there to change the crosshair color, it's one of those things that, once you see it, you wonder why Autodesk didn't include that in AutoCAD in the first place.

In 2k7 they have improved the crosshair color settings, but I still miss that feature...

[nivuahc]

woops, did that backwards 

[nivuahc]

Okay, after doing a little research I'm being led to believe that XRECORDS are the way to go with what I'm trying to do. I've tried to wrap my head around XRECORDS but I keep running into a brick wall. I even tried some sample routines to build/retrieve/delete XRECORDS but I can't seem to get them to actually work.

Anyway, maybe this isn't the way to do this? The routine I mentioned earlier was a way to do pretty much what XRECORDS are supposed to do, if the documentation are to be believed. The only caveat being that an erase, all it would erase that zero-length line. So, according to the documentation I've read, XRECORDS would take care of that.

Mark may or may not remember writing his Drawing Notes routine some time ago but I used it and SMadsens tutorials on Afralisp as a guideline (since the examples/documentation that are out there leave a lot to be desired). Still, I can't seem to get it to actually work.  :ugly:

[LE]

You can use LDATA functions or make your own environment variable to save any value on your drawing, it is much simpler.


LDATA = vlax-ldata-XXX functions

[LE]

In example, if you go the route of your own environment variable, in the case you want to save the value outside the drawing:

Code: [Select]

   (if (or (eq (getenv "DrawHelpVar") nil)
    (eq (getenv "DrawHelpVar") ""))
      (setenv "DrawHelpVar" "0"))

    ;; has been loaded before?
    (setq drawhelp_load?
   (if (and
(getenv "DrawHelpVar")
(eq (getenv "DrawHelpVar") "1"))
     "1"
     "0"))


[Jürg Menzi]

(...) Anyway, maybe this isn't the way to do this?

Chauvin, Xrecords are one of the ways you can walk on. Luis has post a clean and simple example to store values in the AutoCAD environment... keep in mind  that's not drawing specific, but saved for *all* drawings you are work with. Xrecords (or ldata - not my favored because of bad memories in R14) would be the correct solution for saving drawing specific data's. Be patient for some samples...

[CADwoman]

Great, thanks! I'll look for your samples.

(...) Anyway, maybe this isn't the way to do this?

Chauvin, Xrecords are one of the ways you can walk on. Luis has post a clean and simple example to store values in the AutoCAD environment... keep in mind  that's not drawing specific, but saved for *all* drawings you are work with. Xrecords (or ldata - not my favored because of bad memories in R14) would be the correct solution for saving drawing specific data's. Be patient for some samples...