更改属性的脚本
嘿伙计们，我想知道是否有一个脚本可以用来更改实践属性的某个值。
这是因为我需要经常一次更改多个图形上图形的修订值，如果有脚本或Lisp或其他方法来执行此操作，而不是打开我需要更改的所有图形，则会容易得多
干杯
我通过VBA为一个内部工具实现了这一点。不能发布任何代码（雇佣协议禁止），但我可以说这并不难实现 可以通过VBA调用LISP吗？
因为编写LISP来完成这样的任务非常简单，但显然LISP无法打开和关闭图形。 我可以在VBA中给出它，如下所示
Public Sub issued_for_construction()
' This Updates the Issued for construction and sets rev 0
Dim SS As AcadSelectionSet
Dim Count As Integer
Dim FilterDXFCode(1) As Integer
Dim FilterDXFVal(1) As Variant
Dim attribs As Variant
Dim BLOCK_NAME As String
On Error Resume Next
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "DA1DRTXT"
BLOCK_NAME = "DA1DRTXT"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
attribs = SS.Item(Cntr).GetAttributes
attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
attribs(3).TextString = "0"
attribs(0).Update
attribs(3).Update
Next Cntr
ThisDrawing.SelectionSets.Item("issued").Delete
'DO AGAIN FOR REVTABLE
'DATE
'Dim MyDate
'MyDate = Date
Call DashDate
FilterDXFCode(1) = 2
FilterDXFVal(1) = "REVTABLE"
BLOCK_NAME = "REVTABLE"
Set SS = ThisDrawing.SelectionSets.Add("revs")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
attribs = SS.Item(Cntr).GetAttributes
attribs(0).TextString = "0"
attribs(1).TextString = DashDate
attribs(2).TextString = "ISSUED FOR CONSTRUCTION"
attribs(0).Update
attribs(1).Update
attribs(2).Update
Next Cntr
ThisDrawing.SelectionSets.Item("revs").Delete
MsgBox "Drawing now changed to Issued for Construction"
End Sub
只需在菜单等中执行以下操作，或用lisp键敲击，说“I0”
^C^C（vl vbaload“已发布.dvb”）（vl vbarun“已发布用于施工”）
抱歉差点忘了剧本
打开dwg1（vl vbaload“issued.dvb”）（vl vbarun“issued\u for_construction”）关闭y
打开dwg2（vl vbarun“issued_for_construction”）关闭y
打开dwg3（vl vbarun“issued_for_construction”）关闭y 这是怎么回事。它如何找到正确的属性来添加值？ 这是ASMI的一个非常好的例子。
;; ==================================================================== ;;
;; ;;
;;CHAT.LSP - The program for change attributes with the chosen ;;
;; value in dynamic and ordinary blocks. ;;
;; ;;
;; ==================================================================== ;;
;; ;;
;;Command(s) to call: CHAT ;;
;; ;;
;;Pick sample attribute for filter creation, and after that select ;;
;;blocks containing this attribute. The program will request to enter ;;
;;replaced value (the specified attribute by default) and if ;;
;;attributes are found will highlight blocks and will request ;;
;;new value. ;;
;; ;;
;; ==================================================================== ;;
;; ;;
;;THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY ;;
;;MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR ;;
;;PARTS OF IT ABSOLUTELY FREE. ;;
;; ;;
;;THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS AND ;;
;;SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY ;;
;;OR FITNESS FOR A PARTICULAR USE. ;;
;; ;;
;; ==================================================================== ;;
;; ;;
;;V1.1, 18th Aug 2008, Riga, Latvia ;;
;;© Aleksandr Smirnov (ASMI) ;;
;;For AutoCAD 2000 - 2008 (isn't tested in a next versions) ;;
;; ;;
;; http://www.asmitools.com ;;
;; ;;
;; ==================================================================== ;;
(defun c:chat(/ cAtt cBl cTag efNm sStr nLst fSet oVal fLst exLst
fStr actDoc atLst pLst cFrom cTo sucCnt errCnt wSet)
(vl-load-com)
(if
(and
(setq cAtt(nentsel "\nPick sample attribute > "))
(= "ATTRIB"(cdr(assoc 0(entget(car cAtt)))))
); end and
(progn
(setq actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
cBl(vla-ObjectIDtoObject actDoc
(vla-get-OwnerID
(setq cAtt
(vlax-ename->vla-object(car cAtt)))))
cTag(vla-get-TagString cAtt)
sucCnt 0 errCnt 0
wSet(ssadd)
); end setq
(if(vlax-property-available-p cBl 'EffectiveName)
(progn
(setq fStr(vla-get-EffectiveName cBl)
nLst(mapcar 'vla-get-Name
(vl-remove-if-not
(function(lambda(x)
(equal fStr(vla-get-EffectiveName x))))
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex
(ssget "_X" '((0 . "INSERT")
(66 . 1)(2 . "`*U*,")))))))))
); end setq
(foreach n nLst
(if(not(member n exLst))
(setq fStr(strcat "`" n "*," fStr)
exLst(cons n exLst)
); end setq
); end if
); end foreach
(setq fLst(list '(0 . "INSERT")(cons 2 fStr)))
); end progn
(setq fLst(list '(0 . "INSERT")(cons 2(vla-getName cBl))))
); end if
(princ "\n<<< Select blocks >>> ")
(if(setq fSet(ssget fLst))
(progn
(princ(strcat "\n" (itoa(sslength fSet)) " block(s) found. "))
(setq cFrom(getstring T
(strcat "\nChange from <"
(setq oVal(vla-get-TextString cAtt)) ">: ")))
(if(= "" cFrom)(setq cFrom oVal))
(foreach b(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex fSet))))
(setq atLst(vlax-safearray->list
(vlax-variant-value
(vla-GetAttributes b))))
(foreach at atLst
(if(and
(equal(vla-get-TagString at)cTag)
(equal(vla-get-TextString at)cFrom)
); end and
(progn
(setq pLst(cons at pLst))
(ssadd(vlax-vla-object->ename b)wSet)
); end progn
); end if
); end foreacn
); end foreach
(if(/= 0(length pLst))
(progn
(princ
(strcat "\n" (itoa(length pLst)) " attribute(s) found. ")
); end princ
(sssetfirst nil wSet)
(if
(and
(setq cTo(getstring T "\nChange to: "))
(/= "" cTo)
); end and
(progn
(sssetfirst nil nil)
(vla-StartUndoMark actDoc)
(foreach a pLst
(if(vl-catch-all-error-p
(vl-catch-all-apply 'vla-put-TextString
(list a cTo)))
(setq errCnt(1+ errCnt))
(setq sucCnt(1+ sucCnt))
); end if
); end foreach
(princ
(strcat "\n" (itoa sucCnt) " of "
(itoa(length pLst))" attributes changed. ")
); end princ
(if(/= 0 errCnt)
(princ(strcat(itoa errCnt) " were on locked layer! "))
); end if
(vla-EndUndoMark actDoc)
); end progn
); end if
); end progn
(princ
(strcat "\nCan't to find attributes with '"
cFrom "' value!"))
); end if
); end progn
); end if
); end progn
(princ "\n It isn't attribute")
); end if
(princ)
); end of c:chatt
(princ "\n*** Type CHAT for change of attributes with the chosen value. ***")
我使用VBA，按名称调用块，然后按名称调用标记。然后只需编辑值 比格尔在这里做
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "DA1DRTXT"
BLOCK_NAME = "DA1DRTXT"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal
For Cntr = 0 To SS.Count - 1
attribs = SS.Item(Cntr).GetAttributes
attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
attribs(3).TextString = "0"
attribs(0).Update
attribs(3).Update
Next Cntr
如果他知道4个（假定）属性中的这一个，他希望更新#1和#4（基于0） 对不起，伙计们，还有一点信息DA1DRTXT是一个A1标题栏，这就是它的名称。它有大约10个属性，但我只需要更改第一个和第四个ie属性（0）和属性（3）。
使用块名尝试代码，只需更改从0开始的属性编号，以查看需要使用的编号。
还可以双击你的区块，这时会出现“eattedit”，只需在屏幕上编辑属性以计算出数字的信息中从零开始倒计时。
你可能会发现，如果你多次运行它，它会给出一个错误，因为它是第二次创建选择集，只需添加
此图纸。选择集。项目（“已发行”）。删去 你好
我需要有关AutoCAD脚本的小帮助。我使用AutoCAD map 2009，并尝试制作脚本，将块（块名“kc”）中的颜色从红色更改为ByLayer！！该脚本需要对图纸中每个名为“kc”的块执行此操作。我感谢您的帮助！
页:
[1]
2