全てのバルーンの位置リンクを削除する

久々にCATIAのマクロです。

業務で作ったDrawで大量にバルーンを作ったのですが、コピペしながら作った際
うっかり大量に位置リンクを付けてしまう　と言う凡ミス・・・。

それはそれで "もう、いいや　これで" と思ったものの、ビュー自体を他のシートで
使いまわしたくなりましたが、大量の位置リンクが邪魔でしょうがない。

チマチマやり始めたもののキリが無い。マクロでやりたいと強く感じますよね？

”マクロで位置リンクって削除出来たっけ？” から始めました。
・・・こちらにありました。
DrawingTextの位置ﾘﾝｸ - C#ATIA
全く記憶に御座いません。書き残しておくと良いことあるんですね。

あちらは1個1個指定しなければならず、チマチマやりたくない為のマクロなのに
意味が無いため、アクティブなビューの全てのバルーンの位置リンク削除を
行うようにしました。

'vba RemoveAllBalloonPositionalLinks _ver0.0.1 by Kantoku

Sub CATMain()

    '準備
    Dim msg As String
    
    Dim actdoc As DrawingDocument
    Set actdoc = CATIA.ActiveDocument
    
    Dim sheet As DrawingSheet
    Set sheet = actdoc.Sheets.ActiveSheet
    
    'バルーン取得
    Dim balls As Collection
    Set balls = GetAllBalloon(sheet)
    
    'バルーン無し
    If balls.Count < 1 Then
        msg = "バルーンが有りませんでした。"
        MsgBox msg
        Exit Sub
    End If
    
    'バルーン数
    Dim ballsCount As Long
    ballsCount = getBalloonCount(balls)
    
    '問い合わせ
    msg = "バルーン" & ballsCount & "個のが有ります。" & vbCrLf & _
        "全ての位置リンクを削除しますが、よろしいですか？"
    
    If Not MsgBox(msg, vbYesNo + vbQuestion) = vbYes Then
        Exit Sub
    End If
    
    '位置リンク削除
    execRemovePosLink sheet, balls

    '終わり
    MsgBox "Done"
    
End Sub

'位置リンク削除
Private Sub execRemovePosLink( _
    ByVal sheet As DrawingSheet, _
    ByVal balls As Collection)

    Dim sel As selection
    Set sel = sheet.Parent.Parent.selection
    sel.Clear

    CATIA.HSOSynchronized = False

    Dim viBalls As Collection
    Dim vi As DrawingView
    Dim ball As DrawingText
    Dim dmy As DrawingText
    
    For Each viBalls In balls
        Set vi = viBalls.Item(1).Parent.Parent
        Set dmy = vi.Texts.Add("temp", 0, 0)
        
        For Each ball In viBalls
            ball.AssociativeElement = dmy
        Next
        
        With sel
            .Clear
            .Add dmy
            .Delete
        End With
        
    Next
    
    CATIA.HSOSynchronized = True
    
End Sub

'バルーン数取得
Private Function getBalloonCount( _
    balls As Collection) _
    As Long
    
    Dim ballsCount As Long
    ballsCount = 0
    
    Dim viBalls As Collection
    For Each viBalls In balls
        ballsCount = ballsCount + viBalls.Count
    Next
    
    getBalloonCount = ballsCount
    
End Function

'ビュー毎に全バルーン取得
Private Function GetAllBalloon( _
    ByVal sheet As DrawingSheet) _
    As Collection

    Dim sel As selection
    Set sel = sheet.Parent.Parent.selection
    
    Dim balls As Collection
    Set balls = New Collection
    
    Dim viBalls As Collection
    
    CATIA.HSOSynchronized = False

    Dim vi As DrawingView
    Dim i As Long
    For Each vi In sheet.views
        sel.Clear
        sel.Add vi
        sel.Search "CATDrwSearch.DrwBalloon,sel"
        
        If sel.Count2 < 1 Then
            GoTo Continuation
        End If
    
        Set viBalls = New Collection
        For i = 1 To sel.Count2
            viBalls.Add sel.Item2(i).Value
        Next
        balls.Add viBalls
    
Continuation:
    Next
        
    sel.Clear
    
    CATIA.HSOSynchronized = True

    Set GetAllBalloon = balls

End Function

元々バルーンに位置リンクあるのか？　ビューがロックされていないか？
とか細かなチェックしてません。直ぐに使いたかったので。

久々に作りましたが、思ったよりすんなり作れました。
・・・意外と覚えているもんですね。