BOM Balloon Attachment Point Moves to End of Objec

I have attempted to put together a macro that will reattach BOM balloons in a drawing to whatever object is exactly where the arrow head is. This is used to correct dangling balloons when I restructure the assembly hierarchy.

I am running Solidworks 2019 service pack 4.0

First the BOM Balloon needs to be selected and then when the macro is run it is supposed to reattach the balloon to the new object in the same location.
--The problem is that when I save and reopen the drawing the attachment point (and balloon) move to the end point of the object instead of staying at the selected point.
Although I set the leader attachment point, this doesn't survive a save and reopen. Is this a bug? or is there some other way to include the attachment point when setting the attached entities? Any help would be greatly appreciated.

'===================================================

Option Explicit

Sub main()
    Dim swApp       As SldWorks.SldWorks
    Dim swModel     As SldWorks.ModelDoc2
    Dim swSelMgr    As SldWorks.SelectionMgr
    Dim swSelObj1   As Object
    Dim swAnn       As SldWorks.Annotation
    Dim Boolstatus As Boolean
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swSelObj1 = swSelMgr.GetSelectedObject6(1, -1)
    Set swAnn = swSelObj1.GetAnnotation
    Boolstatus = ReattachBalloon(swModel, swAnn)
End Sub

Function ReattachBalloon(swModel As SldWorks.ModelDoc2, swAnn As SldWorks.Annotation) As Boolean
    Dim swAnnPos As Variant
    Dim swArrowPos As Variant
    Dim swObject As Object
Dim swDisplayData As IDisplayData
Dim Boolstatus As Boolean
Dim swSelMgr As SelectionMgr
Dim swSelObj2 As Object
        Debug.Print ""
        Debug.Print " Annotation Type = " & swAnn.GetType & "; Annotation Name: " & swAnn.GetName
'==========get annotation position==========
    swAnnPos = swAnn.GetPosition
        Debug.Print "Annotation Position:       " & Str(swAnnPos(0)) & ", " & Str(swAnnPos(1)) & Str(swAnnPos(2))
'==========get arrow position==========
    Set swObject = swAnn.GetDisplayData
    Set swDisplayData = swObject
   ' If Not swDisplayData Is Nothing Then
      Dim swWeldSymbolAnn As WeldSymbol
      Dim Suitable As Boolean
      Suitable = True

      If swAnn.GetType = swWeldSymbol Then
        Set swWeldSymbolAnn = swAnn.GetSpecificAnnotation
        Debug.Print "number of arrowheads: " & swWeldSymbolAnn.GetArrowHeadCount & "; number of leaders: " & swWeldSymbolAnn.HasExtraLeader

        If swWeldSymbolAnn.GetArrowHeadCount = 0 Then
            Suitable = False
        End If
      End If

Debug.Print "multijog leader count: " & swAnn.GetMultiJogLeaderCount & "; smart arrow head?: " & swAnn.GetSmartArrowHeadStyle

     swArrowPos = swDisplayData.GetArrowHeadAtIndex(0)
     Boolstatus = IsEmpty(swArrowPos)
     '   If Not IsEmpty(swArrowPos) Then
     Debug.Print "bent leader = " & swAnn.GetBentLeader & "; get leader = " & swAnn.GetLeader
'   If swAnn.GetLeader And Not swAnn.GetBentLeader Then
    If swAnn.GetLeader And Suitable Then
    Debug.Print "number of arrowheads: " & swAnn.GetArrowHeadCount & "; number of leaders: " & swAnn.GetLeaderCount & swAnn.BentLeaderLength

            Debug.Print "Arrow Position:            " & Str(swArrowPos(0)) & ", " & Str(swArrowPos(1)) & Str(swArrowPos(2))
       '     End If
      ' Else
      '      MsgBox "Could not get display data for this object"
      ' End If
     '==========get object to attach to==========
        Boolstatus = swModel.Extension.SelectByRay(swArrowPos(0), swArrowPos(1), swArrowPos(2), 0, 0, -1, 0.001, 1, True, 0, 0)
        If Boolstatus = False Then
                  Boolstatus = swModel.Extension.SelectByRay(swArrowPos(0), swArrowPos(1), swArrowPos(2), 0, 0, -1, 0.000000001, 2, True, 0, 0)
        End If
        If Boolstatus Then
            Set swSelMgr = swModel.SelectionManager
            Debug.Print "selected object count " & Str(swSelMgr.GetSelectedObjectCount)
            Set swSelObj2 = swSelMgr.GetSelectedObject6(swSelMgr.GetSelectedObjectCount, -1)
            Debug.Print "object to attach to type " & swSelObj2.GetType

        '==========attach annotation to object==========
            Dim AttEntArr(0) As Object
            Set AttEntArr(0) = swSelObj2
            Dim vAttEntArrIn As Variant
            vAttEntArrIn = AttEntArr

Debug.Print "get attached entities count: " & swAnn.IGetAttachedEntityCount & "   type: " & swAnn.IGetAttachedEntityTypes

'Dim swtempObject As Object
'Set swtempObject = swAnn.IGetAttachedEntity
            Boolstatus = swAnn.SetAttachedEntities(vAttEntArrIn)
            '==========reposition annotation and arrow==========
            Boolstatus = swAnn.SetPosition(swAnnPos(0), swAnnPos(1), swAnnPos(2))

            Boolstatus = swAnn.SetLeaderAttachmentPointAtIndex(0, swArrowPos(0), swArrowPos(1), swArrowPos(2))
        Else
            MsgBox "could not find object to attach to"
        End If

    End If

End Function