|
[code] (defun c:copypps (/ obj ppts)
;获取块的对象名
(setq obj (vlax-ename->vla-object (car (entsel)))
ppts nil
)
;判断是否为动态块,如果是,获取动态块属性
(if (setq obj (vlax-invoke obj 'GetDynamicBlockProperties))
(progn
(repeat (length obj)
;判断是否为只读属性,不是,则记录value值
(if (= (vlax-get (car obj) 'ReadOnly) 0)
(setq ppts (append ppts (list (vlax-get-property (car obj) 'Value))))
)
(setq obj (cdr obj))
)
;获取要修改属性动态块的属性表,该块必须与需复制块是同类块
(setq obj (vlax-invoke
(vlax-ename->vla-object (car (entsel)))
'GetDynamicBlockProperties
)
)
;将所有非只读属性,按第1个块的值进行修改
(while ppts
(if (= (vlax-get (car obj) 'ReadOnly) 0)
(progn
(vlax-put-property (car obj) 'Value (car ppts))
(setq obj (cdr obj)
ppts (cdr ppts)
)
)
(setq obj (cdr obj))
)
)
)
)
(princ)
)[/code] |
|