VB.NET Explode blocks till there are no more blocks

[Xpeter88]

Hi all,

I've got one piece of code that I found here on forum that explodes all the blocks in the drawing till there are no more blocks. I would need it in VB.NET.

Anyone who could help me with this?

 

Many thanks,

 

Sub AxplodeAllBlocks()
   Dim oEnt As AcadEntity
   For Each oEnt In ThisDrawing.ModelSpace
       If TypeOf oEnt Is AcadBlockReference Then
           ExpBlock oEnt
       End If
   Next
End Sub

Sub ExpBlock(ByRef BR)
   Dim varEx As Variant
   Dim BRef As AcadBlockReference
   Dim i As Double
   
   varEx = BR.Explode
   BR.Delete
   For i = 0 To UBound(varEx)
       If TypeOf varEx(i) Is AcadBlockReference Then
           Set BRef = varEx(i)
           ExpBlock BRef
       End If
   Next
End Sub

[Xpeter88]

Ok, I will be first then.

 

#1 What I did was select all the blocks from the drawing. This works fine.

 

'' Start a transaction
           Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
               '' Create a TypedValue array to define the filter criteria
               Dim acTypValAr(0) As TypedValue
               acTypValAr.SetValue(New TypedValue(DxfCode.BlockName, "*"), 0)
               '' Assign the filter criteria to a SelectionFilter object
               Dim acSelFtr As SelectionFilter = New SelectionFilter(acTypValAr)
               '' Request for objects to be selected in the drawing area
               Dim acSSPrompt As PromptSelectionResult = acDoc.Editor.SelectAll(acSelFtr)
               If acSSPrompt.Status = PromptStatus.OK Then
                   Dim acSSet As SelectionSet = acSSPrompt.Value

 

#2 Then I tried to explode each of selected Block Reference. I would expect that it will be easier like "acBlock.Explode" and that's it but seems that it is not and it makes AutoCAD entity on the same place as the block is and then I have to remove that block. Is this really what I have to do when I want to explode the block? Also the issue here is that when I have more than 2 blocks the macro will crash:/

 

For Each acSSObj As SelectedObject In acSSet
                       Using dbObjCol As New DBObjectCollection

                           Dim acBlock As BlockReference = acTrans.GetObject(acSSObj.ObjectId, OpenMode.ForWrite)
                           Dim acCurSpaceBlkTblRec As BlockTableRecord = acTrans.GetObject(acCurDb.CurrentSpaceId, OpenMode.ForWrite)
                           acBlock.Explode(dbObjCol)

                           For Each dbObj As DBObject In dbObjCol
                               Dim acEnt As Entity = dbObj
                               acCurSpaceBlkTblRec.AppendEntity(acEnt)
                               acTrans.AddNewlyCreatedDBObject(dbObj, True)
                           Next
                           acBlock.Erase()
                       End Using
           acTrans.Commit()
                   Next

               End If
           End Using

 

#3 The third step would be to repeat this steps while selected items in acSSet are >0 but what to understand and fix the step #2 first.

 

Any help?

 

Peter,