Hide Table of Contents

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
        If dsApp Is Nothing Then
        End If
        'Get active document
        Set dsDoc = dsApp.GetActiveDocument()
        If dsDoc Is Nothing Then
            MsgBox ("There are no open documents in DraftSight.")
        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
            End If
        '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

Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

Subject:   Feedback on Help Topics
Page:   Create and Remove Dictionaries Example (VBA)
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:


We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again

Web Help Content Version: API Help (English only) 2024 SP02

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.