Get and Set Block Definitions, Block Instances, and BlockAttribute Instances Example (VB.NET)

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