本帖最后由 和尚777 于 2023-4-15 09:58 编辑
向块中增加属性后再修改 不会破坏原块属性,无属性的直接增加
新发现一个函数acet-attsync,可代替command- (defun C:tt (/ b blkref bname doc ent i list0 list1 num ss) ;向块中添加属性
- (setq doc(vla-get-ActiveDocument(vlax-get-acad-object)))
- ;"和尚777"
- (if(and (setq bName (cdr(assoc 2 (entget (car(entsel))))))
- (setq b(vla-item (vla-get-Blocks doc) bName)))
- (progn
- (vla-AddAttribute b
- 50 4 "表示长度" (vlax-3D-point '(0 0 0)) "c" "777")
- (acet-attsync bName);(command "attsync" "n" bname)
- (if(setq ss(ssget "x"(list'(0 . "insert")(cons 2 bName))))
- (progn
- (setq i -1)
- (while(setq ent(ssname ss (setq i(1+ i))))
- (if (= (vla-Get-ObjectName (setq blkref (vlax-Ename->vla-Object ent))) "AcDbBlockReference")
- (if (vla-Get-HasAttributes blkref)
- (progn (setq liST0 (vlax-safearray->list (vlax-variant-value (vla-GetAttributes blkref))))
- (setq liST1 (mapcar 'vla-Get-TagString liST0))
- (setq num (vl-position "c" list1))
- (vla-put-TextString (nth num liST0) (itoa i))
- )
- )
- )
- )
- )
- )
- )
- )(princ)
- )
|