Insert Hatch by Entities or Internal Points Example (VB.NET)

'--------------------------------------------------------------
' Preconditions:
' 1. Create a VB.NET Windows console project.
' 2. Copy and paste this example into the VB.NET IDE.
' 3. Add a reference to:
'    install_dir\APISDK\tlb\DraftSight.Interop.dsAutomation.dll.
' 4. Add references to System and System.Windows.Forms.
' 5. Start DraftSight and open a drawing document with sketch entities.
' 6. Start debugging the project.
'
' In the DraftSight command window, specify how the Hatch should be inserted:
'    1. Type Entities.
'    2. Select the sketch entities that form the boundary of the area to be hatched.
'    3. Press Enter.
'    - or -
'    1. Type InternalPoints.
'    2. Select three points that are in enclosed areas of the drawing.
'
' Postconditions: A Hatch is inserted, and the drawing document
' is zoomed to fit.
'----------------------------------------------------------------
Imports System.Collections.Generic
Imports System.Text
Imports DraftSight.Interop.dsAutomation
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Diagnostics

Module Module1
    Dim dsApp As DraftSight.Interop.dsAutomation.Application
    Dim dsDoc As Document

    Sub Main(ByVal args As String())
        'Connect to DraftSight application
        dsApp = ConnectToDraftSight()
        If dsApp Is Nothing Then
            Return
        End If

        dsApp.AbortRunningCommand() ' abort any command currently running in DraftSight to avoid nested commands

        'Get active document
        dsDoc = dsApp.GetActiveDocument()
        If dsDoc Is Nothing Then
            MessageBox.Show("There are no open documents in DraftSight.")
            Return
        End If

        'Get model space
        Dim dsModel As Model = dsDoc.GetModel()

        'Get sketch manager
        Dim dsSketchMgr As SketchManager = dsModel.GetSketchManager()

        'Get command message object
        Dim dsCommandMessage As CommandMessage = dsApp.GetCommandMessage()

        'Display a prompt at the command line to create Hatch by entities or by internal points
        Dim keywords As String() = {"Entities", "InternalPoints"}
        Dim selectedKeyword As String = ""
        Dim promptResult As Boolean = dsCommandMessage.PromptForKeyword("Insert Hatch by:", keywords, keywords(0), selectedKeyword)
        If promptResult Then
            'The user selected "By Entities" option
            If selectedKeyword.ToUpper() = "_" & keywords(0).ToUpper() OrElse selectedKeyword.ToUpper() = keywords(0).ToUpper() Then
                Dim selectedEntities As DispatchWrapper() = SelectEntities(dsCommandMessage)

                InsertHatchByEntities(dsSketchMgr, selectedEntities)
            End If

            'The user selected "By Internal Points" option
            If selectedKeyword.ToUpper() = "_" & keywords(1).ToUpper() Then
                'Select three internal points
                Dim pointsCount As Integer = 3

                dsCommandMessage.PrintLine("Select three internal points for a Hatch")

                Dim internalPoints As Double() = SelectPoints(dsCommandMessage, pointsCount)

                InsertHatchByInternalPoints(dsSketchMgr, internalPoints)
            End If
        End If
    End Sub

    Sub InsertHatchByInternalPoints(ByVal dsSketchMgr As SketchManager, ByVal internalPoints As Double())
        'Hatch parameters
        Dim patternName As String = "ANSI31"
        Dim patternScale As Double = 1
        Dim patternAngle As Double = 0

        'Insert Hatch
        Dim dsHatch As Hatch = dsSketchMgr.InsertHatchByInternalPoints(internalPoints, patternName, patternScale, patternAngle)
        If dsHatch IsNot Nothing Then
            'Change color of Hatch
            Dim dsColor As Color = dsHatch.Color
            dsColor.SetNamedColor(dsNamedColor_e.dsNamedColor_Green)
            dsHatch.Color = dsColor

            'Zoom to fit
            dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing)
        Else
            MessageBox.Show("Hatch entity was not added to the current drawing.")
        End If
    End Sub

    Function SelectPoints(ByVal dsCommandMessage As CommandMessage, ByVal internalPointsCount As Integer) As Double()
        Dim internalPoints As New List(Of Double)()

        'Display prompt for point
        Dim x As Double, y As Double, z As Double
        Dim count As Integer = 0
        While count < internalPointsCount
            If dsCommandMessage.PromptForPoint("Specify internal point", x, y, z) Then
                internalPoints.Add(x)
                internalPoints.Add(y)
            End If

            count += 1
        End While

        Return internalPoints.ToArray()
    End Function

    Sub InsertHatchByEntities(ByVal dsSketchMgr As SketchManager, ByVal dsEntities As DispatchWrapper())
        'Hatch parameters
        Dim patternName As String = "GRASS"
        Dim patternScale As Double = 1
        Dim patternAngle As Double = 0

        'Insert Hatch
        Dim dsHatch As Hatch = dsSketchMgr.InsertHatchByEntities(dsEntities, patternName, patternScale, patternAngle)
        If dsHatch IsNot Nothing Then
            'Change color of Hatch
            Dim dsColor As Color = dsHatch.Color
            dsColor.SetNamedColor(dsNamedColor_e.dsNamedColor_Blue)
            dsHatch.Color = dsColor

            'Zoom to fit
            dsApp.Zoom(dsZoomRange_e.dsZoomRange_Fit, Nothing, Nothing)
        Else
            MessageBox.Show("Hatch entity was not added to the current drawing.")
        End If
    End Sub

    Function SelectEntities(ByVal dsCommandMessage As CommandMessage) As DispatchWrapper()
        Dim selectedEntities As DispatchWrapper() = Nothing

        'Prompt for multiple selection of entities
        If dsCommandMessage.PromptForSelection(False, "Specify entities", "It is not an entity") Then
            'Get selection manager
            Dim dsSelectionMgr As SelectionManager = dsDoc.GetSelectionManager()

            'Get count of selected entities
            Dim selectionType As dsSelectionSetType_e = dsSelectionSetType_e.dsSelectionSetType_Previous
            Dim count As Integer = dsSelectionMgr.GetSelectedObjectCount(selectionType)
            If count > 0 Then
                selectedEntities = New DispatchWrapper(count - 1) {}
                For index As Integer = 0 To count - 1
                    Dim entityType As dsObjectType_e
                    selectedEntities(index) = New DispatchWrapper(dsSelectionMgr.GetSelectedObject(selectionType, index, entityType))
                Next
            End If
        End If

        Return selectedEntities
    End Function

    Function ConnectToDraftSight() As DraftSight.Interop.dsAutomation.Application
        Dim dsApp As DraftSight.Interop.dsAutomation.Application = Nothing

        Try
            'Connect to DraftSight
            dsApp = DirectCast(Marshal.GetActiveObject("DraftSight.Application"), DraftSight.Interop.dsAutomation.Application)
        Catch ex As Exception
            MessageBox.Show("Failed to connect to DraftSight. Cause: " & ex.Message)
            dsApp = Nothing
        End Try

        Return dsApp
    End Function
End Module