[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 и обратно, пока я провожу эксперименты, или направьте меня на путь истинный, дабы я не мучился с велосипедом.

[Кулик Алексей aka kpblc]

Посмотри на http://www.autocad.ru/cgi-bin/f1/board.cgi?t=29431LT - там А.Ривилис показал 2 функции преобразовний

[mmax]

Вобщем принцип такой

Имеем некоторые переменные R G B
Делаем так
(strcat B_hex G_hex R_hex); обратите внимание на перестановку чисел, почемуто их нужно переворачивать.
Мы получили hex-строку-число цвета OLE_Color соответствующего цвету RGB.
Вот и все.

Дело за малым, осталось только сделать надежные функции перевода целых чисел HEX<->DEC.

[mmax]

поробовал цвет курсора = цвету слоя,
Все работает за исключением некоторых косяков, связанных с HEX<->DEC.
Обнаружил несколько ньюансов.
глючит когда RGB=(0,неноль,любоечисло), тоесть когда начинается на ноль, здесь явно HEX<->DEC не хочет связываться с нолями. И когда HEX имеет буквы, то надо перед каждой вуквой поставить 0.

[Елпанов Евгений]

>mmax

Приведи, пожалуйста, пример математических вычислений.
У меня не получилось повторить твои преобразования...

[Profan]

Для mmax.
А "переворачивать" нужно, IMHO, потому, что в десятичной системе значащие цифры записываются слева направо, а двоичной - справа налево.

[VVA]

Converting Decimal to Hexadecimal and Hexadecimal to Decimal
Ф-ции перевода Hex<->Dec

Код:

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

;;;============ DecToHex ===============================================
;;;Ф-ция переводит десятичные цифры в шестнадцатиричную систему счисления
;;Dec->Hex
;;;Converting Decimal to Hexadecimal
;;; num - дасятичное число (Decimal number)
;;;Пример (DecToHex 255) -> "FF"
;;;Возвращает шестнадцатиричное число как строку
;;;Алгоритмы конвертации
;;;http://www.iwebtool.com/talk/thread884.html
;;;http://visualcplus.blogspot.com/2006/03/numerical-systems-and-transformations_08.html
(defun DecToHex ( num / dechexlist hexlist Remainder Quotient)
(setq dechexlist '((0 "0")(1 "1")(2 "2")(3 "3")(4 "4")(5 "5")
		   (6 "6")(7 "7")(8 "8")(9 "9")(10 "A")(11 "B")
		   (12 "C")(13 "D")(14 "E")(15 "F")))
(setq hexlist nil)
(while (not (zerop (setq Quotient (fix (/ num 16)))))
  (setq Remainder (rem num 16)
          hexlist (append hexlist (cdr(assoc Remainder dechexlist)))
        num Quotient))
  (setq hexlist (append hexlist (cdr(assoc num dechexlist))))
  (apply 'strcat (reverse hexlist))
  )
;;;Ф-ция возводит число base в степень step
;;;Пример
;;;2**3=(degree 2 3) = 8
;;;2**-1=(degree 2 -1)= 0.5
(defun degree (base step / fract ret)
  (if (< step 0)(setq fract t)(setq fract nil))
   (setq step (fix (abs step)) ret base)
    (cond
      ((zerop step)(setq ret 1))
      ((= step 1) (setq ret base))
      (t (repeat (1- step)(setq ret (* ret base)))))
(if fract (/ 1. ret) ret)
    )
;;;============ HexToDec ===============================================
;;;Ф-ция переводит шестнадцатиричные цифры в десятичную систему счисления
;;Hex->Dec
;;;Converting Hexadecimal to Decimal
;;; num - шестнадцатиричное число (Hexadecimal number) as String
;;;Пример (HexToDec "FF") -> 255
;;;       (HexToDec 'FF) -> 255
;;;Возвращает шестнадцатиричное число как строку
;;;Алгоритмы конвертации
;;;http://www.iwebtool.com/talk/thread884.html
;;;http://visualcplus.blogspot.com/2006/03/numerical-systems-and-transformations_08.html

(defun HexToDec ( num / pos numlist)
  (setq num (strcase (VL-PRINC-TO-STRING num))
	num (VL-STRING-LEFT-TRIM "0" num))  
(setq hexlist (mapcar 'chr (VL-STRING->LIST num ))
          pos (- 0 1)
      hexlist (reverse hexlist))
(setq hexdeclist '(("0" 0)("1" 1)("2" 2)("3" 3)("4" 4)("5" 4)
		   ("6" 6)("7" 7)("8" 8)("9" 9)("A" 10)("B" 11)
		   ("C" 12)("D" 13)("E" 14)("F" 15)))
(setq numlist (mapcar '(lambda ( hex )
			 (setq num (* (cadr(assoc hex hexdeclist))(degree 16 (setq pos (1+ pos))))))
		      hexlist))
  (setq numlist (apply '+ numlist))
  )

В поисках алгоритмов набрел на это, может будет полезно
What is your color system? How are numeric color names better than word ones?

[mmax]

Принцип преобразования такой, надеюсь он всем будет понятен.
Функция hex->dec может быть любой
В функции dec->hex должно быть одно условие, описанное ниже
HEX-числа должны быть стрингами

Код:

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

(defun rgb->ole (R G B)
  (setq hex_B (dec->hex B)
	hex_G (dec->hex G)
	hex_R (dec->hex R)
	)
  (setq hex_BGR (strcat hex_B hex_G hex_R))
  (hex->dec hex_BGR)
  )

Ньюансы:
Функция dec->hex должна быть сделана таким образом, чтобы в полученном hex-числе, если в нем есть буквы, то перед каждой буквой надо принудительно поставить 0. Например R=15 G=88 B=55
hex_BGR = 3758F – это обычное преобразование, но так как в нем есть буква то надо перед F поставить 0 -- 37580F. Другой пример AAA->A0A0A ноль в начале не нужен.

Если R = 0, то цвет преобразуется неправильно, этот ньюанс я еще не проработал.

Вот пример использования преобразования цвета(цвет курсора сделать равным цвету слоя):

Код:

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

(setq Redlayer (vla-get-Red(vla-get-TrueColor(vla-get-ActiveLayer (vla-get-activedocument (vlax-get-acad-object)))))))
(setq Greenlayer (vla-get-Green (vla-get-TrueColor(vla-get-ActiveLayer (vla-get-activedocument (vlax-get-acad-object)))))))
(setq Bluelayer (vla-get-Blue (vla-get-TrueColor (vla-get-ActiveLayer (vla-get-activedocument (vlax-get-acad-object)))))))

(vla-put-ModelCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole Redlayer Greenlayer Bluelayer)
    )

Числовые результаты преобразования можно посмотреть в диалоговом окне изменения цвета для курсора с помощью команды _options итд. Более удобная палитра для просмотра результатов в фотошопе, там есть RGB и соответствующее hex-число, толко фотошоповское RGB=автокадовскомуBGR:
Rфотошоп = Bacad
Gфотошоп = Gacad
Bфотошоп = Racad

Ньюансы на этом не закончились:
Если vla-put-ModelCrosshairColor выдает ошибку, то тогда нужно в функции dec->hex убрать принудительную простановку нуля перед буквами. Это связано с тем, что OLE-число получается больше допустимого значения.

Все это проверено и работает, осталось только доработать ошибку R=0, и поставить условия для функции dec->hex, а точнее доработать ее примерно таким образом

Код:

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

(if ((hex->dec hex_BGR) = недопустимому значению) (dec->hex 0 не проставлять) (dec->hex 0 проставлять))

К сожалению мои функции dec<->hex еще не готовы, то полной реализации я сделать пока не могу.

Если ктото хочет понять принцип самостоятельно, то поэкспериментируйте в фотошоповской палитре c такими цветами 0 0 15, 0 15 0, 15 0 0 итп. И сразу станет все понятно.

PS
Я очень плохо разбираюсь в терминологии, и название темы скорее свего неправильное. Насколько я понимаю TRUE color не имеет отношения к ACI color.
[ATTACH]1158249412.gif[/ATTACH]

[mmax]

Не удается разгадать ребус R=0.
И никак не могу сделать нормальный работающий лисп

[Кулик Алексей aka kpblc]

У меня сказанное здесь : http://www.autocad.ru/cgi-bin/f1/board.cgi?t=5445Tm навевает определеннные сомнения с правильностью работы Photoshop'a... Такое на всех машинах? Или ты пробовал только на одной?
---
Исправление: Точнее, не с правильностью работы Photo, а (как бы это сказать) с правильностью логики преобразования цветов. Посмотри на лисп c:\program files\<AutoCAD>\Sample\Visual LISP\color-util.lsp, как посоветовал ShaggyDoc.

[VVA]

В ф-ции DecToHex была ошибка в логике

Код:

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

;;;============ DecToHex ===============================================
;;;Ф-ция переводит десятичные цифры в шестнадцатиричную систему счисления
;;Dec->Hex
;;;Converting Decimal to Hexadecimal
;;; num - дасятичное число (Decimal number)
;;;Пример (DecToHex 255) -> "FF"
;;;Возвращает шестнадцатиричное число как строку
;;;Алгоритмы конвертации
;;;http://www.iwebtool.com/talk/thread884.html
;;;http://visualcplus.blogspot.com/2006/03/numerical-systems-and-transformations_08.html
(defun DecToHex ( num / dechexlist hexlist Remainder Quotient)
(setq dechexlist '((0 "0")(1 "1")(2 "2")(3 "3")(4 "4")(5 "5")
		   (6 "6")(7 "7")(8 "8")(9 "9")(10 "A")(11 "B")
		   (12 "C")(13 "D")(14 "E")(15 "F")))
(setq hexlist nil)
(while (not (zerop (setq Quotient (fix (/ num 16)))))
  (setq Remainder (rem num 16)
          hexlist (append hexlist (cdr(assoc Remainder dechexlist)))
        num Quotient))
  (setq hexlist (append hexlist (cdr(assoc num dechexlist))))
  (apply 'strcat (reverse hexlist))
  )

;;;Ф-ция возводит число base в степень step
;;;Пример
;;;2**3=(degree 2 3) = 8
;;;2**-1=(degree 2 -1)= 0.5
(defun degree (base step / fract ret)
  (if (< step 0)(setq fract t)(setq fract nil))
   (setq step (fix (abs step)) ret base)
    (cond
      ((zerop step)(setq ret 1))
      ((= step 1) (setq ret base))
      (t (repeat (1- step)(setq ret (* ret base)))))
(if fract (/ 1. ret) ret)
    )
;;;============ HexToDec ===============================================
;;;Ф-ция переводит шестнадцатиричные цифры в десятичную систему счисления
;;Hex->Dec
;;;Converting Hexadecimal to Decimal
;;; num - шестнадцатиричное число (Hexadecimal number) as String
;;;Пример (HexToDec "FF") -> 255
;;;       (HexToDec 'FF) -> 255
;;;Возвращает десятичное число
;;;Алгоритмы конвертации
;;;http://www.iwebtool.com/talk/thread884.html
;;;http://visualcplus.blogspot.com/2006/03/numerical-systems-and-transformations_08.html

(defun HexToDec ( num / pos numlist)
  (setq num (strcase (VL-PRINC-TO-STRING num))
	num (VL-STRING-LEFT-TRIM "0" num))  
(setq hexlist (mapcar 'chr (VL-STRING->LIST num ))
          pos (- 0 1)
      hexlist (reverse hexlist))
(setq hexdeclist '(("0" 0)("1" 1)("2" 2)("3" 3)("4" 4)("5" 4)
		   ("6" 6)("7" 7)("8" 8)("9" 9)("A" 10)("B" 11)
		   ("C" 12)("D" 13)("E" 14)("F" 15)))
(setq numlist (mapcar '(lambda ( hex )
			 (setq num (* (cadr(assoc hex hexdeclist))(degree 16 (setq pos (1+ pos))))))
		      hexlist))
  (setq numlist (apply '+ numlist))
  )

Функция dec->hex должна быть сделана таким образом, чтобы в полученном hex-числе, если в нем есть буквы, то перед каждой буквой надо принудительно поставить 0. Например R=15 G=88 B=55 hex_BGR = 3758F – это обычное преобразование, но так как в нем есть буква то надо перед F поставить 0 -- 37580F. Другой пример AAA->A0A0A ноль в начале не нужен.

Проще сделать отдельной ф-цией

Код:

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

;;;hex- Hexadecimal as String
;;;если в полученном hex-числе есть буквы,
;;; то перед каждой буквой надо принудительно поставить 0. Например 3758F ->37580F.
;;;В начале 0 убирается  AAA->A0A0A
;;; (AddHex0 "37A8F") ->"370A80F"
;;; (AddHex0 "AAA") -> "A0A0A"
(defun AddHex0 (hex)
  (setq hexlist (mapcar 'chr (VL-STRING->LIST hex ))
	hexlist (mapcar '(lambda (ch)
			   (if (member ch '("A" "B" "C" "D" "E" "F"))
			     (setq ch (strcat "0" ch))
			     ch
			     )
			   )
			hexlist)
	hexlist (apply 'strcat hexlist)
	hexlist (VL-STRING-LEFT-TRIM "0" hexlist)
	)
  hexlist)

Пример:

Код:

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

(addhex0 (dectohex 4815))  -> "120C0F"

[VVA]

Еще один алгоритм преобразования HexToDec

Код:

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

;;;(HexToDec1 "FF") ->255
(defun HexToDec1 ( strHex / iHx lDEc iDec strHx )
    (setq strHex (strcase (VL-PRINC-TO-STRING strHex))
	strHex (VL-STRING-LEFT-TRIM "0" strHex)
	  lDec 0)
(setq iHx 1)
  (while (<= iHx (strlen strHex))
    (setq strHx (substr strHex iHx 1))
    (if (member strHx '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
      (setq iDec (atoi strHx))
      (setq iDec (- (Ascii strHx) 55)))
    (setq lDec (+ LDec (* iDec (degree 16 (- (strlen strHex) iHx)))))
    (setq iHx (1+ iHx))
    )
lDec)

[Елпанов Евгений]

Я все никак не могу понять.
Вы пытаетесь написать это?
(list
(lsh (lsh OleCol 24) -24)
(lsh (lsh OleCol 16) -24)
(lsh OleCol -16))
Посмотрите
http://www.autocad.ru/cgi-bin/f1/board.cgi?t=20854PJ
Там еще в прошлом году я выкладывал применение этой конструкции для присвоения слою цвета фона автокада...

[CB]

С помощью системного калькулятора из трех номеров 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 и обратно.

Что то мне не понятно - причем здесь HEX? :roll:
Если надо получить число OLE, которое используется в vla-put-ModelCrosshairColor из RGB то зто просто:

Код:

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

  (setq RGB '(55 88 15))
(setq RGB>>OLE (+ (nth 0 RGB) (* (nth 1 RGB) 256) (* (nth 2 RGB) 65536)))
(55 88 15) 
_$ 
1005623 
_$

Другое дело, что в ACAD'е такого цвета нет и выбирается ближайший, а именно для этого примера - color 68, у которого RGB '(57 76 0)
и соответственно OLE = 19513.

[mmax]

>CB
Где же вы раньше были. Я тут голову ломал, а по вашему все так просто.

Вринципе все эти три дня мной руководил простой интерес.
И мой способ всетаки реализовался, надеюсь.
Последнее что я выявил это:
Если в hex-числе есть буква, то не всегда надо ставить ноль принудительно.
например:
число 61dec = 3Dhex зздесь ноль не нужен.
число 15dec = Fhex здесь ноль нужен.

Вобщем, как я понял, данный вопрос мало кому интересен.
И на мой взгляд цвет курсора = цвету слоя это единственное применение данному преобразованию.

Всем спасибо за предоставленную информацию.

[mmax]

Вот , надеюсь, окончательный вариант реализации моих вычислений.
Функции DEC<->HEX могут быть любыми.
Функция DEC->HEX должна возвращать строки в любом регистре.
Функция HEX->DEC не должна вспотыкаться на регистре строковых символов.

Данная функция сама поставит ноли там где это нужно. Также здесь же решена проблема R=0.

Код:

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

(defun rgb->ole (R G B / Rhex Ghex Bhex BGRhex)

(setq Rhex (dec->hex R))
(setq Ghex (dec->hex G))
(setq Bhex (dec->hex B))

(if (or
    (eq Rhex "A")
    (eq Rhex "B")
    (eq Rhex "C")
    (eq Rhex "D")
    (eq Rhex "E")
    (eq Rhex "F")
    (eq Rhex "a")
    (eq Rhex "b")
    (eq Rhex "c")
    (eq Rhex "d")
    (eq Rhex "e")
    (eq Rhex "f")
    (eq Rhex "0")
    (eq Rhex "1")
    (eq Rhex "2")
    (eq Rhex "3")
    (eq Rhex "4")
    (eq Rhex "5")
    (eq Rhex "6")
    (eq Rhex "7")
    (eq Rhex "8")
    (eq Rhex "9"))
  (setq Rhex (strcat "0" Rhex))
  (princ))
(if (or
    (eq Ghex "A")
    (eq Ghex "B")
    (eq Ghex "C")
    (eq Ghex "D")
    (eq Ghex "E")
    (eq Ghex "F")
    (eq Ghex "a")
    (eq Ghex "b")
    (eq Ghex "c")
    (eq Ghex "d")
    (eq Ghex "e")
    (eq Ghex "f")
    (eq Ghex "0")
    (eq Ghex "1")
    (eq Ghex "2")
    (eq Ghex "3")
    (eq Ghex "4")
    (eq Ghex "5")
    (eq Ghex "6")
    (eq Ghex "7")
    (eq Ghex "8")
    (eq Ghex "9"))
  (setq Ghex (strcat "0" Ghex))
  (princ))
(if (or
    (eq Bhex "A")
    (eq Bhex "B")
    (eq Bhex "C")
    (eq Bhex "D")
    (eq Bhex "E")
    (eq Bhex "F")
    (eq Bhex "a")
    (eq Bhex "b")
    (eq Bhex "c")
    (eq Bhex "d")
    (eq Bhex "e")
    (eq Bhex "f")
    (eq Bhex "0")
    (eq Bhex "1")
    (eq Bhex "2")
    (eq Bhex "3")
    (eq Bhex "4")
    (eq Bhex "5")
    (eq Bhex "6")
    (eq Bhex "7")
    (eq Bhex "8")
    (eq Bhex "9"))
  (setq Bhex (strcat "0" Bhex))
  (princ))
;;;;;;;;;;;;;;;;;;;;;;

(setq BGRhex (strcat Bhex Ghex Rhex))
(HEX->DEC BGRhex)
  )

вот только где их можно применить?

[CB]

>mmax
Посмотри внимательно на созданную тобой тему: ACI_color в OLE_color .
ACI_color - это палитра, которую использует ACAD, и здесь всего 256 цветов.

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

Вопрос - зачем тебе вся палитра OLE_color для работы в ACAD'е, если все равно она им не воспринимается??? А прямого перехода ACI_color к OLE_color наверное нет, только через RGB. RGB из ACI_color, насколько я знаю, можно получить только через таблицу соответствия:

Код:

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

(setq RGB (cadr (assoc 4
     '((0       (0 0 0))	  
       (1       (255 0 0))
       (2       (255 255 0))
       (3       (0 255 0))
       (4       (0 255 255))
       (5       (0 0 255))
       (6       (255 0 255))
;;;   .......................
       (255     (255 255 255))
      )
)))

(0 255 255) 
_$

[mmax]

>CB
Я плохо разбираюсь в терминологии и мне уже не раз делали замечания.

[mmax]

Сообщение от CB А прямого перехода ACI_color к OLE_color наверное нет, только через RGB. RGB из ACI_color, насколько я знаю, можно получить только через таблицу соответствия: Код: [Выделить все] (setq RGB (cadr (assoc 4 '((0 (0 0 0)) (1 (255 0 0)) (2 (255 255 0)) (3 (0 255 0)) (4 (0 255 255)) (5 (0 0 255)) (6 (255 0 255)) ;;; ....................... (255 (255 255 255)) ) ))) (0 255 255) _$

А еще можно через (vla-get-truecolor), создав какойнибудь временный объект, например на слое Defpoints.

[CB]

>mmax
Говоря о прямом вычислении ACI_color -> OLE_color, я имел в виду функцию, которая без промежуточного вычисления RGB сразу же бы давала OLE_color, т.е. например (Функция 5) = 16711680 (синий цвет), хотя я в этом и не уверен, т.к. не силен в объектной модели, а там много чего можно...
А сейчас хочу предложить свой вариант функции перевода DEC->HEX:

Код:

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

 (setq dec-hex-lst '((0 "0")(1 "1")(2 "2")(3 "3")(4 "4")(5 "5") 
         (6 "6")(7 "7")(8 "8")(9 "9")(10 "A")(11 "B") 
         (12 "C")(13 "D")(14 "E")(15 "F")))
(defun dec->hex (DEC)
  (if (zerop DEC) ""
 (strcat (dec->hex (fix (/ DEC 16))) (cadr (assoc (rem DEC 16) dec-hex-lst)))
  )
)
;;;Пример вызова: (DEC->HEX 2540)
"9EC" 
_$ 
(DEC->HEX 255)
"FF" 
_$

Единственно, что я не смог здесь сделать - это чтобы при числах <16 (т.е. когда рекурсия работает один раз) впереди ставился "0" :

Код:

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

(DEC->HEX 15)
возвращает "F", а нужно "0F"

Хотя я думаю, что возможно кто нибудь и предложит решение этой задачи...