Hole Thread Notes placement position

[Anonymous]

Hi All,

I am stumped on this hole callout.  When the holes are below the center of the view, the placement is correct.  However, when the holes are above the center, the placement doesnt seem to correspond with the position I am giving.  Is there something I am missing here.  Attached screenshots of what i want and what is happening.

[Anonymous]

'This class is used to create the dimensions required for a hole pattern
'   A pattern has more than two holes in it
'
'   S = Start of pattern
'   P = Pattern spacing / second hole in pattern from left
'   E = End of pattern
'
'   S       P                       E
'   |-------------------------------|
'   |-------|
'   O       O       O       O       O
'

'Declare
Private oCentermarks As ObjectCollection

Public Function ExtractPatternFromCentermarks(ByRef oCentermarks As ObjectCollection) As ObjectCollection

'Looks for pattern in centermarks
'   Returns the first, second and last centermark of the pattern

    Dim dblPatternSpacing As Double
    Dim oFirstCentermark As Centermark
    Dim oSecondCentermark As Centermark
    Dim oLastCentermark As Centermark
    Dim oFloat1 As Centermark
    Dim oFloat2 As Centermark
    Dim lngFloatPos As Long
    Dim bPatternFound As Boolean
    Dim lngPatternCount As Long
    Dim oPatternSet As ObjectCollection
    Dim oPatternSets As ObjectCollection

    'Check that pattern is possible
    If oCentermarks.Count < 3 Then
        Exit Function
    End If

    'Initialize the variables
    lngFloatPos = 2
    Set oFirstCentermark = oCentermarks(lngFloatPos - 1)
    Set oSecondCentermark = oCentermarks(lngFloatPos)
    Set oFloat1 = oCentermarks(lngFloatPos)
    Set oFloat2 = oCentermarks(lngFloatPos + 1)
    bPatternFound = False
    Set oPatternSets = ThisApplication.TransientObjects.CreateObjectCollection

    'Set the intial pattern spacing
    dblPatternSpacing = XDiff(oFirstCentermark, oSecondCentermark)
    
'    ===============================================================
'
'    Pattn = First and second hole of pattern
'    Float = test pair for pattern, left side of float will be
'       the last hole in pattern when test fails;
'       right side of float will be the last hole when float reaches
'       the end and test passes
'
'        Pattn |---|
'        Float     |---|
'        Holes X   O   O   O   X
'
'        Pattn     |---|
'        Float     |---|
'        Holes X   O   O   O   X
'
'        Pattn     |---|
'        Float         |---|
'        Holes X   O   O   O   X
'
'    ===============================================================
    
    Do While lngFloatPos < oCentermarks.Count - 1
    
        If XDiff(oFloat1, oFloat2) = dblPatternSpacing Then
            
            'Set the flag
            bPatternFound = True
            
            'Set the last centermark
            Set oLastCentermark = oFloat2
            
            'Move float
            Set oFloat1 = oCentermarks(lngFloatPos + 1)
            Set oFloat2 = oCentermarks(lngFloatPos + 2)
        
        Else
        
            If bPatternFound Then
                
                'Add pattern to pattern set array
                Set oPatternSet = ThisApplication.TransientObjects.CreateObjectCollection
                Call oPatternSet.Add(oFirstCentermark)
                Call oPatternSet.Add(oSecondCentermark)
                Call oPatternSet.Add(oLastCentermark)
                Call oPatternSets.Add(oPatternSet)
                lngPatternCount = lngPatternCount + 1
                
                'Reset the flag
                bPatternFound = False
                
            End If
            
            'Set first and second hole positions
            Set oFirstCentermark = oCentermarks(lngFloatPos)
            Set oSecondCentermark = oCentermarks(lngFloatPos + 1)
            
            'Set the pattern spacing
            dblPatternSpacing = XDiff(oFirstCentermark, oSecondCentermark)
            
            'Move float
            Set oFloat1 = oCentermarks(lngFloatPos + 1)
            Set oFloat2 = oCentermarks(lngFloatPos + 2)
            
        End If
        
        'Increment the float position
        lngFloatPos = lngFloatPos + 1
        
    Loop
    
    If bPatternFound Then
    
        'Add the pattern to pattern set array
        Set oPatternSet = ThisApplication.TransientObjects.CreateObjectCollection
        Call oPatternSet.Add(oFirstCentermark)
        Call oPatternSet.Add(oSecondCentermark)
        Call oPatternSet.Add(oFloat2)
        Call oPatternSets.Add(oPatternSet)
        lngPatternCount = lngPatternCount + 1
        
        'Reset the flag
        bPatternFound = False
        
    End If

    Set ExtractPatternFromCentermarks = oPatternSets

End Function

Private Function XDiff(ByRef oFirstCentermark As Centermark, ByRef oSecondCentermark As Centermark) As Double

    XDiff = Round(oSecondCentermark.Position.X - oFirstCentermark.Position.X, 5)

End Function

Private Function YDiff(ByRef oFirstCentermark As Centermark, ByRef oSecondCentermark As Centermark) As Double

    YDiff = Round(oSecondCentermark.Position.Y - oFirstCentermark.Position.Y, 5)

End Function

Public Function ExtractCommonCentermarks(ByRef oCenterlinesandmarks As ObjectsEnumerator) As ObjectCollection

'Extract the centermarks that share common geometry arc sizes
'  Ignore geometry that are not arcs

    'Declare
    Dim oObj As Object
    Dim oCentermarks As ObjectCollection
    Dim oExtractedCentermarks As ObjectCollection
    Dim oExtractedCentermarksSet As ObjectCollection
    Dim lngTypeCount As Double
    
    'Initialize the variables
    Set oCentermarks = ThisApplication.TransientObjects.CreateObjectCollection
    Set oExtractedCentermarksSet = ThisApplication.TransientObjects.CreateObjectCollection
    lngTypeCount = 0

    'Extract all the centermarks from oCenterLinesAndMarks
    For Each oObj In oCenterlinesandmarks
        If TypeName(oObj) = "Centermark" Then
            Call oCentermarks.Add(oObj)
        End If
    Next

    Do While oCentermarks.Count <> 0

        Set oExtractedCentermarks = ExtractCentermarkByCommonGeometry(oCentermarks)
        If Not oExtractedCentermarks Is Nothing Then
            Call oExtractedCentermarksSet.Add(oExtractedCentermarks)
            lngTypeCount = lngTypeCount + 1
        End If
        
    Loop
    
    Set ExtractCommonCentermarks = oExtractedCentermarksSet

End Function

Private Function ExtractCentermarkByCommonGeometry(ByRef oCentermarks As ObjectCollection) As ObjectCollection

    'Declare
    Dim oCentermark As Centermark
    Dim oGeometryIntent As GeometryIntent
    Dim oDrawingCurve As DrawingCurve
    Dim oDrawingCurveSegment As DrawingCurveSegment
    Dim oCommonCenterPoint As Point2d
    Dim dblCommonRadius As Double
    Dim oCenterPoint As Point2d
    Dim dblRadius As Double
    Dim oCommonCentermarks As ObjectCollection
    
    'Initialize the variables
    Set oCommonCentermarks = ThisApplication.TransientObjects.CreateObjectCollection
    
    'Define the search criteria for comparison (first centermark in collection)
    '   Using the first centermark, build a collection of common centermarks
    Set oCentermark = oCentermarks.Item(1)
    Set oGeometryIntent = oCentermark.AttachedEntity
    Set oDrawingCurve = oGeometryIntent.Geometry
    Set oDrawingCurveSegment = oDrawingCurve.Segments(1)
    Select Case TypeName(oDrawingCurveSegment.Geometry)
        Case "Circle2d"
            dblCommonRadius = GetRadiusFromCircle2d(oDrawingCurveSegment)
        Case Else
            Debug.Assert (TypeName(oDrawingCurveSegment.Geometry) = "Circle2d")
    End Select
    
    'Add centermarks based on geometry to array
    For Each oCentermark In oCentermarks
        Set oGeometryIntent = oCentermark.AttachedEntity
        Select Case TypeName(oGeometryIntent.Geometry)
            Case "DrawingCurve"
            Set oDrawingCurve = oGeometryIntent.Geometry
        
            For Each oDrawingCurveSegment In oDrawingCurve.Segments
                If GetRadiusFromCircle2d(oDrawingCurveSegment) = dblCommonRadius Then
                    Call oCommonCentermarks.Add(oCentermark)
                    Call oCentermarks.RemoveByObject(oCentermark)
                End If
            Next
                
            Case Else
                Debug.Print "Attached to something else"
                Debug.Print TypeName(oObj)
        End Select
        
    Next
    
    'Return
    Set ExtractCentermarkByCommonGeometry = oCommonCentermarks

End Function

Private Function GetRadiusFromCircle2d(ByRef oDrawingCurveSegment As DrawingCurveSegment) As Double
    
    'Declare
    Dim oCircle2d As Circle2d
    Dim dblRadius As Double
    
    'Initialize the variables
    Set oCircle2d = oDrawingCurveSegment.Geometry

    'Values for radius of drawing curves are sporadic
    '   First 6 digits seem to be consistent between identical features
    dblRadius = Round(oCircle2d.Radius, 5) 'Round values to 5 decimal places
    
    'Return
    GetRadiusFromCircle2d = dblRadius

End Function

Public Sub PlaceHorizontal(ByRef oFirstHole As Centermark, _
                           ByRef oSecondHole As Centermark, _
                           ByRef oLastHole As Centermark)

    'Declare
    Dim oDrawDoc As DrawingDocument
    Dim oSheet As Sheet
    Dim oDrawingView As DrawingView
    Dim oChainPlacementPoint As Point2d
    Dim oLinearPlacementPoint As Point2d
    Dim oHoleCalloutPlacementPoint As Point2d
    Dim oChainIntentCollection As ObjectCollection
    Dim oLinearIntentCollection As ObjectCollection
    Dim oFirstHoleIntent As GeometryIntent
    Dim oSecondHoleIntent As GeometryIntent
    Dim oLastHoleIntent As GeometryIntent
    Dim oChainDimensionSets As ChainDimensionSets
    Dim oChainDimensionSet As ChainDimensionSet
    Dim oGeneralDimensions As GeneralDimensions
    Dim oLinearDimension As LinearGeneralDimension
    Dim oHoleThreadNotes As HoleThreadNotes
    Dim oHoleGeometryIntent As GeometryIntent
    Dim oHoleGeometry As DrawingCurve
    Dim oHoleCallout As HoleThreadNote
    Dim dblChainPlacementPosX As Double
    Dim dblChainPlacementPosY As Double
    Dim dblLinearPlacementPosX As Double
    Dim dblLinearPlacementPosY As Double
    Dim dblHoleCalloutPlacementPosX As Double
    Dim dblHoleCalloutPlacementPosY As Double
    
    'Initialize the variables
    Set oDrawDoc = ThisApplication.ActiveDocument
    Set oSheet = oDrawDoc.ActiveSheet
    Set oDrawingView = oFirstHole.AttachedEntity.Geometry.Parent 'Parent should be drawing view?
    Set oChainIntentCollection = ThisApplication.TransientObjects.CreateObjectCollection
    Set oLinearIntentCollection = ThisApplication.TransientObjects.CreateObjectCollection
    Set oFirstHoleIntent = oSheet.CreateGeometryIntent(oFirstHole)
    Set oSecondHoleIntent = oSheet.CreateGeometryIntent(oSecondHole)
    Set oLastHoleIntent = oSheet.CreateGeometryIntent(oLastHole)
    Set oChainDimensionSets = oSheet.DrawingDimensions.ChainDimensionSets
    Set oGeneralDimensions = oSheet.DrawingDimensions.GeneralDimensions
    Set oHoleThreadNotes = oSheet.DrawingNotes.HoleThreadNotes
    
    'Define the placement points (1 = 10mm)
    '   Place the dimensions above or below and centered between the centermarks
    With oDrawingView
        If oFirstHole.Position.Y > .Center.Y Then 'Place the pattern dims above the drawing view
            dblChainPlacementPosY = .Top + 1.6
            dblLinearPlacementPosY = .Top + 1
            dblHoleCalloutPlacementPosY = .Top + 1
        Else 'Place the pattern dims below the drawing view
            dblChainPlacementPosY = .Center.Y - (.Top - .Center.Y) - 1.6
            dblLinearPlacementPosY = .Center.Y - (.Top - .Center.Y) - 1
            dblHoleCalloutPlacementPosY = dblLinearPlacementPosY + 0.6
        End If
    End With
    
    dblChainPlacementPosX = (oFirstHole.Position.X + oLastHole.Position.X) * 0.5 'Centered between the first and last holes
    dblLinearPlacementPosX = (oFirstHole.Position.X + oSecondHole.Position.X) * 0.5 'Centered between the first and second holes
    dblHoleCalloutPlacementPosX = oSecondHole.Position.X + 0.3
    
    With ThisApplication.TransientGeometry
        Set oChainPlacementPoint = .CreatePoint2d(dblChainPlacementPosX, dblChainPlacementPosY)
        Set oLinearPlacementPoint = .CreatePoint2d(dblLinearPlacementPosX, dblLinearPlacementPosY)
        Set oHoleCalloutPlacementPoint = .CreatePoint2d(dblHoleCalloutPlacementPosX, dblHoleCalloutPlacementPosY)
    End With
    
    'Place a horizontal chain dimension set for the total length of the pattern set
    Call oChainIntentCollection.Add(oFirstHoleIntent)
    Call oChainIntentCollection.Add(oLastHoleIntent)
    Set oChainDimensionSet = oChainDimensionSets.Add(oChainIntentCollection, oChainPlacementPoint, kHorizontalDimensionType)
    
    'Place a horizontal linear dimension for the pattern spacing; and
    '  Add TYP to the end of the dimension text
    '  Center the dimensions text alignment
    Set oLinearDimension = oGeneralDimensions.AddLinear(oLinearPlacementPoint, oFirstHoleIntent, oSecondHoleIntent, kHorizontalDimensionType)
    
    With oLinearDimension.Text
        .FormattedText = "<DimensionValue/><Br/>TYP"
        .HorizontalJustification = kAlignTextCenter
    End With
    
    'Place hole callout
    Set oHoleGeometryIntent = oSecondHole.AttachedEntity
    Set oHoleGeometry = oHoleGeometryIntent.Geometry
    Set oHoleCallout = oHoleThreadNotes.Add(oHoleCalloutPlacementPoint, oHoleGeometry)

End Sub

[Anonymous]

Just to add more information to anyone that searches for this later... I haven't seen any consistent pattern in the placement of the hole callout when giving it a placement position.  Sometimes it is placed in the correct position (mostly on holes with no countersinks) while the rest of the time, the hole callout is placed in some arbitrary location; usually close to the center of the holes geometry intent.  I've tried a few things to correct this, however, it seems like once the hole callout is placed, I am unable to move the location of the holecallout.  The hole callout uses a line to define the leader line, so at this time, without redefining the leader line entirely, I don't see a way to fix the leader line coming in reversed.  Also, whether the arrow is on the inside or the outside is another thing that doesn't seem to be consistent, and I don't see a property to change in the HoleThreadNote to change this.

I have not found a solution to this problem, as it doesn't take much to quickly fix the hole location.  Haven't had a chance to test all the possibilities, as there are many different hole types/hole callouts in inventor.

----------------------------

FYI I am working on drawing tools primarily to speed the creation of drawings; in case anyone is interested.

The code posted above is meant to search for a pattern in centermarks located on similar hole sizes, without querying the hole pattern features from the model.  It will identify patterns of holes regardless of how they were created, so long as the spacing between 3 holes is similar.