[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"

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

[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: