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