This example shows how to get and set Block definitions, Block instances, and BlockAttribute instances.
'-------------------------------------------------------------- ' 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 document. ' 5. Review the code to see how Block definitions, ' Block instances, and BlockAttribute instances ' are modified. ' 6. Run the macro. ' ' Postconditions: Block definitions, Block instances, and ' BlockAttribute instances are modified. Message ' boxes pop up when a Block-related entity does not exist. ' Read the text in each message box before clicking OK to close it. '----------------------------------------------------------------
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 'Get active document Set dsDoc = dsApp.GetActiveDocument() If Not dsDoc Is Nothing Then
'Test Block definitions TestBlockDefinitions dsDoc
Else MsgBox "There are no open documents in DraftSight." End If End Sub Sub TestBlockDefinitions(dsDoc As DraftSight.Document)
Dim dsVarBlkDefinitions As Variant Dim dsBlkDefinition As DraftSight.BlockDefinition Dim dsExtRef As DraftSight.ExternalReference Dim index As Integer
'Get all Block definitions in the drawing dsVarBlkDefinitions = dsDoc.GetBlockDefinitions
'Check if there are any Block definitions If IsArray(dsVarBlkDefinitions) Then
For index = LBound(dsVarBlkDefinitions) To UBound(dsVarBlkDefinitions)
Set dsBlkDefinition = dsVarBlkDefinitions(index)
'Check if Block definition is a reference Set dsExtRef = dsBlkDefinition.GetExternalReference If Not dsExtRef Is Nothing Then MsgBox dsBlkDefinition.GetName & " block definition is a reference." Else MsgBox dsBlkDefinition.GetName & " block definition isn't a reference." End If
'Test BlockAttribute definitions TestAttributeDefinitions dsBlkDefinition
'Test Block instances TestBlockInstances dsBlkDefinition
Next
Else MsgBox "There are no Block definitions in """ & dsDoc.GetPathName & """ document." End If End Sub Sub TestAttributeDefinitions(dsBlkDefinition As DraftSight.BlockDefinition) Dim dsVarAttrDefinitions As Variant Dim dsAttrDefinition As DraftSight.AttributeDefinition Dim index As Integer Dim attrDefCaption As String Dim attrDefValue As String Dim attrDefName As String Dim newAttrCaptionValue As String Dim newAttrDefValue As String Dim newAttrDefName As String
'Get all BlockAttribute definitions in Block definition dsVarAttrDefinitions = dsBlkDefinition.GetAttributeDefinitions
'Check if there are any BlockAttribute definition If IsArray(dsVarAttrDefinitions) Then
For index = LBound(dsVarAttrDefinitions) To UBound(dsVarAttrDefinitions)
Set dsAttrDefinition = dsVarAttrDefinitions(index)
'Get BlockAttribute definition caption and change attrDefCaption = dsAttrDefinition.Caption
'Change caption value newAttrCaptionValue = dsAttrDefinition.Caption & "_Changed" dsAttrDefinition.Caption = newAttrCaptionValue
If newAttrCaptionValue <> dsAttrDefinition.Caption Then MsgBox "The caption of '" & dsAttrDefinition.Name + "' BlockAttribute definition wasn't changed from '" + attrDefCaption + "' to '" + newAttrCaptionValue + "'." End If
'Get BlockAttribute definition value attrDefValue = dsAttrDefinition.Value
'Change BlockAttribute definition value newAttrDefValue = dsAttrDefinition.Value & "_Changed" dsAttrDefinition.Value = newAttrDefValue
If newAttrDefValue <> dsAttrDefinition.Value Then MsgBox "The value of '" & dsAttrDefinition.Name + "' BlockAttribute definition wasn't changed from '" + attrDefValue + "' to '" + newAttrDefValue + "'." End If
'Get BlockAttribute definition name attrDefName = dsAttrDefinition.Name
'Change BlockAttribute definition name newAttrDefName = dsAttrDefinition.Name & "_Changed" dsAttrDefinition.Name = newAttrDefName
If newAttrDefName <> dsAttrDefinition.Name Then MsgBox "The name of '" & dsAttrDefinition.Name + "' BlockAttribute definition wasn't changed from '" + attrDefName + "' to '" + newAttrDefName + "'." End If
Next
Else MsgBox "There are no BlockAttribute definitions in """ & dsBlkDefinition.GetName & """ block definition." End If End Sub Sub TestBlockInstances(dsBlkDefinition As DraftSight.BlockDefinition) Dim dsVarBlockInstances As Variant Dim dsBlockInstance As DraftSight.BlockInstance Dim dsBlockDefinition As DraftSight.BlockDefinition Dim Workspace As Object Dim workSpaceType As DraftSight.dsObjectType_e Dim dsSheet As DraftSight.Sheet Dim dsModel As DraftSight.Model Dim index As Integer
'Get Block instances of Block definition dsVarBlockInstances = dsBlkDefinition.GetBlockInstances
'Check if there are any Block instances If IsArray(dsVarBlockInstances) Then
For index = LBound(dsVarBlockInstances) To UBound(dsVarBlockInstances)
Set dsBlockInstance = dsVarBlockInstances(index)
'Test attribute instances TestAttributeInstances dsBlockInstance
'Get Block definition from Block instance Set dsBlockDefinition = dsBlockInstance.GetBlockDefinition If dsBlockDefinition Is Nothing Then MsgBox "GetBlockDefinition method returns Nothing for Block instance with ID=""" & dsBlockInstance.GetID & "." End If
'Get working space dsBlockInstance.GetWorkingSpace workSpaceType, Workspace
If Not Workspace Is Nothing Then
'If work space is sheet If workSpaceType = dsSheetType Then Set dsSheet = Workspace
If dsSheet Is Nothing Then MsgBox "GetWorkingSpace method returns dsSheetType type, but sheet object is Nothing." End If
ElseIf workSpaceType = dsModelType Then Set dsModel = Workspace
If dsModel Is Nothing Then MsgBox "GetWorkingSpace method returns dsModelType type, but model object is Nothing." End If
End If
Else MsgBox "GetWorkingSpace method returns Nothing for Block instance." End If
Next
Else MsgBox "There are no Block instances of """ & dsBlkDefinition.GetName & """ Block definition." End If End Sub Sub TestAttributeInstances(dsBlockInstance As DraftSight.BlockInstance)
Dim dsVarAttrInstances As Variant Dim dsAttrInstance As DraftSight.AttributeInstance Dim index As Integer Dim attrInstanceName As String Dim attrInstanceValue As String Dim newAttrInstanceValue As String
'Get BlockAttribute instances dsVarAttrInstances = dsBlockInstance.GetAttributeInstances
'Check if there are any BlockAttribute instances If IsArray(dsVarAttrInstances) Then
For index = LBound(dsVarAttrInstances) To UBound(dsVarAttrInstances)
Set dsAttrInstance = dsVarAttrInstances(index)
'Get BlockAttribute instance name attrInstanceName = dsAttrInstance.GetName
'Get BlockAttribute instance value attrInstanceValue = dsAttrInstance.Value
'Change BlockAttribute instance value newAttrInstanceValue = dsAttrInstance.Value + "_Changed" dsAttrInstance.Value = newAttrInstanceValue
If newAttrInstanceValue <> dsAttrInstance.Value Then MsgBox "The value of '" & dsAttrInstance.GetName + "' attribute instance wasn't changed from '" + attrInstanceValue + "' to '" + newAttrInstanceValue + "'." End If
'Test general properties TestAttributeInstanceGeneralProperties dsAttrInstance
'Select BlockAttribute instance dsAttrInstance.Select (True)
'Deselect BlockAttribute instance dsAttrInstance.Select (False)
Next
Else MsgBox "There are no BlockAttribute instances in """ & dsBlockInstance.GetBlockDefinition.GetName & """ Block instance." End If
End Sub Sub TestAttributeInstanceGeneralProperties(dsAttrInstance As DraftSight.AttributeInstance) Dim layer As String Dim lineStyle As String Dim lineScale As Double Dim newLineScale As Double Dim precision As Double Dim lineWeight As DraftSight.dsLineWeight_e Dim newLineWeight As DraftSight.dsLineWeight_e Dim visible As Boolean Dim newVisibleValue As Boolean
'Get layer name layer = dsAttrInstance.layer
'Set the same layer dsAttrInstance.layer = layer
'Get line scale lineScale = dsAttrInstance.lineScale
'Set line scale newLineScale = 8.6 dsAttrInstance.lineScale = newLineScale
precision = 0.000000001 If Abs(newLineScale - dsAttrInstance.lineScale) > precision Then MsgBox "The line scale of '" & dsAttrInstance.GetName + "' attribute instance wasn't changed from '" + lineScale + "' to '" + newLineScale + "'." End If
'Get line style lineStyle = dsAttrInstance.lineStyle
'Set the same line style dsAttrInstance.lineStyle = lineStyle
'Get line weight lineWeight = dsAttrInstance.lineWeight
'Set new line weight newLineWeight = dsLnWt_015 dsAttrInstance.lineWeight = newLineWeight If newLineWeight <> dsAttrInstance.lineWeight Then MsgBox "The line weight of '" & dsAttrInstance.GetName + "' attribute instance wasn't changed from '" + lineWeight + "' to '" + newLineWeight + "'." End If
'Get visible property visible = dsAttrInstance.visible
'Set visible property newVisibleValue = Not visible dsAttrInstance.visible = newVisibleValue If newVisibleValue <> dsAttrInstance.visible Then MsgBox "The visible property of '" & dsAttrInstance.GetName + "' attribute instance wasn't changed from '" + visible + "' to '" + newVisibleValue + "'." End If
End Sub