全ての寸法に番号バルーンを付ける2

こちらの続きです。
全ての寸法に番号バルーンを付ける1 - C#ATIA
取りあえず試すことが出来る状態となりましたが、まだまだ・・・。

個人的な用途として、こんな感じの参照寸法にはバルーンを作りたく
無いです。えぇ作りたくないんです。

寸法を参照寸法に変更したりするマクロがブログの中にあったはず
なのですが見つからない・・・こんな感じの状態を作ってます。

寸法テキスト-関連テキストのメイン値の前後に丸カッコを
付けて表現しています。

これが付いている状態のものは参照寸法として判断し、
バルーンを作らないようにします。
今後の除外するものが増える可能性もある為、除外する為の
フィルターを用意し、簡単に変更出来るようにしました。

'vba using-'KCL0.0.12'  by Kantoku
'アクティブなシートの全寸法に番号バルーンを付ける

'バルーンレポートビュー名
Private Const BALLOON_VIEW_NAME = "BALLOON"

'テンプレートバルーン名
Private Const TEMPLATE_SHEET_NAME = "template"
Private Const TEMPLATE_BALLOON_NAME = "balloon"

'true/false　vbaとCATIA API食い違い代案
Private Enum BOOL
    boolFalse = 0
    boolTrue = 1
End Enum

'関連テキスト用
Private Enum Dimension_Value
    Main_Value = 1
    Dual_Value = 2
End Enum

Option Explicit

Sub CATMain()

    '除外する関連テキストフィルター
    'Before, After, Upper, Lower
    Dim blackList As Variant
    blackList = Array( _
        Array("(", ")", "", "") _
    )

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim sheet As DrawingSheet
    Set sheet = dDoc.sheets.ActiveSheet

    KCL.SW_Start

    'バルーンテンプレート
    Dim balloonInfo As Variant
    balloonInfo = get_template_balloon()
    If UBound(balloonInfo) < 2 Then
        Exit Sub
    End If

    'コピー
    copy_entity balloonInfo
    sheet.Activate
    
    Dim balloonView As DrawingView
    Set balloonView = get_view_by_name( _
        BALLOON_VIEW_NAME)

    Dim drawDims As Variant
    Dim view As DrawingView
    Dim i As Long
    Dim balloon As DrawingText
    Dim center As Variant

    CATIA.HSOSynchronized = False

    Dim balloonIdx As Long
    balloonIdx = 1

    For Each view In sheet.views

        drawDims = get_dimensions_by_view(view, blackList)
        If UBound(drawDims) < 1 Then
            GoTo continue
        End If

        For i = 0 To UBound(drawDims)
            center = get_center_of_boundary_box( _
                get_boundary_box_by_dimension( _
                    drawDims(i) _
                ) _
            )

            Set balloon = pre_copide_and_paste(balloonView)
            
            move_balloon _
                balloon, _
                Array( _
                    center(0) + 10#, _
                    center(1) + 10# _
                ), _
                center

            balloon.text = CStr(balloonIdx)
            balloonIdx = balloonIdx + 1
        Next
        CATIA.RefreshDisplay = True


continue:
    Next

    CATIA.HSOSynchronized = True

    MsgBox "Done : " & KCL.SW_GetTime

End Sub


'寸法文字の範囲取得
Private Function get_boundary_box_by_dimension( _
    ByVal drawDim As DrawingDimension) _
    As Variant
    
    Dim view As DrawingView
    Set view = KCL.GetParent_Of_T(drawDim, "DrawingView")
    
    Dim viewX As Double
    viewX = view.xAxisData
    
    Dim viewY As Double
    viewY = view.yAxisData

    Dim viewScale As Double
    viewScale = view.Scale
    
    Dim valDim As Variant
    Set valDim = drawDim
    
    Dim bBox(7) As Variant
    valDim.GetBoundaryBox bBox

    Dim bBoxCount As Long
    bBoxCount = UBound(bBox) \ 2

    Dim i As Long
    For i = 0 To bBoxCount
        bBox(i * 2) = bBox(i * 2) * viewScale + viewX
        bBox(i * 2 + 1) = bBox(i * 2 + 1) * viewScale + viewY
    Next
    
    get_boundary_box_by_dimension = bBox

End Function


'検索し配列で取得
Private Function get_search_items( _
    ByVal searchWord As String, _
    Optional selectEntity = Nothing) _
    As Variant

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument
    
    Dim sel As Selection
    Set sel = dDoc.Selection
    
    CATIA.HSOSynchronized = False

    sel.Clear
    If Not selectEntity Is Nothing Then
        sel.Add selectEntity
    End If
    
    sel.Search searchWord
    
    If sel.Count2 < 1 Then
        get_search_items = Array()
        Exit Function
    End If
    
    Dim drawDims() As Variant
    ReDim drawDims(sel.Count2 - 1)
    
    Dim i As Long
    For i = 1 To sel.Count2
        Set drawDims(i - 1) = sel.Item(i).value
    Next
    
    sel.Clear
    
    CATIA.HSOSynchronized = True
    
    get_search_items = drawDims

End Function


'ビュー内の寸法取得-フィルター付き
Private Function get_dimensions_by_view( _
    ByVal view As DrawingView, _
    ByVal filterBlack As Variant) _
    As Variant

    Dim dims As Variant
    dims = get_search_items( _
        "CATDrwSearch.DrwDimension,sel", _
        view _
    )
    
    Dim lst As Collection
    Set lst = New Collection
    
    Dim i As Long
    For i = 0 To UBound(dims)
        If Not is_match_bault_text(dims(i), filterBlack) Then
            lst.Add dims(i)
        End If
    Next

    get_dimensions_by_view = collection_to_array_by_obj(lst)

End Function


'関連テキストのメイン値でフィルターと一致するか？
Private Function is_match_bault_text( _
    ByVal drawDim As DrawingDimension, _
    ByVal filterList As Variant) _
    As Boolean
    
    Dim dimValue As Variant 'DrawingDimValue
    Set dimValue = drawDim.GetValue()

    Dim before, after, upper, lower
    dimValue.GetBaultText _
        Dimension_Value.Main_Value, _
        before, _
        after, _
        upper, _
        lower

    Dim stateBaultText As String
    stateBaultText = Join( _
        Array(before, after, upper, lower), _
        "@" _
    )

    Dim i As Long
    Dim filter As String
    For i = 0 To UBound(filterList)
        filter = Join( _
            filterList(i), _
            "@" _
        )
        If stateBaultText = filter Then
            is_match_bault_text = True
            Exit Function
        End If
    Next

    is_match_bault_text = False

End Function


'ビューを名前で取得
'Optional isCreate - true:なきゃ作る false:なきゃnothing
Private Function get_view_by_name( _
    ByVal name As String, _
    Optional isCreate = True) _
    As DrawingView
    
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim views As DrawingViews
    Set views = dDoc.sheets.ActiveSheet.views

    Dim view As DrawingView
    For Each view In views
        If Not view.name = name Then
            GoTo continue
        End If
        
        Set get_view_by_name = view
        Exit Function
        
continue:
    Next

    If isCreate Then
        Set get_view_by_name = views.Add(name)
    Else
        Set get_view_by_name = Nothing
    End If
    
End Function


'シートを名前で取得
Private Function get_sheet_by_name( _
    ByVal name As String, _
    Optional isDetail As Integer) _
    As DrawingSheet
    
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim sheets As DrawingSheets
    Set sheets = dDoc.sheets

    Dim sheet As DrawingSheet
    For Each sheet In sheets
        If Not sheet.name = name Then
            GoTo continue
        End If

        If sheet.isDetail <> isDetail Then
            GoTo continue
        End If

        Set get_sheet_by_name = sheet
        Exit Function
        
continue:
    Next

    Set get_sheet_by_name = Nothing
    
End Function


'テンプレートバルーンの取得
'return array(DrawingSheet, DrawingView, drawingtext)
Private Function get_template_balloon() _
    As Variant

    get_template_balloon = Array()
    
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim backupSheet As DrawingSheet
    Set backupSheet = dDoc.sheets.ActiveSheet.views

    Dim sheet As DrawingSheet
    Set sheet = get_sheet_by_name(TEMPLATE_SHEET_NAME, BOOL.boolTrue)
    If sheet Is Nothing Then
        MsgBox "テンプレートディテールシートがありません"
        Exit Function
    End If
    sheet.Activate
    
    Dim view As DrawingView
    Set view = get_view_by_name(TEMPLATE_BALLOON_NAME)
    If view Is Nothing Then
        MsgBox "テンプレートビューがありません"
        backupSheet.Activate
        Exit Function
    End If

    view.Activate
    Dim items As Variant
    items = get_search_items( _
        "CATDrwSearch.DrwBalloon,sel", _
        view _
    )
    
    If UBound(items) < 0 Then
        MsgBox "テンプレートバルーンがありません"
        backupSheet.Activate
        Exit Function
    End If

    '最初にHitしたバルーン
    get_template_balloon = Array(sheet, view, items(0))

    backupSheet.Activate

End Function


'コピー済みの状態からペースト
Private Function pre_copide_and_paste( _
    ByVal targetView As DrawingView) _
    As DrawingText
    
    Dim targetSheet As DrawingSheet
    Set targetSheet = KCL.GetParent_Of_T(targetView, "DrawingSheet")

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim sel As Selection
    Set sel = dDoc.Selection

    targetSheet.Activate
    'targetView.Activate
    
    sel.Add targetView
    sel.Paste
    
    Set pre_copide_and_paste = sel.Item2(1).value
    sel.Clear

End Function


'バルーン情報から要素をコピーのみ
Private Sub copy_entity( _
    ByVal balloonInfo As Variant)
    
    Dim sheet As DrawingSheet
    Set sheet = balloonInfo(0)

    Dim view As DrawingView
    Set view = balloonInfo(1)
    
    Dim balloon As DrawingText
    Set balloon = balloonInfo(2)
    
    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument
    
    Dim sel As Selection
    Set sel = dDoc.Selection

    sel.Clear
    sheet.Activate
    view.Activate
    sel.Add balloon
    sel.Copy
    sel.Clear

End Sub


'バルーンの移動
Private Sub move_balloon( _
    ByVal balloon As DrawingText, _
    textPos As Variant, _
    leaderPos As Variant)

    Dim drawLeader As DrawingLeader
    Set drawLeader = balloon.leaders.Item(1)

    balloon.x = textPos(0)
    balloon.y = textPos(1)
    
    drawLeader.ModifyPoint 1, leaderPos(0), leaderPos(1)

End Sub


'バウンダリボックスの中心
Private Function get_center_of_boundary_box( _
    bBox As Variant) _
    As Variant

    get_center_of_boundary_box = Array( _
        (bBox(0) + bBox(6)) * 0.5, _
        (bBox(1) + bBox(3)) * 0.5 _
    )

End Function


'オブジェクトコレクション->配列
Private Function collection_to_array_by_obj( _
    lst As Collection) _
    As Variant

    If lst.count < 1 Then
        collection_to_array_by_obj = Array()
        Exit Function
    End If

    Dim ary() As Variant
    ReDim ary(lst.count - 1)

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

    collection_to_array_by_obj = ary

End Function