ざっくりバルーン情報の取得

こちらで記載した通り、テキストと異なりバルーンの
領域は取得出来なかった為の苦肉の策です。
Drawのテキストサイズの取得 - C#ATIA

色々と試したのですがどうしてもダメな上、それらしき情報も
見つからない為、一時的に出来る限りバルーンに近い状態の
テキストを同じ位置に作成し、そのテキストから領域を
取得してみました。

'vba
'ざっくりバルーン領域

Option Explicit

Sub CATMain()
    
    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 "CATDrwSearch.DrwBalloon,sel"

    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

    'ざっくりバルーン領域
    Dim bBox As Variant

    '三個だけ
    For i = 1 To 3
        bBox = get_balloon_bounding_box(balloons.Item(i))
        
        Dim msg As String
        msg = "** ざっくりバルーン情報 **" & vbCrLf & _
            "幅:" & bBox(2) - bBox(0) & vbCrLf & _
            "高さ:" & bBox(3) - bBox(1) & vbCrLf & _
            "中心座標 x:" & (bBox(2) + bBox(0)) * 0.5 & _
            " y:" & (bBox(3) + bBox(1)) * 0.5
        MsgBox msg
    Next
    
End Sub


'ざっくりバルーン領域
'return 0-minX, 1-minY, 2-maxX, 3-maxY
Private Function get_balloon_bounding_box( _
    ByVal balloon As DrawingText) _
    As Variant

    Dim view As DrawingView
    Set view = balloon.Parent.Parent
    
    Dim backUpLock
    backUpLock = view.LockStatus
    view.LockStatus = False

    Dim text As DrawingText
    Set text = create_text_from_balloon(balloon)
    
    Dim bBox As Variant
    bBox = get_text_bounding_box(text)

    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection

    sel.Clear
    sel.Add text
    sel.Delete

    view.LockStatus = backUpLock

    get_balloon_bounding_box = bBox
    
End Function


Private Function create_text_from_balloon( _
    ByVal balloon As DrawingText) _
    As DrawingText

    Dim view As DrawingView
    Set view = balloon.Parent.Parent

    Dim anchorPosition As String
    anchorPosition = balloon.anchorPosition
    
    Dim txtProps As DrawingTextProperties
    Set txtProps = balloon.TextProperties

    Dim cloneTxt As DrawingText
    Set cloneTxt = view.Texts.Add( _
        balloon.text, _
        balloon.x, _
        balloon.y _
    )
    
    cloneTxt.anchorPosition = balloon.anchorPosition

    Dim cloneProps As DrawingTextProperties
    Set cloneProps = cloneTxt.TextProperties

    cloneProps.Bold = txtProps.Bold
    cloneProps.FONTNAME = txtProps.FONTNAME
    cloneProps.FONTSIZE = txtProps.FONTSIZE
    cloneProps.FrameName = txtProps.FrameName
    cloneProps.FrameType = txtProps.FrameType
    cloneProps.Update
    
    Set create_text_from_balloon = cloneTxt

End Function


Private Function get_text_bounding_box( _
    ByVal drawText As DrawingText) _
    As Variant

    drawText.FrameType = catCircle

    Dim minLeader As DrawingLeader
    Set minLeader = drawText.Leaders.Add( _
        drawText.x - 100, _
        drawText.y - 100 _
    )
    
    Dim maxLeader As DrawingLeader
    Set maxLeader = drawText.Leaders.Add( _
        drawText.x + 100, _
        drawText.y + 100 _
    )

    Dim minX As Double
    Dim minY As Double
    minLeader.GetPoint 0, minX, minY

    Dim maxX As Double
    Dim maxY As Double
    maxLeader.GetPoint 0, maxX, maxY

    get_text_bounding_box = Array(minX, minY, maxX, maxY)
    
End Function

何故 "ざっくり" なのかと申しますと、こちらの画像の黒のバルーンに対して
一時的に作っているテキストは赤の部分で、かなり一致していない為です。

サイズ取得は、ズーム率を取得する為だけなので、厳密でなくても構わないと
思っているのですが、それだけの為にテキストを作って削除するのも
良いものかどうか・・・。