VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ObjectDBXAECDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private AxDbDoc As AXDBLib.AxDbDocument
Attribute AxDbDoc.VB_VarHelpID = -1
Private dicAECWalls As Scripting.Dictionary
Private dicAECDoors As Scripting.Dictionary

Private Sub Class_Initialize()
    Set AxDbDoc = New AXDBLib.AxDbDocument
End Sub

Public Property Get Document() As AXDBLib.AxDbDocument
    Set Document = AxDbDoc
End Property

Private Sub Class_Terminate()
    Cleanup
End Sub

Public Function Cleanup()
    Set AxDbDoc = Nothing
End Function

Public Function OpenDoc(ByVal sName As String) As Boolean
    On Error GoTo ErrCatcher
        If AxDbDoc Is Nothing Then Exit Function
        AxDbDoc.Open sName
        OpenDoc = True
        Exit Function
ErrCatcher:
    'Just pass it back out
    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
End Function

Public Function Xrefs() As Collection
    Set Xrefs = GetXrefs
End Function

Private Function GetXrefs() As Collection
    Dim XRefList As New Collection
    Dim o_Block As AXDBLib.AcadBlock
    Dim oEnt As AXDBLib.AcadEntity
    Dim o_Layout As AXDBLib.AcadLayout
    Dim XRBlock As AXDBLib.AcadExternalReference
    ' Get list of availble Xrefs
    For Each o_Layout In AxDbDoc.Layouts
    'For Each o_Block In AxDbDoc.Blocks
    Set o_Block = o_Layout.Block
        If o_Block.IsXRef Then
            ' Simple way to avoid duplicates in collection
            On Error Resume Next
            Set XRBlock = o_Block
            XRefList.Add XRBlock, XRBlock.Handle
            On Error GoTo 0
        Else
            For Each oEnt In o_Block
                If TypeOf oEnt Is AXDBLib.AcadExternalReference Then
                    Set XRBlock = oEnt
                    ' Simple way to avoid duplicates in collection
                    'On Error Resume Next
                    XRefList.Add XRBlock, XRBlock.Handle
                    On Error GoTo 0
                End If
            Next oEnt
        End If
    Next o_Layout
    ' Return list of Blocks in this drawing
    If XRefList.Count > 0 Then
        Set GetXrefs = XRefList
    Else
        Set GetXrefs = Nothing
    End If
End Function

Public Function BlockRefs() As Collection
    Set BlockRefs = GetBlockReferences
End Function

Private Function GetBlockReferences() As Collection
    Dim BlockRefList As New Collection
    Dim LayoutBlk As AXDBLib.AcadBlock
    Dim o_Layout As AXDBLib.AcadLayout
    Dim acadEnt As AXDBLib.AcadEntity
    For Each o_Layout In AxDbDoc.Layouts
        ' Get list of available Block references
        Set LayoutBlk = o_Layout.Block
        For Each acadEnt In LayoutBlk
            If acadEnt.ObjectName = "AcDbBlockReference" Then
                On Error Resume Next    ' Simple way to avoid duplcates in collection
                BlockRefList.Add acadEnt, acadEnt.Handle
                On Error GoTo 0
            End If
        Next
    Next o_Layout
    ' Return list of Block references in this drawing
    If BlockRefList.Count > 0 Then
        Set GetBlockReferences = BlockRefList
    Else
        Set GetBlockReferences = Nothing
    End If
End Function

Public Function aecEnts() As Collection
    Set aecEnts = GetAecEnts
End Function

Private Function GetAecEnts() As Collection
    Dim colAecEnts As New Collection
    Dim aecEnt As AecEntity
    Dim str As String
    Dim o_Block As AXDBLib.AcadBlock
    Dim oEnt As AXDBLib.AcadEntity
    Dim o_Layout As AXDBLib.AcadLayout
    Dim XRBlock As AXDBLib.AcadExternalReference
On Error Resume Next
    ' Get list of available AecEntities
    For Each o_Layout In AxDbDoc.Layouts
        Set o_Block = o_Layout.Block
        For Each oEnt In o_Block
            Set aecEnt = oEnt
            str = aecEnt.Name
                If Not aecEnt Is Nothing Then
                     colAecEnts.Add aecEnt, aecEnt.Handle
                End If
        Next oEnt
    Next o_Layout
    ' Return list of Blocks in this drawing
    If colAecEnts.Count > 0 Then
        Set GetAecEnts = colAecEnts
    Else
        Set GetAecEnts = Nothing
    End If
    Set aecEnt = Nothing
End Function

Public Function AecByType(s_Type As String) As Scripting.Dictionary
    If AecGather Then
        Select Case s_Type
            Case "AecDoor"
                Set AecByType = dicAECDoors
            Case "AecWallFace"
            Case "AecBdgSection"
            Case "AecBdgSectionLine"
            Case "AecCeilingLayoutGrid"
            Case "AecCurtainWallLayout"
            Case "AecCurtainWallUnit"
            Case "AecBdgElevationLine"
            Case "AecOpeningBase"
            Case "AecOpenFiller"
            Case "AecDoor"
            Case "AecWindow"
            Case "AecRailing"
            Case "AecRoof"
                'Case "AecRoofEdge"
                    'Case "AecRoofFace"
            Case "AecSlabBase"
            Case "AecRoofSlab"
            Case "AecSlab"
            Case "AecSpace"
            Case "AecSpaceBoundary"
            Case "AecStair"
            Case "AecWall"
                'Case "AecWallModifier"
            Case "AecWindowAssembly"
            Case Else
                MsgBox s_Type
        End Select
    End If
End Function

Private Function AecGather() As Boolean
    Dim aecEnt As AecEntity
    Dim colAecEnts As New Collection
    Dim str As String
    Dim o_Block As AXDBLib.AcadBlock
    Dim oEnt As AXDBLib.AcadEntity
    Dim o_Layout As AXDBLib.AcadLayout
    Dim XRBlock As AXDBLib.AcadExternalReference
On Error Resume Next
    ' Get list of available AecEntities
    For Each o_Layout In AxDbDoc.Layouts
        Set o_Block = o_Layout.Block
        For Each oEnt In o_Block
            Set aecEnt = oEnt
            str = aecEnt.Name
                If Not aecEnt Is Nothing Then
                    Select Case aecEnt.ObjectName
                        Case "AecDbDoor"
                            If Not dicAECDoors Is Nothing Then
                                'got one so continuing on
                            Else
                                Set dicAECDoors = New Scripting.Dictionary
                            End If
                            If Not dicAECDoors.Exists(aecEnt.Handle) Then
                                dicAECDoors.Add aecEnt.Handle, aecEnt
                            End If
                        Case "AecDbWall"
                            
                        Case Else
                            Debug.Print aecEnt.ObjectName
                            colAecEnts.Add aecEnt, aecEnt.Handle
                    End Select
                End If
        Next oEnt
    Next o_Layout
    ' Return list of Blocks in this drawing
    If colAecEnts.Count > 0 Then
        AecGather = True
    Else
        AecGather = False
    End If
    Set aecEnt = Nothing
End Function