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

CATIA V5です。
先日、絶対座標での寸法値位置の取得が出来ました。
Drawの寸法値に四角を描く - C#ATIA

これを元に連番となる番号バルーンを作ります。
・・・バルーンはDrawingTextオブジェクトなのですが、
DrawingTextsオブジェクトにはバルーンを作る為のメソッドが
無さそうです。
r1 DrawingTexts (Collection)

となると、最後の手段はコピペです。
目的のビューにバルーンさえあれば、バルーンはX/Yプロパティで
r1 DrawingText (Object)
引き出し線はModifyPointメソッドで移動可能だと分かりました。
r1 DrawingLeader (Object)
（後に海外サイトで検索したところ、バルーンはやはりコピペで行うようです）

取りあえず、通常のシートでも構わないのですが、意図したものでは無い
と言う意味を込めてテンプレートとして使うバルーンを、ディテールシートに
ビューを作り入れておきます。

続いて、目的のシートをアクティブにしこちらのマクロを実行します。

'vba using-'KCL0.1.0'  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

Option Explicit

Sub CATMain()

    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

    'test
    Dim baseView As DrawingView
    Set baseView = sheet.views.item(3)
    
    Dim baseBalloon As DrawingText
    Set baseBalloon = copy_and_paste(balloonInfo, baseView)
    
    Dim templateIndex As Long
    templateIndex = baseView.texts.count
    
    Dim baseInfo As Variant
    baseInfo = Array( _
        sheet, _
        baseView, _
        baseBalloon _
    )

    Dim drawDims As Variant

    Dim balloonView As DrawingView
    Set balloonView = get_view_by_name( _
        BALLOON_VIEW_NAME)

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

    Dim sel As Selection
    Set sel = dDoc.Selection
    sel.Clear
    sel.Add baseBalloon
    sel.Copy
    sel.Clear

    CATIA.HSOSynchronized = False

    Dim balloonIdx As Long
    balloonIdx = 1

    For Each view In sheet.views

        drawDims = get_dimensions_by_view(view)
        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
    
    baseView.texts.Remove templateIndex

    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) _
    As Variant

    get_dimensions_by_view = get_search_items( _
        "CATDrwSearch.DrwDimension,sel", _
        view _
    )

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 Function copy_and_paste( _
    ByVal balloonInfo As Variant, _
    ByVal targetView As DrawingView) _
    As DrawingText
    
    Dim targetSheet As DrawingSheet
    Set targetSheet = KCL.GetParent_Of_T(targetView, "DrawingSheet")
    
    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

    Set copy_and_paste = pre_copide_and_paste( _
        targetView _
    )

    sel.Clear

End Function


'バルーンの移動
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

正直な所、無駄な所が有る事に気が付いている上、とにかく汚いので
直したい所なのですが、紛失しそうなのでUpしておきます・・・。

耐え切れず、自作ライブラリを使用しています。
試したい方は、こちらからダウンロードやコピペし、
同じプロジェクト内に"kcl"と言う名前の標準モジュールを
置いておいてください。
github.com

動作はこんな感じです。

通常のマクロに比べ、コピペはとにかく遅いです。
とは言え、243個の連番バルーンを20秒程で作ってくれるのは
楽ですね。出来上がりはひどいのですが、位置を調整するだけ
であれば、かなり負担も減りそうです。

今回試してみて分かったのが、コピペ（特にペースト）の方法です。
バルーンを寸法の数だけコピペする必要があったのですが、
最初は

コピー -> ペースト -> 位置・文字修正 -> コピー -> ペースト  -> 位置・文字修正・・・

で処理させていましたが、兎に角遅かったです。

よく考えた所、コピー自体は1回で良かったんです。
つまり、

コピー -> ペースト -> 位置・文字修正 -> ペースト  -> 位置・文字修正・・・

で大丈夫でした。
但し、クリップボードを利用しているので、マクロ実行中は他でコピーを
行うとNGだと思います。

あぁこれが出来るのであれば、5年ぐらい前に取り組めばよかった。
やっと半分ぐらい出来たかな？