按顺序编号bl中的文本
我想修改下面的lisp例程以满足我的需要。它当前对文本进行顺序编号。但我希望能够对块属性进行编号。此外，我想指定多少位数字。我有一个属性，它由一个详图索引编号和一个我想要更新的属性组成。请帮忙。谢谢（defun*错误*（MSG）
（普林斯消息）
（princ“\n函数已取消”）
（普林斯）
)
（提示“\n加载序列…”）
（定义C:SEQN（/SEQN ENT）
（if（not*SEQN）（setq*SEQN 1））；设置默认值
（setvar“cmdecho”0）
（princ“\n起始编号
（原理*序号）
（setq SEQN（getint“>：”）
（如果（非序列号）
（setq序列号*序列号）
（setq*SEQN SEQN）
)
（图表）
（setq）
ENT（entget）
（汽车
（entsel）
“\n选择要按顺序编号的文本：”
)
)
)
)
（耳鼻喉科时）
（程序
（如果（=（cdr（assoc 0 ENT））“文本”）
（程序
（entmod）
（subst
（缺点1（itoa-SEQN））
（assoc 1 ENT）
耳鼻喉科
)
)
（setq-SEQN（1+SEQN））；提前违约
)
（原则“\指数必须是文本”）
)
（普林斯）
（原则）
（setq）
ENT（entget（car（entsel）-选择文本：））
)
) ;结束程序
（setq*SEQN（1+SEQN））；设置供下次使用
) ;如果结束（princ）
) ;结束顺序N。lsp 嗨，cadsultantI稍微改变了这个程序，
请试一试（仅在2005年测试）
(defun *error* (msg)
(princ msg)
(princ "\nFunction cancelled")
(princ)
)
(prompt "\nLoading SEQN...")
(defun C:SQA (/ *seqn atd atq en ent seqn sset)
(setq atd (getvar "attdia"))
(setq atq (getvar "attreq"))
(setvar "attdia" 0)
(setvar "attreq" 0)
(setvar "cmdecho" 0)
(princ "\nStarting Number < ")
(princ *seqn)
(setq seqn (getint "> : "))
(if (not seqn)
(setq seqn *seqn)
(setq *seqn seqn)
)
(while
(if (setq sset (ssget "_:S" (list (cons 0 "INSERT");|(cons 2 block_name)|;(cons 66 1))))
(progn
(setq ent (ssname sset 0)
en (entnext ent)
)
(while (= "ATTRIB" (cdr (assoc 0 (entget en))))
(entmod (subst (cons 1 (itoa seqn))
(assoc 1 (entget en)) (entget en)))
(setq en (entnext en))
)
(entupd ent)
)
)
(setq seqn (1+ seqn))
)
(command "regen")
(setvar "attdia" atd)
(setvar "attreq" atq)
(setvar "cmdecho" 1)
(princ)
)
~'J'~ 必须学会更快地键入（或调试）。。。。。
我刚刚完成了VBA例程。非常基本，依赖于“on Error resume next”退出，但在某种程度上可行，前提是块中只有一个属性。用“VBASTMT”“IncAtt”命名
Public Sub IncAtt()
Dim myEntity As AcadObject
Dim basePnt(0 To 2) As Double
Dim myAttrib As Variant
Dim i As Integer
Dim myString As String
Dim ExitFlag As Boolean
ExitFlag = False
On Error Resume Next
myString = ThisDrawing.Utility.GetString(0, "Start Number ")
i = Val(myString)
If myString = "" Then i = 1
Do
ThisDrawing.Utility.GetEntity myEntity, basePnt, "Select an object"
If Err <> 0 Then
ExitFlag = True
Else
If myEntity.EntityName = "AcDbBlockReference" Then
myAttrib = myEntity.GetAttributes
If UBound(myAttrib) = 0 Then
myAttrib(0).TextString = Str$(i)
i = i + 1
Else
MsgBox "Must have only 1 attribute"
End If
End If
End If
Loop Until ExitFlag
End Sub
刚刚对其进行了编辑，以消除一些未记录的功能。 这是第二个版本：
(defun C:sqa (/ *error* alist atd atqatt att_ent pkx seqn)
(defun *error* (msg)
(if
(vl-position
msg
'("console break"
"Function cancelled"
"quit / exit abort"
)
)
(princ "Error!")
(princ msg)
)
(while (> (getvar "cmdactive") 0) (command))
(setvar "cmdecho" 1)
(command "._undo" "_end")
(setvar "attdia" atd)
(setvar "attreq" atq)
(setvar "pickbox" pkx)
(princ)
)
(setvar "cmdecho" 0)
(command "._undo" "_end")
(command "._undo" "_mark")
(setq atd (getvar "attdia"))
(setq atq (getvar "attreq"))
(setq pkx (getvar "pickbox"))
(setvar "attdia" 0)
(setvar "attreq" 0)
(setvar "pickbox" 6)
(setq seqn (getint "\n\tEnter start number <1> : "))
(if (not seqn)
(setq seqn 1)
)
(while
(setq att_ent (nentsel "\nSelect an attribute, do not miss \n"))
(if (eq (cdr (assoc 0
(setq alist (entget
(setq att (car att_ent))
)
)
)
)
"ATTRIB"
)
(progn
(entmod (subst (cons 1 (itoa seqn)) (assoc 1 alist) alist))
(entupd att)
(setq seqn (1+ seqn))
)
(progn
(princ "\nThere is not an attribute, you missed, buddy\n")
(exit)
)
)
)
(command "._regen")
(*error* nil)
(princ)
)
(prompt "\n | Programm loaded.\n")
(prompt " | Type SQA to execute.")
~（J）~ 好的，这是我的第二个版本。
Public Sub IncAtt()
Dim myEntity As AcadObject
Dim basePnt(0 To 2) As Double
Dim myAttrib As Variant
Dim i As Integer
Dim myString As String
Dim ExitFlag As Boolean
Dim PickedPoint As Variant, TransMatrix As Variant, ContextData As Variant
ExitFlag = False
On Error Resume Next
myString = ThisDrawing.Utility.GetString(0, "Start Number ")
i = Val(myString)
If myString = "" Then i = 1
Do
ThisDrawing.Utility.GetSubEntity myEntity, basePnt, TransMatrix, ContextData, "Select an object"
If Err <> 0 Then
ExitFlag = True
Else
If myEntity.EntityName = "AcDbAttribute" Or myEntity.EntityName = "AcDbText" Then
myEntity.TextString = Str$(i)
i = i + 1
Else
MsgBox "You must select an Attribute or Text"
End If
End If
Loop Until ExitFlag
End Sub
这一次，您可以选择文本或属性。这并不完全正确，因为即使你选择了一行，数字也会不断增加，但没关系，这是一个开始。 Fatty&Dbroada，
非常感谢你们的帮助。这正是我想要的。你们太棒了！ 大家好！
我的问题真的很愚蠢。很抱歉我已经安装了LISP，我应该键入哪个命令来启动它？
非常感谢。
克洛埃 如何在此存档中使用LISP例程 非常感谢。 这在上面的代码中是什么？
页:
[1]
2