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