Управление прозрачностью слоев с помощью LISP
Вопрос:
Почему не работает код? vla-get-transparency подсвечивается синим в VLIDE, но я получаю текст ошибки:
"Error: ActiveX Server returned the error: unknown name: Transparency"
- (vl-load-com)
- (setq ent (entsel))
- (if ent
- (progn
- (setq vla_obj_name (vlax-ename->vla-object (car ent))
- vla_obj_layer (vla-get-layer vla_obj_name)
- vla_act_doc (vla-get-activedocument (vlax-get-acad-object))
- layername (vla-item (vla-get-layers vla_act_doc) vla_obj_layer)
- ) ;_ end of setq
- (if (>= (atof (substr (getvar "acadver") 1 4)) 18.1)
- (setq proptran (vla-get-transparency layername))
- ) ;_ end of if
- ) ;_ end of progn
- ) ;_ end of if
Решение:
Свойства, к которым Вы получаете доступ через COM, базируются на API ActiveX.
Если посмотреть на свойство Transparency в справке по ActiveX, Вы увидите, что оно доступно только для примитивов класса AcadRasterImage и AcadWipeout.
Прозрачность примитивов (доступная для AutoCAD начиная с версии 2011) обеспечивается новыми интерфейсамм (IAcadEntity2) и называются как EntityTransparency. В случае со слоями, прямого доступа к прозрачности нет.
Но значение прозрачности можно вычислить, используя XData. Если такие данные не записаны, считается, что прозрачность равна 0%.
- ;; gets transparency in percentage
- (defun getlayertransparency (layername / layer transparency)
- (setq layer (tblobjname "LAYER" layername))
- ;; get the XData of AcCmTransparency
- (setq transparency
- (cdr (assoc 1071
- (cdar (cdr (assoc -3
- (entget layer '("AcCmTransparency"))
- ) ;_ end of assoc
- ) ;_ end of cdr
- ) ;_ end of cdar
- ) ;_ end of assoc
- ) ;_ end of cdr
- ) ;_ end of setq
- (if (= transparency nil)
- ;; if we did not get a value it must be the default 0%
- (setq transparency 0)
- ;; if we got a value then calculate from it
- (progn
- ;; get the lower byte of the value 0..255
- ;; (100%..0% in the AutoCAD user interface)
- (setq transparency (lsh (lsh transparency 24) -24))
- ;; convert the value to a percentage
- (setq transparency (fix (- 100 (/ transparency 2.55))))
- ) ;_ end of progn
- ) ;_ end of if
- ) ;_ end of defun
- (defun c:testget (/ ent layername transparency)
- (setq ent (car (entsel)))
- (setq layername (cdr (assoc 8 (entget ent))))
- (setq transparency (getlayertransparency layername))
- (princ transparency)
- (princ)
- ) ;_ end of defun
Установить прозрачность таким методом - устанавливая значения Xdata, - не представляется возможным. Но для этого можно использовать команду _.-layer:
- (defun c:testset (/ ent layername transparency)
- (setq ent (car (entsel)))
- (setq transparency (getint "\nTransparency value"))
- (setq layername (cdr (assoc 8 (entget ent))))
- (command "_.-LAYER" "_TR" transparency layername "")
- (princ)
- ) ;_ end of defun
Обсуждение: http://adn-cis.org/forum/index.php?topic=95.0
