Jump to content

Grread + RGB

Grrr

By Grrr
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Grrr Veteran

Grrr

Posted
Posted

Hi guys,

After reading a very long thread about usage of GRREAD at theswamp forum, I figured out that using it is a matter of user's intuition.

On the other hand - I've decided to build my own colour palette (just a bunch of solid hatches with different truecolours). Well I have to say it wasn't easy to build "similar" matching colours for N-color pallete [even when browsing trough acad's color palettes]. Everything is based on intuition and depents on how many colors the palette must have, and none of the colors outstands from the others (by being darker or lighter).

I'm not sure do you guys understood what I wrote,

but what I'm saying that the easiest way to build a custom colour palette with N colours, would be with GRREAD. For example:

1. Get a selection set

2. Change the colour of all objects in the ss to truecolor

3. By pressing keys R G and B, and then [+/-] the RGB value changes aproximately with increment of 1 unit

Say the starting colour is 0,0,0 - upon pressing R and altering + key five times, and B + thirty one times - the colour is changed dynamically to 5,0,31

This way would be easy to compate the colours of 2 or more hatches next to each other, where one of them is "colored dynamically".

Although I have no experience with GRREAD, and it seems hard to use. Maybe I'll leave this thread as an idea for someone to consider.

Link to comment
Share on other sites
  • 2 weeks later...
Grrr Veteran

Grrr

Posted
  • Author
Posted (edited)

Still no reply, but so what. Heres what I've had in my mind:

; Grrr
; got the original grread example from: CAB, posted by fixo
; Grread + RGB
; 1. Select objects to change their truecolour
; 2. Specify colour increment value
; 3. Press [R/G/B] keys to manipulate the truecolor of the selection, [T] for transparency, [X] key to exit, [TAB] to reverse the increment

(defun C:Grread+RGB ( / go SS ent vla-obj oColor tRed tGreen tBlue tTransparency oldcmdecho inc check)

(defun *error* ( msg )
	(if loopFlag (setq loopFlag nil))
	(if go (setq go nil))
	(if oldcmdecho (setvar 'CMDECHO oldcmdecho))
	(if (not (member msg '("Function cancelled" "quit / exit abort")))
		(princ (strcat "\nError: " msg))
	)
	(princ)
)

(setq oldcmdecho (getvar 'CMDECHO))
(setvar 'CMDECHO 0)

(setq check T)
(if (not inc) (setq inc 5))
(initget (+ 2 4))

(while check
	(setq inc (cond ((getint (strcat "\nSpecify colour increment value:  <" (itoa inc) ">: "))) ( inc )))
	(cond
		( (>= inc 255)
			(princ "\nThe increment must be below 255 !")
		)
		( (<= inc 0)
			(princ "\nThe increment must be above 0 !")
		)
		(T
			(setq check nil)
		)
	)
);while
(if (not inc) (setq inc 5))

(setq go T)
(while go
	(if
		(and
			(princ "\nSelect objects to change their truecolour: ")
			(setq SS (ssget "_:L"))
		)
		(progn			
			
			
			(setq tRed 0)
			(setq tGreen 0)
			(setq tBlue 0)
			(setq tTransparency 0)
			
			(princ "\nPress [R/G/B] keys to manipulate the truecolor of the selection, [T] for transparency, [X] key to exit, [TAB] to reverse the increment") 
			(setq LoopFlag T)
			(while LoopFlag
				(setq UserIn (grread))
				(setq ReturnChar (cadr UserIn))
				
				(cond
					((= ReturnChar 114) ; R
						(setq go nil)
						(setq tRed (+ tRed inc))
						(if (> tRed 255) (setq tRed 0))
						(if (< tRed 0) (setq tRed 255))
						(repeat (setq i (sslength SS)) ; iterate trought selection
							(setq ent (ssname SS (setq i (1- i)))) ; current entity
							(setq vla-obj (vlax-ename->vla-object ent))
							
							(if (vlax-property-available-p vla-obj "TrueColor" T)
								(progn
									(setq oColor (vlax-get-property vla-obj 'TrueColor))
									(vlax-invoke-method oColor 'SetRGB tRed tGreen tBlue) 
									(vlax-put-property vla-obj 'TrueColor oColor) 
									(vla-update vla-obj)
								)
							);if
							
						); repeat
						(princ 
							(strcat
								"\n[R]ed:" (itoa (vlax-get-property oColor 'Red))
								", [G]reen:" (itoa (vlax-get-property oColor 'GREEN))
								", [b]lue:" (itoa (vlax-get-property oColor 'BLUE))
								", [T]ransparency:" (itoa tTransparency)
								", press [X] to exit, [TAB] to reverse the increment "
							)
						)
					) ; R
					((= ReturnChar 103) ; G
						(setq go nil)
						(setq tGreen (+ tGreen inc))
						(if (> tGreen 255) (setq tGreen 0))
						(if (< tGreen 0) (setq tGreen 255))
						(repeat (setq i (sslength SS)) ; iterate trought selection
							(setq ent (ssname SS (setq i (1- i)))) ; current entity
							(setq vla-obj (vlax-ename->vla-object ent))
							
							(if (vlax-property-available-p vla-obj "TrueColor" T)
								(progn
									(setq oColor (vlax-get-property vla-obj 'TrueColor))
									(vlax-invoke-method oColor 'SetRGB tRed tGreen tBlue) 
									(vlax-put-property vla-obj 'TrueColor oColor) 
									(vla-update vla-obj)
								)
							);if
							
						); repeat
						(princ 
							(strcat
								"\n[R]ed:" (itoa (vlax-get-property oColor 'Red))
								", [G]reen:" (itoa (vlax-get-property oColor 'GREEN))
								", [b]lue:" (itoa (vlax-get-property oColor 'BLUE))
								", [T]ransparency:" (itoa tTransparency)
								", press [X] to exit, [TAB] to reverse the increment "
							)
						)
					) ; G
					((= ReturnChar 98) ; B
						(setq go nil)
						(setq tBlue (+ tBlue inc))
						(if (> tBlue 255) (setq tBlue 0))
						(if (< tBlue 0) (setq tBlue 255))
						(repeat (setq i (sslength SS)) ; iterate trought selection
							(setq ent (ssname SS (setq i (1- i)))) ; current entity
							(setq vla-obj (vlax-ename->vla-object ent))
							
							(if (vlax-property-available-p vla-obj "TrueColor" T)
								(progn
									(setq oColor (vlax-get-property vla-obj 'TrueColor))
									(vlax-invoke-method oColor 'SetRGB tRed tGreen tBlue) 
									(vlax-put-property vla-obj 'TrueColor oColor) 
									(vla-update vla-obj)
								)
							);if
							
						); repeat
						(princ 
							(strcat
								"\n[R]ed:" (itoa (vlax-get-property oColor 'Red))
								", [G]reen:" (itoa (vlax-get-property oColor 'GREEN))
								", [b]lue:" (itoa (vlax-get-property oColor 'BLUE))
								", [T]ransparency:" (itoa tTransparency)
								", press [X] to exit, [TAB] to reverse the increment "
							)
						)
					) ; B
					((= ReturnChar 116) ; T
						(setq go nil)
						(setq tTransparency (+ tTransparency inc))
						(if (> tTransparency 90) (setq tTransparency 0))
						(if (< tTransparency 0) (setq tTransparency 90))
						(repeat (setq i (sslength SS)) ; iterate trought selection
							(setq ent (ssname SS (setq i (1- i)))) ; current entity
							(setq vla-obj (vlax-ename->vla-object ent))
							
							(if (vlax-property-available-p vla-obj "EntityTransparency" T)
								(progn
									(vlax-put-property vla-obj 'EntityTransparency tTransparency) 
									(vla-update vla-obj)
								)
							);if
							
						); repeat
						(princ 
							(strcat
								"\n[R]ed:" (itoa (vlax-get-property oColor 'Red))
								", [G]reen:" (itoa (vlax-get-property oColor 'GREEN))
								", [b]lue:" (itoa (vlax-get-property oColor 'BLUE))
								", [T]ransparency:" (itoa tTransparency)
								", press [X] to exit, [TAB] to reverse the increment  "
							)
						)
					) ; T
					; ((= ReturnChar 43) ; +
					; (setq go nil)
					; (if (< inc 0) (setq inc (* inc -1)))
					; (princ 
					; (strcat
					; "\n[R]ed:" (itoa (vlax-get-property oColor 'Red))
					; ", [G]reen:" (itoa (vlax-get-property oColor 'GREEN))
					; ", [b]lue:" (itoa (vlax-get-property oColor 'BLUE))
					; ", [T]ransparency:" (itoa tTransparency)
					; ", press [X] to exit, Increment is set to positive! "
					; )
					; )
					; ) ; +
					; ((= ReturnChar 45) ; -
					; (setq go nil)
					; (if (> inc 0) (setq inc (* inc -1)))
					; (princ 
					; (strcat
					; "\n[R]ed:" (itoa (vlax-get-property oColor 'Red))
					; ", [G]reen:" (itoa (vlax-get-property oColor 'GREEN))
					; ", [b]lue:" (itoa (vlax-get-property oColor 'BLUE))
					; ", [T]ransparency:" (itoa tTransparency)
					; ", press [X] to exit, Increment is set to negative! "
					; )
					; )
					; ) ; -
					((= ReturnChar 9) ; TAB
						(setq go nil)
						(cond
							( (> inc 0)
								(setq inc (* inc -1))
								(princ 
									(strcat
										"\n[R]ed:" (itoa (vlax-get-property oColor 'Red))
										", [G]reen:" (itoa (vlax-get-property oColor 'GREEN))
										", [b]lue:" (itoa (vlax-get-property oColor 'BLUE))
										", [T]ransparency:" (itoa tTransparency)
										", press [X] to exit, Increment switched to negative! "
									)
								)
							)
							( (< inc 0)
								(setq inc (* inc -1))
								(princ 
									(strcat
										"\n[R]ed:" (itoa (vlax-get-property oColor 'Red))
										", [G]reen:" (itoa (vlax-get-property oColor 'GREEN))
										", [b]lue:" (itoa (vlax-get-property oColor 'BLUE))
										", [T]ransparency:" (itoa tTransparency)
										", press [X] to exit, Increment switched to positive! "
									)
								)
							)
						);cond
					) ; TAB
					(T (setq go nil))
				);cond
				(if (= ReturnChar 120) ; X key to exit
					(progn
						(if loopFlag (setq loopFlag nil))
						(setq go T)
						(setvar 'CMDECHO oldcmdecho)
						(princ "\nX key is pressed, command interrupted by user")
					)
				);if
			);while
		);progn
	);if
);while go
(princ)
);defun

I was curious about how grread works, but I was lucky to find a simple example from CAB !

Share your thoughts if you have any. :)

 

EDIT:

I was refering to his code in this thread http://www.cadtutor.net/forum/showthread.php?21545-Arrow-keys-in-a-LISP-routine [#8 post] by fixo.

EDIT2:

Slightly modified the above code, so this whole thing loops - by pressing X the user is prompted again for selection. Additional thoughts is to add transparency change option by pressing T key.

Edited by Grrr
Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Here's another method to consider:

([color=BLUE]defun[/color] c:rgb ( [color=BLUE]/[/color] b g i l r s x )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]))
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] r 0 g 0 b 0)
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))) l))
           )
           ([color=BLUE]while[/color]
               ([color=BLUE]and[/color] ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\r[R]ed: "[/color] ([color=BLUE]itoa[/color] r) [color=MAROON]" | [G]reen: "[/color] ([color=BLUE]itoa[/color] g) [color=MAROON]" | [b]lue: "[/color] ([color=BLUE]itoa[/color] b)))
                    ([color=BLUE]=[/color] 2 ([color=BLUE]car[/color] ([color=BLUE]setq[/color] x ([color=BLUE]grread[/color] [color=BLUE]nil[/color] 10))))
                    ([color=BLUE]vl-some[/color]
                        '([color=BLUE]lambda[/color] ( l s ) ([color=BLUE]if[/color] ([color=BLUE]member[/color] ([color=BLUE]cadr[/color] x) l) ([color=BLUE]set[/color] s ([color=BLUE]rem[/color] ([color=BLUE]1+[/color] ([color=BLUE]eval[/color] s)) 256))))
                        '((114 82) (103 71) (98 66))
                        '(r g b)
                    )
               )
               (    ([color=BLUE]lambda[/color] ( c ) ([color=BLUE]foreach[/color] x l ([color=BLUE]entmod[/color] ([color=BLUE]append[/color] x c))))
                    ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 420 ([color=BLUE]logior[/color] ([color=BLUE]lsh[/color] r 16) ([color=BLUE]lsh[/color] g  b)))
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
  • Author
Posted

I'm amazed how fast you responded with like 4-time shorter code, maybe like 20 mins before your last post in this forum?!

I'll take the opportunity to ask you - will it be easy to add [T]ransparency, so if you can't do it in 5-10 minutes I won't have to waste the next few days for it. :D

Also I suggest - if you like to put this idea on your webside, since I don't care about my copyrights (I'm a standalone drafter - not a programmer).

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

My approach:

 

(defun c:test  (/ _clr r g b c ss gr x)
 ;; Tharwat - Date: 30.May.2016	;;
 (if *inc*
   *inc*
   (setq *inc* 5))
 (if (and (setq r 0
                g 0
                b 0
                c (vlax-create-object
                    (strcat "AutoCAD.AcCmColor."
                            (substr (getvar 'acadver) 1 2)))
                )
          (setq ss (ssget "_:L"))
          (setq *inc*
                 (cond
                   ((getint (strcat "\nSpecify increment value ["
                                    (itoa *inc*)
                                    "]:")))
                   (*inc*)))
          )
   (progn
     (defun _clr  (sel r g b / o i)
       (vla-setrgb c r g b)
       (repeat (setq i (sslength sel))
         (if (vlax-property-available-p
               (setq o (vlax-ename->vla-object
                         (ssname sel (setq i (1- i)))))
               'truecolor)
           (vla-put-truecolor o c)
           )
         )
       )
     (while
       (and (princ (strcat "\rHit any char of these [R,G,B] [R="
                           (itoa r)
                           "/ G="
                           (itoa g)
                           "/ B="
                           (itoa b)
                           "] else to Exit:"))
            (= (car (setq gr (grread nil 10))) 2)
            (vl-position
              (cadr gr)
              '(82 114 71 103 66 98)
              )
            )
        (setq x (cadr gr))
        (cond ((vl-position x '(82 114))
               (if (not (and (setq r (+ r *inc*))
                             (< r 255)
                             )
                        )
                 (setq r 0)))
              ((vl-position x '(71 103))
               (if (not (and (setq g (+ g *inc*))
                             (< g 255)
                             )
                        )
                 (setq g 0)))
              ((vl-position x '(66 98))
               (if (not (and (setq b (+ b *inc*))
                             (< b 255)
                             )
                        )
                 (setq b 0)))
              )
        (_clr ss r g b)
        )
     )
   )
 (princ)
 )(vl-load-com)

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
  • Author
Posted

Tharwat,

I see you keep up with the practice, nice work! :D

What do you think about the [T]ransparency issue, would it be easy?

You both guys are so advanced with this list manipulation, that it would take me quite a while time to analyse whats happening in your codes. For instance if you check my code, there aren't much (perhaps the reason why my code is so long).

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
I'm amazed how fast you responded with like 4-time shorter code, maybe like 20 mins before your last post in this forum?!

I'll take the opportunity to ask you - will it be easy to add [T]ransparency, so if you can't do it in 5-10 minutes I won't have to waste the next few days for it. :D

 

Sure - try the following:

([color=BLUE]defun[/color] c:rgb ( [color=BLUE]/[/color] a b g i l r s x )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color]))
       ([color=BLUE]progn[/color]
           ([color=BLUE]setq[/color] r 0 g 0 b 0 a 0)
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]setq[/color] l ([color=BLUE]cons[/color] ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i)))) l))
           )
           ([color=BLUE]while[/color]
               ([color=BLUE]and[/color] ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\r[R]ed: "[/color] ([color=BLUE]itoa[/color] r) [color=MAROON]" | [G]reen: "[/color] ([color=BLUE]itoa[/color] g) [color=MAROON]" | [b]lue: "[/color] ([color=BLUE]itoa[/color] b) [color=MAROON]" | [T]ransparency: "[/color] ([color=BLUE]itoa[/color] a)))
                    ([color=BLUE]=[/color] 2 ([color=BLUE]car[/color] ([color=BLUE]setq[/color] x ([color=BLUE]grread[/color] [color=BLUE]nil[/color] 10))))
                    ([color=BLUE]vl-some[/color]
                        '([color=BLUE]lambda[/color] ( l s u ) ([color=BLUE]if[/color] ([color=BLUE]member[/color] ([color=BLUE]cadr[/color] x) l) ([color=BLUE]set[/color] s ([color=BLUE]rem[/color] ([color=BLUE]1+[/color] ([color=BLUE]eval[/color] s)) u))))
                        '((114 82) (103 71) (98 66) (116 84))
                        '(r g b a)
                        '(256 256 256 91)
                    )
               )
               (    ([color=BLUE]lambda[/color] ( c a ) ([color=BLUE]foreach[/color] x l ([color=BLUE]entmod[/color] ([color=BLUE]append[/color] x c a))))
                    ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 420 ([color=BLUE]logior[/color] ([color=BLUE]lsh[/color] r 16) ([color=BLUE]lsh[/color] g  b)))
                    ([color=BLUE]list[/color] ([color=BLUE]cons[/color] 440 ([color=BLUE]logior[/color] ([color=BLUE]fix[/color] ([color=BLUE]*[/color] 2.55 ([color=BLUE]-[/color] 100 a))) 33554432)))
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
  • Author
Posted

Thank you, Lee!

I didn't suspected that this thread would recieve any replies with solutions, due its complexity. Still I'm feeling lucky about finding CAB's code (its a good template for an unexpirenced with grread guy like me).

Think about my suggestion in my previous reply, this routine could be for global usage.

 

Tharwat,

I'll think about my next idea/question, so we could practice on. But I'll take the time to learn untill it appears.

 

Nice work guys!

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

Hi Grrr,

You are welcome.

 

I am happy to write routines like that which seems different a bit than normal daily works although my codes could be reduced but I was in a hurry to post the codes from home since the time was too late and I hardly finished writing the codes and went to bed immediately.

Link to comment
Share on other sites
Grrr Veteran

Grrr

Posted
  • Author
Posted

I've modified the code in my post #2, added some options and checked for possible errors.

I have some additional ideas with grread and I'll post my code attempts later in the forum. You guys may find them useful and share your aprroaches! :)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...