C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

Drawの寸法値に四角を描く

CATIA V5です。
あそこまで出来たから、やる気が出てきました。(許可も取った!)

表題の意味ですが、アクティブなシートの寸法値に線で四角を
描きます。

”線じゃなくて、フレーム使えば良いじゃん!”と思われるでしょう。

四角を描くことが目的じゃなくて、寸法値の位置を知りたかったんです。
しかも寸法が所属しているビューでの座標ではなく、絶対座標での位置を
知りたいんです。
つまり、こちらの"30"の寸法は”正面図”内の寸法ですが、
メインビューの原点から見た座標値を取得したいんです。

で、作りました。

'vba
'Drawの寸法値に四角を描く

Option Explicit

Sub CATMain()

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

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

    Dim drawDims As Variant
    drawDims = get_dimensions_from_view(sheet.views.Item(3))

    Dim view As DrawingView
    Dim i As Long
    
    For Each view In sheet.views

        drawDims = get_dimensions_from_view(view)
        If UBound(drawDims) < 1 Then
            GoTo continue
        End If
        
        For i = 0 To UBound(drawDims)
            dump_bbox get_boundary_box_from_dimension(drawDims(i))
        Next
continue:
    Next

End Sub


'寸法文字の範囲取得
Private Function get_boundary_box_from_dimension( _
    ByVal drawDim As DrawingDimension) _
    As Variant
    
    Dim view As DrawingView
    Set view = drawDim.Parent
    
    Dim viewX As Double
    viewX = view.xAxisData 'view.x
    
    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_from_dimension = bBox

End Function


'ビュー内の寸法取得
Private Function get_dimensions_from_view( _
    ByVal view As DrawingView) _
    As Variant

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

    sel.Clear
    sel.Add view
    sel.Search "CATDrwSearch.DrwDimension,sel"
    
    If sel.Count2 < 1 Then
        get_dimensions_from_view = 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_dimensions_from_view = drawDims

End Function


'ビューを名前で取得 - なきゃ作る
Private Function get_view_by_name( _
    ByVal name As String) _
    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 view.name = name Then
            Set get_view_by_name = view
            Exit Function
        End If
    Next

    Set get_view_by_name = views.Add(name)
    
End Function


'debug
Private Sub dump_bbox( _
    ByVal bBox As Variant)

    Dim dDoc As DrawingDocument
    Set dDoc = CATIA.ActiveDocument

    Dim sheet As DrawingSheet
    Set sheet = dDoc.sheets.ActiveSheet
    
    Dim view As DrawingView
    Set view = get_view_by_name("dump")
    
    Dim fact As Factory2D
    Set fact = view.Factory2D

    view.Activate

    Dim ary As Variant
    ary = Array( _
        bBox(0), _
        bBox(1), _
        bBox(2), _
        bBox(3), _
        bBox(6), _
        bBox(7), _
        bBox(4), _
        bBox(5), _
        bBox(0), _
        bBox(1) _
    )
    
    Dim i As Long
    Dim line As Line2D
    For i = 0 To UBound(bBox) Step 2
        Set line = fact.CreateLine( _
            ary(i), _
            ary(i + 1), _
            ary(i + 2), _
            ary(i + 3) _
        )
    Next

End Sub

スケールを変えても大丈夫だったので、間違いないと思います。

正直な所、予想外に悩みました。
ビューの位置を取得する必要が有るのですが、こちらのX/Yプロパティで
大丈夫だと思い込んでました。
r1 DrawingView (Object)
実際試した所、正面図で10mmぐらいズレます・・・。

仕方が無いので10mm分補正していたのですが、下面図でさらにズレ・・・。

結果的に、xAxisData/yAxisDataプロパティの値が正しいビューの位置だと
分かりました。"同等" って書いてあるのに騙された。

実際に試してもらうと分かりますが、アクティブシートに"dump"と言う
ビューを追加し、全てのビューの寸法値に四角を描きます。