按顺序编号bl中的文本

cadsultant · 发表于 2022-7-6 10:17:38

我想修改下面的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

fixo · 发表于 2022-7-6 10:26:25

嗨，cadsultantI稍微改变了这个程序，
请试一试（仅在2005年测试）

copy

    
(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'~

dbroada · 发表于 2022-7-6 10:32:35

必须学会更快地键入（或调试）。。。。。

我刚刚完成了VBA例程。非常基本，依赖于“on Error resume next”退出，但在某种程度上可行，前提是块中只有一个属性。用“VBASTMT”“IncAtt”命名

copy


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

刚刚对其进行了编辑，以消除一些未记录的功能。

fixo · 发表于 2022-7-6 10:33:46

这是第二个版本：

copy


 (defun C:sqa (/ *error* alist atd atq  att 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）~

dbroada · 发表于 2022-7-6 10:39:40

好的，这是我的第二个版本。

copy


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