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"と言う
ビューを追加し、全てのビューの寸法値に四角を描きます。