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等でエクスポートしたら、案外需要有るのではないかな?