# Create and Remove Dictionaries Example (VBA)

This example shows how to create and release dictionaries.

    '--------------------------------------------------------------
    ' Preconditions:
    ' 1. Create a VBA macro in a software product in which VBA is
    '    embedded.
    ' 2. Copy and paste this example into the Visual Basic IDE.
    ' 3. Add a reference to the DraftSight type library,
    '    install_dir\bin\dsAutomation.dll.
    ' 4. Start DraftSight and open a drawing document.
    ' 5. Run the macro.
    '
    ' Postconditions:
    ' 1.  Constructs a Circle.
    ' 2.  Gets the root dictionary of the document.
    ' 3.  Gets the existing table-style dictionary of the document.
    ' 4.  Gets the active style in the table-style dictionary and
    '     prints the style type to the command window.
    ' 5.  Creates a dictionary in the root dictionary called Our_Dict
    '     and prints the name of the dictionary to the command window.
    ' 6.  Adds an XRecord entry to Out_Dict dictionary and prints
    '     the name of the XRecord to the command window.
    ' 7.  Creates an extension dictionary for the Circle.
    ' 8.  Adds XRecord entries to the Circle's extension dictionary.
    ' 9.  Reads the XRecord entries in the Circle's extension dictionary
    '     and prints their data to the command window.
    ' 10. Removes the XRecord entries from the Circle's extension dictionary.
    ' 11. Releases and erases the Circle's extension dictionary and prints
    '     confirmation to the command window.
    '----------------------------------------------------------------

    Option Explicit

        Sub main()

            Dim dsApp As DraftSight.Application
            Dim dsDoc As DraftSight.Document

            'Connect to DraftSight application
            Set dsApp = GetObject(, "DraftSight.Application")

            ' Abort any command currently running in DraftSight to avoid nested commands
            dsApp.AbortRunningCommand

            If dsApp Is Nothing Then
                Return
            End If

            'Get active document
            Set dsDoc = dsApp.GetActiveDocument()
            If dsDoc Is Nothing Then
                MsgBox ("There are no open documents in DraftSight.")
                Return
            End If

            'Get command message
            Dim dsCmdMsg As DraftSight.CommandMessage
            Set dsCmdMsg = dsApp.GetCommandMessage()

            'Construct Circle
            Dim dsModel As DraftSight.Model
            Dim dsSketchMgr As DraftSight.SketchManager
            Set dsModel = dsDoc.GetModel()
            Set dsSketchMgr = dsModel.GetSketchManager()
            Dim dsCircle As DraftSight.Circle
            Set dsCircle = dsSketchMgr.InsertCircle(5, 5, 0, 10)

            'Get drawing's root dictionary
            Dim dsRootDict As DraftSight.Dictionary
            Set dsRootDict = dsDoc.GetNamedObjectsDictionary()

            ' Get an existing dictionary (e.g., each drawing has a table-style dictionary)
            Dim hasEntry As Boolean
            hasEntry = dsRootDict.hasEntry("ACAD_TABLESTYLE")

            If hasEntry Then
                Dim entityType As dsObjectType_e
                Dim entity As Object
                Set entity = dsRootDict.GetEntry("ACAD_TABLESTYLE", entityType)

                'Dictionary entries can be of arbitrary entity types
                'In this case, the arbitrary entity type should be a dictionary
                If entityType = dsObjectType_e.dsDictionaryType Then
                    Dim dict As DraftSight.Dictionary
                    Set dict = entity

                    'Table-style dictionary should contain an active style
                    Dim dsTblStyleMgr As DraftSight.TableStyleManager
                    Set dsTblStyleMgr = dsDoc.GetTableStyleManager()
                    Dim dsActiveTblStyle As DraftSight.TableStyle
                    Set dsActiveTblStyle = dsTblStyleMgr.GetActiveTableStyle()

                    Dim activeTblStyleEntryName As String
                    activeTblStyleEntryName = dict.GetNameOf(dsActiveTblStyle)

                    dsCmdMsg.PrintLine ("Active table-style entry: " & activeTblStyleEntryName)
                End If
            End If

            'Create a dictionary in root dictionary
            Dim dsOurDict As DraftSight.Dictionary
            Set dsOurDict = dsRootDict.CreateDictionary("Our_Dict")

            'New dictionary is entry in root dictionary
            'Check if dictionary has new entry
            Dim hasOurDict As Boolean
            hasOurDict = dsRootDict.hasEntry("Our_Dict")
            If hasOurDict Then
                dsCmdMsg.PrintLine ("Our_Dict dictionary added.")
            End If

            'Add XRecord entry
            Dim dsOurXRecord As DraftSight.xRecord
            Set dsOurXRecord = dsOurDict.CreateXRecord("Our_XRecord")

            'Check if dictionary has new entry
            Dim hasOurXRecord As Boolean
            hasOurXRecord = dsOurDict.hasEntry("Our_XRecord")
            If hasOurXRecord Then
                dsCmdMsg.PrintLine ("Our_XRecord XRecord added.")
            End If

            'XRecords can contain arbitrary data
            Dim dataCount As Long
            dataCount = dsOurXRecord.GetDataCount()

            'Add double data
            dsOurXRecord.InsertDoubleData dataCount, 20, 1.42

            dataCount = dsOurXRecord.GetDataCount()

            'Add string data
            dsOurXRecord.InsertStringData dataCount, 3, "XRecordstring data"

            'Each entity can have its own extension dictionary
            'Create extension dictionary for Circle entity
            Dim extDict As DraftSight.Dictionary
            Set extDict = dsCircle.CreateExtensionDictionary()

            'Add XRecords to Circle's extension dictionary
            Dim dsXRecord1 As DraftSight.xRecord
            Set dsXRecord1 = extDict.CreateXRecord("XRecord1")
            dsXRecord1.InsertStringData 0, 1, "part number"
            dsXRecord1.InsertInteger32Data 1, 90, 1

            Dim dsXRecord2 As DraftSight.xRecord
            Set dsXRecord2 = extDict.CreateXRecord("XRecord2")
            dsXRecord2.InsertStringData 0, 1, "Description"
            dsXRecord2.InsertStringData 1, 3, "Circle"

            'Read entries of Circle's extension dictionary
            Dim entitytypes As Variant
            Dim entries As Variant
            entries = extDict.GetEntries(entitytypes)

            Dim dsEntityTypes As Variant
            dsEntityTypes = entitytypes
            Dim index As Long
            Dim i As Long
            For index = 0 To UBound(dsEntityTypes)
                If dsEntityTypes(index) = dsObjectType_e.dsXRecordType Then
                    Dim xRecord As DraftSight.xRecord
                    Set xRecord = entries(index)

                    If xRecord Is Nothing Then
                        Exit For
                    End If

                    Dim count As Long
                    count = xRecord.GetDataCount()

                    For i = 0 To count - 1
                        Dim dataType As dsCustomDataType_e
                        dataType = xRecord.GetDataType(i)
                        If dataType = dsCustomDataType_e.dsCustomDataType_String Then
                            Dim data As String
                            data = xRecord.GetStringData(i)
                            dsCmdMsg.PrintLine ("String data: " & data)
                        ElseIf dataType = dsCustomDataType_e.dsCustomDataType_Integer32 Then
                            Dim intData As Long
                            intData = xRecord.GetInteger32Data(i)
                            dsCmdMsg.PrintLine ("Int data: " & intData)
                        End If
                    Next
                End If
            Next

            'Remove the XRecords in the Circle's extension dictionary
            extDict.RemoveEntry ("XRecord1")
            extDict.RemoveEntry ("XRecord2")

            'Release and erase the Circle's extension dictionary
            Dim removed As Boolean
            removed = dsCircle.ReleaseExtensionDictionary()
            If removed Then
                dsCmdMsg.PrintLine ("Circle's extension dictionary released and erased.")
            End If

        End Sub