Cursor Color Changing LISP

[StevJ]

Been looking at this too long, and it's time to request assistance.
This little program to change the cursor color works perfectly and without error*, so long as I select from the list. I can enter a color number or select it at the command line. But I can't make it do something I really wish to implement. I work with a cursor color of 31 and a black background, and every now and then I need to change the color of the cursor for some added clarity, hence this program to try to do it quickly.

(defun C:CC19 (/ str)
(vl-load-com)
(initget 1 "1 2 3 4 5 6 7 31")
  (setq str
    (getkword "\nSelect New Cursor Color [1/2/3/4/5/6/7/31]: ")
  )
        (setq disp (vla-get-Display (vla-get-Preferences (vlax-get-acad-object))))
        (cond
          ((eq str "1")(vla-put-ModelCrosshairColor disp 255)); 255 = Red
          ((eq str "2")(vla-put-ModelCrosshairColor disp 65535)); 65535 = Yellow
          ((eq str "3")(vla-put-ModelCrosshairColor disp 65280)); 65280 = Green
          ((eq str "4")(vla-put-ModelCrosshairColor disp 16776960)); 16776960 = Cyan
          ((eq str "5")(vla-put-ModelCrosshairColor disp 16711680)); 16711680 = Blue
          ((eq str "6")(vla-put-ModelCrosshairColor disp 16711935)); 16711935 = Magenta
          ((eq str "7")(vla-put-ModelCrosshairColor disp 16777215)); 16777215 = White
          ((eq str "31")(vla-put-ModelCrosshairColor disp 8372223)); 8372223 = Color 31
        )
(princ)
)


;;=======================================================================

;; The below conversion routines lifted from Lee Mac's excellent web site:
;;  ( http://www.lee-mac.com/colourconversion.html#rgbole ),

;; Thank you, Lee Mac

;RGB -> OLE  (255,191,127 -> 8372223)
;    (logior (fix 255) (lsh (fix 191) 8) (lsh (fix 127) 16))

;OLE -> RGB  (8372223 -> 255,191,127)
;    (mapcar '(lambda (x) (lsh (lsh (fix 8372223) x) -24)) '(24 16 8))
    
;;=======================================================================
    
; Color list:
;1 = 255 = Red
;2 = 65535 = Yellow
;3 = 65280 = Green
;4 = 16776960 = Cyan
;5 = 16711680 = Blue
;6 = 16711935 = Magenta
;7 = 16777215 = White
;Default = 8372223 = Color 31

However, I don't know how to implement my prefered method for returning the cursor color to my default color of 31. You can see I've made a selection entry for it, but is it possible, using the method I have chosen to construct this program, to modify the program so that I can return the cursor color to my default by merely pressing the ENTER or SPACE key to make the default selection? This would make it truly portable and I could share it easily with co-workers who also prefer to use a "custom" cursor color.

 

* Not really an error, but it also changes the color of the text of the Model Space tab. Don't know why, but that's insignificant and can be ignored.

 

Steve

Edited January 13, 2019 by StevJ
Fixed an OOPS.

[dlanorh]

Try this. It's untested as I'm not at a computer with Autocad.

(defun C:CC19 (/ disp c_lst k_lst str s_int)
  (vl-load-com)
  (setq disp (vla-get-Display (vla-get-Preferences (vlax-get-acad-object)))
        c_lst (list 255 65535 65280 16776960 16711680 16711935 16777215 8372223);Red Yellow Green Cyan Blue Magenta White Color31
        k_lst (list "1" "2" "3" "4" "5" "6" "7" "31")
  );end_setq
  (initget (vl-string-right-trim " " (apply 'strcat (mapcar '(lambda (x) (strcat x " ")) k_lst))))
  (setq str (getkword (strcat "\nSelect Cursor Color " "["(vl-string-right-trim "/" (apply 'strcat (mapcar '(lambda (x) (strcat x "/")) k_lst)))"] < 31 > : ")))
  (if (not str) (setq str "31")
  (setq s_int (vl-position str k_lst))
  (vla-put-ModelCrosshairColor disp (nth s_int c_lst))
  (princ)
);end_defun
(princ)

Removing the 1 from the initget allows a null entry. The following if test for this and sets "str" to the default

This is all controlled by the two lists c_lst a list of colors and k_list a list of strings corresponding to the colors in c_lst. If you need to expand or change colors, change these lists. You could also utilise the dynamic prompt and select using the mouse.

[StevJ]

Thanks, dlanorh, for the reply. I get syntax errors from your program but there are a couple things in your post that got the program working as I had envisioned.

 

" Removing the 1 from the initget allows a null entry ." 

Lightbulb lit! Did that.

(if (not str) (setq str "31"))

Incorporated that.  Also removed the '31' from selection choices.

 

Now I have this:

(defun C:CC19 (/ str)
(vl-load-com)
(initget "1 2 3 4 5 6 7")
  (setq str
    (getkword "\nSelect New Cursor Color [1/2/3/4/5/6/7/]: ")
  )
  (if (not str)(setq str "31"))
    (setq disp (vla-get-Display (vla-get-Preferences (vlax-get-acad-object))))
      (cond
        ((eq str "1")(vla-put-ModelCrosshairColor disp 255)); 255 = Red
        ((eq str "2")(vla-put-ModelCrosshairColor disp 65535)); 65535 = Yellow
        ((eq str "3")(vla-put-ModelCrosshairColor disp 65280)); 65280 = Green
        ((eq str "4")(vla-put-ModelCrosshairColor disp 16776960)); 16776960 = Cyan
        ((eq str "5")(vla-put-ModelCrosshairColor disp 16711680)); 16711680 = Blue
        ((eq str "6")(vla-put-ModelCrosshairColor disp 16711935)); 16711935 = Magenta
        ((eq str "7")(vla-put-ModelCrosshairColor disp 16777215)); 16777215 = White
        ((eq str "31")(vla-put-ModelCrosshairColor disp 8372223)); 8372223 = Color 31
      )
(princ)
)

;;=======================================================

;; The below conversion routines lifted from LeeMac's excellent web site:
;;  ( http://www.lee-mac.com/colourconversion.html#rgbole ),

;; Thank you, Lee Mac

;RGB -> OLE  (255[R],191[G],127[B] -> 8372223)
;    (logior (fix 255) (lsh (fix 191) 8) (lsh (fix 127) 16))

;OLE -> RGB  (8372223 -> 255[R],191[G],127[B])
;    (mapcar '(lambda (x) (lsh (lsh (fix 8372223) x) -24)) '(24 16 8))
    
;;=======================================================

; Color list:
;1 = 255 = Red
;2 = 65535 = Yellow
;3 = 65280 = Green
;4 = 16776960 = Cyan
;5 = 16711680 = Blue
;6 = 16711935 = Magenta
;7 = 16777215 = White
;Default = 8372223 = Color 31

 

The program now does exactly as I wanted. The defautl color is now assigned to the cursor with the ENTER or SPACE key, and also right-click, as I have that set to repeat last command/ENTER.

Thanks again for the help and ideas.

 

Steve

Edited January 13, 2019 by StevJ
Correction.

[dlanorh]

It was missing a right parenthesis in (if (not str) (setq str "31")).

 

 

[Lee Mac]

To offer an alternative:

(defun c:cc19 ( / d l )
    (setq l '(8372223 255 65535 65280 16776960 16711680 16711935 16777215)
          d  (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
    )
    (princ "\nPress TAB to cycle crosshair colors <done>: ")
    (while (equal '(2 9) (grread nil 10))
        (vla-put-modelcrosshaircolor d (car (setq l (append (cdr l) (list (car l))))))
    )
    (princ)
)
(vl-load-com) (princ)

Glad you found the colour conversion functions useful @StevJ

[dlanorh]

48 minutes ago, Lee Mac said:

To offer an alternative:

(defun c:cc19 ( / d l )
    (setq l '(8372223 255 65535 65280 16776960 16711680 16711935 16777215)
          d  (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
    )
    (princ "\nPress TAB to cycle crosshair colors <done>: ")
    (while (equal '(2 9) (grread nil 10))
        (vla-put-modelcrosshaircolor d (car (setq l (append (cdr l) (list (car l))))))
    )
    (princ)
)
(vl-load-com) (princ)

Glad you found the colour conversion functions useful @StevJ

 

Wow!

 

I'm playing with this tomorrow.   Lee, As per usual, you come up with some interesting and novel code

[StevJ]

1 hour ago, Lee Mac said:

To offer an alternative:

(defun c:cc19 ( / d l )
    (setq l '(8372223 255 65535 65280 16776960 16711680 16711935 16777215)
          d  (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
    )
    (princ "\nPress TAB to cycle crosshair colors <done>: ")
    (while (equal '(2 9) (grread nil 10))
        (vla-put-modelcrosshaircolor d (car (setq l (append (cdr l) (list (car l))))))
    )
    (princ)
)
(vl-load-com) (princ)

Glad you found the colour conversion functions useful @StevJ

 

Always impressed with your alternatives, Lee.

As with changing cursor color with my version, pressing the TAB key in yours causes the cursor to disappear until the mouse is moved, or in the case of your version, the ENTER key is pressed to make the color selection. But I found if I watch the Model tab text, I can see the colors cycling and make my selection using that as a guide.

I think we have a winner here. Thanks Lee.

 

Steve

Edited January 13, 2019 by StevJ
more spellin errers

[Lee Mac]

21 minutes ago, StevJ said:

Always impressed with your alternatives, Lee.

I think we have a winner here. Thanks Lee.

 

Thanks @StevJ

 

21 minutes ago, StevJ said:

As with changing cursor color with my version, pressing the TAB key in yours causes the cursor to disappear until the mouse is moved, or in the case of your version, the ENTER key is pressed to make the color selection. But I found if I watch the Model tab text, I can see the colors cycling and make my selection using that as a guide.

 

I observed the same in my testing; unfortunately, I think this is unavoidable and simply a byproduct of how AutoCAD applies changes to the display properties - no amount of redraw/regen will cause the changes to be shown instantaneously.

 

32 minutes ago, dlanorh said:

Wow!

 

I'm playing with this tomorrow.   Lee, As per usual, you come up with some interesting and novel code

 

Thank you @dlanorh

[Grrr]

Nice work Lee!

Initially I would suggest the usual, with getkword and an assoc list, but your approach is more user-friendly.

One thing I would suggest, although I saw later that you already accounted it:

 (setq
    l '(8372223 255 65535 65280 16776960 16711680 16711935 16777215)
    d  (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
    l (cons (vla-get-modelcrosshaircolor d) l)
  )

 

I see that 16777215 is the standard acceptable color, but perhaps some users will be exceptions?

 

Also witnessed something weird, while testing-out:

_$ (vla-get-modelcrosshaircolor (vla-get-display (vla-get-preferences (vlax-get-acad-object))))
#<variant 19 16777215>
_$ (vlax-variant-value (vla-get-modelcrosshaircolor (vla-get-display (vla-get-preferences (vlax-get-acad-object)))))
; error: "LispFromPtr failed. The type is not supported:" 19

 

Cheers!  

 

EDIT:

And a small optimization maybe, initially shift the predefined list until the next value is reached (when recalling the routine).. something like

(setq firstcrosshaircolortoset (cdr (member currentrosshaircolor thelist))) so for instance if the cursor was already red, when recalling the routine it will shift to yellow. (thats a small nitpick optimization I know)

 

Edited January 13, 2019 by Grrr

[dlanorh]

2 hours ago, Grrr said:

Also witnessed something weird, while testing-out:

_$ (vla-get-modelcrosshaircolor (vla-get-display (vla-get-preferences (vlax-get-acad-object))))
#<variant 19 16777215>
_$ (vlax-variant-value (vla-get-modelcrosshaircolor (vla-get-display (vla-get-preferences (vlax-get-acad-object)))))
; error: "LispFromPtr failed. The type is not supported:" 19

 

 

 

Try

 

(vlax-variant-value (vlax-variant-change-type (vla-get-modelcrosshaircolor (vla-get-display (vla-get-preferences (vlax-get-acad-object)))) vlax-vbLong))

Solution found Here    I assume B, Jimmy is Jimmy Bergmark

Explanation by Tony Tanzillo in post 5

Edited January 13, 2019 by dlanorh

[Grrr]

Thanks @dlanorh !

Just its a first time seeing a type conversion required, else throw an error from a lisp function.

Anyway Int32 exits as a LispDataType enum in C#, but if one tries to convert the provided lisp value /int/ to Int32 will get an error, so Int16 is used instead.

 

 

[dlanorh]

No problems @Grrr  I had the page bookmarked.

[StevJ]

To @Lee Mac,

I modified a copy of your Cursor Cycle program to cycle the background colors thru shades of grey for the occasional need to quickly enhance contrast and detail.

Your program was easily modified for that purpose.

Here is the result.

Thanks again.

 

Steve

;; Modified from the original by Lee Mac 13 JAN 2019
;; cadtutor.net/forum/topic/66670-cursor-color-changing-lisp/
;; Post 5

;; Cycles the background from black (000), thru all shades
;;   of grey (250/251/8/252/253/9/254) to white (255).

(defun c:BC19 ( / d l )
    (setq l '(000 3355443 5987163 8421504 8684676 11382189 12632256 14079702 16777215)
          d  (vla-get-display (vla-get-preferences (vlax-get-acad-object)))
    )
    (princ "\nPress TAB to cycle BACKGROUND colors <done>: ")
    (while (equal '(2 9) (grread nil 10))
        (vla-put-GraphicsWinModelBackgrndColor d (car (setq l (append (cdr l) (list (car l))))))
    )
    (princ)
)
(vl-load-com) (princ)

 

 

Edited January 14, 2019 by StevJ

[Grrr]

8 hours ago, StevJ said:

To @Lee Mac,

I modified a copy of your Cursor Cycle program to cycle the background colors thru shades of grey for the occasional need to quickly enhance contrast and detail.

Your program was easily modified for that purpose.

 

FWIW, heres an old thread wtih an interesting alternative

 

[Lee Mac]

10 hours ago, StevJ said:

To @Lee Mac,

I modified a copy of your Cursor Cycle program to cycle the background colors thru shades of grey for the occasional need to quickly enhance contrast and detail.

Your program was easily modified for that purpose.

Here is the result.

Thanks again.

Steve

 

Excellent to hear @StevJ - I'm delighted that you were able to easily modify the code.

Thank you for sharing your variation.

 

Lee