(progn
; (vl-load-com) перед работой должна быть
выполнена команда
;
[vla] - VLA-объект
;
[str] - тип данных "строка"
;
[any] - строка или число
;
... - сокращение перечисления. например: (1 2 3 4 5) (1 ... 5)
;
в некоторых функциях требуется предварительно загрузить другие. На все случаи
жизни рекомендую загружать сразу все:
; LM:vl-getattributevalue LM:vl-setattributevalue
LM:vl-setattributevalues LM:vl-getattributes
LM:getdynpropvalue LM:setdynpropvalue
LM:getdynprops LM:setdynprops
LM:getdynpropallowedvalues LM:toggleflipstate
LM:getvisibilityparametername LM:getvisibilitystate
LM:SetVisibilityState
;; получить значение атрибута блока - Lee Mac
;; blk - [vla] блок
;; tag - [str] имя атрибута из этого
блока
;;
Результат: строка значения атрибута, иначе (такого атрибута нет) возвращает nil
(defun
LM:vl-getattributevalue ( blk
tag )
(setq tag (strcase
tag))
(vl-some
'(lambda ( att ) (if (= tag (strcase
(vla-get-tagstring att))) (vla-get-textstring att)))
(vlax-invoke
blk 'getattributes)
)
)
;; записать значение атрибута блока - Lee Mac
;; blk - [vla] блок
;; tag - [str] имя атрибута из этого
блока
;; val - [str] новое значение
;;
Результат: [str] значение атрибута обновится, иначе
(такого атрибута нет) возвращает nil
(defun
LM:vl-setattributevalue ( blk
tag val )
(setq tag (strcase
tag))
(vl-some
'(lambda ( att )
(if (= tag (strcase (vla-get-tagstring att)))
(progn (vla-put-textstring att val) val)
)
)
(vlax-invoke
blk 'getattributes)
)
)
;; пакетная запись значение атрибутов блока - Lee Mac
;; blk - [vla] блок
;; lst - [lst]
список вида: ((<имя_атрибута> . <новое_значение>)
... (<имя_атрибута> .
<новое_значение>))
;; Результат: nil
(defun LM:vl-setattributevalues
( blk lst / itm )
(foreach att
(vlax-invoke blk 'getattributes)
(if (setq itm
(assoc (vla-get-tagstring att) lst))
(vla-put-textstring att (cdr itm))
)
)
)
;; пакетное чтение значений атрибутов блока - Lee Mac
;; blk - [vla] блок
;;
Результат: [lst] список вида ((<имя_атрибута> . <значение>) ... (<имя_атрибута> .
<значение>))
(defun
LM:vl-getattributes ( blk )
(mapcar
'(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att)))
(vlax-invoke blk 'getattributes)
)
)
;; получить значение свойства из динамического
блока - Lee Mac
;; blk - [vla] блок
;; prp - [str] имя свойства из динамического блока
;; Результат: может быть разным, в зависимости
от свойства. Строка в виде текста или строка в виде цифры. Для видимости это
название видимости, а для таблицы свойств это номер строки свойства (начиная с
0 включительно)
(defun LM:getdynpropvalue (blk prp)
(setq prp
(strcase prp))
(vl-some
'(lambda (x)
(if (= prp (strcase
(vla-get-propertyname x)))
(vlax-get x 'value)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
;; установить значение свойства динамического
блока - Lee Mac
;; blk - [vla] блок
;; prp - [str] имя свойства из динамического блока
;; val - [any] новое значение
;; Результат: [any]
свойство изменится, иначе (если такого свойства нет или значение не применимо) nil
(defun LM:setdynpropvalue (blk prp val)
(setq prp
(strcase prp))
(vl-some
'(lambda (x)
(if (= prp (strcase (vla-get-propertyname x)))
(progn
(vla-put-value
x
(vlax-make-variant
val
(vlax-variant-type (vla-get-value x))
)
)
(cond
(val)
(t)
)
)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
;; пакетное получение свойств динамического
блока -
Lee Mac
;; blk - [vla] блок
;; Результат: [lst]
список вида ((<свойство> . <значение>) ... (<свойство> . <значнеие>))
(defun LM:getdynprops (blk)
(mapcar
'(lambda (x)
(cons (vla-get-propertyname x) (vlax-get x 'value))
)
(vlax-invoke
blk 'getdynamicblockproperties)
)
)
;; пакетная запись свойств динамического блока
- Lee Mac
;; blk - [vla] блок
;; lst - [lst] список вида ((<свойство> . <значение>) ...
(<свойство> . <значнеие>))
;; Результат: nil
(defun LM:setdynprops (blk lst / itm)
(setq
lst
(mapcar '(lambda (x) (cons (strcase
(car x)) (cdr x))) lst)
)
(foreach x (vlax-invoke
blk 'getdynamicblockproperties)
(if (setq itm (assoc
(strcase (vla-get-propertyname x)) lst))
(vla-put-value
x
(vlax-make-variant
(cdr itm)
(vlax-variant-type
(vla-get-value x))
)
)
)
)
)
;; Получить допустимые значения свойства
динамического блока - Lee Mac
;; blk - [vla] блок
;; prp - [str] имя свойтва
;; Результат: [lst]
Список допустимых значений для свойства, иначе nil,
если нет ограничений
(defun LM:getdynpropallowedvalues
(blk prp)
(setq prp
(strcase prp))
(vl-some
'(lambda (x)
(if (= prp (strcase
(vla-get-propertyname x)))
(vlax-get x 'allowedvalues)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
;; переключение отражение блока
- Lee Mac
;; Toggles the Flip
parameter if present in a supplied Dynamic Block.
;; blk - [vla] блок
;; Return: [int] отражение блока меняется на противоположную
(defun LM:toggleflipstate (blk)
(vl-some
'(lambda (prp / rtn)
(if (equal '(0 1) (vlax-get prp 'allowedvalues))
(progn
(vla-put-value
prp
(vlax-make-variant
(setq
rtn (- 1 (vlax-get prp 'value)))
vlax-vbinteger
)
)
rtn
)
)
)
(vlax-invoke blk 'getdynamicblockproperties)
)
)
;; получение имени параметра видимости блока - Lee Mac
;; Результат the name of the Visibility Parameter of a
Dynamic Block (if present)
;; blk - [vla] блок
;; Результат: [str]
имя параметра видимости блока, иначе (если нет параметра) nil
(defun LM:getvisibilityparametername
(blk / vis)
(if
(and
(vlax-property-available-p
blk 'effectivename)
(setq blk
(vla-item
(vla-get-blocks (vla-get-document blk))
(vla-get-effectivename blk)
)
)
(= :vlax-true (vla-get-isdynamicblock blk))
(= :vlax-true (vla-get-hasextensiondictionary blk))
(setq vis
(vl-some
'(lambda (pair)
(if
(and
(=
360 (car pair))
(=
"BLOCKVISIBILITYPARAMETER"
(cdr
(assoc 0 (entget (cdr pair))))
)
)
(cdr
pair)
)
)
(dictsearch
(vlax-vla-object->ename (vla-getextensiondictionary
blk))
"ACAD_ENHANCEDBLOCK"
)
)
)
)
(cdr
(assoc 301 (entget vis)))
)
)
;; получение значение текущей видимости блока - Lee Mac
;; blk - [vla] блок
;; Результат: [str]
имя текущей видимости, иначе (есил нет параметра
видимостей) nil
(defun LM:getvisibilitystate
(blk)
(LM:getdynpropvalue blk (LM:getvisibilityparametername
blk))
)
;; установить видимость в динамическом блоке - Lee Mac
;; blk - [vla] блок
;; val - [str] новая видимость
;; Результат: [str]
имя установленной видимости, иначе (нет параемтера
или имени видимости) nil
(defun LM:SetVisibilityState
(blk val / vis)
(if
(and
(setq vis (LM:getvisibilityparametername
blk))
(member (strcase val)
(mapcar 'strcase
(LM:getdynpropallowedvalues blk
vis))
)
)
(LM:setdynpropvalue
blk vis val)
)
)
)