How To "Re-Assemble" Exploded Block

[TTops]

Hello,

I am trying to re-assemble a block that I have exploded. Is this possible? The block consisted of an ACADText object and an ACADLWPolyline object. I have successfully obtained the property values of the individual objects that formerly made up the block. Now I simply want to put the block back together. My code looks like the following:


****Begin Code********
Global ExplodedObjects As Variant
Dim SelectedBlockReference As AcadBlockReference
Dim SelectionSet As AcadSelectionSet
Dim BOMPieceMarkRef as String
Dim BOMPieceMarkID As String
Dim TheLayer As String

Set SelectionSet = ThisDrawing.ActiveSelectionSet
Set SelectedBlockReference = SelectionSet(0)

ExplodedObjects = SelectedBlockReference.Explode
For i = 0 To UBound(ExplodedObjects)
ExplodedObjects(i).Update
If ExplodedObjects(i).ObjectName = "AcDbText" Then
BOMPieceMarkRef = ExplodedObjects(i).TextString
BOMPieceMarkID = ExplodedObjects(i).Hyperlinks.Item(0).URL
LayerName = ExplodedObjects(i).Layer
End If
ExplodedObjects(i).Update
Next
*****End Code******


My other option here is to reference the ACADText object's properties inside the block object. That would be nice because I wouldn't have to explode the block at all, but I can't figure out how to do that yet. Any help is greatly appreciated.



Thanks,
T-Tops

 

[TCARPENTER]

Hi TTops,

It doesn't look as though you are extracting attributes or unique text strings so why not just talk to the block definition?

****Begin Code********
Global ExplodedObjects As Variant
Dim SelectedBlockReference As AcadBlockReference
[red][b]Dim Blk as AcadBlock[/b][/red]
[red][b]Dim Ent as AcadEntity[/b][/red]
Dim SelectionSet As AcadSelectionSet
Dim BOMPieceMarkRef as String
Dim BOMPieceMarkID As String
Dim TheLayer As String

Set SelectionSet = ThisDrawing.ActiveSelectionSet
Set SelectedBlockReference = SelectionSet(0)
[red][b]Set Blk = ThisDrawing.Blocks(SelectedBlockReference.Name)[/b][/red]

For Each Ent in Blk
  If BlkEnt.ObjectName = "AcDbText" Then
    BOMPieceMarkRef = Ent.TextString
    BOMPieceMarkID = Ent.Hyperlinks.Item
    [purple][b]TheLayer[/b][/purple] = Ent.Layer
  End If
Next Ent

*****End Code******

HTH
Todd