[nikolaev]

Возможно ли курсору присвоить цвет текущего слоя? Это было бы удобно! Не нужно лишний раз переводить глаза на окошко слоев.
В опциях цвет курсора менять можно, но переменной такой, к сожалению, нет.

[Torino]

>>nikolaev
Интересная мысль!
Можно например повесить реактор на изменение текущего слоя.
А в функцию отклика добавить изменение цвета курсора.

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

> Torino : надо постоянно писать и читать из реестра, ключ HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R16.1\ACAD-301:409\Profiles\<<Unnamed Profile>>\Drawing Window\XHairPickboxEtc значение цвета курсора (по-моему, там меняется). Проблема в том, что значение там вида REG_DWORD, что осложняет чтение и запись, да и методика хранения там... В общем, я пас.

[zamtmn]

Думается мне из реестра автокад его читает только 1 раз за сеанс, при старте

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

Не, ни фига. Специально менял цвет, значения этого ключа менялись моментально. Логично предположить, что и обратное срабатывает. Только надо не забыть, что ключ надо формировать динамически, используя cprofile. Но это-то не особо тяжело.
Мне не очень нравится, что придется выполнять дополнительную обработку по переводу цветовых индексов када в формат значений, которые хранятся в реестре. А ведь слои могут иметь и True Color, и Color Book... Задачка усложняется.
Да, и вот еще. Там REG_DWORD. Как туда записывать данные? Десятичным числом или шестнадцатиричным? Или и тем, и другим?

[X-DeViL]

REG_DWORD вроде всю жисть было HEX

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

Не знаю, я сужу по тому, что видно через regedit на этот ключ по двойному щелчку.

[Apelsinov]

Чуть подправив обсуждавшееся тут http://www.autocad.ru/cgi-bin/f1/board.cgi?t=5445Tm
получил:

Код:

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

;;;---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---
;;; Функция извлечения цвета курсора пространства модели                           5 февраля 2003
;;;---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---
;;; Функция возвращает цвет курсора  в соответствии с заданным параметром flag
;;; flag может иметь значения "OLE" или "ACI"                                                 
;;; Вызов:                                                                                    
;;; (apel-cursor-get_color "OLE") или (apel-cursor-get_color "ACI")                             
;;; Возврат:                                                                                  
;;; целое число - цвет Windows (OLE) или AutoCAD Color Index (ACI)                            
(defun APEL-CURSOR-GET_COLOR (flag / var_color OLE_color)
  (setq var_color (vla-get-modelcrosshaircolor
                    (vla-get-display
                      (vla-get-preferences (APEL-ACAD_APPLICATION))
                    )
                  )
  )
  (setq OLE_color (vlax-variant-value
                    (vlax-variant-change-type var_color vlax-vblong)
                  )
  )
  (if (= flag "ACI")
    (APEL-OLE-TO-ACI-COLOR OLE_color)
    OLE_color
  )
)

Однако, функция преобразования "OLE" в "ACI" , названная тут APEL-OLE-TO-ACI-COLOR , и взятая оттуда-же, у меня не работает, и возвращает 0.

Код:

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

;;; Функция преобразования номера цвета из OLE в ACI                            5 февраля 2003
;;; kos & ShaggyDoc (скопировано с sw-OLE-to-ACI-color)
;;; Функция преобразует заданный целым аргументом OLE_color номер цвета Windows в номер ACI   
;;; (AutoCAD Color Index)                                                                     
;;; Вызов:                                                                                    
;;; (APEL-OLE-TO-ACI-COLOR 12345678)                                                            
;;; Возврат:                                                                                  
;;; целое число                                                                               

(defun APEL-OLE-TO-ACI-COLOR (OLE_color / result)
  (if (not (setq result  (vl-position
        OLE_color
        '(0         255    65535       65280  16776960   16711680
          16711935   16777215    8421504    12632256  255     8421631
          166         5460902    128       4210816  76     2500172
          38         1250086    16639       8429567  10662     5466278
          8320       4214912    4940       2502732  2598     1251366
          33023      8437759    21414       5471398  16512     4219008
          9804       2505036    4902       1252646  49151     8445951
          31910      5476774    24704       4223104  14668     2507596
          7462       1253670    65535       8454143  42662     5482150
          32896      4227200    19532       2509900  9766     1254950
          65471      8454111    42620       5482129  32864     4227184
          19513      2509891    9757       1254945  65408     8454079
          42579      5482108    32832       4227168  19494     2509881
          9747       1254941    65344       8454047  42537     5482088
          32800      4227152    19475       2509872  9738     1254936
          65280      8454016    42496       5482067  32768     4227136
          19456      2509862    9728       1254931  4259584     10485632
          2729472    6858323    2129920    5275712  1264640     3165222
          665088     1582611    8453888    12582784  5481984     8169043
          4227072    6324288    2509824    3755046  1254912     1910291
          12582656   14679936    8168960    9545299  6324224     7372864
          3755008    4410406    1910272    2172435  16776960   16777088
          10921472   10921555    8421376    8421440  5000192     5000230
          2500096    2500115    16760576   16768896  10910720   10916179
          8413184    8417344    4995328    4997926  2497792     2498835
          16744448   16760704    10900224   10910803  8404992     8413248
          4990464    4995366    2495232    2497811  16728064   16752512
          10889472   10905683    8396800    8409152  4985600     4993062
          2492928    2496531    16711680   16744576  10878976   10900307
          8388608    8405056    4980736    4990502  2490368     2495251
          16711744   16744607    10879017   10900328  8388640     8405072
          4980755    4990512    2490378    2495256  16711808   16744639
          10879059   10900348    8388672    8405088  4980774     4990521
          2490387    2495261    16711871   16744671  10879100   10900369
          8388704    8405104    4980793    4990531  2490397     2495265
          16711935   16744703    10879142   10900390  8388736     8405120
          4980812    4990540    2490406    2495270  12517631   14647551
          8126630    9524134    6291584    7356544  3735628     4400716
          1900582    2167590    8388863    12550399  5439654     8147878
          4194432    6307968    2490444    3745356  1245222     1905446
          4194559    10453247    2687142    6837158  2097280     5259392
          1245260    3155532    655398     1577766  5526612     7763574
          10000536   12303291    14540253   16777215
         )
      ) 
     )
      ) 
    (setq result 0)
  )
  result
)

Так что, обломс!

[Apelsinov]

Кстати, для того чтобы поменять цвет курсора, достаточно выражения типа:

Код:

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

(vla-put-modelcrosshaircolor
  (vla-get-display
    (vla-get-preferences (APEL-ACAD_APPLICATION))
  )
65343
)

где 65343 - номер цвета в "OLE". Но чтобы как-то управлять этим надо знать соответствия "OLE" и "ACI", что у меня и не получается с помощью лиспа от kos.

PS/

Код:

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

(defun APEL-ACAD_APPLICATION ()
  (if (null *apel_acad_application*)
    (setq *apel_acad_application* (vlax-get-acad-object))
    *apel_acad_application*
  )
)

PPS/
интересно, между делом , сменить цвет курсора по OLE например на 0, он тогда сливается с фоном и его не видно вообще 8)

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

Странно, сейчас втупую скопировал код apel-ole-to-aci-color, запустил, все ок. Может, у тебя входящий параметр 0? От балды-то номер ole-цвета задавать нельзя...
Проверял, вызывая (apel-ole-to-aci-color 1250086)

[Apelsinov]

>kpblc
Дошло до меня наконец, этот список соответствий ACI to OLE не всегда попадает в цель при попытке найти ACI по OLE , (что у меня и происходило) , зато замечательно работает в обратную сторону! - что тут собсно и надо.
Вот функция для задания курсору цвета текущего слоя (для автоматизации надо еще написать реактор на смену слоев - но тут я пас, нифига в реакторах не смыслю):

Код:

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

;;;Функция присвоения курсору цвета по цвету текущего слоя
;;;Apelsinov
;;;14.07.05
(defun APEL-CURSOR-COLOR_BY_CURRENT_LAYER ()
  (APEL-CURSOR-PUT_COLOR
    (vla-get-color (vla-get-activelayer (APEL-ACTIVE_DOCUMENT)))
  )
)
;(APEL-CURSOR-COLOR_BY_CURRENT_LAYER)

;;;Присвоение курсору цвета
;;;Apelsinov
;;;14.07.05
;;;ACI_color - цвет из 256 по ACI
(defun APEL-CURSOR-PUT_COLOR (ACI_color /)
  (vla-put-modelcrosshaircolor
    (vla-get-display
      (vla-get-preferences (APEL-ACAD_APPLICATION))
    )
    (APEL-ACI-TO-OLE-COLOR ACI_color)
  )
)

;;; Функция преобразования номера цвета из OLE в ACI
;;;Apelsinov
;;;14.07.05
(defun APEL-ACI-TO-OLE-COLOR (ACI_color /)
  (nth ACI_color
       '(0          255        65535      65280      16776960   16711680   16711935   16777215   8421504    12632256   255
         8421631    166        5460902    128        4210816    76         2500172    38         1250086    16639      8429567
         10662      5466278    8320       4214912    4940       2502732    2598       1251366    33023      8437759    21414
         5471398    16512      4219008    9804       2505036    4902       1252646    49151      8445951    31910      5476774
         24704      4223104    14668      2507596    7462       1253670    65535      8454143    42662      5482150    32896
         4227200    19532      2509900    9766       1254950    65471      8454111    42620      5482129    32864      4227184
         19513      2509891    9757       1254945    65408      8454079    42579      5482108    32832      4227168    19494
         2509881    9747       1254941    65344      8454047    42537      5482088    32800      4227152    19475      2509872
         9738       1254936    65280      8454016    42496      5482067    32768      4227136    19456      2509862    9728
         1254931    4259584    10485632   2729472    6858323    2129920    5275712    1264640    3165222    665088     1582611
         8453888    12582784   5481984    8169043    4227072    6324288    2509824    3755046    1254912    1910291    12582656
         14679936   8168960    9545299    6324224    7372864    3755008    4410406    1910272    2172435    16776960   16777088
         10921472   10921555   8421376    8421440    5000192    5000230    2500096    2500115    16760576   16768896   10910720
         10916179   8413184    8417344    4995328    4997926    2497792    2498835    16744448   16760704   10900224   10910803
         8404992    8413248    4990464    4995366    2495232    2497811    16728064   16752512   10889472   10905683   8396800
         8409152    4985600    4993062    2492928    2496531    16711680   16744576   10878976   10900307   8388608    8405056
         4980736    4990502    2490368    2495251    16711744   16744607   10879017   10900328   8388640    8405072    4980755
         4990512    2490378    2495256    16711808   16744639   10879059   10900348   8388672    8405088    4980774    4990521
         2490387    2495261    16711871   16744671   10879100   10900369   8388704    8405104    4980793    4990531    2490397
         2495265    16711935   16744703   10879142   10900390   8388736    8405120    4980812    4990540    2490406    2495270
         12517631   14647551   8126630    9524134    6291584    7356544    3735628    4400716    1900582    2167590    8388863
         12550399   5439654    8147878    4194432    6307968    2490444    3745356    1245222    1905446    4194559    10453247
         2687142    6837158    2097280    5259392    1245260    3155532    655398     1577766    5526612    7763574    10000536
         12303291   14540253   16777215
        )
  )
)

;;;Apelsinov
;;;13.05.05
(defun APEL-ACAD_APPLICATION ()
  (if (null *apel_acad_application*)
    (setq *apel_acad_application* (vlax-get-acad-object))
    *apel_acad_application*
  )
)

;;;Apelsinov
;;;18.05.05
(defun APEL-ACTIVE_DOCUMENT ()
  (if (null *apel_active_document*)
    (setq *apel_active_document*
	   (vla-get-activedocument
	     (APEL-ACAD_APPLICATION)
	   )
    )
    *apel_active_document*
  )
)

[Apelsinov]

>All
:? вот, тут такая дискуссия была....а я вперся, и всем не интересно что-ли стало?

ладно , буду тут один выеживаться
:roll:

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

Код:

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

 (APEL-REACTOR-CURSOR_BY_CURRENT_LAYER nil nil)

- реактор вступает в силу.
Соответственно, можно все это дело пнуть в автозагрузку, и записать где нибудь (например acad.lsp) это же выражение

Код:

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

(APEL-REACTOR-CURSOR_BY_CURRENT_LAYER nil nil)

и теперь завсегда цвет курсора будет меняться в соотв. с текущим слоем. Насколько это приятно, я и сам еще не понял, но а вдруг?!

PS/ Я в реакторах как свинья в апельсинах :shock: поэтому могут быть мааааленькие бяки, например, если уже есть реактор на изменение системных переменных.....или я че-то не догоняю, эй гуры, кто в теме, уважаемые - ау! Помогите советом! [sm804]

Код:

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

;;;Apelsinov
;;;15.07.05
;;;Реактор на соответствие цвета курсора цвету текущего слоя
(defun APEL-REACTOR-CURSOR_BY_CURRENT_LAYER (A B /)
  (if (null *apel-reactor-setvar*)
    (setq *apel-reactor-setvar*
           (vlr-sysvar-reactor
             nil
             '((:vlr-sysvarchanged . APEL-REACTOR-CURSOR_BY_CURRENT_LAYER))
           )
    )

  )
  (if (or (equal B '("CLAYER" t)) (and (null A) (null B)))
    (APEL-CURSOR-COLOR_BY_CURRENT_LAYER)
  )
)

[mmax]

Все конечно очень классно
Но вот беда,
использую белый экран и по умолчанию в слое 0 стоит белый цвет и курсора не видно. С линиями все нормально Акад сам все делает -- если экран черный то линии белые если белый то линии черные а курср белый в любой ситуации.
Сам я в программировании не силен
так подскажите пожалуйста как сделать так чтобы при запуске Акада слой 0 по умолчанию имел черный цвет для всех шаблонов не только для Acadiso.dwt

А вообще идея цвета курсора просто отличная вещь.
Огромное спасибо Apelsinovу

[4eh]

Люди, подскажите, пжлста, а куда это (и что конкретнно) вставлять?
И если продолжать тему, может и тип линии туда же?

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

> mmax : Попробуй засунуть в автозагрузку следующий лисп:

Код:

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

(defun kpblc-layer-0 (/ layer0)
  (vl-load-com)
  (vlax-put-property (vlax-ename->vla-object (tblobjname "layer" "0")) 'color 250)
  ) ;_ end of defun

(kpblc-layer-0)

И можно в acaddoc.lsp дополнительно прописать в принципе вызов (kpblc-layer-0).

[===AAA===]

Всем привет!

Можно, я тоже одну мысль выскажу? :-)

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

Так вот, я так и не смог подобрать для себя его приемлимый
цвет, поскольку цвет курсора вычитается из попадающих
"под него" объектов. А поскольку у меня курсор 100%, то
постоянно "пропадающие" или дико меняющие цвет
ортогональные линии бесили просто ужасно...

В итоге - вернулся к "классике"... Это так, подумалось просто. :-)

[mmax]

Сообщение от 4eh И если продолжать тему, может и тип линии туда же?

Вообщето штрихпунктирный курсор будет выглядеть не очень красиво

[Apelsinov]

>4eh, mmax.
Вообще-то поменять тип линии курсора лиспом не получится, и плюс неувязки с масштабом линии. Поэтому тут и обсуждать нечего.

[vk]

Сообщение от Apelsinov PS/ Я в реакторах как свинья в апельсинах :shock: поэтому могут быть мааааленькие бяки, например, если уже есть реактор на изменение системных переменных.....или я че-то не догоняю, эй гуры, кто в теме, уважаемые - ау! Помогите советом! [sm804]

Будут отрабатывать все которые есть. Ну по крайней мере должны отрабатывать. Если глючить будет - то на VBA переписывать придется

[mmax]

Сообщение от Apelsinov >4eh, mmax. Вообще-то поменять тип линии курсора лиспом не получится, и плюс неувязки с масштабом линии. Поэтому тут и обсуждать нечего.

Вот и я про то же

Но скорее всего человек имел в виду вес курсора
Это уже лучше
Стоит ли открывать такую тему или здесь обсудим?

[Apelsinov]

Сообщение от mmax Сообщение от Apelsinov >4eh, mmax. Вообще-то поменять тип линии курсора лиспом не получится, и плюс неувязки с масштабом линии. Поэтому тут и обсуждать нечего. Вот и я про то же Но скорее всего человек имел в виду вес курсора Это уже лучше Стоит ли открывать такую тему или здесь обсудим?

Я бы с удовольствием обсудил и тут, но обсуждать нечего, нет такого свойства как вес курсора. Поэтому придумайте еще что нибудь

Вообще с курсору можно задать цвет, можно изменить размер, наверное, но это все. Сделать с ним то, возможность чего не предусмотрели разработчики, нельзя.

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

[nikolaev]

А как Вам это?
;;------------------> Рисование пробных линий <---------
;;-------------------------------------------------------------------
(defun c:t_line (/ p1 p2 DS)
(setq DS (getvar "dimscale")
p1 (getpoint "\nspecify first point:")
p2 (polar p1 0 (* ds 50.0))
)
(setvar "lwdisplay" 1)
(command "line" p1 p2 "")
(command "delay" 300)
(command "erase" "single" "l")
(command "delay" 300)
(command "line" p1 p2 "")
(command "delay" 300)
(command "erase" "single" "l")
(command "delay" 300)
(command "line" p1 p2 "")
(command "delay" 300)
(command "erase" "single" "l")
(command "line" p1)
)

[mmax]

Вот и хорошо
Осталось добить последние косяки и багги

Ну насколько я понимаю с цветом экрана ничего не выйдет ну да ладно.

Косяк:
Цвет слоя = 250  цвет курсора = 84,84,84

Не могли бы вы что нибудь сделать?
Чтобы было Цвет слоя = 250  цвет курсора = 250
Я конечно понимаю что это для черного экрана так сделано, но как я уже говорил у меня экран уже несколько лет белый. От черного экрана глаза болят, а серенький курсор на белом тоже не очень

В Лиспе я как Apelsinov в реакторах

[skkkk]

Очень отличная вещь эта смена цвета курсора! Но не выходит у меня сделать, чтоб при смене слоя курсор бы менялся сам. он меняется только после запуска функции. Что-то я, видимо, недопонял, а вот что.....?

[skkkk]

Взявшись за дело на свежую голову, внимательней вникнув и основательней потыкав, я-таки заставил эту штуку работать. Все оказалось просто: лиспы из #11 и 12 надо добавить в автозагрузку, а строку

Код:

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

(APEL-REACTOR-CURSOR_BY_CURRENT_LAYER nil nil)

вставить в файл acad200X.lsp. Apelsinov в общем-то так и сказал, но я не смекнул сразу... Причем обнаружил особенность: при вставке функции (APEL-REACTOR-CURSOR_BY_CURRENT_LAYER nil nil) в acad.lsp в самый конец, после моих других функций реактор не запускался, приходилось функцию вводить после пуска АвтоКАДа. Когда поставил ее в начало acad.lsp, всё заработало отлично, включая мои другие функции. Видимо об этом шла речь:

поэтому могут быть мааааленькие бяки

А вот от того,

Чтобы было Цвет слоя = 250  цвет курсора = 250

- я бы тоже не отказался. Но и так очень и очень достойно. Огромное СПАСИБО, Apelsinov!!!

[mmax]

Сколько лет сколько зим.
Тоже когдато сильно захотел эту примочку.

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

Я сделал свой

• Стабильный реактор

• Расширена цветовая палитра. Цвета пересчитываются из RGB, предыдущий вариант использует 256 цветов(если не ошибаюсь).

• Полная поддержка перехода из модели в лист и обратно.

• Инверсия цвета курсора производится только если модель - черная или белая, лист только белый.

• Добавлены команды включения и выключения программы
• clcoloron - цвет курсора будет меняться
• clcoloroff - цвет курсора не будет меняться и останется таки каким был на последний момент.

Сделал очень давно и исходники к сожалению уже потерял.

Распакуйте файлы из архива куда нибудь на пути поддержки

При загрузке первым должен загрузиться LibFunctionsSamoCAD.fas.
CursorColor=ClayerColor.VLX должен загрузиться вторым. Это связано с тем что реактор начинает немедленную работу и если он не найдет библиотечные функции то начнет вылетать.

И ввиду того что реактор начинает мгновеннно работать при запуске AutoCAD. Рекомендуется подгружать их из функции s::startup

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

mmax, а чего только компилированный вариант предоставил?

[mmax]

не могу найти исходники. Кажется я их потерял

[skkkk]

Сообщение от mmax Инверсия цвета курсора производится только если модель - черная или белая, лист только белый.

А если у меня цвет в модели сине-зеленый какой-то (136-й) - ну вот я привык к нему - мне кажется, самый уж он не напрягающий для глаз - не будет работать?
Третий день активно работаю - не заметил никакой нестабильности в "устаревшей" версии, работает как часики. Вот только подсказал бы кто, как изменить код из #11, чтоб при выборе слоя с цветом №250 курсор бы тоже становился №250 - частенько приходиться пользовать этот цвет при работе по растру.

[mmax]

Сообщение от skkkk [/list]А если у меня цвет в модели сине-зеленый какой-то (136-й) - ну вот я привык к нему - мне кажется, самый уж он не напрягающий для глаз - не будет работать? Третий день активно работаю - не заметил никакой нестабильности в "устаревшей" версии, работает как часики. Вот только подсказал бы кто, как изменить код из #11, чтоб при выборе слоя с цветом №250 курсор бы тоже становился №250 - частенько приходиться пользовать этот цвет при работе по растру.

Ну я не знаю. Если ты цвет слоя сделаешь равным цвету модели, то цвет курсора станет невидимым так как цвет курсора станет равным цвету модели.
Если кто подскажет по какому принципу происходит инверсия для цветов отличных от черного и белого, попробую подправить. Например черный меняется на белый, белый на черный, а на какой менять например сине-зеленый какой-то (136-й)?

А еще старый вариант не меняет цвет курсора если изменить цвет слоя не меняя самого текущего слоя

Также у меня цвет слоя = 250 делает цвет курсора = 250.

Нашел я исходники. Попробую опубликовать.

Не спрашивайте у меня почему все так замудрено. Это связано с тем что здесь используется два реактора и в процессе инициализации AutoCAD происходит много всякого такого что заставило меня сделать именно так.

Сначала грузятся библиотечные функции

После библиотечных функций должен подгрузиться файл

LayerColor-CursorColorReactorSamoCAD.lsp

Код:

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

;Пустые временные функции для реакторов

(defun layer_color=cursor_color_ObjectReactorFuntion-samocad ()
  (princ)
  )

(defun layer_color=cursor_color_SysvarReactorFuntion-samocad ()
  (princ)
  )


;******************************************************************************************************
;реактор объектов слоев
(setq layer_color=cursor_color_ObjectReactor-samocad
       (vlr-object-reactor (all-layers-obj-samocad t) nil
	 (list (cons :vlr-modified 'layer_color=cursor_color_ObjectReactorFuntion-samocad))))
;******************************************************************************************************

;******************************************************************************************************
;реактор системных переменных
(setq layer_color=cursor_color_sysvarreactor-samocad
       (vlr-sysvar-reactor
       nil (list (cons :vlr-sysvarchanged 'layer_color=cursor_color_SysvarReactorFuntion-samocad))))
;******************************************************************************************************

(vlr-remove layer_color=cursor_color_ObjectReactor-samocad)
(vlr-remove layer_color=cursor_color_sysvarreactor-samocad)

(load "LayerColor-CursorColorSamoCAD.lsp")


(if (eq
      (reg-riad-or-write-samocad
	"HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor"
	"1") "1")
  (progn
    (vlr-add layer_color=cursor_color_ObjectReactor-samocad)
    (vlr-add layer_color=cursor_color_sysvarreactor-samocad)
    (clayer_color=cursor_color-samocad)
    )
  (princ)
  )

Файл
LayerColor-CursorColorSamoCAD.lsp
подгружается предыдущим LayerColor-CursorColorReactorSamoCAD.lsp
его в автозагрузку не надо

Код:

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

;Цвет курсора равен цвету слоя

;;;(vla-get-ModelCrosshairColor(vla-get-Display(vla-get-Preferences (vlax-get-acad-object))))
;;;(vla-put-ModelCrosshairColor(vla-get-Display(vla-get-Preferences (vlax-get-acad-object)))3408653) 
;Получим цветовые характеристики слоя

(defun clayer_color=cursor_color-samocad ( /
					  BLUELAYER
					  GREENLAYER
					  LAYOUT_COLOR
					  LAYOUT_CUR_COLOR
					  MODEL_COLOR
					  MODEL_CUR_COLOR
					  REDLAYER
					  )

  

(setq Redlayer (vla-get-Red (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))
(setq Greenlayer (vla-get-Green (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))
(setq Bluelayer (vla-get-Blue (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))

(setq model_color (vlax-variant-value
		   (vlax-variant-change-type
		   (vla-get-GraphicsWinModelBackgrndColor
		    (vla-get-Display
                      (vla-get-Preferences
                         (vlax-get-acad-object))))3)))

(setq layout_color (vlax-variant-value
		   (vlax-variant-change-type
		   (vla-get-GraphicsWinLayoutBackgrndColor
		    (vla-get-Display
                      (vla-get-Preferences
                         (vlax-get-acad-object))))3)))
  
(vla-put-ModelCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole-samocad Redlayer Greenlayer Bluelayer)
    )
(vla-put-LayoutCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole-samocad Redlayer Greenlayer Bluelayer)
    )

(setq model_cur_color (vlax-variant-value
		        (vlax-variant-change-type
			  (vla-get-ModelCrosshairColor
                             (vla-get-Display
                               (vla-get-Preferences
                                   (vlax-get-acad-object)))) 3)))

(setq Layout_cur_color (vlax-variant-value
		        (vlax-variant-change-type
			  (vla-get-LayoutCrosshairColor
                             (vla-get-Display
                               (vla-get-Preferences
                                   (vlax-get-acad-object)))) 3)))

(if (= model_color model_cur_color 0)

 (vla-put-ModelCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  16777215
    )(princ))

(if (= model_color model_cur_color 16777215)

 (vla-put-ModelCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  0
    )(princ))

(if (= layout_color Layout_cur_color 16777215)
 (vla-put-LayoutCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  0
    )(princ))
(if (= layout_color Layout_cur_color 0)
 (vla-put-LayoutCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  16777215
    )(princ))

  (princ)
					      
  );(clayer_color=cursor_color-samocad)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;SamoCAD


;Функция реактора системных переменных
(defun layer_color=cursor_color_SysvarReactorFuntion-samocad (a b)
  (setq c  a
	d b)
  (if (and (eq (nth 0 b) "CLAYER")
	   (nth 1 b));and
    (progn
      (clayer_color=cursor_color-samocad)
      (layer_color=cursor_color_ChangObjectsForObjectReactor-samocad)
      );T
    (princ);nil
    );if
  (princ)
  )



;Функция реактора объектов(слоев)

(defun layer_color=cursor_color_ObjectReactorFuntion-samocad (a b c)
  (clayer_color=cursor_color-samocad)
  (princ)
  )

;Функция замены объектов для реактора объектов

(defun layer_color=cursor_color_ChangObjectsForObjectReactor-samocad (/ obj_layers_list)
  
;удаление владельцев
  
(mapcar (function (lambda (a)
		    (vlr-owner-remove layer_color=cursor_color_ObjectReactor-samocad
		      a ))) (vlr-owners layer_color=cursor_color_ObjectReactor-samocad))

;Добавление владельцев
  
(mapcar (function (lambda (b)
		    (vlr-owner-add layer_color=cursor_color_ObjectReactor-samocad b)))
	(all-layers-obj-samocad t))
  (princ)
  )


;Включение
(defun c:clcoloron ()
  (if (and
	(null (vlr-added-p layer_color=cursor_color_ObjectReactor-samocad))
	(null (vlr-added-p layer_color=cursor_color_ObjectReactor-samocad))
	);and
    (progn
    (vlr-add layer_color=cursor_color_ObjectReactor-samocad)
    (vlr-add layer_color=cursor_color_sysvarreactor-samocad)
(vl-registry-write
  "HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor" "1")
    (clayer_color=cursor_color-samocad)
    )
    (princ)
    );if
  (princ)
  )


(defun c:clcoloroff ()
  (if (and
	(null (vlr-added-p layer_color=cursor_color_ObjectReactor-samocad))
	(null (vlr-added-p layer_color=cursor_color_ObjectReactor-samocad))
	);and
    (princ)
    (progn
    (vlr-remove layer_color=cursor_color_ObjectReactor-samocad)
    (vlr-remove layer_color=cursor_color_sysvarreactor-samocad)
(vl-registry-write
  "HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor" "0")    
    )
    
    );if
  (princ)
  )

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

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

[skkkk]

Слои такого цвета, коим окрашено мое рабочее пространство (цвет №136), я еще не встречал за свою, пускай недолгую, практику. Но для удовлетворения бушующего любопытства решаю проверить одну вещь. Ставлю цвет слоя соответствующим цвету моего рабочего пространства модели. И что вы думаете? Объекты и курсор становятся цветом заметно темнее рабочего пространства, не сливаются. Иду дальше - пробую те же телодвижения с другими цветами: 80, 74, 154... Начинает сливаться всё, курсора не видно, видны только объекты - чуууть темнее. На 125-м цвете снова не сливаются... Закономерность неясна, но ясно, что некоторые цвета инверсии не требуют.

[mmax]

Извиняюсь за нескромность, но всетаки предлагаю использовать мой вариант. Он более современный и расширеный. А то что инверсии нет так это ничего страшного, навряд ли вы когда нибудь захотите использовать цвет слоя равный цвету экрана.

[skkkk]

Поставил. Действительно, всё так и есть - версия более современная и расширенная. При черном цвете слоя - черный курсор и

меняет цвет курсора если изменить цвет слоя не меняя самого текущего слоя

Я очень доволен этим вариантом, спасибо огромное, mmax!!!

Я вот ненужные "книги из библиотеки", подчистил, прилагаю архив с необходимыми и достаточными файлами.

[mmax]

Ну а я в свою очередь, снова скажу спасибо, Apelsinov!!!,
Еще тогда 4 года назад он на этом форуме ответил на большинство моих вопросов про LISP.


У меня тоже есть косячок. Я в те времена никак не мог разобраться как перевести цвета из RGB в OLE, и изобрел какойто очень странный способ перевода. Он правильный но очень громоздкий.
Поэтому рекомендую заменить библиотечную функцию rgb->ole-samocad
на

Код:

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

(defun rgb->ole-samocad (R G B)
  (+ (* B (expt 16 4)) (* G (expt 16 2)) R)
  )

и соответственно выбросить из библиотеки функции переваода единиц 10 и 16ричной систем
счисления.

[CAHTEXHuK]

Для начала хочу поблагодарить mmax... Спасибо.
а теперь ложку дегтя...
Не так давно вплотную работаю в автокаде, поэтому не ругайте сильно, если глупость спрошу...
Вот взял лиспы, установил, на 2008 enu все вроде хорошо... цвет меняется... красота... но я много использую инструментальные палитры... Причем различные варианты блоков с вставкой в различные слои или в текущий слой... оказалось, что лиспы каким-то образом влияют на их вставку... я в лиспах не силен, тем более в таких замудренных... т.е. блоки не вставляются с палитры в слой отличный от текущего...
в коммандной строке маячит:
Точка вставки или [Базовая точка/Масштаб/X/Y/Z/ПОворот]: *Прервано*
Если же блок вставляется в текущий слой - все идет на ура...
Проверил на чистом автокаде без всяких обвесов... можно ли решить эту проблему ?
Причем еще раз повторю, проблема возникает именно после загрузки выше указанных лиспов.
Заранее благодарен всем за любую помощь.

[mmax]

Сообщение от CAHTEXHuK блоки не вставляются с палитры в слой отличный от текущего...

Вот уже больше года прошло как я ушел из большого Автокада и за это время успел многое позабыть.
Объясни подробней как это вставить блок в слой отличный от текущего?
Я так понимаю в блоке есть объекты имеющие слои не созданные в данном документе?
А еще лучше абсолютно все подробно с файлом-примером с блоками и со слоями или без слоев

[CAHTEXHuK]

Спасибо, что откликнулся...
У кнопки палитры инструментов в свойствах можно задать всякие опции вставки блока... Одна из них - слой, на который блок будет размещен... т.е. у меня большинство блоков в нулевом слое сделаны... а уже в палитрах некоторые направляю в нужный слой.
Возможно эти лиспы как-то блокируют эту "временную смену" слоя для вставки блока в нужный .... поэтому операция прерывается...
Насчет примеров, я могу, но уже не сегодня, но проверил не один раз на разных блоках, разных чертежах... с надстройками типа СПДС и без ... только убираю лиспы из автозагрузки - все начинает работать...
Благодарю за внимание и помощь...

[gomer]

Вот как вариант, учитывая вышесказанное...

Код:

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

(defun vl-ActiveLayerColor->ModelCrosshairColor ( / acobj tcol)
  (vla-put-ModelCrosshairColor
    (vla-get-Display (vla-get-Preferences (setq acobj (vlax-get-acad-object))))
    (vlax-make-variant
      (+ (* (vla-get-Red (setq tcol (vla-get-TrueColor (vla-get-ActiveLayer (vla-get-ActiveDocument acobj))))))
         (* (vla-get-Green tcol) (expt 2 8))
         (* (vla-get-Blue tcol)  (expt 2 16))
      )
      vlax-vbLong
    )
  )
  tcol
)

реактор лень думать... см выше...
и, господа, вы забыли про сетку...
и еще рамку выбора объектов...

[CAHTEXHuK]

я пока слабо разбираюсь, или совсем неразбираюсь в этих писулинах, ... куда мне использовать этот код, имея
LayerColor-CursorColorReactorSamoCAD.lsp
LayerColor-CursorColorSamoCAD.lsp
LibAcadObjectFunctionsSamoCAD.lsp
LibColorFunctionsSamoCAD.lsp
LibGetPutNameSamoCAD.lsp
LibMathFunctionsSamoCAD.lsp
LibOtherFunctionsSamoCAD.lsp
LibRegistryFuntionsSamoCAD.lsp
? и еще вопрос не совсем в тему, но очень срочно нужно...
<...> В отдельную тему /kpblc/

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

Сообщение от CAHTEXHuK куда мне использовать этот код

Как использовать лисп, опубликованный на форуме
Остальное - в отдельную тему.

[mmax]

to gomer в твоем коде нет ничего нового и даже не правильно.
Цвет для ModelCrosshairColor нужно переводить не из RGB, а из BGR, тоесть зачемто нужно переворачивать TrueColor.

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

Я попробую выяснить на каком этапе это происходит. Если окажется что вылет происходит именно во время смены цвета курсора то ничего сделать нельзя.

[CAHTEXHuK]

Кулик Алексей aka kpblc, я кое-как освоил как использовать выложенный код, тут вопрос в другом, что исходные 8 файлов, а куда тот, что предложил gomer, я не понял.
mmax, мне остается только ждать и надеяться...

[mmax]

К сожалению мне удалось выяснить что отмена происходит во время смены слоя в момент выполнения команды вставки блока. Так что в данном случае бессильны будут даже гуру.
Несовместимость называется.
Поэтому могу предложить:

1. Заметил что при перетаскивании блока с палитры на экран сбоя не происходит, но при этом блок тупо перетаскивается без указания точки. Сбой происходит только если кликнуть по палитре.
2. Ну или переключаться на нужный слой пред вставкой блоков.
3. сделать панель инструментов с двумя кнопками которые будут вызывать команды clcoloron и clcoloroff и нажимать их перед работой с палитрой.
4. Еще как вариант отказаться от моей программы.

Если не разбираешься как грузить 8 файлов используй вариант, предложенный тут, там же инструкции:
http://forum.dwg.ru/showpost.php?p=393497&postcount=26
Все что ниже этого поста исходники, предназначенные для программистов и ничего нового или представляющего интерес для непрограммиста в них нет.

То что предложил gomer никуда не надо вставлять, такая функция там уже есть.

Ну и еще у меня у самого будет вопрос к гуру:
можно ли в лиспе определить, что в данный момент выполняется команда с таким то именем?
напрмер в данном случае _executetool

[CAHTEXHuK]

Ну еще есть вариант... чтобы команды clcoloron и clcoloroff срабатывали вместе с открытием / закрытием палитры инструментов... или код проверял, открыта палитра или нет... не знаю насколько это реально сделать...
а насчет 8 лиспов - я же сделал, чтобы работали... но знания в этой области сияют пробелами...

[mmax]

Все же рано оружие чехлить.
кажется я нашел очень неплохе решение
нужно только время для его воплощения

Уже потестил получается. Ждите выхода релиза

[gomer]

>mmax: Еще раз проверил - работает функция нормально, цвет правильный выставляет))) (16.0)
>остальным: Да, не надо вставлять никуда... нового нет, не спорю, просто короче и понятней
Еще не понятно, если текущий цвет не соответствует цвету текущего слоя... посмотрел, например на курсор, он синий, а линии красным рисуются, вот досада...
Остается вопрос, заданный apelsinov: куда девать реактор системных переменных, если он уже загружен...
После выгрузки реактора от mmax вообще ничего не останется... я так понимаю...

[mmax]

Ну вот собственно и все.
Просто скопируйте файлы из архива в папку установки Автокада. Ничего загружать не надо все само загрузится.
Для загрузки используются файл acaddoc.lsp и в нем функция s::startup. Нужно учесть этот момент, если вы используете другие приложения.

Исходники для програмистов:

1. Файл который должен загрузиться функцией s::startup

Код:

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

;******************************************************************************************************
;Бибилиотечные функции

(vl-load-com)
;Чтение раздела и параметра реестра
;если чтото отсутствует то данный раздел и параметр добавляются
;если все наместе возвращает значение ничего неменяя
;Возвращаемое значение - значение параметра
;;;;;Аргументы
;;;;;razdel-Имя раздела
;;;;;parametr-Имя параметра
;;;;;value-значение параметра(строковое)


(defun reg-riad-or-write-samocad (razdel parametr value / osiv_ss *error*)

  (defun *error* (msg)
   (princ "\nОшибка : нет доступа к реестру ")
    (princ msg)
   (princ)
   )

  (setq osiv_ss (vl-registry-read
                   razdel
                   parametr)
      );setq


(if (null osiv_ss)
  (setq osiv_ss 
  (vl-registry-write
  razdel parametr
  value)
  );setq
  (princ )
  )

osiv_ss
    )


(defun rgb->ole-samocad (R G B)
  (+ (* B (expt 16 4)) (* G (expt 16 2)) R)
  )

(defun all-layers-obj-samocad (ename=nil-vla=t / objlist)

(setq objlist
(mapcar
  (function
    (lambda (a)
      (vla-item
	(vla-get-layers
	  (vla-get-activedocument
	    (vlax-get-acad-object))
	  ) a)))
  ( layers-name-list-samocad)))

(if ename=nil-vla=t
  (princ)
  (setq objlist
	 (mapcar (function (lambda (b)
			     (vlax-vla-object->ename b)))
		 objlist)))
  objlist
  );(all-layers-obj-samocad t) (all-layers-obj-samocad nil)

;Возвращает список всех слоев
(defun layers-name-list-samocad (/ samo_layers_lst_s) 
  (vlax-for i 
         (vla-get-layers 
      (vla-get-ActiveDocument (vlax-get-acad-object)) 
         ) 
    (setq samo_layers_lst_s (cons (vla-get-name i) samo_layers_lst_s)) 
  ) 
  (reverse samo_layers_lst_s)
  )

(defun acad-objects-samocad (obj / ob)

  (if (= obj 1)
  (setq ob (vlax-get-acad-object))
        )
  
  (if (= obj 2)
  (setq ob (vla-get-activedocument (vlax-get-acad-object)))
        )
  
  (if (= obj 3)
  (setq ob (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
        )
  
  (if (= obj 4)
  (setq ob (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object))))
        )

  (if (= obj 5)
  (setq ob (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))))
        )

  (if (= obj 6)
  (setq ob (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))))
        )
  ob
    );(acad-objects-samocad 2) 


;Пустые временные функции для реакторов

(defun layer_color=cursor_color_ObjectReactorFuntion-samocad ()
  (princ)
  )

(defun layer_color=cursor_color_SysvarReactorFuntion-samocad ()
  (princ)
  )

(defun clayercoloroff (a b)
 (princ)
  )

(defun clayercoloron (a b)
  (princ)
  )


;******************************************************************************************************
;реактор объектов слоев
(setq layer_color=cursor_color_ObjectReactor-samocad
       (vlr-object-reactor (all-layers-obj-samocad t) nil
	 (list (cons :vlr-modified 'layer_color=cursor_color_ObjectReactorFuntion-samocad))))
;******************************************************************************************************

;******************************************************************************************************
;реактор системных переменных
(setq layer_color=cursor_color_sysvarreactor-samocad
       (vlr-sysvar-reactor
       nil (list (cons :vlr-sysvarchanged 'layer_color=cursor_color_SysvarReactorFuntion-samocad))))
;******************************************************************************************************

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





(vlr-remove layer_color=cursor_color_ObjectReactor-samocad)
(vlr-remove layer_color=cursor_color_sysvarreactor-samocad)

(load "LayerColor-CursorColorSamoCAD.fas")


(if (eq
      (reg-riad-or-write-samocad
	"HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor"
	"1") "1")
  (progn
    (vlr-add layer_color=cursor_color_ObjectReactor-samocad)
    (vlr-add layer_color=cursor_color_sysvarreactor-samocad)
    (clayer_color=cursor_color-samocad)
    )
  (princ)
  )

2. Файл который не надо загружать. Он грузится функцией load в предыдущем файле.

Код:

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

;SamoCAD
;Цвет курсора равен цвету слоя

;;;(vla-get-ModelCrosshairColor(vla-get-Display(vla-get-Preferences (vlax-get-acad-object))))
;;;(vla-put-ModelCrosshairColor(vla-get-Display(vla-get-Preferences (vlax-get-acad-object)))3408653) 
;Получим цветовые характеристики слоя

(defun clayer_color=cursor_color-samocad ( /
					  BLUELAYER
					  GREENLAYER
					  LAYOUT_COLOR
					  LAYOUT_CUR_COLOR
					  MODEL_COLOR
					  MODEL_CUR_COLOR
					  REDLAYER
					  )

  

(setq Redlayer (vla-get-Red (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))
(setq Greenlayer (vla-get-Green (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))
(setq Bluelayer (vla-get-Blue (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))

(setq model_color (vlax-variant-value
		   (vlax-variant-change-type
		   (vla-get-GraphicsWinModelBackgrndColor
		    (vla-get-Display
                      (vla-get-Preferences
                         (vlax-get-acad-object))))3)))

(setq layout_color (vlax-variant-value
		   (vlax-variant-change-type
		   (vla-get-GraphicsWinLayoutBackgrndColor
		    (vla-get-Display
                      (vla-get-Preferences
                         (vlax-get-acad-object))))3)))
  
(vla-put-ModelCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole-samocad Redlayer Greenlayer Bluelayer)
    )
(vla-put-LayoutCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole-samocad Redlayer Greenlayer Bluelayer)
    )

(setq model_cur_color (vlax-variant-value
		        (vlax-variant-change-type
			  (vla-get-ModelCrosshairColor
                             (vla-get-Display
                               (vla-get-Preferences
                                   (vlax-get-acad-object)))) 3)))

(setq Layout_cur_color (vlax-variant-value
		        (vlax-variant-change-type
			  (vla-get-LayoutCrosshairColor
                             (vla-get-Display
                               (vla-get-Preferences
                                   (vlax-get-acad-object)))) 3)))

(if (= model_color model_cur_color 0)

 (vla-put-ModelCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  16777215
    )(princ))

(if (= model_color model_cur_color 16777215)

 (vla-put-ModelCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  0
    )(princ))

(if (= layout_color Layout_cur_color 16777215)
 (vla-put-LayoutCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  0
    )(princ))
(if (= layout_color Layout_cur_color 0)
 (vla-put-LayoutCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  16777215
    )(princ))

  (princ)
					      
  );(clayer_color=cursor_color-samocad)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;SamoCAD


;Функция реактора системных переменных
(defun layer_color=cursor_color_SysvarReactorFuntion-samocad (a b)
  (setq c  a
	d b)
  (if (and (eq (nth 0 b) "CLAYER")
	   (nth 1 b));and
    (progn
      (clayer_color=cursor_color-samocad)
      (layer_color=cursor_color_ChangObjectsForObjectReactor-samocad)
      );T
    (princ);nil
    );if
  (princ)
  )



;Функция реактора объектов(слоев)

(defun layer_color=cursor_color_ObjectReactorFuntion-samocad (a b c)
  (clayer_color=cursor_color-samocad)
  (princ)
  )

;Функция замены объектов для реактора объектов

(defun layer_color=cursor_color_ChangObjectsForObjectReactor-samocad (/ obj_layers_list)
  
;удаление владельцев
  
(mapcar (function (lambda (a)
		    (vlr-owner-remove layer_color=cursor_color_ObjectReactor-samocad
		      a ))) (vlr-owners layer_color=cursor_color_ObjectReactor-samocad))

;Добавление владельцев
  
(mapcar (function (lambda (b)
		    (vlr-owner-add layer_color=cursor_color_ObjectReactor-samocad b)))
	(all-layers-obj-samocad t))
  (princ)
  )


;Включение
(defun c:clcoloron ()
  (if (and
	(null (vlr-added-p layer_color=cursor_color_ObjectReactor-samocad))
	(null (vlr-added-p layer_color=cursor_color_sysvarreactor-samocad))
	);and
    (progn
    (vlr-add layer_color=cursor_color_ObjectReactor-samocad)
    (vlr-add layer_color=cursor_color_sysvarreactor-samocad)
    (vl-registry-write
  "HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor" "1")
    (clayer_color=cursor_color-samocad)
    )
    (princ)
    );if
  (princ)
  )


(defun c:clcoloroff ()
  (if (and
	(null (vlr-added-p layer_color=cursor_color_ObjectReactor-samocad))
	(null (vlr-added-p layer_color=cursor_color_sysvarreactor-samocad))
	);and
    (princ)
    (progn
    (vlr-remove layer_color=cursor_color_ObjectReactor-samocad)
    (vlr-remove layer_color=cursor_color_sysvarreactor-samocad)
    (vl-registry-write
  "HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor" "0")    
    )
    
    );if
  (princ)
  )

(defun clayercoloroff (a b)
  (if (eq
      (reg-riad-or-write-samocad
	"HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor"
	"1") "1")
  (progn
  (if (and
	(null (vlr-added-p layer_color=cursor_color_ObjectReactor-samocad))
	(null (vlr-added-p layer_color=cursor_color_sysvarreactor-samocad))
	);and
    (princ)
    (progn
    (vlr-remove layer_color=cursor_color_ObjectReactor-samocad)
    (vlr-remove layer_color=cursor_color_sysvarreactor-samocad)
        
    )
    
    );if
  )
    (princ "И так выключено")
    )
  (princ)
  )



(defun clayercoloron (a b)
  (if (eq
      (reg-riad-or-write-samocad
	"HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor"
	"1") "1")
  (progn
  (if (and
	(null (vlr-added-p layer_color=cursor_color_ObjectReactor-samocad))
	(null (vlr-added-p layer_color=cursor_color_sysvarreactor-samocad))
	);and
    (progn
    (vlr-add layer_color=cursor_color_ObjectReactor-samocad)
    (vlr-add layer_color=cursor_color_sysvarreactor-samocad)
    (clayer_color=cursor_color-samocad)
    )
    (princ)
    );if
    )
  (princ)
    )
  (princ)
  )

;реакторы команд
(setq layer_color=cursor_color_commandreactor-startcommand-samocad
       (vlr-command-reactor nil (list '(:vlr-commandwillstart . clayercoloroff))))

(setq layer_color=cursor_color_commandreactor-endcommand-samocad
       (vlr-command-reactor nil (list '(:vlr-commandended . clayercoloron))))

[gomer]

Ох уж эти студенты

[mmax]

Если вы заметили разницу в цветах слоя и курсора, это не ошибка, а так называемый баг Windows, монитора и видеокарты.

Напомню что разные люди воспринимают цвета по разному. Есть еще дальтоники. В данной ситуации программа не смотрит на цвет глазами, она оперирует их номерами, поэтому то что мы видим глазами программу не интересует.

Для примера.
Сделаем цвет слоя 52
Смотрим что цвет курсора визуально не равен цвету слоя.
Слой имеет темный цвет то ли коричневый то ли зеленый (типа хаки), курсор при этом имеет яркий коричневый цвет почти желтый.
[IMG]http://i069.***********/1005/7f/994baf3b221f.jpg[/IMG]

Смотрим какой RGB у цвета 52 (получается 165 165 0):

[IMG]http://s49.***********/i126/1005/b5/ec42fc345133.jpg[/IMG]

идем уже в настройки рабочего пространства (там где цвет курсора руками меняется):

[IMG]http://s48.***********/i120/1005/12/4b5b055b520b.jpg[/IMG]

цвет курсора 52. Совпадает.

Смотрим какой RGB у курсора получился:

[IMG]http://s61.***********/i173/1005/f8/c99435630925.jpg[/IMG]

Снова все совпадает, но визуально чувствуется разница.
Программа тут ни при чем. Разница в цветах вас ждет даже если вы будете задавать вручную цвет курсора.

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

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

[CAHTEXHuK]

mmax, спасибо, вроде так шустро потестил... все работает...

[gomer]

>mmax: наши функции делают одно и тоже, в чем ошибка? Превод цвета: 52->52... нормально? Откуда BGR не понимаю.

Сообщение от mmax (defun rgb->ole-samocad (R G B) (+ (* B (expt 16 4)) (* G (expt 16 2)) R) )

А понял все!!! R в степени 0 B в степени 4 B (G в степени 2) а от перемены мест слагаемых сумма не меняется Не путай народ! И без ошибок пиши А так респект и уважуха...

[superkot007]

Сообщение от mmax Ну вот собственно и все. Просто скопируйте файлы из архива в папку установки Автокада. Ничего загружать не надо все само загрузится.

А если не "в папку установки Автокада" - то достаточно прописать путь к папке (Настройка - Файлы - Путь к вспомогательным файлам) и всё ?

[mmax]

Кстати. Я тут подумал, да и gomer намекал на это дело, но я сначала не въехал о чем речь.
А не логичнее бы было сделать привязку цвета курсора вот к этой пнельке.
Тогда цвет курсора будет равен цвету вновь рисуемых линий.
[IMG]http://s51.***********/i133/1005/81/7d5e49365178.jpg[/IMG]
Ну и соответственно в этой ситуации будет присутствовать частный случай когда цвет будет ПОСЛОЮ.

to superkot007 ты сам ответил на свой вопрос.

[CAHTEXHuK]

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

[grachev.p]

>mmax, заметил такую вещь.

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

То есть получается так.

Код:

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

Command: _dimaligned
Specify first extension line origin or <select object>: *Cancel*

Хотя команду я не отменяю.

Ни у кого больше подобного не происходит?

PS. AutoCAD 2011 ENG

[mmax]

Я тут поправил пост 49, там рассказывается про визуальную разницу цветов. В Автокад 2011 с этим делом ситуация вообще аховая. Не смотря на то что цвета совпадают по номерам, у некоторых цветов визуальная разница просто огромная.

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

укажи какой конкретно лисп используешь&

проверил иногда конфликтует.

Надо разбираться. Плохо что нет стандартов на использование реакторов. Все их пользуют как хотят

[grachev.p]

mmax, лисп использую вот этот.

Код:

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

(vl-load-com)
(setq *OldLayer* (getvar "CLAYER"))
(vl-cmdf "_layer" "_make" "Размеры" "_color" 142 "" "") ;_Создаем слой размеры и задаем цвет 142 ...
(vl-cmdf "_layer" "_make" "Штриховка" "_color" 5 "" "") ;_Создаем слой штриховка и задаем цвет 5
(vl-cmdf "_layer" "_make" "Текст" "_color" 126 "" "") ;_Создаем слой текст и задаем цвет 126
(vl-cmdf "_layer" "_make" "Таблицы" "_color" 126 "" "") ;_Создаем слой таблицы и задаем цвет 126
(vl-cmdf "_layer" "_make" "Выноски" "_color" 126 "" "") ;_Создаем слой выноски и задаем цвет 126
(setvar "clayer" *OldLayer*)
(setq *OldLayer* nil)
;;;;;;По аналогии добавить создание своего слоя
;;; ...
;;;;;;
;;;;;;-------------------------------------------------------------
(if *vlr-cmd*
  (progn
    (setq *vlr-cmd* nil)
    (vlr-remove-all :vlr-command-reactor)
  ) ;_ end of progn
) ;_ end of if
(if (not *vlr-cmd*)
  (setq	*vlr-cmd* (vlr-command-reactor
		    "cmd"
		    '((:vlr-commandwillstart . cmd-start)
		      (:vlr-commandended . cmd-end)
		      (:vlr-commandcancelled . cmd-end)
		      (:vlr-commandfailed . cmd-end)
		     )
		  )
  )
)
;;;;;;-------------------------------------------------------------
(defun cmd-start (calling-reactor startcommandInfo / thecommandstart)
  (setq thecommandstart (nth 0 startcommandInfo))
  (if (null *OldLayer*)
    (setq *OldLayer* (getvar "CLAYER"))
  )
  (cond
;;;_Реакция на начало команды DIM* (DIMALIGNED DIMLINEAR и все что начинается с DIM)
    ((wcmatch thecommandstart "DIM*") ;_Если выполняется команда DIM*
     (setvar "clayer" "размеры") ;_Слой размеры должен быть создан выше (vl-cmdf "_layer" ...
    )
;;; Конец реакции на DIM*
    ((wcmatch thecommandstart "*HATCH*") ;_Если выполняется команда *HATCH*
     (setvar "clayer" "штриховка")
    )
    ((wcmatch thecommandstart "*TEXT") ;_Если выполняется команда *TEXT (TEXT DTEXT)
     (setvar "clayer" "Текст")
    )
    ((wcmatch thecommandstart "*TABLE") ;_Если выполняется команда *TABLE
     (setvar "clayer" "Таблицы")
    )
    ((wcmatch thecommandstart "*LEADER") ;_Если выполняется команда *QLEADER MLEADER
     (setvar "clayer" "Выноски")
    )
    (t (setq *OldLayer* nil))
    ;;_Если не наша команда, чистим список текущих слоев
;;;См http://forum.dwg.ru/showpost.php?p=318806&postco...
;;;и http://forum.dwg.ru/showpost.php?p=318806&postco...
  )
  (princ)
)
;;;-------------------------------------------------------------
(defun cmd-end (calling-reactor cmd / cmd_name)
  (setq cmd_name (strcase (car cmd)))
  (if (or
	(wcmatch cmd_name "*HATCH*") ;_Если выполняется команда DIM*
	(wcmatch cmd_name "DIM*") ;_Если выполняется команда *HATCH*
	(wcmatch cmd_name "*TEXT") ;_Если выполняется команда *TEXT (TEXT DTEXT)
	(wcmatch cmd_name "*TABLE") ;_Если выполняется команда ТАБЛИЦА
	(wcmatch cmd_name "*LEADER") ;_Если выполняется команда *QLEADER или MLEADER
      )
    (progn
      (if *OldLayer*
	(setvar "clayer" *OldLayer*)
      )
      (setq *OldLayer* nil)
    )
  )
  (princ)
)

[CAHTEXHuK]

Тут такое дело... Выявился еще один неприятный момент... видима из той же оперы что и размеры у grachev.p При желании перетащить группу объектов или объект на неактивном слое за ручку и нажатии на пробел, чтобы активировать Перемещение... команда отменяется...
Автокад по прежнему 2008 рус

[mmax]

Значит так.
Все команды прерываются если цвет курсора сменился прямо во время выполнения команды. Это может произойти если слой сменился во время работы команды. Некоторые команды в процессе своей работы временно меняют слой и восстанавливают предыдущий при завершении своей работы.

В случае с перемещением можно что-то придумать, а вот в с размерами неизвестно.

[grachev.p]

Сообщение от mmax В случае с перемещением можно что-то придумать, а вот в с размерами неизвестно.

А возможно ли убрать обработку размеров вообще.То есть создать еще один командный реактор, который отменяет смену цвета курсора при выполнении команды размеров. Ведь размеры и так на нужный слой переносятся.

Хотя тоже не вариант, не все пользуются тем лиспом.

[mmax]

Вроде нашел решение для обоих случаев.
Завтра все будет.

Тестируем:
команд включения выключения тут нет.
очень часто будет в констроке два слова: start end

Код:

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

;SamoCAD
;Цвет курсора равен цвету слоя
(vl-load-com)
;;;(vla-get-ModelCrosshairColor(vla-get-Display(vla-get-Preferences (vlax-get-acad-object))))
;;;(vla-put-ModelCrosshairColor(vla-get-Display(vla-get-Preferences (vlax-get-acad-object)))3408653) 
;Получим цветовые характеристики слоя

(defun clayer_color=cursor_color-samocad ( /
					  BLUELAYER
					  GREENLAYER
					  LAYOUT_COLOR
					  LAYOUT_CUR_COLOR
					  MODEL_COLOR
					  MODEL_CUR_COLOR
					  REDLAYER
					  )

  

(setq Redlayer (vla-get-Red (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))
(setq Greenlayer (vla-get-Green (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))
(setq Bluelayer (vla-get-Blue (vla-get-TrueColor (vla-get-ActiveLayer (acad-objects-samocad 2)))))

(setq model_color (vlax-variant-value
		   (vlax-variant-change-type
		   (vla-get-GraphicsWinModelBackgrndColor
		    (vla-get-Display
                      (vla-get-Preferences
                         (vlax-get-acad-object))))3)))

(setq layout_color (vlax-variant-value
		   (vlax-variant-change-type
		   (vla-get-GraphicsWinLayoutBackgrndColor
		    (vla-get-Display
                      (vla-get-Preferences
                         (vlax-get-acad-object))))3)))
  
(vla-put-ModelCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole-samocad Redlayer Greenlayer Bluelayer)
    )
(vla-put-LayoutCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole-samocad Redlayer Greenlayer Bluelayer)
    )

(setq model_cur_color (vlax-variant-value
		        (vlax-variant-change-type
			  (vla-get-ModelCrosshairColor
                             (vla-get-Display
                               (vla-get-Preferences
                                   (vlax-get-acad-object)))) 3)))

(setq Layout_cur_color (vlax-variant-value
		        (vlax-variant-change-type
			  (vla-get-LayoutCrosshairColor
                             (vla-get-Display
                               (vla-get-Preferences
                                   (vlax-get-acad-object)))) 3)))

(if (= model_color model_cur_color 0)

 (vla-put-ModelCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  16777215
    )(princ))

(if (= model_color model_cur_color 16777215)

 (vla-put-ModelCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  0
    )(princ))

(if (= layout_color Layout_cur_color 16777215)
 (vla-put-LayoutCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  0
    )(princ))
(if (= layout_color Layout_cur_color 0)
 (vla-put-LayoutCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  16777215
    )(princ))

  (princ)
					      
  );(clayer_color=cursor_color-samocad)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;SamoCAD


;Бибилиотечные функции

(vl-load-com)
;Чтение раздела и параметра реестра
;если чтото отсутствует то данный раздел и параметр добавляются
;если все наместе возвращает значение ничего неменяя
;Возвращаемое значение - значение параметра
;;;;;Аргументы
;;;;;razdel-Имя раздела
;;;;;parametr-Имя параметра
;;;;;value-значение параметра(строковое)


(defun reg-riad-or-write-samocad (razdel parametr value / osiv_ss *error*)

  (defun *error* (msg)
   (princ "\nОшибка : нет доступа к реестру ")
    (princ msg)
   (princ)
   )

  (setq osiv_ss (vl-registry-read
                   razdel
                   parametr)
      );setq


(if (null osiv_ss)
  (setq osiv_ss 
  (vl-registry-write
  razdel parametr
  value)
  );setq
  (princ )
  )

osiv_ss
    )


(defun rgb->ole-samocad (R G B)
  (+ (* B (expt 16 4)) (* G (expt 16 2)) R)
  )

(defun all-layers-obj-samocad (ename=nil-vla=t / objlist)

(setq objlist
(mapcar
  (function
    (lambda (a)
      (vla-item
	(vla-get-layers
	  (vla-get-activedocument
	    (vlax-get-acad-object))
	  ) a)))
  ( layers-name-list-samocad)))

(if ename=nil-vla=t
  (princ)
  (setq objlist
	 (mapcar (function (lambda (b)
			     (vlax-vla-object->ename b)))
		 objlist)))
  objlist
  );(all-layers-obj-samocad t) (all-layers-obj-samocad nil)

;Возвращает список всех слоев
(defun layers-name-list-samocad (/ samo_layers_lst_s) 
  (vlax-for i 
         (vla-get-layers 
      (vla-get-ActiveDocument (vlax-get-acad-object)) 
         ) 
    (setq samo_layers_lst_s (cons (vla-get-name i) samo_layers_lst_s)) 
  ) 
  (reverse samo_layers_lst_s)
  )

(defun acad-objects-samocad (obj / ob)

  (if (= obj 1)
  (setq ob (vlax-get-acad-object))
        )
  
  (if (= obj 2)
  (setq ob (vla-get-activedocument (vlax-get-acad-object)))
        )
  
  (if (= obj 3)
  (setq ob (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
        )
  
  (if (= obj 4)
  (setq ob (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object))))
        )

  (if (= obj 5)
  (setq ob (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))))
        )

  (if (= obj 6)
  (setq ob (vla-get-Layers (vla-get-activedocument (vlax-get-acad-object))))
        )
  ob
    );(acad-objects-samocad 2) 

(defun clayercoloroff (a b)
  
   (princ "Start")
(princ)
  )



(defun clayercoloron (a b)
  (clayer_color=cursor_color-samocad)
     (princ"end")
(princ)
  )

;реакторы команд
(setq layer_color=cursor_color_commandreactor-startcommand-samocad
       (vlr-command-reactor nil (list '(:vlr-commandwillstart . clayercoloroff))))

(setq layer_color=cursor_color_commandreactor-endcommand-samocad
       (vlr-command-reactor nil (list '(:vlr-commandended . clayercoloron))))

[grachev.p]

Спасибо!

Бегло потестировал.
С размерами все путем. Курсор цвет не меняет на них, но это и не нужно.

И еще одна особенность странная. При редактировании мультивыносок по двойному щелчку текст подсвечивается цветом текущего слоя. И это только на мультивыноске почему-то. С MTEXT, DTEXT, редактировании размеров подобного не проявляется.

Но и это на работу не влияет.

PS. В первой версии почему-то реакторы не удалялись из рисунка. Я в автозагрузку лисп не добавлял, но сегодня при открытии шаблона все равно происходила смена цвета курсора. Или это так и задумано?

[mmax]

Релизкандидат-версия.
Все предыдущее удаляем, этот код либо в автозагрузку либо в (s::startup)
Работают команды clcoloron clcoloroff
Смена цвета курсора происходит только при переключении слоев и изменении цвета текущего слоя при работе с панелями инструментов "Слои" и работе Диспетчера свойств слоев, а так же с командами _-layer _layer '_layer
При работе LISP-приложений или команд, изменяющих слои, смены цвета курсора не происходит.
Так же автоматическая смена цвета не будет выполняться если цвет активного слоя меняется LISP-приложениями.

Код:

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

(vl-load-com)

;******************************************************************************************************
;Бибилиотечные функции

;Чтение раздела и параметра реестра
;если что-то отсутствует, то данный раздел и параметр будут созданы
;если все наместе возвращает значение ничего неменяя
;Возвращаемое значение - значение параметра
;;;;;Аргументы
;;;;;razdel-Имя раздела
;;;;;parametr-Имя параметра
;;;;;value-значение параметра(строковое)

(defun reg-riad-or-write-samocad (razdel parametr value / osiv_ss *error*)

  (defun *error* (msg)
   (princ "\nОшибка : нет доступа к реестру ")
    (princ msg)
   (princ)
   )

  (setq osiv_ss (vl-registry-read
                   razdel
                   parametr)
      );setq

(if (null osiv_ss)
  (setq osiv_ss 
  (vl-registry-write
  razdel parametr
  value)
  );setq
  (princ )
  )

osiv_ss
    )

;;;перевод цветов из RGB в OLE
(defun rgb->ole-samocad (R G B)
  (+ (* B (expt 16 4)) (* G (expt 16 2)) R)
  )
;Бибилиотечные функции
;******************************************************************************************************

;;;Функция устанавливающая цвет курсора равным цвету текущего слоя
(defun clayer_color=cursor_color-samocad ( /
					  BLUELAYER
					  GREENLAYER
					  LAYOUT_COLOR
					  LAYOUT_CUR_COLOR
					  MODEL_COLOR
					  MODEL_CUR_COLOR
					  REDLAYER
					  )

  

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

(setq model_color (vlax-variant-value
		   (vlax-variant-change-type
		   (vla-get-GraphicsWinModelBackgrndColor
		    (vla-get-Display
                      (vla-get-Preferences
                         (vlax-get-acad-object))))3)))

(setq layout_color (vlax-variant-value
		   (vlax-variant-change-type
		   (vla-get-GraphicsWinLayoutBackgrndColor
		    (vla-get-Display
                      (vla-get-Preferences
                         (vlax-get-acad-object))))3)))
  
(vla-put-ModelCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole-samocad Redlayer Greenlayer Bluelayer)
    )
(vla-put-LayoutCrosshairColor
  (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  (rgb->ole-samocad Redlayer Greenlayer Bluelayer)
    )

(setq model_cur_color (vlax-variant-value
		        (vlax-variant-change-type
			  (vla-get-ModelCrosshairColor
                             (vla-get-Display
                               (vla-get-Preferences
                                   (vlax-get-acad-object)))) 3)))

(setq Layout_cur_color (vlax-variant-value
		        (vlax-variant-change-type
			  (vla-get-LayoutCrosshairColor
                             (vla-get-Display
                               (vla-get-Preferences
                                   (vlax-get-acad-object)))) 3)))

(if (= model_color model_cur_color 0)

 (vla-put-ModelCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  16777215
    )(princ))

(if (= model_color model_cur_color 16777215)

 (vla-put-ModelCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  0
    )(princ))

(if (= layout_color Layout_cur_color 16777215)
 (vla-put-LayoutCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  0
    )(princ))
(if (= layout_color Layout_cur_color 0)
 (vla-put-LayoutCrosshairColor
   (vla-get-Display
    (vla-get-Preferences
      (vlax-get-acad-object)))
  16777215
    )(princ))

  (princ)
					      
  );(clayer_color=cursor_color-samocad)

;;;Пустая временная функция для реактора
;;;на случай если смена цвета отключена - цвет не будет меняться при создании реактора
(defun clayercoloron (a b)
;;;  (clayer_color=cursor_color-samocad)
     (princ)
  )

;;;Реактор
(setq layer_color=cursor_color_commandreactor-endcommand-samocad
       (vlr-command-reactor nil (list '(:vlr-commandended . clayercoloron) )))

;;;отключение реактора на случай если смена цвета отключена
(vlr-remove layer_color=cursor_color_commandreactor-endcommand-samocad)

;;;Команда включения
(defun c:clcoloron ()
  (if 	(null (vlr-added-p layer_color=cursor_color_commandreactor-endcommand-samocad))
    (progn
    (vlr-add layer_color=cursor_color_commandreactor-endcommand-samocad)
    (vl-registry-write
      "HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor" "1")
    (clayer_color=cursor_color-samocad)
    )
    (princ)
    );if
  (princ)
  )

;;;команда выключения
(defun c:clcoloroff ()
  (if (null (vlr-added-p layer_color=cursor_color_commandreactor-endcommand-samocad))
    (princ)
    (progn
    (vlr-remove layer_color=cursor_color_commandreactor-endcommand-samocad)
    (vl-registry-write
  "HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor" "0")    
    )
    );if
  (princ)
  )


;;;Включение реактора в зависимости от конфигурации
(if (eq
      (reg-riad-or-write-samocad
	"HKEY_CURRENT_USER\\Software\\MaksCAD Soft\\SamoCAD\\AutoCAD\\Interfase"
	"layercolor=cursorcolor"
	"1") "1")
  (progn
    (vlr-add layer_color=cursor_color_commandreactor-endcommand-samocad)
    (clayer_color=cursor_color-samocad)
    )
  (princ)
  )

;;;Постоянная функция для реактора
(defun clayercoloron (a b)
  (setq layer_color=cursor_color-command-samocad b) ;в этой глобальной переменной сохранена команда в том виде в котором она должна быть в списке ниже. Чтобы прочитать имя команды сначала выполните эту команду и введите в командной строке (!layer_color=cursor_color-command-samocad) (без скобок и с восклицательным знаком)
  (if (null (vl-position (car layer_color=cursor_color-command-samocad) (list "LAYER" "_LAYER" "-LAYER" "_-LAYER" "SETVAR" "_SETVAR" "_LAYERP" "LAYERP" "LAYMCUR"))); при необходимости вы можете добавить другие имена команд в этот список при выполнении которых будет меняться цвет курсора. Как получить имя команды смотрите выше

    (princ)
  (clayer_color=cursor_color-samocad)
    )

(princ)
  )

Особенности:
замечено, что реактор команд реагирует на клики по панели и на операции в диспетчере свойств слоев, поэтому убраны все реакторы системных переменных а так же реакторы объектов контролирующие состояние активного слоя. Оставлен только один реактор команд который реагирует на событие :vlr-commandended, все другие события этого реактора вызывают конфликты с командами и LISP-приложениями от сторонних разработчиков.

При щелканьи по панели слоев и окну диспетчера слоев выполняются команды _LAYER - при редактировании свойств слоя, _SETVAR - при смене слоя. Данное приложение реагирует только на эти команды. Вы можете добавить другие команды, на которые будет реагировать это приложение, в список команд (смотрите комментарии в коде).

Ну и в заключение:
Как выяснилось золотой середины тут нет. Даже этот код будет вызывать конфликты:
1. при выполнении некоторых LISP-приложений, которые выполняются во время работы команд автокада, в которых используются функции:
(command "_LAYER" .....
(vl-cmdf "_LAYER" .....
Редко кто использует такой способ работы со слоями

2. цвет курсора не будет меняться если LISP-приложения меняют цвет слоя без использования command и vl-cmdf.
В данной ситуации правильное LISP-приложение должно возвращать текущий слой на место после окончания своей работы. поэтому если вы пользуетесь правильными приложениями то сбой вам не грозит.

[skkkk]

В продолжение темы, для полной красоты картины, к смене цвета курсора по цвету слоя хотелось бы добавить смену цвета динамической размерной линии (dynamic dimension line), которую называют также "резиновой нитью" (rubber band). Тогда эта самая нить была бы тем же цветом, что и отрисовываемая, к примеру, полилиния.
Но кто подскажет, куда копать? В ActiveX такого свойства я найти так и не смог. Из похожего - только DimensionLineColor, но это о цвете размерных линий примитива "размер". В системных переменных - тоже тишина. Нашел ветку в реестре HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R18.1\ACAD-9001:419\Profiles\<<Unnamed Profile>>\Dynamic Dimension, но что с ней делать - не понимаю.
mmax что-то давненько не появлялся...

[mmax]

Сообщение от skkkk mmax что-то давненько не появлялся.

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

[skkkk]

Сообщение от skkkk Нашел ветку в реестре HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R18.1\ACAD-9001:419\Profiles\<<Unnamed Profile>>\Dynamic Dimension, но что с ней делать - не понимаю.

На досуге (спустя почти год) вдруг разобрался, что с ней делать, с этой веткой:

Код:

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

 (vl-registry-write  (strcat 
						"HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R18.1\\ACAD-9001:419\\Profiles\\" 
						(vla-get-ActiveProfile (vla-get-Profiles (vla-get-Preferences (vlax-get-acad-object)))) 
						"\\Dynamic Dimension"
					) 
					"Model Dynamic Dimension Line Color" 
					(vlax-variant-value 
								(vlax-variant-change-type 
									(vla-get-ModelCrosshairColor 
										(vla-get-Display (vla-get-Preferences 
															(vlax-get-acad-object)))) 3))
)

НО результатов это не принесло: значение параметра "Model Dynamic Dimension Line Color" в реестре при нажатии ""Обновить" меняется, но в автокаде цвет "резиновой нити" - нет. После перезагрузки AutoCAD не считывает значение из реестра, а записывает в реестр свое значение - тот цвет, что был у "резиновой нити" до перезагрузки. Значит, он берет значение НЕ из реестра? А откуда же тогда?

[357]

Как много неизведанного в анналах dwg.ru!!!
Спасибо!
С Новым годом и Рождеством!
===================================
В автокад_2012_рус работает нормально

[skkkk]

Сообщение от 357 В авитокад_2012_рус работает нормально

В 2011-м тоже работает, но почему-то всегда хочется большего
Как же заставить AutoCAD прочитать значение из реестра? Всю голову сломал себе...

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

Сообщение от skkkk Как же заставить AutoCAD прочитать значение из реестра?

По идее - только программно. Если лиспом, то vl-registry-read. Если через .NET, то опять же - Registry.ReadValue (точнее не скажу, пишу с планшета).

[skkkk]

Не совсем правильно выразился. Не прочитать, а обновить значение надо. Читать пробовал и через vl-registry-read и через getenv. Читать-то оно читает, возвращает мне значение цвета в комстроку или в переменную записывает, а толку? Нить как была белой, так и остается. При перезагрузке ACAD значение в реестре меняется опять на "бело"

[mmax]

skkkk, очень редкая программа реагирует на изменения реестра, если вообще такие существуют. Не думаю, что автокад входит в их число.
К реестру вообще можно не цепляться. Забудь про него.

Если мне не изменяет память, то цвет резиновой нити не меняется никогда и нигде. Нет в автокаде никаких опций менюшек настроек для смены цвета резиновой нити. Или я ошибаюсь?
Это говорит о том, что разработчики забыли включить это свойство в объектную модель. Может им письмо написать?

А пока мне кажется тут без дизассемблеров не обойтись

[skkkk]

Сообщение от mmax Нет в автокаде никаких опций менюшек настроек для смены цвета резиновой нити. Или я ошибаюсь?

mmax, вручную поменять-то можно. В Настройках, во вкладке Экран кнопка Цвета элемент Динамические размерные линии. Но хочется-то - программно. Блажь, конечно, но и еще живой, здоровый интерес. Твоей прогой пользуюсь уже, наверное, около четырех лет и до сих пор не нарадуюсь, когда до начала отрисовки примитивов я уже сразу знаю, какой слой активен без отрыва от курсора или командной строки, динамически менять цвет которой проблем не составило, времени разобраться ушло не более 15-ти минут в свое время. Спасибо за такой кайф тебе. Работает, кстати, чётенько, даже в багах не замечена последняя версия (только не переключает цвет при переключении слоя через панель свойств, но там и неудобно слои менять). До этого были конфликты с моими кодами, почему-то при наличии в чертеже блокированных слоев. Все хотел разобраться помню, но ты мне не дал, выпустив новую версию.

Сообщение от mmax очень редкая программа реагирует на изменения реестра, если вообще такие существуют

Это я уже понял. Но еще я накопал вот что. В Автокаде есть профили. Те, что на последней вкладке окна Настройки. Если профиль экспортировать, то мы получаем файл с расширением *.arg. Этот файл мы переносим на другой компьютер, там делаем импорт, - и настройки (в т.ч. цвет резиновой нити) уже на новом компе. Если открыть файл .arg блокнотом, то увидим, что первая строка в нем такова:

Код:

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

REGEDIT 4

Погуглив, я выяснил, что это признак файла, меняющего реестр. Там есть такие строки:

Код:

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

[HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R18.1\ACAD-9001:419\Profiles\MyProfile\Dynamic Dimension]
"Model Dynamic Dimension Line Color"=dword:0000FF00

Оставляю в файле только эту строку (ну и первую еще, конечно), сохраняю его с расширением .reg, запускаю файл - он меняет значение в реестре. То есть, можно предположить, что если мы экспортируем файл профиля на другой комп, то он прописывает в реестре того другого компа все настройки из компа-источника (ну на самом деле не все, а многие, в том числе - цвет резиновой нити). Почему-то у меня стойкое предчувствие, что надо каким-то образом заставить КАД прочитать и применить нужное значение реестра.
Если я создаю профиль "MyProfile2" с другим цветом нити и добавляю в твой код строки

Код:

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

 	(vla-put-ActiveProfile 
		(vla-get-Profiles 
			(vla-get-Preferences
				(vlax-get-acad-object))) "MyProfile2")

то цвет меняется. Но это не комильфо вариант, поскольку АКАД при этом подвисает на секунду-полторы, да и для каждого переключения слоя создавать новый профиль..... Костыль в общем. В комстроке он при этом пишет:

Файл адаптации загружен успешно. Группа адаптации: ACAD Файл адаптации загружен успешно. Группа адаптации: CUSTOM Файл адаптации загружен успешно. Группа адаптации: EXPRESS

Что ли грузит он это из файла CUI?
В общем, я пока в тупике...

[mmax]

skkkk, ну вот смотри.
В автокаде есть так называемая объектная модель. Разработчики автокада разрешили нам простым смертным просматривать и изменять свойства объектов объектной модели. При этом они к одним разрешили, к каким-то запретили, а к каким-то забыли открыть доступ.

Так вот.

Есть значит у некоего объекта объектной модели свойство ModelCrosshairColor с которым мы можем делать всё что нам вздумается.
А вот свойства ModelDynamicDimensionLineColor почему-то нету. Почему? Преднамеренно запретили? Случайно забыли?

Лично я, да и не только я, могу сказать одно. Если нету значит нету и нет смысла искать пути решения которых не существует.

Есть несколько выходов из данной ситуации:
1. Смириться
2. Завалить разработчиков автокада просьбами, а желательно требованиями, включения этих возможностей. При этом просьб и требований должно быть очень много потому, что ни одна коммерческая организация никогда не будет стараться угодить маленькой аудитории
3. Обратиться к программистам хакерам-ассемблерщикам. Они создадут приложение которое будет искать значение цвета резиновой нити в памяти приложения, в общем я даже сам не знаю чего они там смогут наворотить. Знаю одно - смогут, если захотят.