How to Delete Multiple Instances of a BlockReference?

[brad.moon126662]

I have some drawings with multiple insertions of an attributed block. I have pulled the attribute values from the block and want to delete all instances of the block from the drawing so I can insert a clean version of the block and update the attributes with the attribute values stored previously.

The problem is I am havening trouble deleting more than one instance of the same block.

Code snippet as follows:
--------------------------------------------------------------------------
For Each elem In ThisDrawing.ModelSpace
ThisDrawing.PurgeAll
If TypeOf elem Is AcadBlockReference Then
Set aBRef = elem
' If StrComp(elem.EntityName, "AcDbBlockReference", 1) = 0 Then
If aBRef.Name = "bdrtit" Or aBRef.Name = "bdrref" Or aBRef.Name = "BdrIssue" Or aBRef.Name = "bdrrev" Then
aBRef.Delete
End If
End If
Next elem
--------------------------------------------------------------------------

Any thoughts?

Thanks,

Brad

[Ed Jobe]

Try these functions for getting a ss of blocks.

Public Function AddSelectionSet(SetName As String) As AcadSelectionSet
' This routine does the error trapping neccessary for when you want to create a
' selectin set. It takes the set and the proposed name and either adds it to the selectionsets
' collection or sets it.
    On Error Resume Next
    Set AddSelectionSet = ThisDrawing.SelectionSets.Add(SetName)
    If Err.Number <> 0 Then
        Set AddSelectionSet = ThisDrawing.SelectionSets.Item(SetName)
        AddSelectionSet.Clear
    End If
End Function

Public Function GetSS_BlockName(BlockName As String) As AcadSelectionSet
    'creates a ss of blocks with the name supplied in the argument
    Dim s2 As AcadSelectionSet
    
    Set s2 = AddSelectionSet("ssBlocks")                ' create ss with a name
    s2.Clear                                        ' clear the set
    Dim intFtyp(3) As Integer                       ' setup for the filter
    Dim varFval(3) As Variant
    Dim varFilter1, varFilter2 As Variant
    intFtyp(0) = -4: varFval(0) = "<AND"
    intFtyp(1) = 0: varFval(1) = "INSERT"           ' get only blocks
    intFtyp(2) = 2: varFval(2) = BlockName          ' whose name is specified in argument
    intFtyp(3) = -4: varFval(3) = "AND>"
    varFilter1 = intFtyp: varFilter2 = varFval
    s2.Select acSelectionSetAll, , , varFilter1, varFilter2        ' do it
    Set GetSS_BlockName = s2

End Function

[MikeJarosz]

I wrote practically the same thing several years ago. Some of this code I would do differently today, but this does work. This example was written for a large project where we decided after several hundred sheets were drawn that the door target had to be changed. What it does is make a selection set of all the door targets on the sheet, loop through the set extracting xyz, scale rotation and attributes. Then it deletes the door target and inserts the new one with the same attributes.

It was designed to be called as a subroutine from a larger batch program that loads the sheets one at a time, runs the routine then saves the sheet.

 
 '================================================================================================
Sub ReplaceBlock()
'================================================================================================
Dim Ipt As Variant
Dim RoomNumber As String
Dim BldgLocation As String
Dim DoorSequence As String
Dim Attrib As Variant
Dim Tag As Variant
Dim Angle As Double
Dim DrTar As AcadBlockReference
Dim BlkRef As AcadBlockReference
Const ScX As Double = 1#
Const ScY As Double = 1#
Const ScZ As Double = 1#
Dim Target As String
Target = "w:\a\blocks\door_tag_oval.dwg"
Dim Sset As AcadSelectionSet
Set Sset = ThisDrawing.SelectionSets.Add("DoorTarget")
Dim Codes() As Integer
ReDim Codes(2)
Dim CodeValues() As Variant
ReDim CodeValues(2)
Codes(1) = 0
Codes(2) = 2
CodeValues(1) = "INSERT"
CodeValues(2) = "door_tag" 'Block name
Sset.Select acSelectionSetAll, , , Codes, CodeValues
If Sset.Count = 0 Then Exit Sub
For Each DrTar In Sset
    Ipt = DrTar.InsertionPoint
    Ipt(2) = 0#
    Angle = DrTar.Rotation
    RoomNumber = ""
    BldgLocation = ""
    DoorSequence = ""
 
    For Each Attrib In DrTar.GetAttributes
    With Attrib
        Select Case .TagString
        Case "RMNO"
            RoomNumber = Trim(.TextString)
        Case "LO"
            BldgLocation = Trim(.TextString)
        Case "DS"
            DoorSequence = Trim(.TextString)
        End Select
    End With
    Next Attrib
 
    If RoomNumber = "" Then RoomNumber = "----"
    If BldgLocation = "" Then BldgLocation = "--"
    If DoorSequence = "" Then DoorSequence = "--"
    DrTar.Delete
 
    'insert new block here and set attributes
    Set BlkRef = ThisDrawing.ModelSpace.InsertBlock(Ipt, Target, ScX, ScY, ScZ, Angle)
    For Each Tag In BlkRef.GetAttributes
        Select Case Tag.TagString
        Case "RMNO"
            Tag.TextString = RoomNumber
        Case "LO"
            Tag.TextString = BldgLocation
        Case "DS"
            Tag.TextString = DoorSequence
        End Select
    Next Tag
    BlkRef.Update
    Print #G, RoomNumber; Chr(9); BldgLocation; Chr(9); DoorSequence; Chr(9); _
        Ipt(0); Chr(9); Ipt(1); Chr(9); FileName
Next DrTar
ThisDrawing.PurgeAll
ThisDrawing.PurgeAll
ThisDrawing.SelectionSets("DoorTarget").Delete
End Sub

The redim() statements I learned from the Joe Sutphin book. It's not really neccessary. Just dim the array directly. Also, I was in the habit of setting option base 1. I don't do that anymore. Just remember you are always off by 1.