Fixing Wipeout Blocks Draworder in Civil3D 2008

Private Sub cmdFixWipeoutBlock_Click()
 
    Dim blockObj As AcadBlock
    Dim eDictionary As AcadDictionary
    Dim sentityObj As Object
    Dim ents As AcadEntity
    Dim arr(0) As AcadObject
    
    For Each blockObj In ThisDrawing.Blocks
    'Set blockObj = ThisDrawing.Blocks(bname)
        'Gxet an extension dictionary and, if necessary, add a SortentsTable object**this is done "inside" the block.
        Set eDictionary = blockObj.GetExtensionDictionary '***this was the key
        ' Prevent failed GetObject calls from throwing an exception
        On Error Resume Next
        Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
        If Err.Number <> 0 Then
            If sentityObj Is Nothing Then
                ' No SortentsTable object, so add one
                Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
            End If
            Err.Clear   '   just a way to get error numbers if/when they occur
        End If
        On Error GoTo 0
        For Each ents In blockObj
            If ents.ObjectName = "AcDbWipeout" Then
                Set arr(0) = ThisDrawing.ObjectIdToObject(ents.ObjectID)
                'Move the wipeout object to the bottom
                sentityObj.MoveToBottom arr
                'MsgBox ents.ObjectName
            End If
        Next
    Next
    ThisDrawing.Regen acActiveViewport
    'clean up anything that may be left over
    Set sentityObj = Nothing
    Set eDictionary = Nothing
    Set blockObj = Nothing
    Set ents = Nothing
 
End Sub