Block-Explode

[thomas_weberX5WMZ]

Hello,

for years I've used the code down below to explode all blocks in my models - all blocks, regardless whether they are nested or not (a purge in between was not necessary), the last ACAD/ASteel Version we've used was 2019.

Now we've switched to ACAD/ASteel 2023 and the macro isn't working as it should?

It still explode blocks, but does not finish it's job, there are blocks left

I've updated the ACAD Project References to VBA for Applications, AutoCAD 2021 Type Library and OLE Automation?

Did I forget something? The Code still looks fine and should do it's work?

My Test file is a XREF File with ~10 Levels of XRef's which I bind and then the macro should 'kill' all blocks.

It would be nice if someone has an idea and could give me a hint.

kind regards

Code:

Sub block_xplode()
Dim oEnt As AcadEntity
Dim iChoice As Integer
Dim strPrompt As String
Dim strTitle As String

strPrompt = "Entfernt ALLE Bloecke im Modellbereich"
strTitle = "Block-Xplode"
iChoice = MsgBox(strPrompt, vbOKCancel, strTitle)

If iChoice = vbOK Then
For Each oEnt In ThisDrawing.ModelSpace
If TypeOf oEnt Is AcadBlockReference Then
ExpBlock oEnt
End If
On Error Resume Next
Next
Else
Exit Sub
End If
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

Moderator edit: Put code in code window. Please read this.

[Ed__Jobe]

Please read this.

You didn't post the important part, the ExpBlk sub.

[thomas_weberX5WMZ]

Ahh...sorry, that was a mistake

Here the complete code:

' Block-Explode - Auflösen aller Blöcke

Sub block_xplode()

Dim oEnt As AcadEntity
Dim iChoice As Integer
Dim strPrompt As String
Dim strTitle As String

strPrompt = "Entfernt ALLE Bloecke im Modellbereich"
strTitle = "Block-Xplode"
iChoice = MsgBox(strPrompt, vbOKCancel, strTitle)

If iChoice = vbOK Then
For Each oEnt In ThisDrawing.ModelSpace
If TypeOf oEnt Is AcadBlockReference Then
ExpBlock oEnt
End If
On Error Resume Next
Next
Else
Exit Sub
End If
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

[Ed__Jobe]

You didn't read the link I gave you. Please post your code to a code window to preserve formatting. It would also help if you posted a sample steel dwg.

[thomas_weberX5WMZ]

Ah, sorry again. I didn't see the link you've added to my post, below the code.
I saw it, after you pointet me at it.
The next post, containing code will be correct! 🙂

I also would post a sample of a steel file, but my smallest file, I've used for testing is ~25MB, I think thats a bit too large for here (I can't create a new one, because I don't have ASteel 2019 anymore and can test if the macro is still working with the file in the old version)

If 25MB would be okay, I'll post it here, itherwise I have to weit till my IT-department is back from the Autodesk University and give me a slot on our ftp-server.

kind regards

[Ed__Jobe]

You can edit your post by clicking on the 3 vertical dots and chosing Edit Reply.

Just give it a try. Post it and see if the forum rejects it. Or you can delete some unnecessary entities to make it smaller,

[thomas_weberX5WMZ]

I've edited the wrong formated post 🙂

And I've attached the file. THe file was "exploded" till the end in ASteel/ACAD 2019 with only one run of the macro, in 2023 it's, as mentioned not running that fine.

Kind regards