Bind & insert xref containing dynamic block - explode doubles up object- VBA

[brentcole3410]

I xref'd some dynamic block stamps into all of our Client templates.  I was trying to put some code together to run when drawings are open by users.

1. Check for xref stamp name

2. If found then bind/insert

3. Run through model space and all other layout tabs and explode "LEVG_ENG_STAMP" block

Everything works fine except after exploding, the block is sort of duplicated.  It was exploded but there is still an unexploded block underneath the dynamic block.  Test DWG attached with xref.

Also, even though I set the BINDTYPE var to 1, it prefixes the block and test styles from stamp with xref name $0$.

Any ideas what I could change to get it to explode and finish properly?

Option Explicit

'Find & bind Xref'd LevG_Eng_Stamp
Sub FindBindXrefStamp()

Dim abl As AcadBlock

    For Each abl In ThisDrawing.Blocks
        'check for xrefs
        If abl.IsXRef Then
            'Check for xref stamp name
            If abl.Name = "LevG_Eng_Stamp" Then
                    'MsgBox (abl.Name) & " Found"
                'unlock xref layer
                'Call LayerUnLock_Xref
                    'MsgBox "Layer UnLocked " & (abl.Name)
                'set bindtype variable for xref
                ThisDrawing.SetVariable "BINDTYPE", 1
                'bind/insert xref
                ThisDrawing.Blocks.Item(abl.Name).Bind False
                    'MsgBox "The external reference " & (abl.Name) & " is bound."
                'this is where something needs to cycle through all layouts and explode stamp one time each
                'Call LayerLock_Xref
                    'MsgBox "Layer Locked " & (abl.Name)
        End If
    End If
Next
         
End Sub

'Setting each layout to active layout before you can loop through each entity on that layout,
'as you did, may be good enough for your needs. But if the layouts have a lots of entities,
'setting a layout to active layout may 'trigger AutoCAD to regenerate the view, which may take time.
'Another way is to use AcadSelectionSet.Select() with layout name as filter,
'so that you do not need to set each layout to active layout. Sample code like this:
Public Sub RunThruLayouts()

    Dim l As AcadLayout
    Dim ss As AcadSelectionSet
    
    Set ss = ThisDrawing.SelectionSets.Add("MySet")

    Call LayerUnLock_Xref
                
    For Each l In ThisDrawing.Layouts
        'If UCase(l.Name) <> "MODEL" Then
            
            SelectEntitiesOnLayout l.Name, ss
            ''''MsgBox "Selected entities on layout """ & l.Name & """: " & ss.Count
            
            ''You then do something with the entities on the layout
            DoSomething ss
            
        'End If
    Next
    
    ss.Delete
    
    Call LayerLock_Xref

End Sub

Private Sub SelectEntitiesOnLayout(layoutName As String, ss As AcadSelectionSet)

    ss.Clear
    
    Dim gpCode(0) As Integer
    Dim dataValue(0) As Variant
    gpCode(0) = 410 'Group Code for layout name
    dataValue(0) = layoutName
    
    Dim groupCode As Variant, dataCode As Variant
    groupCode = gpCode
    dataCode = dataValue
    
    ss.Select acSelectionSetAll, , , groupCode, dataCode

End Sub

'explode stamp block
Private Sub DoSomething(ss As AcadSelectionSet)
    
    Dim ent As AcadEntity
    Dim block As AcadBlockReference 'try this
    
    For Each ent In ss
        If TypeOf ent Is AcadBlockReference Then 'try this
            Set block = ent 'try this
                If UCase(block.EffectiveName) = "LEVG_ENG_STAMP" Then 'try this
                
                '''''explode here 'try this
                block.Explode
                
                'MsgBox "Found it"
                
                End If 'try this
        End If 'try this
            
            'MsgBox ent.ObjectName
    Next
End Sub

'Create XREF layer if does not exist and lock layer
Sub LayerUnLock_Xref()
  ' Create a new layer called "XREF"
  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("XREF")

  ' UnLock layer "XREF"
  layerObj.Lock = False
End Sub

'Create XREF layer if does not exist and lock layer
Sub LayerLock_Xref()
  ' Create a new layer called "XREF"
  Dim layerObj As AcadLayer
  Set layerObj = ThisDrawing.Layers.Add("XREF")

  ' Lock layer "XREF"
  layerObj.Lock = True
End Sub

[Ed__Jobe · Accepted solution]

That's the way the Explode method works. You have to delete the original block if you don't still need it. The EXPLODE command takes care of that for you.

When you call

block.Explode

follow it with

block.Delete

[brentcole3410]

That worked great. 

What about the xref prefixes on everything?  Block Name: "LevG_Eng_Stamp$0$LevG_LLC"

[Ed__Jobe]

You can rename it using the block.Name property. Use the Split function to get the base name.

[Ed__Jobe]

Just to be clear, you have an instance of the AcadBlockReference object. Use the Name of that blockref to get an instance of the corresponding AcadBlock object and change that object's Name.