# Get and Set Hatch Pattern Data Example (VB.NET)

This example shows how to get and set Hatch pattern data.

'--------------------------------------------------------------
' 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. Make sure that C:\ProgramData\Dassault Systemes\DraftSight\Examples
' exists.
' 6. Copy all .dxf and .dwg files in this folder to a backup folder.
' 7. Set all .dxf and .dwg files in
' C:\ProgramData\Dassault Systemes\DraftSight\Examples
' to read/write.
' 8. Start DraftSight.
' 9. Open the Immediate window.
' 10. Start debugging the project.
'
' Postconditions:
' 1. Each .dxf or .dwg file in
' C:\ProgramData\Dassault Systemes\DraftSight\Examples is
' filtered for Hatch patterns.
' 2. Hatch patterns are changed in the .dxf and .dwg files
' that have them. Examine the Immediate window.
' 3. Copy all .dxf and .dwg files from the backup folder to
' C:\ProgramData\Dassault Systemes\DraftSight\Examples.
'----------------------------------------------------------------
Imports System.Collections.Generic
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.IO
Imports DraftSight.Interop.dsAutomation
Imports System.Diagnostics
Module Module1
Sub Main()
'Connect to DraftSight application
Dim dsApp = GetObject(, "DraftSight.Application")
If dsApp Is Nothing Then
Return
End If
dsApp.AbortRunningCommand() ' abort any command currently running in DraftSight to avoid nested commands
'Check if the specified folder with drawings exists
Dim folderName As String = "C:\ProgramData\Dassault Systemes\DraftSight\Examples"
If False = Directory.Exists(folderName) Then
Console.WriteLine("""" & folderName & """ does not exist.")
Return
End If
'Get drawing files in the folder
Dim drawings As List(Of String) = GetDrawings(folderName)
If 0 = drawings.Count Then
MessageBox.Show("There are no DWG/DXF files in """ & folderName & """ directory.")
Return
End If
'Iterate through all drawings
For Each docName As String In drawings
'Open document
Dim dsDoc As Document = dsApp.OpenDocument2(docName, dsDocumentOpenOption_e.dsDocumentOpen_Default, dsEncoding_e.dsEncoding_Default)
If dsDoc IsNot Nothing Then
' Print name of document
Debug.Print("Name of document: " & dsDoc.GetPathName())
'Change Hatch pattern for all Hatch entities in the drawing
ChangeHatchPattern(dsDoc)
'Save document
dsDoc.Save()
'Close document
dsApp.CloseDocument(docName, True)
Else
MessageBox.Show("""" & docName & """ document could not be opened.")
Return
End If
Next
End Sub
Sub ChangeHatchPattern(ByVal dsDoc As Document)
'Get model space
Dim dsModel As Model = dsDoc.GetModel()
'Get Sketch Manager
Dim dsSketchMgr As SketchManager = dsModel.GetSketchManager()
'Get Selection Manager
Dim dsSelectionMgr As SelectionManager = dsDoc.GetSelectionManager()
'Get selection filter
Dim dsSelectionFilter As SelectionFilter = dsSelectionMgr.GetSelectionFilter()
'Clear selection filter
dsSelectionFilter.Clear()
'Add Hatch entity to the selection filter
dsSelectionFilter.AddEntityType(dsObjectType_e.dsHatchType)
'Activate selection filter
dsSelectionFilter.Active = True
'Get all Layer names
Dim layerNames As String() = GetLayers(dsDoc)
Dim entityTypes As Object
Dim entityObjects As Object
'Get Hatch entities
dsSketchMgr.GetEntities(dsSelectionFilter, layerNames, entityTypes, entityObjects)
Dim dsEntities As Object() = DirectCast(entityObjects, Object())
If entityObjects Is Nothing Then
Debug.Print(" Document does not have Hatch patterns.")
Debug.Print(" ")
Else
Debug.Print(" Document has Hatch patterns.")
'Iterate through Hatch entities
For Each entityItem As Object In dsEntities
'Cast to Hatch entity
Dim dsHatch As Hatch = TryCast(entityItem, Hatch)
'Get Hatch pattern
Dim patternName As String = ""
Dim angle As Double = 0.0
Dim scale As Double = 0.0
Dim patternType As dsHatchPatternType_e = dsHatchPatternType_e.dsHatchPatternType_Predefined
Dim spacing As Double = 1.0
Dim dsHatchPattern As HatchPattern = dsHatch.GetHatchPattern()
dsHatchPattern.GetHatchOrSolidData(patternName, angle, scale, patternType, spacing)
Debug.Print(" Pattern name, angle, scale, pattern types, spacing: " & patternName & ", " & angle & ", " & scale & ", " & patternType & ", " & spacing)
'Update Hatch pattern
patternName = "HOUND"
angle = 0.0
scale = 1.0
patternType = dsHatchPatternType_e.dsHatchPatternType_Predefined
spacing = 1.0
dsHatchPattern.SetHatchOrSolidData(patternName, angle, scale, patternType, spacing)
Next
Debug.Print(" ")
End If
End Sub
Function GetLayers(ByVal dsDoc As Document) As String()
'Get Layer Manager and Layer names
Dim dsLayerManager As LayerManager = dsDoc.GetLayerManager()
Dim dsLayers As Object() = DirectCast(dsLayerManager.GetLayers(), Object())
Dim layerNames As String() = New String(dsLayers.Length - 1) {}
For index As Integer = 0 To dsLayers.Length - 1
Dim dsLayer As Layer = TryCast(dsLayers(index), Layer)
layerNames(index) = dsLayer.Name
Next
Return layerNames
End Function
Function GetDrawings(ByVal folderName As String) As List(Of String)
Dim drawings As New List(Of String)()
'Get DWG files
Dim files As String() = Directory.GetFiles(folderName, "*.dwg")
If files IsNot Nothing Then
drawings.AddRange(files)
End If
'Get DXF files
files = Directory.GetFiles(folderName, "*.dxf")
If files IsNot Nothing Then
drawings.AddRange(files)
End If
Return drawings
End Function
End Module