This example shows how to insert a Hatch in a drawing document.
'-------------------------------------------------------------- ' 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 drawing document. ' 5. Run the macro. ' ' Postconditions: A Hatch is inserted in the drawing document ' and zoomed to fit.
'---------------------------------------------------------------- Option Explicit
Dim dsApp As DraftSight.Application Dim dsDoc As DraftSight.Document Dim dsModel As DraftSight.Model Dim dsSketchManager As DraftSight.SketchManager
Sub main() 'Connect to DraftSight 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 dsDoc Is Nothing Then MsgBox ("There are no open documents in DraftSight.") End End If
'Get model space Set dsModel = dsDoc.GetModel
'Get Sketch Manager Set dsSketchManager = dsModel.GetSketchManager
'Hatch parameters Dim boundaryPointCountArray(0) As Long boundaryPointCountArray(0) = 4
Dim boundaryPoints(0 To 7) As Double boundaryPoints(0) = 0: boundaryPoints(1) = 0 boundaryPoints(2) = 2: boundaryPoints(3) = 0 boundaryPoints(4) = 2: boundaryPoints(5) = 2 boundaryPoints(6) = 0: boundaryPoints(7) = 2
Dim patternName As String patternName = "ANSI31"
Dim patternScale As Double patternScale = 1#
Dim patternAngle As Double patternAngle = 3.14159265358979 / 4 'In radians
'Insert Hatch Dim dsHatch As DraftSight.Hatch Set dsHatch = dsSketchManager.InsertHatchByBoundary(boundaryPointCountArray, boundaryPoints, patternName, patternScale, patternAngle)
If Not dsHatch Is Nothing Then 'Change color of Hatch Dim dsColor As DraftSight.Color Set dsColor = dsHatch.Color dsColor.SetNamedColor dsNamedColor_Green dsHatch.Color = dsColor
'Zoom to fit dsApp.Zoom dsZoomRange_Fit, Nothing, Nothing Else MsgBox ("Hatch entity was not added to the current drawing.") End If End Sub