查找和替换属性值
hai all公司我是一名大学生，也是一名兼职工人
请帮助我使用Auto cad lisp程序，该程序可以查找并替换autocad属性中的属性值
例如，如果不同属性的值为CAXXXXYYYY001、CAXXXXYYYY002、CAXXXXYYYY003等
然后
我想用字母“D”替换第二个字母“C”
因此，它成为
CDXXXXYYYY001、CDXXXXYY002、CDXXXXYYYY003等
已经有一个了。exe程序，但系统安全不允许我安装程序到我的系统，这是我急需一个lisp
请帮忙
提前感谢
梅林·梅纳奥
这只适用于以“CA”开头的属性
对于其他情况，更改代码内的属性模式
;; cav.lsp
;; change attribute values by given pattern
(defun C:CAV (/ *error* adoc atts cnt layer locked newvalue oldvalue)
;; error trapping function
(defun *error* (msg)
(if (and msg
(vl-position
msg
'("console break"
"Function cancelled"
"quit / exit abort"
)
)
)
(princ (strcat "Error >>> " (princ msg)))
(princ msg)
)
(vla-endundomark
(vla-get-activedocument
(vlax-get-acad-object))
)
)
(setq adoc (vla-get-activedocument
(vlax-get-acad-object))
)
(vla-startundomark adoc)
(setq cnt 0)
;; loop through all layouts
(vlax-for layout(vla-get-layouts adoc)
(vlax-for obj(vla-get-block layout)
(if (and (eq "AcDbBlockReference" (vla-get-objectname obj))
(eq :vlax-true (vla-get-hasattributes obj)))
(progn
(setq layer (vla-item (vla-get-layers adoc) (vla-get-layer obj)))
(if (eq :vlax-true (vla-get-lock layer))
(progn
(setq locked (cons (vla-get-layer obj) locked))
(vla-put-lock layer :vlax-false)) ;<--unlock layer if locked
)
(setq atts (vlax-invoke obj 'GetAttributes))
(foreach att atts
(setq oldvalue (vla-get-textstring att)) ;<--get attribute value
(if (wcmatch oldvalue "CA*") ;<-- CA* is attribute pattern, change to suit
(progn
(setq cnt (1+ cnt)) ;<--increment counter
(setq newvalue (vl-string-subst "D" "A" oldvalue)) ;<--change patterns(letters) to suit
(vla-put-textstring att newvalue) ;<--set new attribute value
(vla-update att)
(princ (strcat "\n\t\t\t\t\>> Attribute value "
(vl-princ-to-string oldvalue)
" changed on: "
(vl-princ-to-string newvalue)))
)
)
)
(vla-update obj)
)
)
)
)
;; turn all layers state back
(if locked
(foreach layerlocked
(vla-put-lock
(vla-item (vla-get-layers adoc) layer)
:vlax-true))
)
(setq locked nil)
(alert (strcat "Done. Processed "
(itoa cnt)
" attributes on all layouts"))
(*error* nil)
(princ)
)
(prompt"\n\t\t\t\tType CAV to change attributes by pattern")
(princ)
(vl-load-com);_end of code
李，你永远不会停止惊叹，完美！！！我绝对欠你一到四品脱。下次我在伦敦或周围的时候，我会让你知道！
不客气，Jaylo-随时都可以，伙计 Give this a shot:
(defun c:attupd (/ i ss ent att) (vl-load-com) (or *def_com* (setq *def_com* "NORTH")) ;; First-time Default (if (and (setq i -1 ss (ssget "_:L" '((0 . "INSERT") (66 . 1)))) (not (initget "NORTH SOUTH EAST WEST")) (setq *def_com* (cond ((getkword (strcat "\nNorth/South/East/West?: "))) (*def_com*)))) (while (setq ent (ssname ss (setq i (1+ i)))) (foreach att (vlax-invoke (vlax-ename->vla-object ent) 'GetAttributes) (and (eq "COMMENTS" (strcase (vla-get-TagString att))) (vla-put-TextString att (strcat "LKG. " *def_com* (vla-get-TextString att)))))))(princ)) Lee Mac you never cease to amaze, PERFECT!!!I definitely owe you a pint or 4.Next time im in or around London ill let ya know!
You're welcome Jaylo - anytime mate
页:
[1]