ADN Open CIS
Сообщество программистов Autodesk в СНГ

15/01/2015

Прозрачность в AutoCAD средствами lisp

Понадобилось тут "поиграться" с прозрачностью примитивов и слоев в AutoCAD. Это оказалось очень интересно и очень познавательно.

 

Прежде чем двигаться дальше, понадобится вспомнить, что само понятие прозрачности появилось в AutoCAD 2011. В AutoCAD 2009 (других версий просто нет) было понятие "растр либо прозрачен, либо нет", но установить прозрачность равной, например, 15%, было невозможно.

Итак, попробуем разобраться с установлением и изменением прозрачности:

  1. графических примитивов
  2. слоев

Конечно, идеальным был бы вариант установки прозрачности через ActiveX – тогда можно будет безболезненно менять прозрачность даже в неактивном документе. Но, к сожалению, тут не все просто.

Во-первых, возникает путаница с самим понятие "прозрачности" для растров и масок: этим примитивам можно установить свойство Transparency в :vlax-true, повторив ситуацию с более старыми версиями AutoCAD. А для "процентной" прозрачности используется EntityTransparency. То есть, казалось бы, можно нарисовать код установки прозрачности примитиву:

Код - Auto/Visual LISP: [Выделить]
  1. (vl-load-com)
  2. (defun set-ent-trans-vla (ent tr / err res)
  3.                          ;|
  4.     * Установка прозрачности для примитива
  5.     * Параметры вызова:
  6.     ent - vla-указатель на графический примитив. Не контролируется
  7.     tr - устанавливаемое значение прозрачности. Строка или целое число
  8.     |;
  9.   (cond
  10.     ((not (vlax-property-available-p ent 'entitytransparency t))
  11.      (princ "\nEntityTRansparency not available")
  12.      )
  13.     ((vl-catch-all-error-p
  14.        (setq err (vl-catch-all-apply
  15.                    (function
  16.                      (lambda ()
  17.                        (vla-put-entitytransparency ent tr)
  18.                        ) ;_ end of lambda
  19.                      ) ;_ end of function
  20.                    ) ;_ end of vl-catch-all-apply
  21.              ) ;_ end of setq
  22.        ) ;_ end of vl-catch-all-error-p
  23.      (princ (strcat "\nError set EntityTransparency property : "
  24.                     (vl-catch-all-error-message err)
  25.                     ) ;_ end of strcat
  26.             ) ;_ end of princ
  27.      )
  28.     (t
  29.      (vla-get-entitytransparency ent)
  30.      )
  31.     ) ;_ end of cond
  32.   ) ;_ end of defun

Но! Попробуем задать прозрачность "ByLayer" ("ПоСлою") или "ByBlock" ("ПоБлоку")! Что проще, казалось бы! Задаем в качестве tr прямо строку – "ByLayer", и все!

И все? Нет, не получится. Стоит код запустить в русской версии AutoCAD, и вместо "bylayer" придется передавать "послою". Сильно подозреваю, что при работе в других локализациях ситуация будет аналогичной. Конечно, от безысходности можно и такое использовать, но попробуем все же работу через ename-представления. Понятно, что это практически гарантированно отключает работу в неактивном документе и осложняет обработку блоков, но что поделать…

Внимательно посмотрев DXF Reference, мы можем увидеть новую необязательную группу: 440. Именно ее значение и регулирует значение прозрачности. Кажется, вот оно! Но несколько экспериментов по установке прозрачности "ПоСлою" у меня сначала потерпели полное фиаско. Спасибо Александру Ривилису, он подсказал решение. Всего-то надо установить в 440 группу значение 0, и она исчезает. Благодаря Евгению Елпанову, показавшему весьма оригинальный вариант на обсуждении исходной статьи, можно нарисовать код:

Код - Auto/Visual LISP: [Выделить]
  1. (defun set-ent-transparency (ent tr / eval_value)
  2.                             ;|
  3.     * Установка прозрачности ename-представлению примитива (не слоя!)
  4.     * Параметры вызова:
  5.     ent ename-указатель на графический примитив
  6.     tr устанавливаемое значение прозрачности. Строка или целое число (для нецелых дробная часть отсекается)
  7.     |;
  8.   (defun eval_value (value)
  9.     (+ 33554431 (fix (* (- 100 value) 2.56)))
  10.     ) ;_ end of defun
  11.   (_kpblc-ent-modify-autoregen
  12.     ent
  13.     440
  14.     (cond
  15.       ((and (/= (type tr) 'str) (> tr 90.)) (eval_value 90))
  16.       ((member (type tr) (list 'real 'int)) (eval_value (fix tr)))
  17.       ((and (= (type tr) 'str) (= (strcase tr) "BYBLOCK"))
  18.        16777216
  19.        )
  20.       (t 0)
  21.       ) ;_ end of cond
  22.     t
  23.     ) ;_ end of _kpblc-ent-modify-autoregen
  24.   ) ;_ end of defun

Используется функция модификации ename-примитива:

Код - Auto/Visual LISP: [Выделить]
  1. (defun _kpblc-ent-modify-autoregen
  2.                                    (ent bit value ext_regen / ent_list old_dxf new_dxf)
  3.                                    ;|
  4.     * Функция модификации указанного бита примитива
  5.     * Параметры вызова:
  6.     * entity - примитив, полученный через (entsel), (entlast) etc
  7.     * bit - dxf-код, значение которого надо установить
  8.     * value - новое значение
  9.     * regen - выполнять или нет регенерацию примитива сразу. t/ nil
  10.     * Примеры вызова:
  11.     (_kpblc-ent-modify-autoregen (entlast) 8 "0" t) ; перенести последний примитив на слой 0
  12.     (_kpblc-ent-modify-autoregen (entsel) 62 10 nil) ; установить выбранному примитиву цвет 10
  13.     * Возвращаемое значение:
  14.     * примитив с модифицированным dxf-списком. Примитив перерисовывается в
  15.     * зависимости от значения ключа ext_regen
  16.     |;
  17.   (if
  18.     (not
  19.       (and (or (= (strcase (cdr (assoc 0 (entget ent))) nil) "STYLE")
  20.                (= (strcase (cdr (assoc 0 (entget ent))) nil) "DIMSTYLE")
  21.                (= (strcase (cdr (assoc 0 (entget ent))) nil) "LAYER")
  22.                ) ;_ end of or
  23.            (= bit 100)
  24.            ) ;_ end of and
  25.       ) ;_ end of not
  26.      (progn (setq ent_list (entget ent)
  27.                   new_dxf  (cons bit
  28.                                  (if (and (= bit 62) (= (type value) 'str))
  29.                                    (if (= (strcase value) "BYLAYER")
  30.                                      256
  31.                                      0
  32.                                      ) ;_ end of if
  33.                                    value
  34.                                    ) ;_ end of if
  35.                                  ) ;_ end of cons
  36.                   ) ;_ end of setq
  37.             (if (not (equal new_dxf (setq old_dxf (assoc bit ent_list))))
  38.               (progn (entmod (if old_dxf
  39.                                (subst new_dxf old_dxf ent_list)
  40.                                (append ent_list (list new_dxf))
  41.                                ) ;_ end of if
  42.                              ) ;_ end of entmod
  43.                      (if ent_regen
  44.                        (entupd ent)
  45.                        (redraw ent)
  46.                        ) ;_ end of if
  47.                      ) ;_ end of progn
  48.               ) ;_ end of if
  49.             ) ;_ end of progn
  50.      ) ;_ end of if
  51.   ent
  52.   ) ;_ end of defun

Теперь можно передавать в функцию числа и строки "bylayer" и "byblock", не учитывая локализацию. Но, повторюсь, решение будет работать только с текущим документом. Хотя Евгений и предложил вариант

Код - Auto/Visual LISP: [Выделить]
  1. (entmod (entget (vlax-vla-object->ename ent)))

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

 

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

Попробуем сначала поработать с ActiveX-представлением слоя:

Код - Auto/Visual LISP: [Выделить]
  1. $ (vlax-dump-Object (vla-item (vla-get-layers (vla-get-ActiveDocument (vlax-get-acad-object))) "0") t)
  2. ; IAcadLayer: A logical grouping of data, similar to transparent acetate overlays on a drawing
  3. ; Property values:
  4. ;   Application (RO) = #
  5. ;   Description = ""
  6. ;   Document (RO) = #
  7. ;   Freeze = 0
  8. ;   Handle (RO) = "10"
  9. ;   HasExtensionDictionary (RO) = -1
  10. ;   LayerOn = -1
  11. ;   Linetype = "Continuous"
  12. ;   Lineweight = -3
  13. ;   Lock = 0
  14. ;   Material = "Global"
  15. ;   Name = "0"
  16. ;   ObjectID (RO) = 42
  17. ;   ObjectID32 (RO) = 42
  18. ;   ObjectName (RO) = "AcDbLayerTableRecord"
  19. ;   OwnerID (RO) = 43
  20. ;   OwnerID32 (RO) = 43
  21. ;   PlotStyleName = "Color_7"
  22. ;   Plottable = -1
  23. ;   TrueColor = #
  24. ;   Used (RO) = -1
  25. ;   ViewportDefault = 0
  26. ; Methods supported:
  27. ;   Delete ()
  28. ;   GetExtensionDictionary ()
  29. ;   GetXData (3)
  30. ;   SetXData (2)

Как видно, в свойствах слоя попросту отстутствует что бы то ни было, имеющее отношение к Transparency. Поэтому для исследования берем ename-представление слоя:

Код - Auto/Visual LISP: [Выделить]
  1. _$ (entget (tblobjname "layer" "0") '("*"))
  2. '((-1 . <entity name: 7ffffb03900>)
  3.   (0 . "LAYER")
  4.   (5 . "10")
  5.   (102 . "{ACAD_XDICTIONARY")
  6.   (360 . <entity name: 7ffffb05240>)
  7.   (102 . "}")
  8.   (330 . <entity name: 7ffffb03820>)
  9.   (100 . "AcDbSymbolTableRecord")
  10.   (100 . "AcDbLayerTableRecord")
  11.   (2 . "0")
  12.   (70 . 0)
  13.   (62 . 7)
  14.   (6 . "Continuous")
  15.   (290 . 1)
  16.   (370 . -3)
  17.   (390 . <entity name: 7ffffb038f0>)
  18.   (347 . <entity name: 7ffffb03ee0>)
  19.   (348 . <entity name: 0>)
  20.   )

(Возвращаемый результат приведен в удобочитаемый вид)

После этого вручную установим слою прозрачность и выполним повторный entget:

Код - Auto/Visual LISP: [Выделить]
  1. _$ (entget (tblobjname "layer" "0") '("*"))
  2. '((-1 . <entity name: 7ffffb03900>)
  3.   (0 . "LAYER")
  4.   (5 . "10")
  5.   (102 . "{ACAD_XDICTIONARY")
  6.   (360 . <entity name: 7ffffb05240>)
  7.   (102 . "}")
  8.   (330 . <entity name: 7ffffb03820>)
  9.   (100 . "AcDbSymbolTableRecord")
  10.   (100 . "AcDbLayerTableRecord")
  11.   (2 . "0")
  12.   (70 . 0)
  13.   (62 . 7)
  14.   (6 . "Continuous")
  15.   (290 . 1)
  16.   (370 . -3)
  17.   (390 . <entity name: 7ffffb038f0>)
  18.   (347 . <entity name: 7ffffb03ee0>)
  19.   (348 . <entity name: 0>)
  20.   (-3 ("AcCmTransparency" (1071 . 33554646)))
  21.   )

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

Код - Auto/Visual LISP: [Выделить]
  1. (regapp "AcCmTransparency")

После этого становится возможным внести соответствующие изменения в представление слоя. Код получается достаточно простой:

Код - Auto/Visual LISP: [Выделить]
  1. (vl-load-com)
  2. (defun layer-trans-vla (name tr / ent xd xt adoc err)
  3.   ;; name : имя слоя
  4.   ;; tr : прозрачность, число от 0 до 90
  5.   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  6.   (vla-add (vla-get-registeredapplications adoc)
  7.            "AcCmTransparency"
  8.            ) ;_ end of vla-add
  9.   (if (vl-catch-all-error-p
  10.         (setq err (vl-catch-all-apply
  11.                     (function
  12.                       (lambda ()
  13.                         (setq ent (vla-item (vla-get-layers adoc) name))
  14.                         (vla-getxdata ent "AcCmTransparency" 'xt 'xd)
  15.                         (setq xt (if xt
  16.                                    (vlax-safearray->list xt)
  17.                                    (list 1001 1071)
  18.                                    ) ;_ end of if
  19.                               xd (if xd
  20.                                    (mapcar (function vlax-variant-value)
  21.                                            (vlax-safearray->list xd)
  22.                                            ) ;_ end of mapcar
  23.                                    (list "AcCmTransparency" 0)
  24.                                    ) ;_ end of if
  25.                               xd (mapcar (function cons) xt xd)
  26.                               xd (subst (cons 1071
  27.                                               (+ 33554431
  28.                                                  (fix (* (- 100
  29.                                                             (fix (cond
  30.                                                                    ((> tr 90.) 90)
  31.                                                                    ((< tr 0.) 0)
  32.                                                                    (t tr)
  33.                                                                    ) ;_ end of cond
  34.                                                                  ) ;_ end of fix
  35.                                                             ) ;_ end of -
  36.                                                          2.56
  37.                                                          ) ;_ end of *
  38.                                                       ) ;_ end of fix
  39.                                                  ) ;_ end of +
  40.                                               ) ;_ end of cons
  41.                                         (assoc 1071 xd)
  42.                                         xd
  43.                                         ) ;_ end of subst
  44.                               ) ;_ end of setq
  45.                         (vla-setxdata
  46.                           ent
  47.                           (vlax-safearray-fill
  48.                             (vlax-make-safearray
  49.                               vlax-vbinteger
  50.                               (cons 0 (1- (length xd)))
  51.                               ) ;_ end of vlax-make-safearray
  52.                             (mapcar (function car) xd)
  53.                             ) ;_ end of vlax-safearray-fill
  54.                           (vlax-safearray-fill
  55.                             (vlax-make-safearray
  56.                               vlax-vbvariant
  57.                               (cons 0 (1- (length xd)))
  58.                               ) ;_ end of vlax-make-safearray
  59.                             (mapcar
  60.                               (function
  61.                                 (lambda (x)
  62.                                   (vlax-make-variant (cdr x))
  63.                                   ) ;_ end of LAMBDA
  64.                                 ) ;_ end of function
  65.                               xd
  66.                               ) ;_ end of mapcar
  67.                             ) ;_ end of vlax-safearray-fill
  68.                           ) ;_ end of vla-setxdata
  69.                         ) ;_ end of lambda
  70.                       ) ;_ end of function
  71.                     ) ;_ end of vl-catch-all-apply
  72.               ) ;_ end of setq
  73.         ) ;_ end of vl-catch-all-error-p
  74.     (princ
  75.       (strcat "\nError : " (vl-catch-all-error-message err))
  76.       ) ;_ end of princ
  77.     ) ;_ end of if
  78.   (command "_.regenall")
  79.   ) ;_ end of defun

И для варианта обработки ename-представления:

Код - Auto/Visual LISP: [Выделить]
  1. (defun layer-trans-ename (name tr / ent xd value)
  2.   ;; name : имя слоя
  3.   ;; tr : прозрачность, число от 0 до 90
  4.   (setq ent   (tblobjname "layer" name)
  5.         ent   (entget ent '("*"))
  6.         xd    (cdr (assoc -3 ent))
  7.         value (+ 33554431
  8.                  (fix (* (- 100
  9.                             (fix (cond
  10.                                    ((> tr 90.) 90)
  11.                                    ((< tr 0.) 0)
  12.                                    (t tr)
  13.                                    ) ;_ end of cond
  14.                                  ) ;_ end of fix
  15.                             ) ;_ end of -
  16.                          2.56
  17.                          ) ;_ end of *
  18.                       ) ;_ end of fix
  19.                  ) ;_ end of +
  20.         ) ;_ end of setq
  21.   (regapp "AcCmTransparency")
  22.   (setq xd
  23.          (if xd
  24.            (subst
  25.              (cons "AcCmTransparency"
  26.                    (subst (cons 1071 value)
  27.                           (assoc 1071 (cdr (assoc "AcCmTransparency" xd)))
  28.                           (cdr (assoc "AcCmTransparency" xd))
  29.                           ) ;_ end of subst
  30.                    ) ;_ end of cons
  31.              (assoc "AcCmTransparency" xd)
  32.              xd
  33.              ) ;_ end of subst
  34.            (cons "AcCmTransparency" (list (cons 1071 value)))
  35.            ) ;_ end of if
  36.         ) ;_ end of setq
  37.   (entmod (if (assoc -3 ent)
  38.             (subst (cons -3 xd) (assoc -3 ent) ent)
  39.             (append ent (list (list -3 xd)))
  40.             ) ;_ end of if
  41.           ) ;_ end of entmod
  42.   (entupd (cdr (assoc -1 ent)))
  43.   (command "_.regenall")
  44.   ) ;_ end of defun

Но при этом следует учитывать несколько дополнительных моментов:

  1. Открытый диспетчер слоев может не отобразить внесенные изменения, хотя слой изменится
  2. Модификация через ename приводит к моментальному изменению слоя и всех примитивов, ему принадлежащих. Обработка через vla к такому не приводит. Возможно, понадобится дополнительно проходить по всем примитивам, принадлежащим этому слою, и выполнять из обновление (я такого кода не рисовал)
  3. Повторное открытие файла с прозрачностью, измененной через ActiveX-представление, покажет корректные результаты
  4. Выполнение команды _.regen или _.regenall при обработке через ActiveX никакого видимого эффекта не дает

Остались совсем мелочи: получить установленное значение прозрачности примитива

Код - Auto/Visual LISP: [Выделить]
  1. (defun get-ent-trans-ename (ent / res)
  2.                            ;|
  3.     * Получение прозрачности слоя / примитива
  4.     * Параметры вызова:
  5.     ent - ename-указатель на примитив
  6.     |;
  7.   (cond
  8.     ((and (setq res (cdr (assoc 440 (entget ent))))
  9.           (= res 16777216)
  10.           ) ;_ end of and
  11.      "byblock"
  12.      )
  13.     ((or (setq res (cdr (assoc 440 (entget ent))))
  14.          (setq res (cdr
  15.                      (assoc
  16.                        1071
  17.                        (cdar
  18.                          (cdr
  19.                            (assoc -3
  20.                                   (entget ent '("AcCmTransparency"))
  21.                                   ) ;_ end of assoc
  22.                            ) ;_ end of cdr
  23.                          ) ;_ end of cdar
  24.                        ) ;_ end of assoc
  25.                      ) ;_ end of cdr
  26.                ) ;_ end of setq
  27.          ) ;_ end of or
  28.      (fix (- 100 (/ (logand res -33554433) 2.55)))
  29.      )
  30.     ) ;_ end of cond
  31.   ) ;_ end of defun
и то же самое, но для слоя:
Код - Auto/Visual LISP: [Выделить]
  1. (defun get-layer-trans-ename (name / ent res)
  2.                              ;|
  3. * Получение прозрачности для слоя.
  4. * Параметры вызова:
  5.   name имя слоя
  6.   Если прозрачность не устанавливалась, возвращается nil
  7. |;
  8.   (if (setq ent (tblobjname "layer" name))
  9.     (if (setq res
  10.                (cdr (assoc
  11.                       1071
  12.                       (cdadr (assoc -3 (entget ent '("AcCmTransparency"))))
  13.                       ) ;_ end of assoc
  14.                     ) ;_ end of cdr
  15.               ) ;_ end of setq
  16.       (fix (- 100 (/ (logand res -33554433) 2.55)))
  17.       ) ;_ end of if
  18.     ) ;_ end of if
  19.   ) ;_ end of defun

Авторы: Алексей Кулик; Евгений Елпанов; Александр Ривилис.

Использованы материалы: обсуждение на форуме adn-cis.org, статья на autolisp.ru, http://adndevblog.typepad.com/autocad/2013/04/get-and-set-layer-and-entity-transparency-using-lisp.html

Обсуждение: http://adn-cis.org/forum/index.php?topic=1778

Опубликовано 15.01.2015
Отредактировано 15.01.2015 в 14:15:31