This example shows how to add, modify, and remove custom data from a Circle.
'-------------------------------------------------------------- '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. Open the Immediate window. ' 5. Start DraftSight and open a document. ' 6. Run the macro. ' 'Postconditions: ' 1. Circle is constructed. ' 2. Custom data is added to, modified, and removed from ' the Circle. ' 3. Examine the Immediate window to verify. '----------------------------------------------------------------
Option Explicit
Sub main()
Dim dsApp As DraftSight.Application
'Connect to DraftSight application Set dsApp = GetObject(, "DraftSight.Application") 'Abort any command currently running in DraftSight 'to avoid nested commands dsApp.AbortRunningCommand
'Get active document Dim dsDoc As DraftSight.Document Set dsDoc = dsApp.GetActiveDocument() If dsDoc Is Nothing Then MsgBox ("There are no open documents in DraftSight.") Return End If
'Get model space Dim dsModel As DraftSight.Model Set dsModel = dsDoc.GetModel()
'Get sketch manager Dim dsSketchMgr As DraftSight.SketchManager Set dsSketchMgr = dsModel.GetSketchManager()
'Draw a Circle Dim centerX As Double centerX = 1 Dim centerY As Double centerY = 1 Dim centerZ As Double centerZ = 0 Dim radius As Double radius = 5 Dim dsCircle As DraftSight.Circle Set dsCircle = dsSketchMgr.InsertCircle(centerX, centerY, centerZ, radius)
'Zoom to fit dsApp.Zoom dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing
'Add custom data to the Circle Dim applicationName As String applicationName = "CircleApp" AddCustomDataToCircle dsCircle, applicationName
Debug.Print ("Circle custom data...") Debug.Print ("")
'Print custom data PrintCustomDataInfo dsCircle.GetCustomData(applicationName)
'Change custom data Dim dsCustomData As DraftSight.CustomData Set dsCustomData = dsCircle.GetCustomData(applicationName) ChangeCustomData dsCustomData
'Apply the changed custom data to the Circle dsCircle.SetCustomData applicationName, dsCustomData
Debug.Print ("") Debug.Print ("Custom data changed...") Debug.Print ("")
'Print custom data after changing it PrintCustomDataInfo dsCircle.GetCustomData(applicationName)
'Remove all string values from custom data Set dsCustomData = dsCircle.GetCustomData(applicationName) DeleteStringDataFromCustomData dsCustomData, dsCustomDataType_e.dsCustomDataType_String
'Apply the changed custom data to the Circle dsCircle.SetCustomData applicationName, dsCustomData
Debug.Print ("") Debug.Print ("Removed all string values from custom data...") Debug.Print ("")
'Print custom data after removing elements PrintCustomDataInfo dsCircle.GetCustomData(applicationName)
'Delete custom data from the Circle dsCircle.DeleteCustomData applicationName
Debug.Print ("") Debug.Print ("The custom data for the circle is removed...") Debug.Print ("")
'Print custom data after removing it from the Circle PrintCustomDataInfo dsCircle.GetCustomData(applicationName)
End Sub
Sub AddCustomDataToCircle(ByVal dsCircle As DraftSight.Circle, ByVal applicationName As String) 'Get custom data for the Circle Dim dsCustomData As DraftSight.CustomData Set dsCustomData = dsCircle.GetCustomData(applicationName)
'Clear existing custom data dsCustomData.Empty
'Get the index Dim index As Long index = dsCustomData.GetDataCount()
'Add a description of the Circle as a string value to the custom data Dim markerForString As Long markerForString = 1000 dsCustomData.InsertStringData index, markerForString, "Circle entity"
'Get the next index index = dsCustomData.GetDataCount()
'Add custom data section to custom data Dim dsInnerCustomData As DraftSight.CustomData Set dsInnerCustomData = dsCustomData.InsertCustomData(index)
'Get the next index index = dsInnerCustomData.GetDataCount()
'Get the center point of the Circle 'and add it as point data to the custom data Dim markerForPoint As Long markerForPoint = 1011 Dim centerX As Double, centerY As Double, centerZ As Double dsCircle.GetCenter centerX, centerY, centerZ dsInnerCustomData.InsertPointData index, markerForPoint, centerX, centerY, centerZ
'Get the next index index = dsInnerCustomData.GetDataCount()
'Get the radius of the Circle 'and add it as double data to the custom data Dim markerForDouble As Long markerForDouble = 1040 Dim doubleValue As Double doubleValue = dsCircle.radius dsInnerCustomData.InsertDoubleData index, markerForDouble, doubleValue
'Get the next index index = dsInnerCustomData.GetDataCount()
'Add the layer name of Circle as layer name data 'to custom data dsInnerCustomData.InsertLayerName index, dsCircle.Layer
'Get the next index index = dsInnerCustomData.GetDataCount()
'Add the name of the LineStyle of the Circle 'as a string data to custom data dsInnerCustomData.InsertStringData index, markerForString, dsCircle.LineStyle
'Get the next index index = dsInnerCustomData.GetDataCount()
'Add Int16 data to custom data Dim markerForInt16 As Integer markerForInt16 = 1070 Dim intValue As Long intValue = 5 dsInnerCustomData.InsertInteger16Data index, markerForInt16, intValue
'Get the next index index = dsInnerCustomData.GetDataCount()
'Add Int32 data to custom data Dim markerForInt32 As Integer markerForInt32 = 1071 Dim int32Value As Long int32Value = 7 dsInnerCustomData.InsertInteger32Data index, markerForInt32, int32Value
'Get the next index index = dsInnerCustomData.GetDataCount()
'Add the handle of the Circle as handle data to custom data dsInnerCustomData.InsertHandle index, dsCircle.handle
'Get the next index index = dsInnerCustomData.GetDataCount()
'Add binary data to custom data Dim binaryDataArray(3) As Byte binaryDataArray(0) = 0 binaryDataArray(1) = 1 binaryDataArray(2) = 0 binaryDataArray(3) = 1 dsInnerCustomData.InsertByteData index, binaryDataArray
'Set custom data dsCircle.SetCustomData applicationName, dsCustomData End Sub
Sub DeleteStringDataFromCustomData(ByVal dsCustomData As DraftSight.CustomData, ByVal dataType As dsCustomDataType_e) 'Get custom data count Dim count As Long count = dsCustomData.GetDataCount()
Dim index As Long For index = count - 1 To 0 Step -1 'Get custom data type Dim customDataType As dsCustomDataType_e dsCustomData.GetDataType index, customDataType
If customDataType = dataType Then 'Delete custom data element dsCustomData.Delete (index) End If
If customDataType = dsCustomDataType_e.dsCustomDataType_CustomData Then 'Get inner custom data Dim dsInnerCustomData As DraftSight.CustomData Set dsInnerCustomData = Nothing dsCustomData.GetCustomData index, dsInnerCustomData
DeleteStringDataFromCustomData dsInnerCustomData, dataType End If Next End Sub
Sub ChangeCustomData(ByVal dsCustomData As CustomData) 'Get custom data count Dim count As Long count = dsCustomData.GetDataCount()
Dim index As Long For index = 0 To count - 1 'Get custom data type Dim dataType As dsCustomDataType_e dsCustomData.GetDataType index, dataType
Select Case dataType Case dsCustomDataType_e.dsCustomDataType_BinaryData If True Then 'Get binary data from custom data Dim binaryDataArray As Variant binaryDataArray = dsCustomData.GetByteData(index)
'Check if binary data is not empty Dim i As Long If Not IsEmpty(binaryDataArray) Then For i = LBound(binaryDataArray) To UBound(binaryDataArray) binaryDataArray(i) = binaryDataArray(i) + 1 Next i
'Set the updated binary data to custom data dsCustomData.SetByteData index, binaryDataArray End If
End If Case dsCustomDataType_e.dsCustomDataType_CustomData If True Then 'Get the inner custom data Dim dsInnerCustomData As DraftSight.CustomData Set dsInnerCustomData = Nothing dsCustomData.GetCustomData index, dsInnerCustomData
ChangeCustomData dsInnerCustomData
End If Case dsCustomDataType_e.dsCustomDataType_Double If True Then 'Get double custom data Dim doubleValue As Double dsCustomData.GetDoubleData index, doubleValue
'Change double value doubleValue = doubleValue + 1
'Set the updated double value to custom data dsCustomData.SetDoubleData index, doubleValue
End If Case dsCustomDataType_e.dsCustomDataType_Integer16 If True Then 'Get Int16 custom data Dim intValue As Long dsCustomData.GetInteger16Data index, intValue
'Change Int16 value intValue = intValue + 1
'Set the updated Int16 value to custom data dsCustomData.SetInteger16Data index, intValue
End If Case dsCustomDataType_e.dsCustomDataType_Integer32 If True Then 'Get Int32 custom data dsCustomData.GetInteger32Data index, intValue
'Change Int32 value intValue = intValue + 1
'Set the updated Int32 value to custom data dsCustomData.SetInteger32Data index, intValue
End If Case dsCustomDataType_e.dsCustomDataType_Point If True Then 'Get point custom data Dim x As Double, y As Double, z As Double dsCustomData.GetPointData index, x, y, z
'Change point coordinates x = x + 2 y = y + 2 z = z + 2
'Set the updated point coordinates to custom data dsCustomData.SetPointData index, x, y, z
End If Case dsCustomDataType_e.dsCustomDataType_String If True Then 'Get string custom data Dim stringValue As String stringValue = "" dsCustomData.GetStringData index, stringValue
'Modify string value stringValue = stringValue + "_Changed"
'Set the updated string value to custom data dsCustomData.SetStringData index, stringValue
End If Case Else End Select Next End Sub
Sub PrintCustomDataInfo(ByVal dsCustomData As CustomData) 'Get custom data count Dim count As Long count = dsCustomData.GetDataCount() Debug.Print ("Custom data count:" & count)
Dim index As Long For index = 0 To count - 1 'Get custom data type Dim dataType As dsCustomDataType_e dsCustomData.GetDataType index, dataType
'Get custom data marker Dim marker As Long dsCustomData.GetDataMarker index, marker
Select Case dataType Case dsCustomDataType_e.dsCustomDataType_BinaryData If True Then 'Get binary data from custom data Dim binaryArray As Variant binaryArray = dsCustomData.GetByteData(index)
Dim binaryDataContent As String binaryDataContent = ""
If IsEmpty(binaryArray) Then binaryDataContent = "Empty" Else Dim j As Long For j = LBound(binaryArray) To UBound(binaryArray) binaryDataContent = binaryDataContent + CStr(binaryArray(j)) & "," Next j End If
'Print custom data index, data type, marker, and binary value PrintCustomDataElement index, dataType, marker, binaryDataContent
End If Case dsCustomDataType_e.dsCustomDataType_CustomData If True Then 'Get inner custom data Dim dsGetCustomData As DraftSight.CustomData Set dsGetCustomData = Nothing dsCustomData.GetCustomData index, dsGetCustomData
PrintCustomDataInfo dsGetCustomData
End If Case dsCustomDataType_e.dsCustomDataType_Double If True Then 'Get double value from custom data Dim doubleValue As Double dsCustomData.GetDoubleData index, doubleValue
'Print custom data index, data type, marker and double value PrintCustomDataElement index, dataType, marker, doubleValue
End If Case dsCustomDataType_e.dsCustomDataType_Handle If True Then 'Get handle value from custom data Dim handle As String handle = dsCustomData.GetHandleData(index)
'Print custom data index, data type, marker, and handle value PrintCustomDataElement index, dataType, marker, handle
End If Case dsCustomDataType_e.dsCustomDataType_Integer16 If True Then Dim int16Value As Long dsCustomData.GetInteger16Data index, int16Value
'Print custom data index, data type, marker, and Int16 value PrintCustomDataElement index, dataType, marker, int16Value
End If Case dsCustomDataType_e.dsCustomDataType_Integer32 If True Then Dim int32Value As Long dsCustomData.GetInteger32Data index, int32Value
'Print custom data index, data type, marker, and Int32 value PrintCustomDataElement index, dataType, marker, int32Value
End If Case dsCustomDataType_e.dsCustomDataType_LayerName If True Then 'Get layer name from custom data Dim layerName As String dsCustomData.GetLayerName index, layerName
'Print custom data index, data type, marker, and layer name value PrintCustomDataElement index, dataType, marker, layerName
End If Case dsCustomDataType_e.dsCustomDataType_Point If True Then 'Get point coordinates from custom data Dim x As Double, y As Double, z As Double dsCustomData.GetPointData index, x, y, z
'Print custom data index, data type, marker, and point values Dim pointCoordinates As String pointCoordinates = x & "," & y & "," & z PrintCustomDataElement index, dataType, marker, pointCoordinates
End If Case dsCustomDataType_e.dsCustomDataType_String If True Then 'Get string value from custom data Dim stringValue As String dsCustomData.GetStringData index, stringValue
'Print custom data index, data type, marker, and string value PrintCustomDataElement index, dataType, marker, stringValue
End If Case dsCustomDataType_e.dsCustomDataType_Unknown If True Then 'Print custom data index, data type, marker and value PrintCustomDataElement index, dataType, marker, "Unknown value"
End If Case Else End Select Next End Sub
Sub PrintCustomDataElement(ByVal index As Long, ByVal dataType As dsCustomDataType_e, ByVal marker As Integer, ByVal customDataValue As Variant) 'Print custom data index, data type, marker, and value Dim message As String message = "Index: " & index message = message + " Data type: " & dataType message = message + " Marker: " & marker message = message + " Value: " & customDataValue
Debug.Print (message) End Sub