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

'Declare a Private Variable to bind to our drawing
Private AxDbDoc As AXDBLib.AxDbDocument
Attribute AxDbDoc.VB_VarHelpID = -1

Private Sub Class_Initialize()
    'This is the first routine that will fire when an instance
    'of our class is first allocated
    'This is where we initialize our ObjectDBX document
    'and allocate the memory required.
    Set AxDbDoc = New AXDBLib.AxDbDocument
End Sub

Public Property Get Document() As AXDBLib.AxDbDocument
    'This a public property allowing us to pass out the
    'ObjectDBX document to a form or other function which
    'is calling it.
    Set Document = AxDbDoc
End Property

Private Sub Class_Terminate()
    'This is the routine that will fire when an instance
    'of our class is is destroyed.
    'Since the Cleanup function can be called by any other
    'statement we will centralize all memory cleanup and
    'object destruction in that function.
    Cleanup
End Sub

Public Function Cleanup()
    'This is where we destroy our ObjectDBX document
    'and clear the memory for other usage.
    Set AxDbDoc = Nothing
End Function

Public Function OpenDoc(ByVal sName As String) As Boolean
    'This function receives a fully qualified file name and
    'the path to the file (dwg) and if all is well with
    'the open command, it will return a boolean value of True
    On Error GoTo ErrCatcher
        If AxDbDoc Is Nothing Then Exit Function
        AxDbDoc.Open sName
        OpenDoc = True
        Exit Function
ErrCatcher:
    'The default setting for a boolean is False so we don't need
    'to do anything, just raise our error and let it report back.
    '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
    'Maintain our separation by using a public function as
    'an intermediary to return the Xrefs collection which is
    'passed out of the private function below
    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
    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 duplicates 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