;|====================================================
Динамическое изменение цвета (оттенок, насыщенность, яркость) слоя или объектов
Программа Дениса Флюстикова "Color_Den" от 22.04.11, новое:
Возможность с помощью программ-пипеток задать
объектам цвет взятым с любой точки рабочего стола.
Загрузка программы-пипетки на примере "Just Color Picker" от www.annystudio.com:
1. Положить файл jcpicker.exe из архива http://www.annystudio.com/jcpicker.zip в
любую папку, которую видит AutoCAD (Support, Fonts,...).
2. Если AutoCAD найдет файл jcpicker.exe, то при запросе "Color_Den":
"4 и 6 - Оттенок, 2 и 8 - Насыщенность, - и + - Яркость, ПРОБЕЛ - Палитра, С - Пипетка или указать образец"
набрать С и должна запуститься пипетка "Just Color Picker".
3. При первом запуске "Just Color Picker" указать язык, в настройках: "Поверх всех окон".
4. Курсором указать точку с необходимым цветом, выбрать цвет ("Alt+X" по умолчанию),
скопировать в буфер обмена цвет в RGB или HTML кодировке кнопкой "<- Копировать".
5. "Just Color Picker" закрыть, цвет выбранных объектов должен обновиться и "Enter".
При большом количестве выбранных объектов возможно замедление работы программы!
В программе использован алгоритм конвертирования цветовых моделей HSL и RGB с форума:
http://forum.dwg.ru/showthread.php?t=9406
Макрос для кнопки: ^C^C^P(load "Color_Den");Color_Den
Замечания и предложения по адресу fd-@mail.ru
====================================================|;
(defun c:Color_Den (/ *error* aa0 aa1 aa2 aa3 aa4 aa5 aa6 aa7 aa8 aa9
aa10 aa11 aa12 aa13 aa14 aa15 aa16 aa17)
(if (>= (atof (getvar "ACADVER")) 16.0)(progn
(vl-load-com)
(setq aa13 (list
"jcpicker.exe" ; http://www.annystudio.com/jcpicker.zip
"pixie.exe" ; http://www.nattyware.com/bin/pixie.zip
"Zzoom.exe" ; http://www.omiod.com/dl/Zzoom.zip
"ColorSPY.exe" ; http://www.iconico.com/download.aspx?app=ColorPic
"EyeDropper.exe" ; http://www.inetia.com/en/eyedropper/download/
))
(mapcar '(lambda (x)(if (findfile x)(setq aa17 x)))(reverse aa13))
(if (setq aa14 (ssget "_i"))
(setq aa0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex aa14)))
aa0 (mapcar 'vlax-ename->vla-object aa0))
(if (setq aa0 (entsel "\nВыберите объект необходимого слоя или <Изменение цвета объектов>:"))
(setq aa13 nil
aa0 (list (vlax-ename->vla-object (car aa0))))
(setq aa14 (ssget)
aa0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex aa14)))
aa0 (mapcar 'vlax-ename->vla-object aa0))
))
(sssetfirst)
(defun Color_Den1 ()
(setq aa2 (/ (cadr aa1) 255.)
aa3 (/ (caddr aa1) 255.)
aa1 (/ (car aa1) 255.)
aa4 (min aa1 aa2 aa3 )
aa5 (max aa1 aa2 aa3 )
aa6 (- aa5 aa4)
aa9 (/ (+ aa5 aa4 ) 2.)
aa7 0
aa8 0)
(if (/= aa6 0 )(progn
(if (< aa9 0.5)
(setq aa8 (/ aa6 (+ aa5 aa4)))
(setq aa8 (/ aa6 (- 2 aa5 aa4)))
)
(setq aa10 (/ (+ (/ (- aa5 aa1) 6.)(/ aa6 2.)) aa6)
aa11 (/ (+ (/ (- aa5 aa2) 6.)(/ aa6 2.)) aa6)
aa12 (/ (+ (/ (- aa5 aa3) 6.)(/ aa6 2.)) aa6))
(cond
((equal aa1 aa5 1e-6)(setq aa7 (- aa12 aa11)))
((equal aa2 aa5 1e-6)(setq aa7 (- (+ (/ 1. 3) aa10) aa12)))
((equal aa3 aa5 1e-6)(setq aa7 (- (+ (/ 2. 3) aa11) aa10)))
)
(if (< aa7 0)(setq aa7 (1+ aa7)))
(if (> aa7 1)(setq aa7 (1- aa7)))
))
(setq aa7 (* 3.6 aa7)
aa9 (mapcar '(lambda(x)(atoi (rtos (* 100 x) 2 0)))(list aa7 aa8 aa9)))
)
(setq aa16 (vla-get-display (vla-get-preferences (vlax-get-acad-object))))
(if (= (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))) 0)
(setq aa16 (vla-get-GraphicsWinLayoutBackgrndColor aa16))
(setq aa16 (vla-get-GraphicsWinModelBackgrndColor aa16))
)
(setq aa16 (vlax-variant-value (vlax-variant-change-type aa16 '3))
aa1 (list (lsh (lsh aa16 24) -24)(lsh (lsh aa16 16) -24)(lsh aa16 -16)))
(Color_Den1)
(if (> (sqrt (+ (expt (- 120 (cadr aa9)) 2)(expt (- 320 (caddr aa9)) 2))) 295)
(setq aa16 (list (list 255 255 255) 7))
(setq aa16 (list (list 0 0 0) 250))
)
(setq aa1 (car aa0)
aa15 (vla-get-layer aa1)
aa12 (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) aa15))
(if aa13 (progn
(setq aa13 aa12
aa15 "")
(if (= 256 (vla-get-color aa1))
(setq aa1 aa13))
)
(setq aa1 aa12
aa0 (list aa12)
aa15 (strcat "Изменение цвета слоя " aa15 ". "))
)
(if (= (vla-get-Color aa1) 7)
(setq aa1 (car aa16))
(setq aa1 (vla-get-TrueColor aa1)
aa1 (list (vla-get-Red aa1)(vla-get-Green aa1)(vla-get-Blue aa1)))
)
(Color_Den1)
(setvar "CMDECHO" 0)
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(defun *error* (msg)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
(if (< (atof (getvar "ACADVER")) 17.1)
(vla-sendcommand (vla-get-activedocument
(vlax-get-acad-object)) "_.undo 1 ")
(command nil nil nil nil "_.undo" 1))
(setvar "CMDECHO" 1)
(princ "\nВыход во время обработки данных\n")
)
(command "_.undo" "_m")
(if aa14 (command "_.dimoverride" "dimclrd" 0 "dimclre" 0 "dimclrt" 0 "" aa14 ""))
(if aa17 (setq aa1 ", С - Пипетка")(setq aa1 ""))
(princ (strcat "\n" aa15 "Клавиши для изменения цвета:
\n4 и 6 - Оттенок, 2 и 8 - Насыщенность, - и + - Яркость, ПРОБЕЛ - Палитра" aa1 " или указать образец"))
(if (null aa13)(setq aa13 aa0))
(setq aa15 nil
aa1 nil
aa14 (getvar "MODEMACRO"))
(while (setq aa1 (tblnext "Layer" (null aa1)))
(setq aa15 (append aa15 (list (cdr (assoc 2 aa1)))))
)
(setq aa1 (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
aa2 (mapcar '(lambda (x)(vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) x)) aa15)
aa15 nil
aa1 nil
aa3 (vlax-create-object "htmlfile"))
(vlax-invoke (vlax-get (vlax-get aa3 'ParentWindow) 'ClipBoardData) 'clearData "Text")
(vlax-release-object aa3)
(mapcar '(lambda (x)
(if (= (vla-get-lock x) :vlax-true)
(progn
(vla-put-lock x :vlax-false)
(vla-put-freeze x :vlax-false)
(setq aa15 (append aa15 (list x)))
))) aa2)
(while aa2
(if aa1 (progn
(setq aa1 (vl-catch-all-apply 'grread (list 1 4 2)))
;;;(print aa1)
(if (= (type aa1) 'LIST)
(cond
((and (= (car aa1) 2)(= (cadr aa1) 13)) ; Enter
(setq aa2 nil)
)
((or (= (car aa1) 25) ; Правый клик
(and (= (car aa1) 2)(= (cadr aa1) 32))) ; Пробел
(setq aa2 (car aa0)
aa3 (vla-get-Color aa2))
(if (= 256 aa3)
(setq aa3 (vla-get-Color aa13)
aa2 aa13)
)
(if (or (= 7 aa3)
(= 0 aa3)
(and (= 18 aa3)(= 0 (vla-get-Red (vla-get-TrueColor aa2)))))
(setq aa3 (cadr aa16))
)
(setq aa1 (car aa0)
aa3 (vl-catch-all-apply 'acad_colordlg (list aa3 nil)))
(if (eq (type aa3) 'INT)(progn
(mapcar '(lambda (x)(vla-put-Color x aa3)) aa0)
(setq aa1 (vla-get-TrueColor aa1)
aa1 (list (vla-get-Red aa1)(vla-get-Green aa1)(vla-get-Blue aa1)))
(Color_Den1)
(setq aa1 nil)
))
)
((= (car aa1) 3) ; Образец
(if (setq aa1 (ssget (cadr aa1)))(progn
(setq aa1 (vlax-ename->vla-object (ssname aa1 0)))
(if (= 256 (vla-get-color aa1))
(setq aa1 (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (vla-get-layer aa1)))
)
(if (= (vla-get-Color aa1) 7)
(setq aa1 (car aa16))
(setq aa1 (vla-get-TrueColor aa1)
aa1 (list (vla-get-Red aa1)(vla-get-Green aa1)(vla-get-Blue aa1)))
)
(Color_Den1)
(setq aa1 nil)
)(progn
(if aa17 (setq aa3 ", С - Пипетка")(setq aa3 ""))
(princ (strcat "\nОбразец не быбран.
\n4 и 6 - Оттенок, 2 и 8 - Насыщенность, - и + - Яркость, ПРОБЕЛ - Палитра" aa3 " или указать образец"))
)
)
)
((and (= (car aa1) 2)(= (cadr aa1) 54)) ; "6"
(if (> 360 (car aa9))
(setq aa9 (mapcar '+ aa9 '(1 0 0))
aa1 nil))
)
((and (= (car aa1) 2)(= (cadr aa1) 52)) ; "4"
(if (< 0 (car aa9))
(setq aa9 (mapcar '- aa9 '(1 0 0))
aa1 nil))
)
((and (= (car aa1) 2)(= (cadr aa1) 56)) ; "8"
(if (> 100 (cadr aa9))
(setq aa9 (mapcar '+ aa9 '(0 1 0))
aa1 nil))
)
((and (= (car aa1) 2)(= (cadr aa1) 50)) ; "2"
(if (< 0 (cadr aa9))
(setq aa9 (mapcar '- aa9 '(0 1 0))
aa1 nil))
)
((and (= (car aa1) 2)(= (cadr aa1) 43)) ; "+"
(if (> 100 (caddr aa9))
(setq aa9 (mapcar '+ aa9 '(0 0 1))
aa1 nil))
)
((and (= (car aa1) 2)(= (cadr aa1) 45)) ; "-"
(if (< 0 (caddr aa9))
(setq aa9 (mapcar '- aa9 '(0 0 1))
aa1 nil))
)
((or (and (= (car aa1) 2)(= (cadr aa1) 99)) ; "c" англ.
(and (= (car aa1) 2)(= (cadr aa1) 67)) ; "C" англ.
(and (= (car aa1) 2)(= (cadr aa1) 1089)) ; "с" рус.
(and (= (car aa1) 2)(= (cadr aa1) 1057))) ; "С" рус.
(if aa17 (startapp aa17))
)
(T
(setq aa3 (vlax-create-object "htmlfile")
aa4 (vlax-invoke (vlax-get (vlax-get aa3 'ParentWindow) 'ClipBoardData) 'GetData "Text"))
(vlax-release-object aa3)
(if aa4 (progn
(setq aa4 (vl-string-trim " #" aa4))
(cond
((wcmatch aa4 "#* #* #*")
(setq aa1 (list (atoi aa4)
(atoi (substr aa4 (1+ (vl-string-position 32 aa4))))
(atoi (substr aa4 (1+ (vl-string-position 32 aa4 0 T))))))
(Color_Den1)
(setq aa1 nil)
)
((= (strlen aa4) 6)
(setq aa3 "0123456789ABCDEF"
aa1 (list (+ (* (vl-string-search (substr aa4 1 1) aa3) 16)(vl-string-search (substr aa4 2 1) aa3))
(+ (* (vl-string-search (substr aa4 3 1) aa3) 16)(vl-string-search (substr aa4 4 1) aa3))
(+ (* (vl-string-search (substr aa4 5 1) aa3) 16)(vl-string-search (substr aa4 6 1) aa3))))
(Color_Den1)
(setq aa1 nil)
)
)
(setq aa3 (vlax-create-object "htmlfile"))
(vlax-invoke (vlax-get (vlax-get aa3 'ParentWindow) 'ClipBoardData) 'clearData "Text")
(vlax-release-object aa3)
))
)
)(progn
(setq aa2 nil) ; Esc
(command "_.undo" "_b"
"_.regen")
))
)
(setq aa1 nil
aa2 T)
)
(if (and (null aa1) aa2)(progn
(setq aa1 (/ (car aa9) 360.)
aa2 (/ (cadr aa9) 100.)
aa3 (/ (caddr aa9) 100.)
aa4 (strcat "Оттенок:" (itoa (car aa9)) ","))
(while (< (strlen aa4) 13)(setq aa4 (strcat aa4 " ")))
(setq aa4 (strcat aa4 "Насыщенность:" (itoa (cadr aa9)) ","))
(while (< (strlen aa4) 32)(setq aa4 (strcat aa4 " ")))
(setq aa4 (strcat aa4 "Яркость:" (itoa (caddr aa9))))
(while (< (strlen aa4) 45)(setq aa4 (strcat aa4 " ")))
(setvar "MODEMACRO" aa4)
(defun Color_Den2 (aa7 aa8 aa9)
(if (< aa9 0)(setq aa9 (+ aa9 1)))
(if (> aa9 1)(setq aa9 (- aa9 1)))
(if (< (* 6. aa9) 1)
(setq aa6 (+ (* (- aa8 aa7) 6. aa9) aa7))
(if (< (* 2. aa9) 1)
(setq aa6 aa8)
(if (< (* 3. aa9) 2)
(setq aa6 (+ aa7 (* (- (/ 2. 3) aa9) 6. (- aa8 aa7))))
(setq aa6 aa7)
)))
aa6
)
(if (= aa2 0)
(setq aa4 aa3 aa5 aa3 aa6 aa3)
(progn
(if (< aa3 0.5)
(setq aa8 (* aa3 (+ 1. aa2)))
(setq aa8 (- (+ aa3 aa2)(* aa3 aa2))))
(setq aa7 (- (* 2. aa3) aa8)
aa4 (Color_Den2 aa7 aa8 (+ aa1 (/ 1. 3)))
aa5 (Color_Den2 aa7 aa8 aa1 )
aa6 (Color_Den2 aa7 aa8 (- aa1 (/ 1. 3))))
)
)
(setq aa1 (mapcar '(lambda(x)(atoi (rtos (* 255 x) 2 0)))(list aa4 aa5 aa6))
aa3 (vla-get-TrueColor (car aa0)))
(vla-setRGB aa3 (car aa1)(cadr aa1)(caddr aa1))
(mapcar '(lambda (x)(vla-put-TrueColor x aa3)) aa0)
))
)
(mapcar '(lambda (x)(vla-put-lock x :vlax-true)) aa15)
(setvar "MODEMACRO" aa14)
(setvar "CMDECHO" 1)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
(princ "\nДля AutoCAD с 2004 версии")
)
(princ)
)
(princ)