Create and Remove Dictionaries Example (VB.NET)

This example shows how to create and release dictionaries.

'--------------------------------------------------------------
' Preconditions:
' 1.  Create a VB.NET Windows console project.
' 2.  Copy and paste this example into the VB.NET IDE.
' 3.  Add a reference to:
'     install_dir\APISDK\tlb\DraftSight.Interop.dsAutomation.dll.
' 4.  Start DraftSight and open a document.
' 5.  Start debugging the project.
'
' 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.
'----------------------------------------------------------------
 
Imports DraftSight.Interop.dsAutomation
Imports System.Runtime.InteropServices
 
Module Module1
 
    Sub Main()
        Dim dsApp As Application
        Dim dsDoc As Document
 
        'Connect to DraftSight application
        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
        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 CommandMessage = dsApp.GetCommandMessage()
 
        'Construct Circle
        Dim dsModel As Model
        Dim dsSketchMgr As SketchManager
        dsModel = dsDoc.GetModel()
        dsSketchMgr = dsModel.GetSketchManager()
        Dim dsCircle As Circle
        dsCircle = dsSketchMgr.InsertCircle(5, 5, 0, 10)
 
        'Get drawing's root dictionary
        Dim dsRootDict As Dictionary
        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
            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 Dictionary
                dict = DirectCast(entity, Dictionary)
 
                'Table-style dictionary should contain an active style
                Dim dsTblStyleMgr As TableStyleManager
                dsTblStyleMgr = dsDoc.GetTableStyleManager()
                Dim dsActiveTblStyle As TableStyle
                dsActiveTblStyle = dsTblStyleMgr.GetActiveTableStyle()
 
                Dim activeTblStyleEntryName As String
                activeTblStyleEntryName = dict.GetNameOf(dsActiveTblStyle)
 
                dsCmdMsg.PrintLine([String].Format("Active table-style entry: {0}", activeTblStyleEntryName))
            End If
        End If
 
        'Create a dictionary in root dictionary
        Dim dsOurDict As Dictionary
        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 XRecord
        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 Integer
        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 Dictionary
        extDict = dsCircle.CreateExtensionDictionary()
 
        'Add XRecords to Circle's extension dictionary
        Dim dsXRecord1 As XRecord
        dsXRecord1 = extDict.CreateXRecord("XRecord1")
        dsXRecord1.InsertStringData(0, 1, "part number")
        dsXRecord1.InsertInteger32Data(1, 90, 1)
 
        Dim dsXRecord2 As XRecord
        dsXRecord2 = extDict.CreateXRecord("XRecord2")
        dsXRecord2.InsertStringData(0, 1, "Description")
        dsXRecord2.InsertStringData(1, 3, "Circle")
 
        'Read entries of Circle's extension dictionary
        Dim entitytypes As Object = Nothing
        Dim entries As Object() = Nothing
        entries = TryCast(extDict.GetEntries(entitytypes), Object())
 
        Dim dsEntityTypes As Integer() = DirectCast(entitytypes, Integer())
        For index As Integer = 0 To dsEntityTypes.Length - 1
            If DirectCast(dsEntityTypes(index), dsObjectType_e) = dsObjectType_e.dsXRecordType Then
                Dim xRecord As XRecord
                xRecord = DirectCast(entries(index), XRecord)
 
                If xRecord Is Nothing Then
                    Continue For
                End If
 
                Dim count As Integer
                count = xRecord.GetDataCount()
 
                For i As Integer = 0 To count - 1
                    Dim type As dsCustomDataType_e = xRecord.GetDataType(i)
                    If type = dsCustomDataType_e.dsCustomDataType_String Then
                        Dim data As String
                        data = xRecord.GetStringData(i)
 
 
                        dsCmdMsg.PrintLine([String].Format("String data: {0}", data))
                    ElseIf type = dsCustomDataType_e.dsCustomDataType_Integer32 Then
                        Dim intData As Integer
                        intData = xRecord.GetInteger32Data(i)
                        dsCmdMsg.PrintLine([String].Format("Int data: {0}", 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([String].Format("Circle's extension dictionary released and erased."))
        End If
 
    End Sub
 
End Module