数字のバルーン文字の最小最大を取得する

CATIA V5です。

業務で測定用の図面を作成するのですが、寸法にバルーンでナンバリング
してます。　・・・面倒です。

自動化出来れば良いのですが、拘る部分もあり、なかなか良い方法を
思い付かないのでチマチマやってます。

極まれに、修正で番号を追加となった際に "一体幾つが最後の番号なのか？"
を見失わない為に、図面枠外にメモってます。

驚くほどに原始的・・・。ミスする可能性もあります。

重い腰を上げて、数字のバルーン文字の最小最大を確認する為のマクロを
作りました。

'vba Draw_Balloon_Number_Info Ver0.0.1
'バルーン文字の数値のものの先頭と最後を表示

Option Explicit

Sub CATMain()

    'ドキュメントのチェック
    'If Not KCL.CanExecute("DrawingDocument") Then Exit Sub
    
    'バルーン文字の数値のものをソートして取得
    Dim balloonNumbers As Variant
    balloonNumbers = quick_sort( _
        get_balloon_text_numeric_array( _
            get_balloon_list() _
        ) _
    )

    Dim msg As String
    If IsEmpty(balloonNumbers) Then
        msg = "数字のバルーンが見つかりませんでした"
    Else
        msg = "先頭の番号:" & balloonNumbers(0) & vbCrLf & _
        "最後の番号:" & balloonNumbers(UBound(balloonNumbers))
    End If
    
    MsgBox msg

End Sub


Private Function get_balloon_text_numeric_array( _
    ByVal balloonList As Collection) _
    As Variant
    
    Dim numbers As Collection
    Set numbers = New Collection
    
    Dim balloon As DrawingText
    Dim txt As String
    For Each balloon In balloonList
        txt = balloon.Text
        If Not IsNumeric(txt) Then GoTo continue
        
        numbers.Add (Val(txt))

continue:
    Next

    get_balloon_text_numeric_array = collection_to_array(numbers)

End Function


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

    If lst.count < 1 Then
        collection_to_array = 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(i)
    Next

    collection_to_array = ary

End Function


Private Function get_balloon_list() _
    As Collection

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim sel As Selection
    Set sel = dDoc.Selection
    
    CATIA.HSOSynchronized = False
    
    sel.Search "CATDrwSearch.DrwBalloon,all"

    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_balloon_list = balloons

End Function


'非破壊非再帰クイック＆挿入ソート
'参考 https://foolexp.wordpress.com/2011/10/29/%e3%82%af%e3%82%a4%e3%83%83%e3%82%af%e3%82%bd%e3%83%bc%e3%83%88%e3%81%a8%e6%8c%bf%e5%85%a5%e3%82%bd%e3%83%bc%e3%83%88%e3%81%ae%e3%83%8f%e3%82%a4%e3%83%96%e3%83%aa%e3%83%83%e3%83%89/
Private Function quick_sort( _
    ByVal ary As Variant) As Variant

    If IsEmpty(ary) Then
        quick_sort = Empty
        Exit Function
    End If

    Dim stack As Object
    Set stack = CreateObject("Scripting.Dictionary")
   
    Dim leftIdx As Long
    Dim rightIdx As Long
    Dim pivot As Variant
    Dim tPivot(2) As Variant
    Dim temp As Variant
   
    Dim i As Long
    Dim j As Long
    stack.Add stack.count + 1, LBound(ary)
    stack.Add stack.count + 1, UBound(ary)
    Do While stack.count > 0
               
        leftIdx = stack(stack.count - 1)
        rightIdx = stack(stack.count)
        stack.Remove stack.count
        stack.Remove stack.count

        'クイックソート
        If leftIdx < rightIdx Then
       
            pivot = ary((leftIdx + rightIdx) / 2)
           
            i = leftIdx
            j = rightIdx
           
            Do While i <= j
           
                Do While ary(i) < pivot
                    i = i + 1
                Loop
           
                Do While ary(j) > pivot
                    j = j - 1
                Loop
           
                If i <= j Then
                    temp = ary(i)
                    ary(i) = ary(j)
                    ary(j) = temp
                   
                    i = i + 1
                    j = j - 1
                End If
           
            Loop
           
            If rightIdx - i >= 0 Then
                If rightIdx - i <= 10 Then
                    insertion_sort ary, i, rightIdx
                Else
                    stack.Add stack.count + 1, i
                    stack.Add stack.count + 1, rightIdx
                End If
            End If
           
            If j - leftIdx >= 0 Then
                If j * leftIdx <= 10 Then
                    insertion_sort ary, leftIdx, j
                Else
                    stack.Add stack.count + 1, leftIdx
                    stack.Add stack.count + 1, j
                End If
            End If
        End If
   
    Loop

    quick_sort = ary
End Function

Private Function insertion_sort( _
    ary As Variant, _
    minIdx As Long, _
    maxIdx As Long)

    '挿入ソート
    Dim i As Long, j As Long
    Dim temp As Variant
    j = 1
    For j = minIdx To maxIdx
        i = j - 1
        Do While i >= 0
            If ary(i + 1) < ary(i) Then
                temp = ary(i + 1)
                ary(i + 1) = ary(i)
                ary(i) = temp
            Else
                Exit Do
            End If
            i = i - 1
        Loop
    Next
    
    insertion_sort = ary
End Function

ソート処理が必要なのですが、Excelであればあるようなのですが
VBAは無いんですね・・・。

こちらのクイック・挿入ハイブリッドソートをお借りしました。
クイックソートと挿入ソートのハイブリッド | 愚者の経験
破壊的部分や大文字な部分は好みの関係で修正しています。

クイック・挿入ハイブリッドソートが一番高速だと言う事は、
僕も知っています。

実際にこの様な図面で

マクロを使用するとこんな感じです。

本当は番号の重複や欠番等のチェックも入れたいのですが、
ご覧の通り、まだまだバルーン作らなきゃいけないんです。
（しかも3枚組の1枚目）

〇追記
実際使ったら全バルーンが検索されていたので、
アクティブシート内だけにする為、get_balloon_list関数内を
変更しました。

    'sel.Search "CATDrwSearch.DrwBalloon,all"

    sel.Add dDoc.sheets.ActiveSheet
    sel.Search "CATDrwSearch.DrwBalloon,sel"