请问怎样读取属性块中的数据 并修改

NANBIAO

回答《请问怎样读取属性块中的数据》之高手，请问如何在此基础上修改属性值，我试过ENTMOD，ENTUPD屏幕都没改，但改动属性值中的提示却可以，

王咣生

我写过Visual Lisp的代码,明天上传.

王咣生

;;actj2k是块名，L1,L2等是属性标记(Tag)
(vl-load-com) (defun c:mychange ( / ss item blk)
(if (setq ss (vlex-SelectOnScreen-Filter (list 0 2)(list "INSERT" "actj2tk")))
(vlax-For item ss
(if (equal (type item) 'vla-object)
(setq blk (vlax-vla-object->Ename item))
(setq blk item)
)
(vlex-ChangeAttributes (list blk (cons "L1" "a")))
(vlex-ChangeAttributes (list blk (cons "L2" "b")))
(vlex-ChangeAttributes (list blk (cons "R3" "c")))
(terpri)
)
)
) (defun vlex-SSetExists-p (Name)
(not
(vl-Catch-All-Error-p
(vl-Catch-All-Apply
'vla-Item
(list (vla-Get-SelectionSets (vlex-ActiveDocument)) Name)
)
)
)
) (defun vlex-SelectOnScreen-Filter (GroupCodes FilterLists / ss)
(if (vlex-SSetExists-p "%TEMP_SET")
(vla-Delete
(vla-Item
(vla-get-SelectionSets (vlex-ActiveDocument))
"%TEMP_SET"
)
)
)
(setq ss
(vla-Add
(vla-get-SelectionSets (vlex-ActiveDocument))
"%TEMP_SET"
)
)
(vla-Select ss
ACSelectionSetAll nil nil
(vlex-IntList->VarArray GroupCodes)
(vlex-VarList->VarArray FilterLists)
)
ss
) (defun vlex-VarList->VarArray (aList)
(vlax-SafeArray-Fill
(vlax-Make-SafeArray
vlax-vbVariant ;(12) Variant
(cons 0 (- (length aList) 1))
)
aList
)
) (defun vlex-IntList->VarArray (aList)
(vlax-SafeArray-Fill
(vlax-Make-SafeArray
vlax-vbInteger ; (2) Integer
(cons 0 (- (length aList) 1))
)
aList
)
) (defun vlex-ChangeAttributes (lst / blk item atts)
(setq blk (vlax-Ename->vla-Object (car lst))
lst (cdr lst)
)
(if (= (vla-Get-HasAttributes blk) :vlax-true)
(progn
(setq atts (vlax-SafeArray->list
(vlax-Variant-Value (vla-GetAttributes blk))
)
); setq
(foreach item lst
(mapcar
'(lambda (x)
(if (= (strcase (car item)) (strcase (vla-Get-TagString x)))
(vla-Put-TextString x (cdr item))
); endif
)
atts
); mapcar
); foreach
(vla-Update blk)
)
); endif
) (defun vlex-ActiveDocument ()
(vla-Get-ActiveDocument (vlax-get-acad-object))
)

NANBIAO

(Defun Si (/ slist sname etbll)
(setq sliST (entget (ssname (ssget) 0)))
(SetQ sname (Cdr (Assoc 2 sliST)) sli (TblSearch "BLOCK" sname) )
(SetQ sname (Cdr (Assoc -2 sliST)))
(While sname
(setq slist (entget sname))
(if (/= (cdr (assoc 3 slist)) nil)
(progn

(SETQ slist(SUBST (cons 1 "bbbb") (assoc 1 slist) slist))

(ENTMOD slist)
(entupd sname)
)
)
(setq sname (EntNext sname))
)
;(entupd sli)
(princ)
)
屏幕没刷新