重置块的一个实例
你好使用同步属性（attsync），将图形中该块的所有引用的所有属性重置为默认值。
任何人都有一个lisp，可以将一个块实例的所有属性重置为默认属性（包括属性）？
lisp只应重置拾取的实例或多个拾取的引用。
非常感谢。 重新插入是一种选择吗？
是否要保留原始的X/Y/Z块比例和旋转？
或者只想将属性值重置为其默认值？ 重新插入将破坏属性的值。
我只需要将属性重置为默认值。
比如旋转、高度、可见性等等。
当做 对不起，我忘了张贴你问题的答案。
是的，我想保留原始的X/Y/Z块比例和旋转。 以下是一种重新插入方法：
(defun C:test ( / SS spc i nm e1 o1 enx1 e2 o2 enx2 L blks )
(and
(princ "\nSelect Attributed blocks: ")
(setq SS (ssget "_:L" '((0 . "INSERT")(66 . 1))))
(setq spc (getvar 'ctab))
(repeat (setq i (sslength SS))
(and
(setq o1 (vlax-ename->vla-object (setq e1 (ssname SS (setq i (1- i))))))
(VanillaINSERT (vlax-get o1 'InsertionPoint) (setq nm (vlax-get o1 'EffectiveName)) spc)
(progn
(foreach x
(mapcar 'list
(vlax-invoke o1 'GetAttributes)
(vlax-invoke (setq o2 (vlax-ename->vla-object (setq e2 (entlast)))) 'GetAttributes)
)
(apply (function (lambda (a b) (vla-put-TextString b (vla-get-TextString a)))) x)
)
(mapcar 'set '(enx1 enx2) (mapcar 'entget (list e1 e2)))
(foreach x '(8 41 42 43 50)
(setq enx2 (subst (assoc x enx1) (assoc x enx2) enx2))
)
(entmod enx2)
(and
(eq (vla-get-IsDynamicBLock o1) :vlax-true)
(setq L (vlax-invoke o1 'GetDynamicBlockProperties))
(foreach x (mapcar 'list L (vlax-invoke o2 'GetDynamicBlockProperties))
(vl-catch-all-apply
(function
(lambda (a b)
(vla-put-Value b (vla-get-Value a))
); lambda
); function
x
)
); foreach
); and
(entdel e1) (setq blks (cons (if (not (member nm blks)) nm) blks)) T
); progn
); and
); repeat
(and (setq blks (vl-remove 'nil blks))
(setvar 'cmdecho 0)
(foreach x (vl-remove 'nil blks) (command "_.ATTSYNC" "_N" x) )
(setvar 'cmdecho 1)
)
); and
(princ)
); defun
(vl-load-com) (princ)
; (VanillaINSERT (getpoint) "VLD_Tag" (getvar 'ctab))
(defun VanillaINSERT ( p nm spc / GetBlkAttDefProps atts r )
; '(87 114 105 116 116 101 110 32 66 121 32 71 114 114 114)
(setq GetBlkAttDefProps
(lambda ( bnm / e enx typ L )
(and
(setq e (tblobjname "BLOCK" bnm))
(= 2 (logand 2 (cdr (assoc 70 (setq enx (entget e))))))
(setq e (cdr (assoc -2 enx)))
(while (and e (setq enx (entget e)) (/= "SEQEND" (setq typ (cdr (assoc 0 enx)))))
(if (= "ATTDEF" typ) (setq L (cons (vl-remove-if-not (function (lambda (x) (member (car x) '(1 2 3 7 10 11 40)))) enx) L)))
(setq e (entnext e))
); while
); and
(reverse L)
); lambda
); setq GetBlkAttDefProps
(cond
( (tblsearch "BLOCK" nm) (setq atts (GetBlkAttDefProps nm))
(if
(setq r
(mapcar 'entmake
(append
(list
(append
'((0 . "INSERT")(100 . "AcDbEntity")(67 . 0)) (list (cons 410 spc)) (list (cons 8 (getvar 'clayer))) '((100 . "AcDbBlockReference"))
(list (cons 66 (if atts 1 0)) (cons 2 nm) (cons 10 p))
'((41 . 1.)(42 . 1.)(43 . 1.)(50 . 0.0)(70 . 0)(71 . 0)(44 . 0.0)(45 . 0.0)(210 0.0 0.0 1.0))
); append
); list
(if atts
(mapcar
(function
(lambda (x / pt10 pt11 )
(setq pt10 (mapcar '+ p (cdr (assoc 10 x))))
(setq pt11 (mapcar '+ p (cdr (assoc 11 x))))
(append
'((0 . "ATTRIB")(100 . "AcDbEntity")(67 . 0))
(list (cons 410 spc))
'((8 . "0"))
'((100 . "AcDbText"))
(list (cons 10 pt10))
(list (assoc 40 x))
(list (assoc 1 x))
'((50 . 0.0)(41 . 1.0)(51 . 0.0))
(list (cons 7 (cond ((cdr (assoc 7 x))) ("Standard"))))
'((71 . 0)(72 . 1))
(list (cons 11 pt11))
'((210 0.0 0.0 1.0)(100 . "AcDbAttribute")(280 . 0)) (list (assoc 2 x)) '((70 . 0)(73 . 0)(74 . 2)(280 . 1))
); append
); lambda (x)
); function
atts
); mapcar
); if atts
(list (append '((0 . "SEQEND")(100 . "AcDbEntity")(67 . 0)) (list (cons 410 spc)) '((8 . "0")) ))
); append
); mapcar
); setq r
( (lambda ( c / ) (setvar 'cmdecho 0) (if acet-attsync (acet-attsync nm) (vl-cmdf "_.ATTSYNC" "_N" nm)) (setvar 'cmdecho c)) (getvar 'cmdecho) )
); if
r
); (tblsearch "BLOCK" nm)
); cond
); defun VanillaINSERT
非常感谢你。
效果很好！！ 不用担心，我只是在测试VanillaINSERT函数——这里有一个更简洁、更可靠的函数：
(defun C:test ( / SS spc f L i o1 tmpL o2 blks )
(and '(87 114 105 116 116 101 110 32 66 121 32 71 114 114 114)
(setq SS (ssget "_:L" '((0 . "INSERT"))))
(setq spc (vla-get-Block (vla-get-ActiveLayout (vla-get-ActiveDocument (vlax-get-acad-object)))))
(setq f (lambda (prp s d) (setq prp (vl-prin1-to-string prp)) ((eval (read (strcat "vla-put-" prp))) d ((eval (read (strcat "vla-get-" prp))) s))))
(setq L '(HasAttributes IsDynamicBlock Layer InsertionPoint EffectiveName XScaleFactor YScaleFactor ZScaleFactor Rotation))
(progn
(repeat (setq i (sslength SS))
(and
(setq o1 (vlax-ename->vla-object (ssname SS (setq i (1- i)))))
(setq tmpL (mapcar (function (lambda (x) (vlax-get o1 x))) L))
(setq o2 (apply 'vlax-invoke (cons spc (cons 'InsertBlock (cdddr tmpL)))))
(progn
(vlax-put o2 'Layer (caddr tmpL))
(and (= -1 (car tmpL)) (setq blks (cons (nth 4 tmpL) blks))
(foreach x (apply 'mapcar (cons 'list (mapcar (function (lambda (x) (vlax-invoke x 'GetAttributes))) (list o1 o2))))
(apply 'f (cons 'TextString x))
)
); and
(and (= -1 (cadr tmpL))
(foreach x (apply 'mapcar (cons 'list (mapcar (function (lambda (x) (vlax-invoke x 'GetDynamicBlockProperties))) (list o1 o2))))
(vl-catch-all-apply 'f (cons 'Value x))
)
); and
(vla-Delete o1)
); progn
); and
); repeat
(and blks
(
(lambda ( / used )
(setvar 'cmdecho 0)
(foreach x blks
(cond
( (member x used) )
( (setq used (cons x used)) (command "_.ATTSYNC" "_N" x) )
); cond
); foreach
(setvar 'cmdecho 1)
); lambda
)
); and blks
); progn
); and
(princ)
); defun C:test
(vl-load-com) (princ) @Grrr：
为了使代码真正可靠，您必须考虑更多属性：颜色、线型、法线。。。
为什么调用ATTSYNC命令？
我同意，也许一个简单的解决方案是利用原子族来提取所需的属性：
(setq prps
(apply 'append
(mapcar
(function
(lambda (x / prp)
(if
(and
(wcmatch x "VLA-PUT-*")
(vlax-property-available-p o (setq prp (substr x 9)))
)
(list prp)
)
)
)
(atoms-family 1)
)
)
)
Hm看起来是多余的，我被我的手动测试误导了（将属性块旋转45度并应用不同的x/y/z比例），
最后忘了我是在创建新的引用，而不是操纵实际的。。。 下面是另一个例子：
http://www.theswamp.org/index.php?topic=48770.msg538705#msg538705
页:
[1]
2