# Get Hatch and Hatch Boundary Loop Data Example (VBA)

This example shows how to get Hatch and Hatch boundary loop data.

    '--------------------------------------------------------------
    ' 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, construct a Circle, Rectangle, Spline, or
    '    Ellipse, and apply a Hatch to the entity.
    ' 5. Open the Immediate window.
    ' 6. Run the macro.
    '
    ' Postconditions:
    ' 1. When the prompt appears in the DraftSight command window to
    '    select an entity, select the entity with the Hatch.
    ' 2. The selected entity's Hatch and Hatch boundary loop data is printed
    '    to the Immediate Window.
    '----------------------------------------------------------------
    Option Explicit

        Dim dsApp As DraftSight.Application
        Dim dsDoc As DraftSight.Document
        Dim dsModel As DraftSight.Model
        Dim dsSketchManager As DraftSight.SketchManager
        Dim dsSelectionMgr As DraftSight.SelectionManager
        Dim dsSelectionFilter As DraftSight.SelectionFilter

        Sub main()

        'Connect to DraftSight
        Set dsApp = GetObject(, "DraftSight.Application")

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

        'Abort any command currently running in DraftSight
        'to avoid nested commands
        dsApp.AbortRunningCommand

        'Get Selection Manager
        Set dsSelectionMgr = dsDoc.GetSelectionManager

        'Get selection filter
         Set dsSelectionFilter = 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 command message object
        Dim dsCommandMessage As CommandMessage
        Set dsCommandMessage = dsApp.GetCommandMessage

        'Prompt user to select a Hatch entity
        'and get whether selected entity is a Hatch entity
        Dim singleSelection As Boolean
        singleSelection = True
        Dim prompt As String
        prompt = "Please select a Hatch entity."
        Dim errorMessage As String
        errorMessage = "Selected entity is not a Hatch entity."
        If dsCommandMessage.PromptForSelection(singleSelection, prompt, errorMessage) Then
                'Get selected entity
                Dim index As Long
                index = 0
                Dim entityType As dsObjectType_e
                Dim selectedEntity As Object
                Set selectedEntity = dsSelectionMgr.GetSelectedObject(dsSelectionSetType_e.dsSelectionSetType_Previous, index, entityType)

                If dsObjectType_e.dsHatchType <> entityType Then
                    MsgBox (entityType & " was selected, but should be Hatch entity.")
                Else
                    Dim dsHatch As Hatch
                    Set dsHatch = selectedEntity
                    PrintHatchParameters dsHatch
                End If
            End If
        End Sub

            Sub PrintHatchParameters(ByVal dsHatch As Hatch)
            Debug.Print ("Hatch parameters:")

            Debug.Print ("Color = " & dsHatch.Color.GetNamedColor)
            Debug.Print ("LineScale = " & dsHatch.LineScale)
            Debug.Print ("LineStyle = " & dsHatch.LineStyle)
            Debug.Print ("LineWeight = " & dsHatch.LineWeight)
            Debug.Print ("Layer = " & dsHatch.Layer)
            Debug.Print ("Visible = " & dsHatch.Visible)
            Debug.Print ("Erased = " & dsHatch.Erased)
            Debug.Print ("Handle = " & dsHatch.Handle)

            Dim x1 As Double, y1 As Double, z1 As Double
            Dim x2 As Double, y2 As Double, z2 As Double
            dsHatch.GetBoundingBox x1, y1, z1, x2, y2, z2
            Debug.Print ("BoundingBox: " & x1 & ", " & y1 & ", " & z1 & ", " & x2 & ", " & y2 & ", " & z2)

            'Iterate through Hatch boundary loops
            Dim loopsCount As Long
            loopsCount = dsHatch.GetBoundaryLoopsCount()
            Debug.Print ("Count of loops = " & loopsCount)
            Dim index As Long
            For index = 0 To loopsCount - 1
                Debug.Print ("Loop(" & index & "):")

                'Get Hatch boundary loop
                Dim dsHatchBoundaryLoop As DraftSight.HatchBoundaryLoop
                Set dsHatchBoundaryLoop = dsHatch.GetHatchBoundaryLoop(index)

                Debug.Print ("Type = " & dsHatchBoundaryLoop.Type)
                Debug.Print ("IsPolyline = " & dsHatchBoundaryLoop.IsPolyLine)

                If dsHatchBoundaryLoop.IsPolyLine Then
                    'Get 2D PolyLine boundary loop data
                    GetPolyLineBoundaryLoopData dsHatchBoundaryLoop
                Else
                    'Get edges count
                    Dim edgesCount As Long
                    edgesCount = dsHatchBoundaryLoop.GetEdgesCount()
                    Debug.Print ("Edges count = " & edgesCount)
                    Dim edgeIndex As Long
                    For edgeIndex = 0 To edgesCount - 1
                        Dim edgeType As dsHatchEdgeType_e
                        edgeType = dsHatchBoundaryLoop.GetEdgeType(edgeIndex)
                        Debug.Print ("Edge type = " & edgeType)

                        Select Case edgeType
                            Case dsHatchEdgeType_e.dsHatchEdgeType_Line
                                If True Then
                                    'Get Line edge data
                                    GetLineEdgeData dsHatchBoundaryLoop, edgeIndex
                                End If
                            Case dsHatchEdgeType_e.dsHatchEdgeType_CircleArc
                                If True Then
                                    'Get Circle edge data
                                    GetArcEdgeData dsHatchBoundaryLoop, edgeIndex
                                    End
                                End If
                            Case dsHatchEdgeType_e.dsHatchEdgeType_EllipseArc
                                If True Then
                                    'Get Ellipse edge data
                                    GetEllipseEdgeData dsHatchBoundaryLoop, edgeIndex
                                End If
                            Case dsHatchEdgeType_e.dsHatchEdgeType_Spline
                                If True Then
                                    'Get Spline edge data
                                    GetSplineEdgeData dsHatchBoundaryLoop, edgeIndex
                                End If
                        End Select
                    Next
                End If
            Next
        End Sub

    Sub GetSplineEdgeData(ByVal dsHatchBoundaryLoop As HatchBoundaryLoop, ByVal edgeIndex As Long)
            Dim degree As Long
            Dim rational As Boolean
            Dim periodic As Boolean
            Dim knotValues As Variant
            Dim controlPoints As Variant
            dsHatchBoundaryLoop.GetSplineEdgeData edgeIndex, degree, rational, periodic, knotValues, controlPoints
            Debug.Print ("Spline edge data:")
            Debug.Print ("   Degree = " & degree)
            Debug.Print ("   Rational = " & rational)
            Debug.Print ("   Periodic = " & periodic)

            If IsArray(knotValues) Then
                Dim knotValue As Double
                Dim index As Long
                index = 0
                For index = 0 To UBound(knotValues)
                    Debug.Print ("   Knot(" & index & "):" & knotValues(index))
                Next
            End If

            If IsArray(controlPoints) Then
                 Dim controlPointIndex As Long
                 controlPointIndex = 0
                 For index = 0 To UBound(controlPoints) - 1
     		Debug.Print (" Control point({0}): ({1},{2}), " & index & ", " & controlPoints(index) & ", " & controlPoints(index + 1))
                    controlPointIndex = controlPointIndex + 1
                 Next
            End If
        End Sub

        Sub GetEllipseEdgeData(ByVal dsHatchBoundaryLoop As HatchBoundaryLoop, ByVal edgeIndex As Long)
            Dim centerX As Double
            Dim centerY As Double
            Dim majorAxisX As Double
            Dim majorAxisY As Double
            Dim minorAxisLengthRatio As Double
            Dim startAngle As Double
            Dim endAngle As Double
            Dim isCounterclockwiseFlag As Boolean
            dsHatchBoundaryLoop.GetEllipseEdgeData edgeIndex, centerX, centerY, majorAxisX, majorAxisY, minorAxisLengthRatio, startAngle, endAngle, isCounterclockwiseFlag
            Debug.Print ("Ellipse edge data:")
            Debug.Print ("   Center X = " & centerX)
            Debug.Print ("   Center Y = " & centerY)
            Debug.Print ("   Major axis X = " & majorAxisX)
            Debug.Print ("   Major axis Y = " & majorAxisY)
            Debug.Print ("   Minor axis length ratio = " & minorAxisLengthRatio)
            Debug.Print ("   Start angle = " & startAngle)
            Debug.Print ("   End angle = " & endAngle)
            Debug.Print ("   Is counter-clockwise = " & isCounterclockwiseFlag)
        End Sub

        Sub GetArcEdgeData(ByVal dsHatchBoundaryLoop As HatchBoundaryLoop, ByVal edgeIndex As Long)
            Dim centerX As Double
            Dim centerY As Double
            Dim radius As Double
            Dim startAngle As Double
            Dim endAngle As Double
            Dim isCounterclockwiseFlag As Boolean
            dsHatchBoundaryLoop.GetArcEdgeData edgeIndex, centerX, centerY, radius, startAngle, endAngle, isCounterclockwiseFlag
            Debug.Print ("Arc edge data:")
            Debug.Print ("   Center X = " & centerX)
            Debug.Print ("   Center Y = " & centerY)
            Debug.Print ("   Radius = " & radius)
            Debug.Print ("   Start angle = " & startAngle)
            Debug.Print ("   End angle = " & endAngle)
            Debug.Print ("   Is counter-clockwise = " & isCounterclockwiseFlag)
        End Sub

        Sub GetLineEdgeData(ByVal dsHatchBoundaryLoop As HatchBoundaryLoop, ByVal edgeIndex As Long)
            Dim startPointX As Double
            Dim startPointY As Double
            Dim endPointX As Double
            Dim endPointY As Double
            dsHatchBoundaryLoop.GetLineEdgeData edgeIndex, startPointX, startPointY, endPointX, endPointY
            Debug.Print ("Line edge data:")
            Debug.Print ("   Start point X = " & startPointX)
            Debug.Print ("   Start Point Y = " & startPointY)
            Debug.Print ("   End point X = " & endPointX)
            Debug.Print ("   End point Y = " & endPointY)
        End Sub

        Sub GetPolyLineBoundaryLoopData(ByVal dsHatchBoundaryLoop As HatchBoundaryLoop)
            Dim hasBulge As Boolean
            Dim isClosed As Boolean
            Dim coordinates As Object
            Dim bulges As Object
            dsHatchBoundaryLoop.GetPolyLineBoundaryLoopData hasBulge, isClosed, coordinates, bulges

            Debug.Print ("2D PolyLine boundary loop data:")
            Debug.Print ("   Has bulge = " & hasBulge)
            Debug.Print ("   Is closed = " & isClosed)
            If Not IsArray(coordinates) Then
                Dim coordinatesDblArray() As Double
                coordinatesDblArray = coordinates
                If Not IsArray(coordinatesDblArray) Then
                    Dim vertexIndex As Long
                    vertexIndex = 0
                    For coordinateIndex = 0 To (UBound(coordinatesDblArray) - 1)
                        Debug.Print ("   Coordinate({0}): ({1},{2},{3}), " & System.Math.Max(System.Threading.Interlocked.Increment(vertexIndex) & ", " & vertexIndex - 1) & ", " & coordinatesDblArray(coordinateIndex) & ", " & coordinatesDblArray(coordinateIndex + 1))
                    Next
                End If
            End If

            If hasBulge Then
                If Not IsArray(bulges) Then
                    Dim bulgesDblArray() As Double
                    bulgesDbleArray = bulges
                    If Not IsArray(bulgesDblArray) Then
                        For bulgeIndex = 0 To (UBound(bulgesDblArray) - 1)
                            Debug.Print ("   Bulge(" & bulgeIndex & "):" & bulgesDblArray(bulgeIndex))
                        Next
                    End If
                End If
            End If
        End Sub