Get and Set Block Definitions, Block Instances, and BlockAttribute Instances Example (VBA)

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