Vba code wanted

[john]

Hi all,

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

John B 

[Hallex · Accepted solution]

Give this a shot

{code}

Option Explicit
'Tools --> Options --> General tab --> Error Trapping --> Break on Unhandled Errors
    Sub Block_Renumbering()

    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))
   
    Do
   
    ThisDrawing.Utility.GetEntity bRef, pick, "Select a block reference"
   
    If Err <> 0 Then
        Err.Clear
        MsgBox "Program ended.", , "Block Selection Error"
        Exit Sub
    Else
        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
        End If
        Next
End If

Loop Until Err.Description Like "keyword"

ProblemHere:

    End Sub

{code}

~'J'~

[truss_85]

Hi John,

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

[truss_85]

Faster then me 🙂

I did not see your post

Sorry...

[Hallex]

It's good to allow to choose user what he needs 🙂

Regards,

~'J'~

[john]

Hallex,

Thanks for that it worked a treat. Exactly what i was looking for.

Regards

John

[Hallex]

You're welcome

Happy coding 🙂

Oleg