This example shows how to get and set Block definitions, Block instances, and BlockAttribute instances.
'-------------------------------------------------------------- ' Preconditions: ' 1. Create a VB.NET Windows console project. ' 2. Copy and paste this code 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. Review the macro to see how Block definitions, ' Block instances, and BlockAttribute instances ' are modified. ' 6. Start debugging the project. ' ' Postconditions: Block definitions, Block instances, and ' BlockAttribute instances are modified. Message ' boxes are popped up when a Block-related object does not exist. ' Read the text in each message box before clicking OK to close it. '---------------------------------------------------------------- Imports DraftSight.Interop.dsAutomation
Module Module1
Sub Main()
Dim dsApp As Application Dim dsDoc As Document
'Connect to DraftSight application dsApp = GetObject(, "DraftSight.Application") dsApp.AbortRunningCommand() ' abort any command currently running in DraftSight to avoid nested commands 'Get active document 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(ByVal dsDoc As Document)
Dim dsVarBlkDefinitions As Object Dim dsBlkDefinition As BlockDefinition Dim dsExtRef As 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)
dsBlkDefinition = dsVarBlkDefinitions(index)
'Check if Block definition is a reference 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(ByVal dsBlkDefinition As BlockDefinition) Dim dsVarAttrDefinitions As Object Dim dsAttrDefinition As 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)
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(ByVal dsBlkDefinition As BlockDefinition) Dim dsVarBlockInstances As Object Dim dsBlockInstance As BlockInstance Dim dsBlockDefinition As BlockDefinition Dim Workspace As Object = Nothing Dim workSpaceType As dsObjectType_e Dim dsSheet As Sheet Dim dsModel As 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)
dsBlockInstance = dsVarBlockInstances(index)
'Test attribute instances TestAttributeInstances(dsBlockInstance)
'Get Block definition from Block instance 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 = dsObjectType_e.dsSheetType Then dsSheet = Workspace
If dsSheet Is Nothing Then MsgBox("GetWorkingSpace method returns dsSheetType type, but sheet object is Nothing.") End If
ElseIf workSpaceType = dsObjectType_e.dsModelType Then 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(ByVal dsBlockInstance As BlockInstance)
Dim dsVarAttrInstances As Object Dim dsAttrInstance As 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)
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 the '" & dsAttrInstance.GetName + "' 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(ByVal dsAttrInstance As AttributeInstance) Dim layer As String Dim lineStyle As String Dim lineScale As Double Dim newLineScale As Double Dim precision As Double Dim lineWeight As dsLineWeight_e Dim newLineWeight As 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 Math.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 = dsLineWeight_e.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
End Module