I would like to know if anyone has some code that they would like to share.
What i am looking for is something that would allow be to auto number a particular attributte within ablock on a drawing
The block attribute would be called ID and i would like to run the code and then just go around and select the first instance of the block, set a starting number and have it incrementally continue numbering from that number on as i select the blocks thereafter.
The block which is a component id mark would generally have about 10 attributes and only 1 of them is needed to be changed.
Thanks in anticipation
Solved! Go to Solution.
Give this a shot
'Tools --> Options --> General tab --> Error Trapping --> Break on Unhandled Errors
Dim bRef As AcadBlockReference
Dim pick As Variant
Dim atArr As Variant
Dim oAtt As AcadAttributeReference
Dim aTag As String
Dim i As Integer, k As Integer
On Error GoTo ProblemHere
k = CInt(InputBox("Enter initial number:", "Block Renumbering", 1))
ThisDrawing.Utility.GetEntity bRef, pick, "Select a block reference"
If Err <> 0 Then
MsgBox "Program ended.", , "Block Selection Error"
atArr = bRef.GetAttributes
For i = 0 To UBound(atArr)
Set oAtt = atArr(i)
aTag = oAtt.TagString
If aTag = "ID" Then
oAtt.TextString = k
k = k + 1
Loop Until Err.Description Like "keyword"
here is what you want I suppose...
Public Sub att_sort() Dim waz As String Dim pt As Variant Dim xy As Variant Dim objBlock As AcadBlockReference Dim var_atts As Variant On Error Resume Next ThisDrawing.SelectionSets.Item("SS1").Delete Dim ssetObj As AcadSelectionSet Set ssetObj = ThisDrawing.SelectionSets.Add("SS1") Dim FilterType(0) As Integer Dim FilterData(0) As Variant m = ThisDrawing.Utility.GetReal("Enter a number to start:") m_s = ThisDrawing.Utility.GetString(True, "Enter a prefix:") FilterType(0) = 0 FilterData(0) = "INSERT" ssetObj.SelectOnScreen FilterType, FilterData n = 0 For Each Item In ssetObj Set objBlock = ssetObj.Item(n) var_atts = objBlock.GetAttributes For i = 0 To UBound(var_atts) If var_atts(i).TagString = "TYPE HERE ATTRIBUTE NAME" Then var_atts(i).TextString = m_s & m m = m + 1 End If Next n = n + 1 Next Item ThisDrawing.SelectionSets.Item("SS1").Delete End Sub