Grread+RGB 乐筑天下 - Powered by Discuz! Archiver

Grrr 发表于 2022-7-5 17:38:31

Grread+RGB

大家好，
在theswamp论坛上阅读了一篇关于GRREAD使用的很长的帖子后，我发现使用它是用户直觉的问题。
另一方面，我决定建立自己的调色板（只是一堆不同真彩色的实心图案填充）。我不得不说，为N色托盘构建“相似”的匹配颜色并不容易（即使是在浏览acad的调色板时）。一切都是基于直觉的，取决于调色板必须有多少颜色，没有一种颜色比其他颜色更突出（通过更暗或更亮）。
我不确定你们是否理解我写的内容，
但是我要说的是，用N种颜色构建自定义调色板的最简单方法是用GRREAD。例如：
1、获取选择集
2.将ss中所有对象的颜色更改为True Color
3.按下R G和B键，然后[+/-]RGB值随着1个单位的增量近似变化
假设起始颜色为0,0,0-按R并更改+键五次，B+31次后，颜色将动态更改为5,0,31
这种方法很容易使相邻的两个或多个图案填充的颜色兼容，其中一个是“动态着色”。
虽然我没有GRREAD的经验，而且它似乎很难使用。也许我会把这条线索作为一个想法留给别人考虑。

Grrr 发表于 2022-7-5 17:49:27

仍然没有回复，但那又怎样。以下是我的想法：
; 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 keys to manipulate the truecolor of the selection, for transparency, key to exit, 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 keys to manipulate the truecolor of the selection, for transparency, key to exit, 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
"\ned:" (itoa (vlax-get-property oColor 'Red))
", reen:" (itoa (vlax-get-property oColor 'GREEN))
", lue:" (itoa (vlax-get-property oColor 'BLUE))
", ransparency:" (itoa tTransparency)
", press to exit, 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
"\ned:" (itoa (vlax-get-property oColor 'Red))
", reen:" (itoa (vlax-get-property oColor 'GREEN))
", lue:" (itoa (vlax-get-property oColor 'BLUE))
", ransparency:" (itoa tTransparency)
", press to exit, 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
"\ned:" (itoa (vlax-get-property oColor 'Red))
", reen:" (itoa (vlax-get-property oColor 'GREEN))
", lue:" (itoa (vlax-get-property oColor 'BLUE))
", ransparency:" (itoa tTransparency)
", press to exit, 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
"\ned:" (itoa (vlax-get-property oColor 'Red))
", reen:" (itoa (vlax-get-property oColor 'GREEN))
", lue:" (itoa (vlax-get-property oColor 'BLUE))
", ransparency:" (itoa tTransparency)
", press to exit, to reverse the increment"
)
)
) ; T
; ((= ReturnChar 43) ; +
; (setq go nil)
; (if (< inc 0) (setq inc (* inc -1)))
; (princ
; (strcat
; "\ned:" (itoa (vlax-get-property oColor 'Red))
; ", reen:" (itoa (vlax-get-property oColor 'GREEN))
; ", lue:" (itoa (vlax-get-property oColor 'BLUE))
; ", ransparency:" (itoa tTransparency)
; ", press to exit, Increment is set to positive! "
; )
; )
; ) ; +
; ((= ReturnChar 45) ; -
; (setq go nil)
; (if (> inc 0) (setq inc (* inc -1)))
; (princ
; (strcat
; "\ned:" (itoa (vlax-get-property oColor 'Red))
; ", reen:" (itoa (vlax-get-property oColor 'GREEN))
; ", lue:" (itoa (vlax-get-property oColor 'BLUE))
; ", ransparency:" (itoa tTransparency)
; ", press to exit, Increment is set to negative! "
; )
; )
; ) ; -
((= ReturnChar 9) ; TAB
(setq go nil)
(cond
( (> inc 0)
(setq inc (* inc -1))
(princ
(strcat
"\ned:" (itoa (vlax-get-property oColor 'Red))
", reen:" (itoa (vlax-get-property oColor 'GREEN))
", lue:" (itoa (vlax-get-property oColor 'BLUE))
", ransparency:" (itoa tTransparency)
", press to exit, Increment switched to negative! "
)
)
)
( (< inc 0)
(setq inc (* inc -1))
(princ
(strcat
"\ned:" (itoa (vlax-get-property oColor 'Red))
", reen:" (itoa (vlax-get-property oColor 'GREEN))
", lue:" (itoa (vlax-get-property oColor 'BLUE))
", ransparency:" (itoa tTransparency)
", press 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

我很好奇grread是如何工作的，但我很幸运地从CAB找到了一个简单的例子！
如果有任何想法，请分享。

编辑：
我在这个帖子中引用了他的代码http://www.cadtutor.net/forum/showthread.php?21545-fixo提供的Arrow-keys-in-a-LISP-ROUTE[#8 post]。
编辑2：
稍微修改了上面的代码，所以整个过程都是循环的——按X键，再次提示用户进行选择。其他想法是通过按T键添加透明度更改选项。

Lee Mac 发表于 2022-7-5 17:54:20

下面是另一种需要考虑的方法：

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

Grrr 发表于 2022-7-5 18:03:45

我很惊讶你的回复速度如此之快，代码缩短了4倍，可能比你在这个论坛上的最后一篇帖子快了20分钟？！
我想借此机会问你，增加透明度是否容易，如果你不能在5-10分钟内做到，我就不必浪费接下来的几天时间了。
此外，我建议-如果你想把这个想法放在你的网站上，因为我不关心我的版权（我是一个独立的起草人-不是一个程序员）。

Tharwat 发表于 2022-7-5 18:11:52

我的方法：

(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="
                        (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)

Grrr 发表于 2022-7-5 18:18:13

塔尔瓦特，
我看到你坚持练习，干得好！
你认为透明性问题怎么样，容易吗？
你们两个在列表操作方面都非常先进，我需要花相当长的时间来分析代码中发生了什么。例如，如果你检查我的代码，没有太多（可能是我的代码这么长的原因）。

Lee Mac 发表于 2022-7-5 18:22:54

当然-尝试以下操作：

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

Grrr 发表于 2022-7-5 18:29:35

谢谢你，李！
由于它的复杂性，我没有想到这个线程会收到任何带有解决方案的回复。尽管如此，我还是很幸运找到了CAB的代码（对于像我这样的未过期的grread人来说，这是一个很好的模板）。
想想我在之前的回复中提出的建议，这个例程可以在全球范围内使用。

塔尔瓦特，
我会考虑下一个想法/问题，这样我们可以继续练习。但我会花时间学习直到它出现。

干得好，伙计们！

Tharwat 发表于 2022-7-5 18:34:49

您好，Grrr，
不客气。

虽然我的代码可以减少，但我很高兴编写这样的例程，这似乎与正常的日常工作有所不同，但我急于从家中发布代码，因为时间太晚了，我几乎没有完成代码的编写，并立即上床睡觉。

Grrr 发表于 2022-7-5 18:41:03

我在帖子#2中修改了代码，添加了一些选项，并检查了可能的错误。
我对grread有一些额外的想法，稍后我会在论坛上发布我的代码尝试。你们可能会发现它们很有用，并分享你们的方法！

页: [1]

乐筑天下's Archiver

Grread+RGB