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

Private AxDbDoc As AXDB15Lib.AxDbDocument
Attribute AxDbDoc.VB_VarHelpID = -1
Private BlockNameList As Scripting.Dictionary

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

Public Property Get Document() As AXDB15Lib.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 acBlock As AXDB15Lib.AxDbDocument
    Dim oEnt As AXDB15Lib.AcadEntity
    Dim o_Layout As AXDB15Lib.AcadLayout
    Dim XRBlock As AXDB15Lib.AcadExternalReference
    
    ' Get list of availble Xrefs
    For Each o_Layout In AxDbDoc.Layouts
    'For Each acBlock In AxDbDoc.Blocks
    Set acBlock = o_Layout.Block
        For Each oEnt In acBlock
            If TypeOf oEnt Is AcadExternalReference Then
                XRefList.Add oEnt, acBlock.Handle
            End If
        Next oEnt
    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 AXDB15Lib.AcadBlock
    Dim o_Layout As AXDB15Lib.AcadLayout
    Dim acadEnt As AXDB15Lib.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 BlockNames() As Collection
    Set BlockNames = GetBlockNameCollection
End Function

Private Function GetBlockNameCollection() As Collection
    Dim oBlck As AXDB15Lib.AcadBlock
    Dim colBNameList As New Collection
    Dim sBName As String
    Dim varBNames
    Dim i As Long
    Dim iCnt As Long
    Set BlockNameList = New Scripting.Dictionary
    For Each oBlck In AxDbDoc.Blocks
        sBName = ReturnBlockName(oBlck)
        If Not sBName Like "*MODEL_SPACE" And Not sBName Like "*PAPER_SPACE" Then
            If Not BlockNameList.Exists(sBName) Then
                BlockNameList.Add oBlck.Name, iCnt
                iCnt = iCnt + 1
            End If
        End If
    Next oBlck
    varBNames = BlockNameList.Keys
    For i = LBound(varBNames) To UBound(varBNames)
        colBNameList.Add varBNames(i)
    Next i
    Set GetBlockNameCollection = colBNameList
End Function

Private Function ReturnBlockName(oAcadBlock As AXDB15Lib.AcadBlock) As String
    Dim oEnt As AXDB15Lib.AcadEntity
    Dim oBlck As AXDB15Lib.AcadBlock
    Dim sBName As String
    For Each oEnt In oAcadBlock
        If TypeOf oEnt Is AXDB15Lib.AcadBlock Then
            sBName = ReturnBlockName(oBlck)
        End If
    Next oEnt
    If sBName = "" Then
        sBName = oAcadBlock.Name
    End If
    ReturnBlockName = sBName
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 AecXBase.AecEntity
    Dim str As String
    Dim o_Block As AXDB15Lib.AcadBlock
    Dim oEnt As AXDB15Lib.AcadEntity
    Dim o_Layout As AXDB15Lib.AcadLayout
    Dim XRBlock As AXDB15Lib.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 AecEnts in this drawing
    If colAECEnts.Count > 0 Then
        Set GetAecEnts = colAECEnts
    Else
        Set GetAecEnts = Nothing
    End If
    Set aecEnt = Nothing
End Function