Hide Table of Contents

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

This example shows how to insert a Hatch either by selecting sketch entities that form the Hatch boundary or by selecting internal points of enclosed areas of a drawing.

'--------------------------------------------------------------
' 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



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Insert Hatch by Entities or Internal Points (VB.NET)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2019 SP04

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.