Jump to content
StevJ

Cursor Color Changing LISP

Recommended Posts

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 by StevJ
Fixed an OOPS.

Share this post


Link to post
Share on other sites
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.

Share this post


Link to post
Share on other sites
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 by StevJ
Correction.

Share this post


Link to post
Share on other sites
dlanorh

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

 

 

Share this post


Link to post
Share on other sites
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 :thumbsup:

  • Like 2

Share this post


Link to post
Share on other sites
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 :thumbsup:

 

Wow! :notworthy:

 

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

Share this post


Link to post
Share on other sites
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 :thumbsup:

 

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 by StevJ
more spellin errers

Share this post


Link to post
Share on other sites
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! :notworthy:

 

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

 

Thank you @dlanorh :thumbsup:

Share this post


Link to post
Share on other sites
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!  :beer:

 

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 by Grrr

Share this post


Link to post
Share on other sites
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 by dlanorh
  • Like 1

Share this post


Link to post
Share on other sites
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.

 

 

LispDataType.jpg

Share this post


Link to post
Share on other sites
dlanorh

No problems @Grrr  I had the page bookmarked. :thumbsup:

Share this post


Link to post
Share on other sites
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 by StevJ

Share this post


Link to post
Share on other sites
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

 

Share this post


Link to post
Share on other sites
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

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×