[mmax]

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

Я кажется разгадал математическую связь между RGB_color и OLE_color.

Видел я тут одну функцию , но мой способ позволяет вычислить цвет без использования длинного списка, который там, как я понял, отражает не всю палитру

С помощью системного калькулятора из трех номеров RGB (55 88 15) у меня получается вычислить номер цвета для функции
(vla-put-ModelCrosshairColor (vla-get-Display (vla-get-Preferences (vlax-get-acad-object)))1005623)
если выполнить эту функцию, а потом с помощью _options выйти на диалоговое окно выбора цвета для курсора, то можно увидеть R=55 G=88 B=15. Число 1005623 я сначала получил с помощью vla-get- ModelCrosshairColor, а потом мне удалось получить его с помощью вычислений на калькуляторе, в принципе там все сводится к переводу из DEC в HEX и обратно.

Если можно это делать вручную то в Лиспе и подавно.

Если кому не трудно подкиньне функцию перевода чисел из DEC в HEX и обратно, пока я провожу эксперименты, или направьте меня на путь истинный, дабы я не мучился с велосипедом.

[CB]

Новый вариант программы, в котором вроде все работает нормально:

Код:

[Выделить все]

(defun dec->hex (DEC / dec->hex)
 (defun dec->hex (DEC tmp)
  (cond
    ( (not (numberp DEC)) nil)
    ( (zerop DEC) (if (zerop tmp) "0" "") )
    ( t (if tmp (setq tmp (1+ tmp)) (setq tmp 0))
        (strcat (dec->hex (fix (/ DEC 16)) tmp) (cadr (assoc (fix (rem DEC 16)) dec-hex-lst))) )
  )
 )
 (dec->hex DEC nil)
)

(DEC->HEX 2540)
"9EC" 
(DEC->HEX 15)
"0F"
(DEC->HEX 12a3)
nil
(DEC->HEX 2540.00)
"9EC"

[mmax]

>CB
В моей последней функции rgb->ole уже не нужна принудительная проставка нолей, она сама проставит ноли где надо.
Нужно чтобы Hex-числа были строками, тк rgb->ole обрабатывает только строки.
Аргументы R G B - должны быть целыми числами.

Вот мои варианты DEC<->HEX

Код:

[Выделить все]

;Возвращает список-последовательность чисел разных типов
(defun num-lst-alltypes (vlax-vbtypes index1 index2 start step  / i n sf) 
(setq sf (vlax-make-safearray vlax-vbtypes (cons index1 index2)))
(setq i 0)
(setq n (- start step))
(repeat index2 (vlax-safearray-put-element sf (setq i (1+ i)) (setq n (+ step n))))
(vlax-safearray->list sf)
)
;пример
;(num-lst-alltypes vlax-vbdouble 1 10 1 1)
;возвращает
;(1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0)
;Удобная функция для создания инексов

Код:

[Выделить все]

(defun dec->hex (decinteger / res dec membhex hex_lst len_hex_lst hex i RESLST)

  (setq dec decinteger)
   
(setq reslst (append (list decinteger) (while (/= (last res) 0) (setq res (append res (list (setq dec(/ dec 16))))))))
(setq membhex (reverse (mapcar (function (lambda (a) (rem a 16))) reslst)))
(rem 123 16)
  (setq membhex (subst "A" 10 membhex))
  (setq membhex (subst "B" 11 membhex))
  (setq membhex (subst "C" 12 membhex))
  (setq membhex (subst "D" 13 membhex))
  (setq membhex (subst "E" 14 membhex))
  (setq membhex (subst "F" 15 membhex))
  (setq hex_lst (cdr (mapcar (function (lambda (b) (strcat (vl-princ-to-string b)))) membhex)))

  (setq len_hex_lst (length  hex_lst))
  (setq hex (nth 0 hex_lst))
  
  (setq i 0)
  (if (= len_hex_lst 1) hex
  (repeat (1- len_hex_lst) (setq hex (strcat hex (nth (setq i (1+ i)) hex_lst))))
    )
    ); (dec->hex 254)

;***************************************************
;***************************************************

;Перевод из шестнадцатиричной в десятичную

(defun hex->dec (hex_str)

(setq len_str (strlen hex_str))

(setq hex_lst
(mapcar (function (lambda (a) (substr hex_str a 1))) (num-lst-alltypes vlax-vbinteger 1 len_str 1 1)))

  (setq hex_lst (subst "10" "A" hex_lst))
  (setq hex_lst (subst "11" "B" hex_lst))
  (setq hex_lst (subst "12" "C" hex_lst))
  (setq hex_lst (subst "13" "D" hex_lst))
  (setq hex_lst (subst "14" "E" hex_lst))
  (setq hex_lst (subst "15" "F" hex_lst))
(setq dec_lst_for_summ
(mapcar (function (lambda (a b) (* (atoi a) (expt 16 b))))
	hex_lst (num-lst-alltypes vlax-vbinteger 1 len_str (1- len_str) -1)))
(setq dec1 (nth 0 dec_lst_for_summ))
(setq i 1)
(repeat (1- len_str) (progn (setq dec1 (+ dec1 (nth i dec_lst_for_summ)))
			      (setq i (1+ i))
  ))
dec1
  ); (HEX->DEC "F0F")

Эти функции работают нормально с функцией rgb->ole, и так как разгаданы все секреты преобразования, то ошибочный результат исключен, уже не надо условий на то что rgb->ole возвратит ошибку, или выдаст несоответствие. Хотя иногда бывает что числа совпадают, а цвета нет, он это очень редко. Например цвет RAL-1000 светлокоричневый, а курсор получается светлосерый,


Также если уж взялся за это дело, то попытаюсь сделать еще несколько функций работы с цветом.
Например:
ACI->RGB
OLE->RGB
RGB->ACI

Например ACI->RGB
Рисуется точка на слое defpoints, модифицируется ее цвет по aci(vla-put-indexcolor или еще какойнибудь метод) потом (vla-get-truecolor) позволит вычислить цвет по RGB. Точка удаляется.

Наверно на этой неделе чтонибудь придумаю.

А еще вопрос к знающим людям
(acad_colordlg)выдает скудный диалог цветов по ACI, а как вызвать диалог со всеми палитрами и альбомаим?
У меня пока одна задумка (command "_.color" pause), а потом составить список своиств из (vla-get-truecolor)

Код:

[Выделить все]

;   Blue (RO) = 147
;   BookName (RO) = "DIC COLOR GUIDE(R)"
;   ColorIndex = 41
;   ColorMethod = 194
;   ColorName (RO) = "DIC 8"
;   EntityColor = -1023880557
;   Green (RO) = 210
;   Red (RO) = 248

[Александр Ривилис]

(acad_truecolordlg color [allowbylayer] [currentlayercolor])

[mmax]

>Александр Ривилис, спасибо вам за предоставленную информацию.

В данном диалоге выбрал цвет по RGB=9 17 246 -- синий.
Под кодом 420 возвращается цвет по OLE=594422, только в превернутом виде по RGB, тоесть
(vla-put-ModelCrosshairColor(vla-get-Display(vla-get-Preferences (vlax-get-acad-object)))594422)
изменяет цвет на красный, а RGB = уже 246 17 9

следовательно если я хочу в своей программе использовать цвета RGB, то придется использовать функцию ole->rgb, которая будет работать как rgb->ole(сообщение 16) только в обратном порядке.

И вот вопрос:
А почему AUTODESK держит в секрете сведения по преобразованию цветов? В справке по этой проблеме нет никаких сведений.
Сделал поиск, на этом форуме по слову "цвет", то наткнулся только на вопросы без ответа.
А идея преобразования появилась только тогда когда в палитре фотошопа случайно увидел, что RGB = 0 15 0 = 000F00.

PS
Если комуто это вопрос интересен, то верная информация начинается с сообщения №16, все мои предыдущие сообщения это домыслы и догадки.

[mmax]

;Функция преобразования ACI->RGB

Код:

[Выделить все]

(defun aci->rgb (ACI_color / vla_point  RGB_lst)

  (entmake (list (cons 0 "POINT") '(10 0.0 0.0 0.0) (cons 62 ACI_color) (cons 8 "Defpoints")))
  (setq vla_point (vlax-ename->vla-object (entlast)))
  
  (setq RGB_lst
       (list	 (vla-get-red (vla-get-truecolor vla_point))
	 (vla-get-Green (vla-get-truecolor vla_point))
	 (vla-get-Blue (vla-get-truecolor vla_point))))
      (vla-delete vla_point)
	 
  RGB_lst
      ) ;(aci->rgb 156)

Почему не работают функции vla-put-ColorIndex vla-put-ColorMethod, и не работает метод vla-SetRGB?

Вот например:

Код:

[Выделить все]

;;;(defun rgb->aci (r g b)
  (setq r  0 
	g  63 
	b  127 )
  (entmake (list (cons 0 "POINT") '(10 0.0 0.0 0.0) (cons 8 "Defpoints")))
  (setq vla_point (vlax-ename->vla-object (entlast)))
  (vla-SetRGB (vla-get-truecolor vla_point) r g b)
  (vlax-dump-object (vla-get-truecolor vla_point) t)

;;;)
; IAcadAcCmColor: Интерфейс AutoCAD для AcCmColor
; Значения свойств:
;   Blue (RO) = 0
;   BookName (RO) = ""
;   ColorIndex = 256
;   ColorMethod = 192
;   ColorName (RO) = ""
;   EntityColor = -1073741824
;   Green (RO) = 0
;   Red (RO) = 0
; Поддерживаемые методы:
;   Delete ()
;   SetColorBookColor (2)
;   SetNames (2)
;   SetRGB (3)

T 
_$

[CB]

Здесь Александр Ривилис показал функции для RGB>>TrueColor<<RGB. Для OLE_color они будут выглядеть так:

Код:

[Выделить все]

(defun GetOleColor ( r g b )
  (+ r (lsh g 8) (lsh b 16))
)
;;;(GetOleColor 55 88 15)   -> 1005623

(defun GetRGB ( Olecolor )
 (list
   (logand Olecolor 255)            ;; R
   (logand (lsh Olecolor -8) 255)   ;; G
   (logand (lsh Olecolor -16) 255)  ;; B
 )
)
;;;(GetRGB 1005623)        -> (55 88 15)

Чтобы понять, как это работает, пришлось немного изучить бинарную систему исчисления, сделать функции перевода чисел в двоичную систему и только после этого стало понятно как работают эти "страшные" (правда теперь уже в прошлом) функции - logand, logior, lsh.
А теперь вопрос - начиная с какой версии ACAD появилось свойство TrueColor (и соответственно группа (420 . ) в свойствах примитива)? В 2002м этого еще нет. :cry: