Cursor Color Change with Snap

Is there a way to change the cursor color when the snap is toggled?

 

Hi rjb

A 'VLR-SysVar-Reactor' can do that. Add the following code to your
AcadDoc.lsp or if you don't have one create a file with this name in the
AutoCAD support environment.

; -- Begin code
(vl-load-com)

(or Me:Svr
(setq Me:Svr (VLR-SysVar-Reactor
nil
'(VLR-sysVarChanged . MeChangeCrosshairColor))
)
)
)
(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 MeChangeCrosshairColor (Rea Arg / AcaApp AcaDsp CurSnp)
(if (eq (car Arg) "SNAPMODE")
(progn
(setq AcaApp (vlax-get-acad-object)
AcaDsp (vla-get-Display (vla-get-Preferences AcaApp))
CurSnp (getvar "SNAPMODE")
)
;
; Color list:
; 0 = Black
; 255 = Red
; 65535 = Yellow
; 65280 = Green
; 16776960 = Cyan
; 16711680 = Blue
; 16711935 = Magenta
; 16777215 = White
; Set the standard cursor color (last number in the lines below)
; to a value corresponding with your background color, eg.:
; White background = Cursor color Black (0)
; Black background = Cursor color White (16777215)
;
(vla-put-LayoutCrosshairColor AcaDsp (if (= CurSnp 1) 255 0))
(vla-put-ModelCrosshairColor AcaDsp (if (= CurSnp 1) 255 16777215))
)
)
(princ)
)

(princ)
; -- End code

Cheers

 

I repost this in the web ng because the thread wasn't refreshed since today 09:51:09 GMT (hi Anne, what's happen?)

Hi rjb

A 'VLR-SysVar-Reactor' can do that. Add the following code to your
AcadDoc.lsp or if you don't have one create a file with this name in the
AutoCAD support environment.

; -- Begin code
(vl-load-com)

(or Me:Svr
(setq Me:Svr (VLR-SysVar-Reactor
nil
'(VLR-sysVarChanged . MeChangeCrosshairColor))
)
)
)
(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 MeChangeCrosshairColor (Rea Arg / AcaApp AcaDsp CurSnp)
(if (eq (car Arg) "SNAPMODE")
(progn
(setq AcaApp (vlax-get-acad-object)
AcaDsp (vla-get-Display (vla-get-Preferences AcaApp))
CurSnp (getvar "SNAPMODE")
)
;
; Color list:
; 0 = Black
; 255 = Red
; 65535 = Yellow
; 65280 = Green
; 16776960 = Cyan
; 16711680 = Blue
; 16711935 = Magenta
; 16777215 = White
; Set the standard cursor color (last number in the lines below)
; to a value corresponding with your background color, eg.:
; White background = Cursor color Black (0)
; Black background = Cursor color White (16777215)
;
(vla-put-LayoutCrosshairColor AcaDsp (if (= CurSnp 1) 255 0))
(vla-put-ModelCrosshairColor AcaDsp (if (= CurSnp 1) 255 16777215))
)
)
(princ)
)

(princ)
; -- End code

Cheers

 

I always like to see what you come up with.
you share some of the bet stuff.

THANKS

 

Hi anonymous with no.name

Thx for the flowers...¦-)

 

We will look into the possible non-synching of messages. Thanks.

 

Hi Jürg,

Thanks very much for the code. It works great except that, on my PC, it it
does not properly check for the current background color.
The cursor disappears with one of the background colors.

Regards,
rjb

 

And a small improvement to switch the cursor color also by changing the
viewport...

(defun MeChangeCrosshairColor (Rea Arg / AcaDsp AcaDoc AcaObj CurSnp)
(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))
)
;
; Color list:
; 0 = Black
; 255 = Red
; 65535 = Yellow
; 65280 = Green
; 16776960 = Cyan
; 16711680 = Blue
; 16711935 = Magenta
; 16777215 = White
; Set the standard cursor color (last number in the lines below)
; to a value opposite to your background color, eg.:
; White background = Cursor color Black (0)
; Black background = Cursor color White (16777215)
;
(if (= (getvar "TILEMODE") 0)
(progn
(setq CurSnp (vla-get-SnapOn (vla-get-ActivePViewport AcaDoc)))
(vla-put-LayoutCrosshairColor
AcaDsp
(if (= CurSnp :vlax-true) 255 0)
)
)
(progn
(setq CurSnp (vla-get-SnapOn (vla-get-ActiveViewport AcaDoc)))
(vla-put-ModelCrosshairColor
AcaDsp
(if (= CurSnp :vlax-true) 255 16777215)
)
)
)
)
)
(princ)
)

Cheers