Тема: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

;|====================================================

 Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта
 Программа Дениса Флюстикова "Color_Den"
 
В программе использован алгоритм конвертирования цветовых моделей 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)

(if (>= (atof (getvar "ACADVER")) 16.0)(progn

(vl-load-com)
  
(setq aa0 (car (entsel))
      aa0 (vlax-ename->vla-object aa0)
      aa1 aa0)

(if (= 256 (vla-get-color aa0))
(setq aa1 (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))(vla-get-layer aa0))))

(setq aa3 (vla-get-TrueColor aa1)
      aa1 (/ (vla-get-Red aa3) 255.)
      aa2 (/ (vla-get-Green aa3) 255.)
      aa3 (/ (vla-get-Blue aa3) 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))
      aa12 (getvar "MODEMACRO")
      aa11 (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))(vla-get-layer aa0)))

(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))
(princ "\nВыход во время обработки данных\n")
)

(if (= (vla-get-lock aa11) :vlax-true)
(vla-put-lock aa11 :vlax-false)
(setq aa11 nil)
)

(princ "\nКлавиши для изменения цвета: 4 и 6 - Оттенок, 2 и 8 - Насыщенность, - и + - Яркость")

(while aa2

(setq aa1 (vl-catch-all-apply 'grread (list 1 4 0)))
;;;(print aa1)
(if (= (type aa1) 'LIST)
(cond
((or (and (= (car aa1) 25)(= (cadr aa1) 524))    ; Правый клик
     (and (= (car aa1) 2)(= (cadr aa1) 32))    ; Пробел
     (and (= (car aa1) 2)(= (cadr aa1) 13)))    ; Enter
(setq aa2 nil)
)  
((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))
)
)(progn
(setq aa2 nil)                ; Esc
(command "_.undo" 1)
))

(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) 12)(setq aa4 (strcat aa4 " ")))
(setq aa4 (strcat aa4 "Насыщенность:" (itoa (cadr aa9))))
(while (< (strlen aa4) 29)(setq aa4 (strcat aa4 " ")))
(setq aa4 (strcat aa4 "Яркость:" (itoa (caddr aa9))))
(while (< (strlen aa4) 41)(setq aa4 (strcat aa4 " ")))

(setvar "MODEMACRO" aa4)
  
(defun c_d (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 (c_d aa7 aa8 (+ aa1 (/ 1. 3)))
      aa5 (c_d aa7 aa8 aa1 )
      aa6 (c_d aa7 aa8 (- aa1 (/ 1. 3))))
)
)

(setq aa1 (mapcar '(lambda(x)(atoi (rtos (* 255 x) 2 0)))(list aa4 aa5 aa6))
      aa3 (vla-get-TrueColor aa0))

(vla-setRGB aa3 (car aa1)(cadr aa1)(caddr aa1))
(vla-put-TrueColor aa0 aa3)

))
)

(if aa11 (vla-put-lock aa11 :vlax-true))

(setvar "MODEMACRO" aa12)
(setvar "CMDECHO" 1)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

)
(princ "\nДля AutoCAD с 2004 версии")
)

(princ)
)
(princ)

(изменено: Yuriy, 21 марта 2011г. 08:23:51)

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

О, интересно!!!
Вот бы с цветом  слоев так

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Yuriy пишет:

О, интересно!!!
Вот бы с цветом слоев так

Yuriy,
Думаю это реально, позже попробую вставить в программу эту возможность

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

;|====================================================

 Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта или слоя
 Программа Дениса Флюстикова "Color_Den" от 21.03.11:
 Возможность изменения цвета слоя (правый клик при первом диалоге)

В программе использован алгоритм конвертирования цветовых моделей 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)

(if (>= (atof (getvar "ACADVER")) 16.0)(progn

(vl-load-com)

(if (setq aa13 nil
      aa0 (entsel "\nВыберите объект или <Изменение цвета слоя>:"))
(setq aa13 T)
(setq aa0 (entsel "\nВыберите объект необходимого слоя:"))
)
  
(setq aa0 (vlax-ename->vla-object (car aa0))
      aa1 aa0
      aa12 (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))(vla-get-layer aa0)))

(if aa13 (progn
(setq aa13 aa12)
(if (= 256 (vla-get-color aa0))
(setq aa1 aa13))
)
(setq aa0 aa12
      aa1 aa0)
)

(setq aa3 (vla-get-TrueColor aa1)
      aa1 (/ (vla-get-Red aa3) 255.)
      aa2 (/ (vla-get-Green aa3) 255.)
      aa3 (/ (vla-get-Blue aa3) 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))
      aa12 (getvar "MODEMACRO"))

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

(if (null aa13)(setq aa13 aa0))

(if (= (vla-get-lock aa13) :vlax-true)
(vla-put-lock aa13 :vlax-false)
(setq aa11 nil)
)

(princ "\nКлавиши для изменения цвета: 4 и 6 - Оттенок, 2 и 8 - Насыщенность, - и + - Яркость")

(while aa2

(setq aa1 (vl-catch-all-apply 'grread (list 1 4 0)))
;;;(print aa1)
(if (= (type aa1) 'LIST)
(cond
((or (and (= (car aa1) 25)(= (cadr aa1) 524))    ; Правый клик
     (and (= (car aa1) 2)(= (cadr aa1) 32))    ; Пробел
     (and (= (car aa1) 2)(= (cadr aa1) 13)))    ; Enter
(setq aa2 nil)
)  
((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))
)
)(progn
(setq aa2 nil)                ; Esc
(command "_.undo" 1)
))

(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 c_d (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 (c_d aa7 aa8 (+ aa1 (/ 1. 3)))
      aa5 (c_d aa7 aa8 aa1 )
      aa6 (c_d aa7 aa8 (- aa1 (/ 1. 3))))
)
)

(setq aa1 (mapcar '(lambda(x)(atoi (rtos (* 255 x) 2 0)))(list aa4 aa5 aa6))
      aa3 (vla-get-TrueColor aa0))

(vla-setRGB aa3 (car aa1)(cadr aa1)(caddr aa1))
(vla-put-TrueColor aa0 aa3)

))
)

(if aa11 (vla-put-lock aa13 :vlax-true))

(setvar "MODEMACRO" aa12)
(setvar "CMDECHO" 1)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

)
(princ "\nДля AutoCAD с 2004 версии")
)

(princ)
)
(princ)

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Супер  :!:
У нас все в восторге!!
Спасибо!!!

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

;|====================================================

 Динамическое изменение цвета (оттенок, насыщенность, яркость) слоя или объекта
 Программа Дениса Флюстикова "Color_Den" от 23.03.11:
1. При первом запросе выбор объекта для изменения цвета слоя, для изменения цвета объекта – правый клик.
2. Возможность вызова палитры цветов

В программе использован алгоритм конвертирования цветовых моделей 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)

(if (>= (atof (getvar "ACADVER")) 16.0)(progn

(vl-load-com)

(if (setq aa13 T
      aa0 (entsel "\nВыберите объект необходимого слоя или <Изменение цвета объекта>:"))
(setq aa13 nil)
(setq aa0 (entsel))
)

(setq aa0 (vlax-ename->vla-object (car aa0))
      aa1 aa0
      aa15 (vla-get-layer aa0)
      aa12 (vla-item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) aa15)
      aa14 (getvar "MODEMACRO"))

(if aa13 (progn
(setq aa13 aa12
      aa15 "")
(if (= 256 (vla-get-color aa0))
(setq aa1 aa13))
)
(setq aa0 aa12
      aa1 aa0
      aa15 (strcat "Изменение цвета слоя " aa15 ". "))
)

(defun Color_Den1 ()

(setq aa3 (vla-get-TrueColor aa1)
      aa1 (/ (vla-get-Red aa3) 255.)
      aa2 (/ (vla-get-Green aa3) 255.)
      aa3 (/ (vla-get-Blue aa3) 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)))
)

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

(princ (strcat "\n" aa15 "Клавиши для изменения цвета:
\n4 и 6 - Оттенок, 2 и 8 - Насыщенность, - и + - Яркость, ПРОБЕЛ - Палитра"))

(if (null aa13)(setq aa13 aa0))

(if (= (vla-get-lock aa13) :vlax-true)
(vla-put-lock aa13 :vlax-false)
(setq aa15 nil)
)

(while aa2

(setq aa1 (vl-catch-all-apply 'grread (list 1 4 0)))
;;;(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)))    ; Пробел

(if (= 256 (setq aa3 (vla-get-Color aa0)))
(setq aa3 (vla-get-Color aa13)))
 
(setq aa1 aa0
      aa3 (vl-catch-all-apply 'acad_colordlg (list aa3 nil)))

(if (eq (type aa3) 'INT)(progn

(vla-put-Color aa0 aa3)
(Color_Den1)
(setq aa1 nil)
))
)
((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))
)
)(progn
(setq aa2 nil)                ; Esc
(command "_.undo" 1)
))

(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 aa0))

(vla-setRGB aa3 (car aa1)(cadr aa1)(caddr aa1))
(vla-put-TrueColor aa0 aa3)

))
)

(if aa15 (vla-put-lock aa13 :vlax-true))

(setvar "MODEMACRO" aa14)
(setvar "CMDECHO" 1)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))

)
(princ "\nДля AutoCAD с 2004 версии")
)

(princ)
)
(princ)

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Программа классная, но было бы, на мой взгляд, удобнее если бы имелась панель с ползунками на подобие фотошопвской.

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Nick Navi пишет:

Программа классная, но было бы, на мой взгляд, удобнее если бы имелась панель с ползунками на подобие фотошопвской.

Nick Navi,
Удобнее, но как из панели сделать динамическое изменение цвета, не знаю. :(

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

;|====================================================
 Динамическое изменение цвета (оттенок, насыщенность, яркость) слоя или объектов
 Программа Дениса Флюстикова "Color_Den" от 27.03.11, новое:
1. Выбор цвета по образцу
2. Изменение цвета объектов (цвет по первому объекту в наборе,
при большом количестве выбранных объектов возможно замедление работы программы)

В программе использован алгоритм конвертирования цветовых моделей 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)

(if (>= (atof (getvar "ACADVER")) 16.0)(progn

(vl-load-com)

(if (setq aa13 T
      aa0 (ssget "_i"))
(setq aa0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex aa0)))
      aa0 (mapcar 'vlax-ename->vla-object aa0))
(if (setq aa0 (entsel "\nВыберите объект необходимого слоя или <Изменение цвета объектов>:"))
(setq aa13 nil
      aa0 (list (vlax-ename->vla-object (car aa0))))
(setq aa0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget))))
      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)
      aa14 (getvar "MODEMACRO"))

(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)))
(command "_.undo" "_m")

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

(princ (strcat "\n" aa15 "Клавиши для изменения цвета:
\n4 и 6 - Оттенок, 2 и 8 - Насыщенность, - и + - Яркость, ПРОБЕЛ - Палитра или указать образец"))

(if (null aa13)(setq aa13 aa0))

(setq aa15 nil
      aa1 nil)

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

(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)
)
(princ "\nОбразец не быбран.
\n4 и 6 - Оттенок, 2 и 8 - Насыщенность, - и + - Яркость, ПРОБЕЛ - Палитра или указать образец")
)
)
((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))
)
)(progn
(setq aa2 nil)                    ; Esc
(command "_.undo" "_b")
))
)
(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)

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

;|====================================================
 Динамическое изменение цвета (оттенок, насыщенность, яркость) слоя или объектов

 Программа Дениса Флюстикова "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)

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

"Color_Den" от 17.10.11, новое:
Получение ближайшего цвета из альбомов:
RAL® Classic
RAL® DESIGN
TOYO®
FOCOLTONE®
TRUMATCH®
PANTONE®
PANTONEMETALLIC®
TIKKURILA® Symphony
TIKKURILA® FACADE 2004TVT
MONICOLOR®
DULUX®
Sherwin Williams®
CAPAROL® 3D SYSTEM PLUS
Benjamin Moore® Paints Color Collection Designer Classics
Московская Палитра®
NCS INDEX EDITION 2
DIC COLOR GUIDE®
DIC COLOR GUIDE® PART II
W3C Named Colors
Named Web Colors
Websafe Colors

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

"Color_Den" от 30.10.11, новое:
1. Задание цвета именем из подгруженного альбома цветов.
2. Получение ближайшего цвета из альбома "RAL EFFECT".

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Это крутая прога для тех кто делает расколеровку в ACADe  :!:  Спасибо  ;)

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Largo_GT,
За отзыв спасибо, а пожелания по работе программы есть?
А-то все необходимые задачи для моей работы были отработаны еще в первых версиях программы, далее доработки шли потому что было интересно само решение и может быть кому-то пригодятся новые функции.
И пока не остыл к этой теме и есть наработки, например, сервисные программки для создания альбомов цветов, готов продолжить.

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

сейчас на ум ни чего не приходит...
почему то у меня функция "альбом" не работает, выбрал объект жму "А"-ни чего не происходит...(пробывал в разных раскладках)
AA 2012 рус, win 7 x32

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Largo_GT пишет:

...выбрал объект жму "А"-ни чего не происходит...

Если программа не реагирует на русскую "А", то могу предположить, что AutoCAD не может найти файл Color_Den.lst
Введи в командную строку:
(findfile "Color_Den.lst")
если после "Enter" сообщение:
nil
перенеси файл Color_Den.lst в любую папку которую видит AutoCAD (Support, Fonts,...) или пропиши путь.

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Денис Флюстиков пишет:

перенеси файл Color_Den.lst в любую папку которую видит AutoCAD (Support, Fonts,...) или пропиши путь.

теперь при нажатии русской "А" выдает:

Выход во время обработки данных

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Largo_GT,
попробуй новую версию, все что писал о файле Color_Den.lst нужно сделать с Color_Den.dat

"Color_Den" от 04.11.11, новое:
1. Возможность выбора цвета из альбома.
2. Подправлены моментики.

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Денис Флюстиков пишет:

попробуй новую версию

пробовал на AA 2012x64rus, acad 2007 - без изменений...

при нажатии русской "А" выдает:
Выход во время обработки данных

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Largo_GT,
Нашел машину с подобным сообщением, оказалось, что в настройках AutaCAD'a прописана несуществующая папка для файла автосохранения.
В программе это учел, архив перезалил.
Если в твоем случае и это не помогло, пришли, пожалуйста, свой адрес мне на fd-@mail.ru

(изменено: Максим К., 3 ноября 2012г. 14:51:04)

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Здраствуйте! Сразу скажу что в програмировании и написании лиспов ничего не понимаю, могу лишь что то логически догодаться. Думаю для вас занающи людей не составит большого труда помочь мне.
Есть чертеж с большим количеством десятичных цифр от 0 ну и до 200 примерно с двумя или одним знаком после запятой(точки). Так вот мне надо допустим чтобы предел цифр:
-от 0 до 21,56 заменился на текст"%%247 16" и изменил цвет на заданный сразу в лиспе (какие цвета буду применять еще не думал, так что неплохо было бы уточнить в лиспе каким образом и где менять код цвета)
-от 21,57 до 37,58 заменился на текст"%%247 18"и опять изменить цвет, но уже другой
- и так 5, 6 строчек которые я уже сам могу  добавить по анологии.
ну в лиспе указать где и как менять эти пределы мне тоже было бы не плохо.
Цифры в виде обычного текста.
Ну и желательно бы какую то команду (забить на кнопку я знаю как уже  :D ) на выполнении данного лиспа с выбором области объектов.
Может где есть уже что то подобное в лиспе??
Помогите пожалуйста решить данную несложную для вас, но невыполнимую задачу для меня!

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Максим К.,
Не очень понял, что требуется, да и не особенно вникал, т.к. программированием давно не занимался и LISP вспоминаю, когда выявляются явные баги в моих программках. Так, что извини, лучше тебе обратиться в соответствующие темы форумов:
https://www.caduser.ru/forum/forum23.html
или
http://forum.dwg.ru/forumdisplay.php?f=13
Удачи!

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

"Color_Den" от 13.06.13:
Возможность динамического изменения цвета слоя или объектов через компоненты RGB (красный, зеленый, синий).

(изменено: Дмитрий Лунов, 2 апреля 2015г. 09:43:58)

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Подскажите, а собственно файлик(и) *.acb с палитрами, в частности "NCS INDEX EDITION 2" Вы не могли бы выложить?

И, кстати, проблема с "нереагированием" на "А" в любой раскладке подтверждается. Autocad 2014 x64.

Re: LISP. Динамическое изменение цвета (оттенок, насыщенность, яркость) объекта

Для работы с альбомами, в частности и с "NCS INDEX EDITION 2" (отдельно файлов *.acb нет), файл Color_Den.dat из архива http://dwg.ru/dnl/10169 должен находиться в путях доступа AutoCad (проверено на Autocad 2014 x64).