CODE --> vba

'vba

Option Explicit

Private Const tolerance = 0.001

Sub CATMain()

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim balloon_infos
    balloon_infos = get_balloon_info_referring_dimensions( _
        dDoc, _
        tolerance _
    )

    Dim msg As String
    If IsEmpty(balloon_infos) Then
        msg = "There are no applicable balloons."
    Else
        msg = "Balloon Text : Dimension Values" & _
            vbCrLf & _
            Join(balloon_infos, vbCrLf)
    End If
    
    Debug.Print msg
    MsgBox msg

End Sub


Private Function get_balloon_info_referring_dimensions( _
    ByVal drawDoc As DrawingDocument, _
    ByVal tolerance As Double) _
    As Variant

    get_balloon_info_referring_dimensions = Empty

    Dim balloons As Collection
    Set balloons = get_balloons()
    
    If balloons Is Nothing Then
        Exit Function
    End If

    Dim infos As Collection
    Set infos = New Collection

    Dim balloon As DrawingText
    For Each balloon In balloons

        Dim dims As Collection
        Set dims = get_target_dimensions(balloon)
        If dims Is Nothing Then
            GoTo continue
        End If

        Dim msg As String
        msg = balloon.text & " : "
        msg = msg & get_values_by_dimensions(dims, tolerance)

        infos.Add msg
continue:
    Next

    get_balloon_info_referring_dimensions = lst2ary(infos)

End Function


Private Function get_values_by_dimensions( _
    ByVal dims As Collection, _
    ByVal tolerance As Double) _
    As String

    Dim lst As Collection
    Set lst = New Collection
    
    Dim dimension As DrawingDimension
    For Each dimension In dims
        lst.Add Round(dimension.GetValue().value, tolerance)
    Next

    get_values_by_dimensions = Join(lst2ary(lst), ",")

End Function


Private Function lst2ary( _
    lst As Collection) _
    As Variant

    If lst.count < 1 Then
        lst2ary = Empty
        Exit Function
    End If

    Dim ary() As Variant
    ReDim ary(lst.count - 1)
    
    Dim i As Long
    For i = 1 To lst.count
        ary(i - 1) = lst.Item(i)
    Next

    lst2ary = ary

End Function


Private Function get_target_dimensions( _
    ByVal balloon As DrawingText) _
    As Collection

    If balloon.leaders.count < 1 Then
        Set get_target_dimensions = Nothing
        Exit Function
    End If

    Dim dims As Collection
    Set dims = New Collection

    Dim leader As DrawingLeader
    Dim target As AnyObject
    For Each leader In balloon.leaders
        
        On Error Resume Next
            Set target = leader.HeadTarget
            If target Is Nothing Then
                GoTo continue
            End If
        On Error GoTo 0

        If Not TypeName(target) = "DrawingDimension" Then
            GoTo continue
        End If

        dims.Add target

continue:
    Next
    
    If dims.count < 1 Then
        Set get_target_dimensions = Nothing
    Else
        Set get_target_dimensions = dims
    End If

End Function


Private Function get_balloons() _
    As Collection

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument
    
    Dim sel As Selection
    Set sel = dDoc.Selection
    
    CATIA.HSOSynchronized = False
    
    sel.Clear
    sel.Add dDoc.sheets.ActiveSheet
    
    sel.Search "(CAT2DLSearch.DrwBalloon + CATDrwSearch.DrwBalloon),sel"

    If sel.Count2 < 1 Then
        Set get_balloons = Nothing
        Exit Function
    End If

    Dim balloons As Collection
    Set balloons = New Collection
    
    Dim i As Long
    For i = 1 To sel.Count2
        balloons.Add sel.Item(i).value
    Next

    sel.Clear

    CATIA.HSOSynchronized = True

    Set get_balloons = balloons

End Function