C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

バルーンに参照されている寸法値の取得

CATIA V5です。こちらに挑戦しました。
Macro to read value dimension associate at Baloon - DASSAULT: CATIA products - Eng-Tips

質問されていた時期が2月だったので、もう解決済みの可能性も
有りましたが、今年散々バルーンを扱ったので心当たりがありました。

同じことの繰り返しですが・・・

'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


バルーンの1,2はそれぞれ寸法を参照しており、
3は形状で4はバルーンを作成しリーダーを削除したもの。
5は何故か欠番wで6は2個の寸法を参照をしています。
恐らく大丈夫でしょう。

これCSV等でエクスポートしたら、案外需要有るのではないかな?