Grrr Posted May 16, 2016 Share Posted May 16, 2016 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. Quote Link to comment Share on other sites More sharing options...
Grrr Posted May 29, 2016 Author Share Posted May 29, 2016 (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 May 30, 2016 by Grrr Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 29, 2016 Share Posted May 29, 2016 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]) ) Quote Link to comment Share on other sites More sharing options...
Grrr Posted May 29, 2016 Author Share Posted May 29, 2016 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. 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). Quote Link to comment Share on other sites More sharing options...
Tharwat Posted May 29, 2016 Share Posted May 29, 2016 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) Quote Link to comment Share on other sites More sharing options...
Grrr Posted May 29, 2016 Author Share Posted May 29, 2016 Tharwat, I see you keep up with the practice, nice work! 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). Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted May 29, 2016 Share Posted May 29, 2016 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. 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]) ) Quote Link to comment Share on other sites More sharing options...
Grrr Posted May 29, 2016 Author Share Posted May 29, 2016 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! Quote Link to comment Share on other sites More sharing options...
Tharwat Posted May 30, 2016 Share Posted May 30, 2016 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. Quote Link to comment Share on other sites More sharing options...
Grrr Posted May 30, 2016 Author Share Posted May 30, 2016 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! Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.