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