MeChangeCrosshairColor Request

Juerg Menzi, thanks for your routine. I have a request.

When using your MeChangeCrosshairColor routine, I want to be able to
control the crosshairs color between open drawings....having the crosshairs
change colors whenever a drawing is made active.

The way it stands now, a red crosshair in drawing one with "CVPORT" is "2", will
also be red in when "CVPORT" is "1" in drawing two when it is made active.

I am doing the same (calling-reactor commandinfo) reactor for my modemacro
routine
and it works fine.
Example:
(defun modeexe (calling-reactor commandinfo) (C:MODE) (princ))
This is in my startup:
(cond
((>= (distof (substr (getvar "acadver") 1 4)) 15.0)
(progn (vl-load-com) ;needs to be loaded first to run reactor
(vlr-docmanager-reactor () '(vlr-documentBecameCurrent .
modeexe))))))
Where (C:MODE) is my modemacreo routine command.

I need this function to do the crosshair change whenever a drawing document is
made active:
(defun vportreactor
(*do reactor function here*)
)

This is what I will place in my statup:
(cond
((>= (distof (substr (getvar "acadver") 1 4)) 15.0)
(progn (vl-load-com) ;needs to be loaded first to run reactor
(vlr-docmanager-reactor () '(vlr-documentBecameCurrent .
vportreactor))))))

Modified MeChangeCrosshairColor routine:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;
;;; This original Copyrighted routine has been modified...
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;; reactor functions
;;; Juerg Menzi
(or Me:Svr
(setq Me:Svr (VLR-SysVar-Reactor
nil
'(VLR-sysVarChanged . MeChangeCrosshairColor-vport)) ;vport
activated
)
)
)
(or Memr
(setq Memr (vlr-DocManager-reactor
nil
'(VLR-documentToBeDestroyed . MeDoCloseStuff))
)
)
)
(defun MeDoCloseStuff (Rea Arg)
(mapcar 'VLR-remove (list Me:Svr Memr))
(setq Memr nil
Me:Svr nil
)
(princ)
)
(defun MeInvGreyCol (Col)
(boole 6
(*
(*
(/
(/
(+ (logand Col 255) (logand (/ Col 256) 255) (logand (/ Col 65536) 255))
3
)
128
)
255
)
65793
)
16777215
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;; the reactor changes crosshair colors on switching SNAPMODE on/off
;;; Juerg Menzi
(defun MeChangeCrosshairColor-snap (Rea 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
)
)
)
;;
;; Set the cursor color to the appropriate value.
;; Color list:
;; 0 = Black
;; 255 = Red
;; 65535 = Yellow
;; 65280 = Green
;; 16776960 = Cyan
;; 16711680 = Blue
;; 16711935 = Magenta
;; 16777215 = White
;;
(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)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;; the reactor changes crosshair color of the crosshairs from white (when in
pspace)
;;; to red (when in active viewport)
;;; Juerg Menzi
(defun MeChangeCrosshairColor-vport (Rea Arg / AcaDsp AcaObj LayBco)
(if (vl-position (car Arg) '("CVPORT"))
(progn
(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 (= (getvar "CVPORT") 2)
255 ;Cursor color in Paperspace
(MeInvGreyCol LayBco)
)
)
)
)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;
(princ)


Gary

 

Hi Gary

Stand by, it's late today. I'll check this tomorrow.

Cheers

 

Thanks...I really like this routine.
Hopefully I was clear in explaining my request..........

Gary

 

Hi Gary

Meanwhile I've done some other modifications (some goodies from my reactor
library added). You'll find another reactor to set the layer on Vport commands:

Code:

; - Initialize ActiveX support
(vl-load-com)
; - 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-commandEnded . MeCommandEndedCallbacks))
)
)
)
; - CommandEnded notifications
(defun MeCommandEndedCallbacks (Rea Arg)
(MeSetVportLayer Arg)
(MeChangeCrosshairColorSpace Arg)
(princ)
)
; - DocBecameCurrent notifications
(defun MeDocBecameCurrentCallbacks (Rea Arg)
(MeChangeCrosshairColorSpace nil)
(princ)
)
; - DocToBeDestroyed notifications
(defun MeDocToBeDestroyedCallbacks (Rea Arg)
(MeDoCloseStuff)
(princ)
)
; - Reactor cleanup function
(defun MeDoCloseStuff ( / VarLst)
(setq VarLst (MeGetReaVars))
(mapcar 'VLR-remove (mapcar 'eval VarLst))
(mapcar '(lambda (l) (set l nil)) VarLst)
(princ)
)
; - Set Vport layer on creating new Vport(s)
(defun MeSetVportLayer (Arg / CurEnt CurSet FltLst LayNme)
(setq LayNme "VportLayer")	;Set the desired Vport layer name (must exist)
(if (wcmatch (car Arg) "*VPORTS,MVIEW")
(progn
(if (tblsearch "LAYER" LayNme)
(progn
(setq FltLst (list '(0 . "VIEWPORT") (cons 8 (strcat "~" LayNme)))
CurSet (ssget "X" FltLst)
)
(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. "
)
)
)
)
)
(princ)
)
; - Set crosshair color on Paperspace active
(defun MeChangeCrosshairColorSpace (Arg / AcaDsp AcaObj LayBco)
(if (or
(not Arg)
(vl-position (car Arg) '("PSPACE" "MSPACE" "LAYOUT_CONTROL" "U" "UNDO"))
)
(progn
(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)
255	;Cursor color in Paperspace
)
)
)
)
(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)
)
; - 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)

Cheers

 

Thanks works great....I,ve got a lot to learn.

)))))))
(o)-(o)
-----oo0---(_)---0oo--------------------------
| | | | | | | | | | | |
| | | | | | | | | | | |

Gary

 

This is my modification, I wanted the red crosshairs only in the active vport.

Thanks again for your time and helping everyone on this side of the big pond.

(vla-put-LayoutCrosshairColor
AcaDsp
;;(if (or (= (getvar "TILEMODE") 1) (> (getvar "CVPORT") 1))
(if (and (= (getvar "TILEMODE") 0) (= (getvar "CVPORT") 2)) ;new modication
255 ;Cursor color in Paperspace <revised order>
(MeInvGreyCol LayBco)
;;255 ;Cursor color in Paperspace
)
)

Gary

 

Glad to help you...¦-)

Cheers

 

Juerg

Because of a conflict with my error handler routine, I had to modify the line
below for undo.

(defun MeChangeCrosshairColorSpace (Arg / AcaDsp AcaObj LayBco)
(if (or
(not Arg)
(vl-position (car Arg) '("PSPACE" "MSPACE" "LAYOUT_CONTROL")) ;; "U"
"UNDO")) modified this line
)

Gary

 

Hi Gary

If you remove undo from the reactor and you undoing a space change, the color
is not anymore changed...
You can avoid this if you use
(vla-StartUndoMark AcadDocObj)
(vla-EndUndoMark AcadDocObj)
in your error handler.

Cheers

 

Thanks...do you have an example of how to use these functions
in an error handler?

Gary

 

Hi Gary

Yep, if you have an error handler inside a function:

Code:

(defun C:MyFunc ( / OldCmd *Error*)
(or Me:Aco (setq Me:Aco (vlax-get-acad-object)))
(or Me:Acd (setq Me:Acd (vla-get-ActiveDocument Me:Aco)))
(vla-StartUndoMark Me:Acd)
(setq OldDas (getvar "CMDECHO"))
(defun *Error* (Msg)
(setvar "CMDECHO" OldCmd)
(vla-EndUndoMark Me:Acd)
(if (and Msg (not (eq Msg "quit / exit abort")))
(princ Msg)
)
(princ)
)
;
;...code...
;
(*Error* nil)
)

An external error handler can look like this:

Code:

(defun C:MyFunc ( / )
(MeStartFunc '("CMDECHO" "OSMODE"))
;
;...code...
;
(MeEndFunc)
)
;
; == Function MeStartFunc
; Start function to LISP programs.
; Arguments [Type]:
;   Lst = Systemvars list [LIST]
; Return [Type]:
;   > Null
; Notes:
;   None
;
(defun MeStartFunc (Lst)
(or Me:Aco (setq Me:Aco (vlax-get-acad-object)))
(or Me:Acd (setq Me:Acd (vla-get-ActiveDocument Me:Aco)))
(vla-StartUndoMark Me:Acd)
(setq Me:Oer *Error*
*Error* MeUserError
)
(mapcar
'(lambda (l)
(if (not (assoc l Me:Var))
(setq Me:Var (append Me:Var (list (cons l (getvar l)))))
)
) Lst
)
(princ)
)
;
; == Function MeEndFunc
; End function to LISP programs.
; Arguments [Type]:
;   --- =
; Return [Type]:
;   > Null
; Notes:
;   None
;
(defun MeEndFunc ()
(if Me:Var
(mapcar '(lambda (l) (setvar (car l) (cdr l))) Me:Var)
)
(setq *Error* Me:Oer
Me:Oer  nil
Me:Var  nil
)
(vla-EndUndoMark Me:Acd)
(princ)
)
;
; == Function MeUserError
; User error handler.
; Arguments [Type]:
;   Msg = AutoLISP message [STR]
; Return [Type]:
;   > Null
; Notes:
;   None
;
(defun MeUserError (Msg)
(if (and Msg (not (eq Msg "quit / exit abort")))
(princ Msg)
)
(MeEndFunc)
(princ)
)

Cheers

 

Thanks again for all your help.
Have a good weekend.

[_]P

Gary