Getting hatch boundaries

[Thomas.Long]

I'm looking at an acad program to get all the hatches in a filtered selection set, detect their hatch pattern name, and write the x and y values for the bottom left on them, as well as height and width of each instance of each loop of the hatch object to an excel file. I plan to use them to generate objects and generate 3D modeled parts and correctly place them in a 3D file. Unfortunately, some will be associated hatches and some will not be.

I already have code for creating and writing to excel files, it's just the hatch boundaries I need.

Code thus far: 

Sub test()

    Dim oEnt As AcadEntity
    Dim HatchObj As AcadHatch


    'Selection Prompt information
    ThisDrawing.Utility.Prompt ("Select Hatches: " & vbCrLf)

    'Select Information
    Set oSset = ThisDrawing.PickfirstSelectionSet
    oSset.Clear
    
    Dim fcode(0) As Integer
    Dim fdata(0) As Variant
    
    fcode(0) = 0
    fdata(0) = "HATCH"

    oSset.SelectOnScreen fcode, fdata

    'Separate beams and stringers into different arrays
    For Each oEnt In oSset
        Set HatchObj = oEnt
        MsgBox (HatchObj.PatternName)
    Next

End Sub

Thank you in advance,

Thomas Long

[Thomas.Long]

Slight Update, I've managed to get the bottom left of the overall hatch object, which is fine if each individual hatch is only 1 loop. However, in the case of a hatch object that has multiple loops, it only gives it to me once and only the bottom left point of the entire area. What I'm really needing is the bottom left of each individual loop.

Updated Code

Sub test()

    Call SetUCS
    
    Dim oEnt As AcadEntity
    Dim HatchObj As AcadHatch

    'Selection Prompt information
    ThisDrawing.Utility.Prompt ("Select Hatches: " & vbCrLf)

    'Select Information
    Set oSset = ThisDrawing.PickfirstSelectionSet
    oSset.Clear
    
    Dim fcode(0) As Integer
    Dim fdata(0) As Variant
    
    fcode(0) = 0
    fdata(0) = "HATCH"

    oSset.SelectOnScreen fcode, fdata
    
    Dim x As Variant
    Dim y As Variant
    Dim InsertionPoint As Variant

    For Each oEnt In oSset
        Set HatchObj = oEnt
        MsgBox (HatchObj.PatternName)
        Call HatchObj.GetBoundingBox(x, y)
        InsertionPoint = ThisDrawing.Utility.TranslateCoordinates(x, acWorld, acUCS, False)
        MsgBox (HatchObj.NumberOfLoops)
        MsgBox (InsertionPoint(0) & "," & InsertionPoint(1))
    Next

End Sub

[Thomas.Long]

Attempt 3, getting closer:

I've successfully gotten the min and max of the hatch for each loop of associative hatches only. However, if you have a non associative hatch with multiple loops it doesn't seem like it allows you to iterate through multiple loops. So I'm trying to convert non associative hatches to associative hatches with the recreate boundary function. Unfortunately, setting the selection set to the latest hatch object and then entering the command line function, or vice versa, doesn't seem to work. It just dumps out whatever I set to the latest selection set and waits for users to input it manually.

It should be noted the only reason I have to do this is that non associative hatches don't seem to do anything when you call the GetLoopAt function. You can call it just fine, but the array doesn't fill with anything, it just remains empty and throws an error when you try to get a bounding box for the loop object, even though it recognizes that non associative hatches still have multiple loops and I can't figure out why.

Any help at all would be greatly appreciated.

Thank you,

Thomas Long

Sub test()

    Call SetUCS
    
    Dim oEnt As AcadEntity
    Dim HatchObj As AcadHatch

    'Selection Prompt information
    ThisDrawing.Utility.Prompt ("Select Hatches: " & vbCrLf)

    'Select Information
    Set oSset = ThisDrawing.PickfirstSelectionSet
    oSset.Clear
    
    Dim fcode(0) As Integer
    Dim fdata(0) As Variant
    
    fcode(0) = 0
    fdata(0) = "HATCH"

    oSset.SelectOnScreen fcode, fdata
    
    Dim botLeftPoint As Variant
    Dim topRightPoint As Variant
    Dim InsertionPoint As Variant
    
    Dim xMin As Double
    Dim xMax As Double
    Dim yMin As Double
    Dim yMax As Double
    
    Dim LoopObj As Variant
    Dim LoopObjs As Variant
    
    Dim corrSelSet As AcadSelectionSet
    Set corrSelSet = ThisDrawing.SelectionSets.Add("corrSelSet")
    
    For Each oEnt In oSset
        Set HatchObj = oEnt
        
        If Not HatchObj.AssociativeHatch Then
            ThisDrawing.SendCommand ("-HATCHEDIT" & vbCr)
            Dim ssobjs(0) As AcadEntity
            Set ssobjs(0) = oEnt
            corrSelSet.AddItems (ssobjs)
            ThisDrawing.ActiveSelectionSet.AddItems (ssobjs)
            ThisDrawing.SendCommand (vbCr)
            ThisDrawing.SendCommand ("B" & vbCr)
            ThisDrawing.SendCommand ("R" & vbCr)
            ThisDrawing.SendCommand ("Y" & vbCr)
        End If
        
        If HatchObj.AssociativeHatch Then
        
            For i = 0 To HatchObj.NumberOfLoops - 1
            
                MsgBox (HatchObj.PatternName)
                Call HatchObj.GetLoopAt(i, LoopObjs)
                
                For Each LoopObj In LoopObjs
                    Call LoopObj.GetBoundingBox(botLeftPoint, topRightPoint)
                    
                    InsertionPoint = ThisDrawing.Utility.TranslateCoordinates(botLeftPoint, acWorld, acUCS, False)
                    xMin = InsertionPoint(0)
                    yMin = InsertionPoint(1)
                    
                    InsertionPoint = ThisDrawing.Utility.TranslateCoordinates(topRightPoint, acWorld, acUCS, False)
                    xMax = InsertionPoint(0)
                    yMax = InsertionPoint(1)
                    
                    MsgBox ("Start: " & xMin & "," & yMin & vbLf & xMax - xMin & "," & yMax - yMin)
                Next
            Next
        End If
    Next
    corrSelSet.Delete

End Sub