topic Re: Edit attributes of existing block in VBA Forum

Edit attributes of existing block

snichols — Fri, 10 May 2019 13:45:30 GMT

First i'm not a programmer! I need to edit the value of existing attributes within a block. I have looked at many examples and everything I find incorporates inserting a new block into the drawing. I want to select the block (by name preferably) and simply change the "PARTNUM" value. Any direct code would be greatly appreciated.

Re: Edit attributes of existing block

Ed__Jobe — Fri, 10 May 2019 14:28:51 GMT

@snichols wrote:

First i'm not a programmer!

If we did give you code, would you know what to do with it?

Re: Edit attributes of existing block

snichols — Fri, 10 May 2019 14:46:15 GMT

Depends on the code, if it's vague and cryptic probably not. If it's well documented as to what it is doing then sure.

Re: Edit attributes of existing block

Ed__Jobe — Fri, 10 May 2019 14:49:01 GMT

I don't mean would you understand it. Would you know how to transfer it to the vbaide and run it?

Re: Edit attributes of existing block

snichols — Fri, 10 May 2019 14:56:32 GMT

yes

Re: Edit attributes of existing block

norman.yuan — Fri, 10 May 2019 19:34:30 GMT

Here is some code that update a block reference's attribute in this scenario:

1. the code asks user to select a block reference in drawing;

2. the code then loop through the block's attributes to identify the target attribute by its tag;

3. once the target attribute is found, the code ask user to enter desired value for the attribute;

4. If user enters a text value for the attribute, the attribute value is updated.

Option Explicit

Public Sub EditAttribute()

    Dim blk As AcadBlockReference
    Set blk = SelectBlockReference()
    If Not blk Is Nothing Then
        SetAttributeValue blk, "PartNumber"
    End If
    
End Sub

Private Function SelectBlockReference() As AcadBlockReference

    Dim ent As AcadEntity
    Dim pt As Variant
    Dim blk As AcadBlockReference
    Dim repick As Boolean
    
    On Error Resume Next
    
    Do
        If repick Then
            ThisDrawing.Utility.GetEntity ent, pt, _
                vbCrLf & "Invalid selection - not a block!" & vbCrLf & "Select a block:"
        Else
            ThisDrawing.Utility.GetEntity ent, pt, _
                vbCr & "Select a block:"
        End If
        
        If Err.Number <> 0 Then Exit Do
        repick = False
        If TypeOf ent Is AcadBlockReference Then
            Set blk = ent
            Exit Do
        Else
            repick = True
        End If
    Loop
    
    Set SelectBlockReference = blk
    
End Function

Private Sub SetAttributeValue(blk As AcadBlockReference, attTag As String)
    
    If Not blk.HasAttributes Then
        MsgBox "Seelected block does not have attribute!"
        Exit Sub
    End If
    
    Dim atts As Variant
    Dim att As AcadAttributeReference
    Dim i As Integer
    Dim found As Boolean
    Dim inputValue As String
    
    atts = blk.GetAttributes()
    For i = 0 To UBound(atts)
        Set att = atts(i)
        If UCase(att.TagString) = UCase(attTag) Then
            found = True
            inputValue = GetUserInput(attTag)
            If Len(inputValue) > 0 Then
                att.TextString = inputValue
            End If
            Exit For
        End If
    Next
    
    If Not found Then
        MsgBox "The selected block does not have attribute with tag """ & attTag & """!"
    Else
        blk.Update
    End If

End Sub

Private Function GetUserInput(attTag As String) As String

    On Error Resume Next
    
    Dim text As String
    text = ThisDrawing.Utility.GetString(vbCrLf & "Enter value for """ & attTag & """:")
    GetUserInput = text
    
End Function

As you can see, 2 things the process needs to do correctly is identify target block reference (by user picking here) and identify target attribute in a block reference (by looping through attributes' tag here).

If you have multiple block references to a block, instead of letting user to pick one by one, you can use code to loop through entire drawing (such as ModelSpace) for identify block references by its Name/EffectiveName (so you know these block references have the target attribute). The code would look like:

Dim ent As AcadEntity

Dim blk As AcadBlockReference

For Each ent In ThsiDrawing.ModelSpace

If TypeOf ent Is AcadBlockReference Then

Set blk = ent

If UCase(blk.EffectiveName)="MY_TARGET_BLOCK" Then

SetAttributeValue blk, "PartNumber" ' ' This is the method shown in code above

End If

Since you said "yes" to @Ed__Jobe , I trust you could easily adapt the code here to your need.

HTH

Re: Edit attributes of existing block

snichols — Fri, 10 May 2019 19:59:57 GMT

Ahh, see that wasn't so hard

Sub ChangeAtt()

' Select the block by name
Dim ent As AcadEntity
Dim blk As AcadBlockReference
For Each ent In ThisDrawing.PaperSpace
If TypeOf ent Is AcadBlockReference Then
Set blk = ent
If UCase(blk.EffectiveName) = "B_BORD_ATTRIBUTES" Then

Dim varAttributes As Variant
varAttributes = blk.GetAttributes

' Change the value of the attributes. These will be fed data from Inventor iproperties.
varAttributes(0).TextString = "123654" 'PARTNUM
varAttributes(1).TextString = "0.25" 'THK
varAttributes(2).TextString = "a36" 'MATERIAL
varAttributes(3).TextString = "blk" 'FINISH
varAttributes(4).TextString = "tiny" 'WELD
varAttributes(5).TextString = "" 'TOLERANCE
varAttributes(6).TextString = "" 'PROD
varAttributes(7).TextString = "" 'DATE
varAttributes(8).TextString = "" 'DRAWN
varAttributes(9).TextString = "" 'CHECKED
varAttributes(10).TextString = "" 'PRODCODE
varAttributes(11).TextString = "" 'CLASSCODE
varAttributes(12).TextString = "" 'CLASSNO
varAttributes(13).TextString = "" 'WEIGHT
varAttributes(14).TextString = "" 'DDD_04
varAttributes(15).TextString = "" 'DDD_37
varAttributes(16).TextString = "" 'DDD_38
varAttributes(17).TextString = "" 'DDD_40
varAttributes(18).TextString = "None" 'SCALE
blk.Update
End If
End If
Next

End Sub