ダクトの断面図を一括で作成するマクロ｜CATIAマクロの作成方法
今回は「お問い合わせ」より頂いた内容です。
内容は以下のとおりです。
作成しようと考えているマクロはdrawによるダクトの断面検討図です。
主な流れは下記となります。
１．作成済みのダクト中央線を選択
２．drawにて正面視作成時の面を選択
３．作成する断面数を指定
４．drawにて断面作成時に使用する平面を作成
５．drawにて正面視作成
６．drawにて断面図作成
７．end
今回のマクロは2つのドキュメントを使い、機能も多めなのでかなり難しめの内容となっています。
ただその分、非常に実用的なマクロなので業務の効率UPが測れます。
(ある程度は自身の環境に合わせ多少書き換える必要が出てくるかもしれませんが)
※今回はVBAの「配列」についてある程度の知識がないと理解が難しいと思います。
全く分からないという方は先に「配列」を理解しておくことをオススメします。
マクロの機能
今回作成したマクロは「ダクトの断面図を一括で作成する」というものです。
具体的な機能は以下のとおりです。
・作成するビューは全て新規CATDrawingに書き出される
・断面数の指定が可能
・断面長(断面範囲)の指定が可能
※注意点※
・ダクトの中心線と投影平面の関係性によっては作成不可
(厳密にいえばダクトの中心線が投影平面に「投影(projection)」できない場合)
上の画像を見ると断面図がきれいに並んでいますが、これは画像用に手動で並べ直しています。
CATIAマクロではビューの位置を決めることは可能ですが、今回のような形状によってビューの大きさが変わる場合には、一列にきれいに並べることはおそらく不可能です。
以下のサンプルコードでは断面図作成時に位置をずらすように配置はしていますがきれいに並んで作成されることはほぼありません。手動で並べ直すか、ビューの位置をキレイに配置する手法を見つけて導入するかして下さい。
サンプルコード
マクロのサンプルコードは以下のとおりです。
マクロ実行後、①ダクトの中心線、②投影平面(XY,YZ,ZX平面のみ対応)の順に選択します。
※ダクトの中心線と投影平面の関係性によっては処理中にエラーが発生します。
選択後、「断面数」と「断面長」を入力すれば平面視と指定した数の断面図が作成されます。
機能が多くエラー対応できていない部分もありますが、ある程度の柔軟性はあります。
Option Explicit
Sub CATMain()
Dim DOC As PartDocument
Set DOC = CATIA.ActiveDocument
Dim PT As Part
Set PT = DOC.Part
Dim HSF As HybridShapeFactory
Set HSF = PT.HybridShapeFactory
Dim SEL 'As Selection
Set SEL = DOC.Selection
'*****************************************************************
'
' 中央線＆投影平面取得
'
'*****************************************************************
SEL.Clear
Dim Status As String
Dim Msg As String
Dim Filter1
Dim Filter2
Filter1 = Array("AnyObject")
Msg = "断面中央線を選択して下さい。"
Status = SEL.SelectElement2(Filter1, Msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
Dim SELObj1 As AnyObject
Set SELObj1 = SEL.Item(1).Value 'SELObj1にユーザーが選択したオブジェクトを入れる
SEL.Clear
label1:
Filter2 = Array("Plane")
Msg = "投影方向となる平面を選択してください。(XY,YZ,ZX平面のみ対応)"
Status = SEL.SelectElement2(Filter2, Msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
Dim SELObj2 As AnyObject
Set SELObj2 = SEL.Item(1).Value 'SELObj2にユーザーが選択した平面を入れる
If Not (SELObj2.Name = "XY平面" Or SELObj2.Name = "YZ平面" Or SELObj2.Name = "ZX平面") Then
MsgBox "「XY平面」「YZ平面」「ZX平面」のいずれかを選択し直して下さい。"
SEL.Clear
GoTo label1 'XY,YZ,ZX平面以外の平面が選択されたら平面を再選択させる(label1:に戻る)
End If
Debug.Print "中央線 「" & SELObj1.Name & "」" & vbLf & _
"投影平面「" & SELObj2.Name & "」" '取得の確認用
'*****************************************************************
'
' 形状作成(断面位置座標を取得するため)
'
'*****************************************************************
'断面数指示------------------------------------
Dim Danmen As String
Danmen = InputBox("断面数を入力して下さい。", "断面検討図マクロ", 20)
If Danmen = "" Then
MsgBox "キャンセルします。"
Exit Sub
End If
Dim SectSize As Integer
SectSize = InputBox("断面線の長さを指定してください。" & vbLf & "（断面範囲が変わります。）", "断面検討図マクロ", 100)
'投影(SELObj1をSELObj2に投影)------------------
Dim HB As HybridBody
Set HB = PT.HybridBodies.Add()
HB.Name = "断面検討マクロ"
Dim Ref1 As Reference
Set Ref1 = PT.CreateReferenceFromObject(SELObj1)
Dim SELPLNRef As Reference
Set SELPLNRef = PT.CreateReferenceFromObject(SELObj2)
Dim HSProject As HybridShapeProject
Set HSProject = HSF.AddNewProject(Ref1, SELPLNRef)
HSProject.SolutionType = 0
HSProject.Normal = False
HSProject.SmoothingType = 0
Dim HSDirection1 As HybridShapeDirection
Set HSDirection1 = HSF.AddNewDirection(SELPLNRef)
HSProject.Direction = HSDirection1
HB.AppendHybridShape HSProject
PT.Update
Dim i As Integer
For i = 1 To Danmen
'点(曲線上)作成-------------------------------------------------------------
Dim Ref3 As Reference
Set Ref3 = PT.CreateReferenceFromObject(HSProject)
Dim HSPointOnCurve As HybridShapePointOnCurve
If i = 1 Then
Set HSPointOnCurve = HSF.AddNewPointOnCurveFromPercent(Ref3, 0, False)
ElseIf i = Danmen Then
Set HSPointOnCurve = HSF.AddNewPointOnCurveFromPercent(Ref3, 1, False)
Else
Set HSPointOnCurve = HSF.AddNewPointOnCurveFromPercent(Ref3, (i - 1) * (1 / (Danmen - 1)), False)
End If
HB.AppendHybridShape HSPointOnCurve
PT.Update
'平面(曲線に直交)作成--------------------------------------------------------
Dim Ref4 As Reference
Set Ref4 = PT.CreateReferenceFromObject(HSPointOnCurve)
Dim HSPlaneNormal As HybridShapePlaneNormal
Set HSPlaneNormal = HSF.AddNewPlaneNormal(Ref3, Ref4)
HB.AppendHybridShape HSPlaneNormal
PT.Update
'交差作成---------------------------------------------------------------------
Dim Ref5 As Reference
Set Ref5 = PT.CreateReferenceFromObject(HSPlaneNormal)
Dim HSIntersect As HybridShapeIntersection
Set HSIntersect = HSF.AddNewIntersection(SELPLNRef, Ref5)
HSIntersect.PointType = 0
HB.AppendHybridShape HSIntersect
PT.Update
'直線作成---------------------------------------------------------------------
Dim Ref6 As Reference
Set Ref6 = PT.CreateReferenceFromObject(HSIntersect)
Dim HSDirection2 As HybridShapeDirection
Set HSDirection2 = HSF.AddNewDirection(Ref6)
Dim HSLinePtDir 'As HybridShapeLinePtDir
Set HSLinePtDir = HSF.AddNewLinePtDirOnSupport(Ref4, HSDirection2, SELPLNRef, SectSize * -1, SectSize, False)
HB.AppendHybridShape HSLinePtDir
PT.Update
'直線の端点(始点、終点)の作成--------------------------------------------------
Dim Ref7 As Reference
Set Ref7 = PT.CreateReferenceFromObject(HSLinePtDir)
Dim StartPoint 'As HybridShapePointOnCurve
Set StartPoint = HSF.AddNewPointOnCurveFromPercent(Ref7, 0, False)
HB.AppendHybridShape StartPoint
PT.Update
Dim EndPoint 'As HybridShapePointOnCurve
Set EndPoint = HSF.AddNewPointOnCurveFromPercent(Ref7, 1, False)
HB.AppendHybridShape EndPoint
PT.Update
'直線の端点の座標取得---------------------------------------------------------
Dim SPCoord(2), EPCoord(2)
Dim SPCoords() As Double
Dim EPCoords() As Double
Call StartPoint.GetCoordinates(SPCoord)
Call EndPoint.GetCoordinates(EPCoord)
If SELObj2.Name = "XY平面" Then
If i = 1 Then
ReDim SPCoords(1)
SPCoords(0) = SPCoord(0)
SPCoords(1) = SPCoord(1)
ReDim EPCoords(1)
EPCoords(0) = EPCoord(0)
EPCoords(1) = EPCoord(1)
Else
ReDim Preserve SPCoords(UBound(SPCoords) + 2)
SPCoords(UBound(SPCoords) - 1) = SPCoord(0)
SPCoords(UBound(SPCoords)) = SPCoord(1)
ReDim Preserve EPCoords(UBound(EPCoords) + 2)
EPCoords(UBound(EPCoords) - 1) = EPCoord(0)
EPCoords(UBound(EPCoords)) = EPCoord(1)
End If
ElseIf SELObj2.Name = "YZ平面" Then
If i = 1 Then
ReDim SPCoords(1)
SPCoords(0) = SPCoord(1)
SPCoords(1) = SPCoord(2)
ReDim EPCoords(1)
EPCoords(0) = EPCoord(1)
EPCoords(1) = EPCoord(2)
Else
ReDim Preserve SPCoords(UBound(SPCoords) + 2)
SPCoords(UBound(SPCoords) - 1) = SPCoord(1)
SPCoords(UBound(SPCoords)) = SPCoord(2)
ReDim Preserve EPCoords(UBound(EPCoords) + 2)
EPCoords(UBound(EPCoords) - 1) = EPCoord(1)
EPCoords(UBound(EPCoords)) = EPCoord(2)
End If
ElseIf SELObj2.Name = "ZX平面" Then
If i = 1 Then
ReDim SPCoords(1)
SPCoords(0) = SPCoord(2)
SPCoords(1) = SPCoord(0)
ReDim EPCoords(1)
EPCoords(0) = EPCoord(2)
EPCoords(1) = EPCoord(0)
Else
ReDim Preserve SPCoords(UBound(SPCoords) + 2)
SPCoords(UBound(SPCoords) - 1) = SPCoord(2)
SPCoords(UBound(SPCoords)) = SPCoord(0)
ReDim Preserve EPCoords(UBound(EPCoords) + 2)
EPCoords(UBound(EPCoords) - 1) = EPCoord(2)
EPCoords(UBound(EPCoords)) = EPCoord(0)
End If
End If
Next i
PT.Update
'今まで作成した形状を形状セットごと削除-------------------------
With SEL
.Clear
.Add HB
.Delete
End With
'*****************************************************************
'
' 断面図作成
'
'*****************************************************************
Dim DrwDoc As DrawingDocument
Set DrwDoc = CATIA.Documents.Add("Drawing")
Dim DrwSht As DrawingSheet
Set DrwSht = DrwDoc.Sheets.Item(1)
Dim DrwViw1 As DrawingView
Set DrwViw1 = DrwSht.Views.Add("AutomaticNaming")
Dim DrwViwGL1 As DrawingViewGenerativeLinks
Set DrwViwGL1 = DrwViw1.GenerativeLinks
Dim DrwViwGB1 As DrawingViewGenerativeBehavior
Set DrwViwGB1 = DrwViw1.GenerativeBehavior
DrwViwGB1.Document = DOC
'正面(,平面,側面視)作成-----------------------------------------
Dim x1 As Double
Dim y1 As Double
Dim z1 As Double
Dim x2 As Double
Dim y2 As Double
Dim z2 As Double
If SELObj2.Name = "XY平面" Then
x1 = 0
y1 = 1
z1 = 0
x2 = -1
y2 = 0
z2 = 0
ElseIf SELObj2.Name = "YZ平面" Then
x1 = 0
y1 = 1
z1 = 0
x2 = 0
y2 = 0
z2 = 1
ElseIf SELObj2.Name = "ZX平面" Then
x1 = -1
y1 = 0
z1 = 0
x2 = 0
y2 = 0
z2 = 1
End If
DrwViwGB1.DefineFrontView x1, y1, z1, x2, y2, z2
DrwViwGB1.Update
'断面図作成-----------------------------------------------------
Dim SPEPCoords(3)
Dim ViewDirection As Integer
For i = 1 To Danmen
If SELObj2.Name = "XY平面" Then
SPEPCoords(0) = SPCoords(2 * i - 1)
SPEPCoords(1) = -SPCoords(2 * i - 2)
SPEPCoords(2) = EPCoords(2 * i - 1)
SPEPCoords(3) = -EPCoords(2 * i - 2)
ViewDirection = 0 '断面方向を変更する(0 or 1)
ElseIf SELObj2.Name = "YZ平面" Then
SPEPCoords(0) = SPCoords(2 * i - 2)
SPEPCoords(1) = SPCoords(2 * i - 1)
SPEPCoords(2) = EPCoords(2 * i - 2)
SPEPCoords(3) = EPCoords(2 * i - 1)
ViewDirection = 1 '断面方向を変更する(0 or 1)
ElseIf SELObj2.Name = "ZX平面" Then
SPEPCoords(0) = -SPCoords(2 * i - 1)
SPEPCoords(1) = SPCoords(2 * i - 2)
SPEPCoords(2) = -EPCoords(2 * i - 1)
SPEPCoords(3) = EPCoords(2 * i - 2)
ViewDirection = 0 '断面方向を変更する(0 or 1)
End If
Dim DrwViw2 As DrawingView
Set DrwViw2 = DrwSht.Views.Add("AutomaticNaming")
Dim DrwViwGB2 As DrawingViewGenerativeBehavior
Set DrwViwGB2 = DrwViw2.GenerativeBehavior
Dim DrwViwGB2Variant 'As DrawingViewGenerativeBehavior
Set DrwViwGB2Variant = DrwViwGB2
Call DrwViwGB2Variant.DefineSectionView(SPEPCoords, "SectionCut", "Offset", ViewDirection, DrwViwGB1)
Dim DrwViwGL2 As DrawingViewGenerativeLinks
Set DrwViwGL2 = DrwViw2.GenerativeLinks
DrwViwGL1.CopyLinksTo DrwViwGL2
Set DrwViwGB2 = DrwViw2.GenerativeBehavior
DrwViwGB2.Update
'断面図作成位置の指定(※要調整)
DrwViw2.xAxisData = 200 * i
DrwViw2.yAxisData = 500
Next i
'作成した図面をリフレームさせる
Dim MyViewer As Viewer
Set MyViewer = CATIA.ActiveWindow.Viewers.Item(1)
MyViewer.Reframe
End Sub
XY,YZ,ZX平面の3平面のみの対応ですが、コードを見ればわかる通り各平面ごとに処理を分岐させています。これは3次元上で取得した座標(x,y,z)を図面での2次元座標(x,y)で利用する際にどうしても共通で利用可能なコードが思いつかなかったためです。
コード解説
今回はコードが長いため重要部分である「座標の取得(変換)」について解説していきます。
2つのドキュメント間をまたぐため「配列の中に配列を入れる(多次元配列)」「3次元座標を2次元座標に変換」など、初心者の方には少し難し目の内容となっています。
以下の内容だけでは理解できず、もう少し詳しく理解したいという方は「お問い合わせ」よりご連絡ください。
断面座標の取得
コード内の「形状作成(断面位置座標を取得するため)」部分では「断面作成時に必要な座標を取得する」という処理を行っています。この部分で作成される形状は以下のようなイメージです。
ダクト中心線の投影
はじめにダクトの中心線を投影平面に投影します。
今回のマクロは下図の通り、3次元上で作成した点の座標を取得し、そのまま図面でも利用します。
(下図の3Dと図面にある赤丸の対応箇所はそれぞれ同じ座標になるようにする)
ただ座標を同じにしようとしても3Dの方は(x,y,z)の3次元座標、図面の方は(x,y)の2次元座標と次元が違うため、3次元上の点をすべて2次元座標で表す必要があります。
これは非常にシンプルで点をすべて平面に投影すれば解決です。
3次元上で表されていた点をすべて平面上に投影することで、x,y,zの3座標のうち1つは必ず「0」になります。(XY平面に投影した場合はz=0、YZ平面に投影した場合はx=0、ZX平面に投影した場合はy=0)
この0になった座標を無視すれば3次元上で取得した座標でも2次元座標として考えることができます。
ただ作成した点をすべて投影するのも面倒なので、はじめにその根本であるダクトの中心線を平面に投影してしてしまおうという考えがここでの処理に繋がります。
'投影(SELObj1をSELObj2に投影)------------------ Dim HB As HybridBody Set HB = PT.HybridBodies.Add() HB.Name = "断面検討マクロ" Dim Ref1 As Reference Set Ref1 = PT.CreateReferenceFromObject(SELObj1) Dim SELPLNRef As Reference Set SELPLNRef = PT.CreateReferenceFromObject(SELObj2) Dim HSProject As HybridShapeProject Set HSProject = HSF.AddNewProject(Ref1, SELPLNRef) HSProject.SolutionType = 0 HSProject.Normal = False HSProject.SmoothingType = 0 Dim HSDirection1 As HybridShapeDirection Set HSDirection1 = HSF.AddNewDirection(SELPLNRef) HSProject.Direction = HSDirection1 HB.AppendHybridShape HSProject PT.Update
断面座標の取得
点の座標は「GetCoordinatesメソッド」で取得が可能です。
'直線の端点の座標取得---------------------------------------------------------
Dim SPCoord(2), EPCoord(2)
Call StartPoint.GetCoordinates(SPCoord) 'SPCoordにx,y,z座標を入れる
Call EndPoint.GetCoordinates(EPCoord) 'EPCoordにx,y,z座標を入れる
取得した始点はSPCoord()、終点はEPCoord()の中に格納されます。
(0番目がx座標、1番目がy座標、2番目がz座標)
先に説明した通り、このうちx,y,zのいずれかの座標は0になっています。
これら座標を図面に渡すためにさらに配列に格納します。
以下のコードは複雑そうに見えますが、全ての始点の座標をSPCoords()に、全ての終点の座標をEPCoords()に入れているだけです。
Dim SPCoords() As Double
Dim EPCoords() As Double
If SELObj2.Name = "XY平面" Then
If i = 1 Then
ReDim SPCoords(1)
SPCoords(0) = SPCoord(0)
SPCoords(1) = SPCoord(1)
ReDim EPCoords(1)
EPCoords(0) = EPCoord(0)
EPCoords(1) = EPCoord(1)
Else
ReDim Preserve SPCoords(UBound(SPCoords) + 2)
SPCoords(UBound(SPCoords) - 1) = SPCoord(0)
SPCoords(UBound(SPCoords)) = SPCoord(1)
ReDim Preserve EPCoords(UBound(EPCoords) + 2)
EPCoords(UBound(EPCoords) - 1) = EPCoord(0)
EPCoords(UBound(EPCoords)) = EPCoord(1)
End If
ElseIf SELObj2.Name = "YZ平面" Then
If i = 1 Then
ReDim SPCoords(1)
SPCoords(0) = SPCoord(1)
SPCoords(1) = SPCoord(2)
ReDim EPCoords(1)
EPCoords(0) = EPCoord(1)
EPCoords(1) = EPCoord(2)
Else
ReDim Preserve SPCoords(UBound(SPCoords) + 2)
SPCoords(UBound(SPCoords) - 1) = SPCoord(1)
SPCoords(UBound(SPCoords)) = SPCoord(2)
ReDim Preserve EPCoords(UBound(EPCoords) + 2)
EPCoords(UBound(EPCoords) - 1) = EPCoord(1)
EPCoords(UBound(EPCoords)) = EPCoord(2)
End If
ElseIf SELObj2.Name = "ZX平面" Then
If i = 1 Then
ReDim SPCoords(1)
SPCoords(0) = SPCoord(2)
SPCoords(1) = SPCoord(0)
ReDim EPCoords(1)
EPCoords(0) = EPCoord(2)
EPCoords(1) = EPCoord(0)
Else
ReDim Preserve SPCoords(UBound(SPCoords) + 2)
SPCoords(UBound(SPCoords) - 1) = SPCoord(2)
SPCoords(UBound(SPCoords)) = SPCoord(0)
ReDim Preserve EPCoords(UBound(EPCoords) + 2)
EPCoords(UBound(EPCoords) - 1) = EPCoord(2)
EPCoords(UBound(EPCoords)) = EPCoord(0)
End If
End If
これがループされることで
SPCoords(1つ目の始点x座標、1つ目の始点y座標、2つ目の始点x座標、2つ目の始点y座標…)
EPCoords(1つ目の終点x座標、1つ目の終点y座標、2つ目の終点x座標、2つ目の終点y座標…)
のように始点、終点の座標を表す2成分が順々に入っていきます。
ここで注意しないといけないのはx,y,zのうち0でない2つの成分を入れないといけないという点です。
今回のマクロでは投影平面としてXY,YZ,ZX平面のみしか使えないようにしているので、条件分岐でそれぞれ配列に格納する値を振り分けています。
いずれも同じ処理をしているのでここでは代表して投影平面として「XY平面」が選ばれた場合の分岐で何をしているかを見ていきましょう。また、その中でも始点と終点の処理内容は同じなのでここでは始点のみの処理を見ていきます。
If SELObj2.Name = "XY平面" Then
If i = 1 Then 'ループ初回の場合
ReDim SPCoords(1)
SPCoords(0) = SPCoord(0)
SPCoords(1) = SPCoord(1)
Else 'ループ2回目以降の場合
ReDim Preserve SPCoords(UBound(SPCoords) + 2)
SPCoords(UBound(SPCoords) - 1) = SPCoord(0)
SPCoords(UBound(SPCoords)) = SPCoord(1)
End If
まずループが初回のときにはReDimを使ってSPCoordsの要素数を2つにします(配列は0スタート)
そしてその中にSPCoord(0)とSPCoord(1)を入れます。
これで初回ループ時の処理は終わりです。
ループが2回目以降では「配列の要素数を増やして入れる」という処理を行います。
現在SPCoordsは要素数が2つで、中にはSPCoord(0)とSPCoord(1)が入っているのでもう一杯です。
というわけで配列の要素数を2つ増やします。
ReDim Preserve SPCoords(UBound(SPCoords) + 2)
UBound()はカッコ内の配列の要素数を取得することができます。
つまり現在の配列の要素数を「現在の配列の要素数+2」にするという訳です。
またReDimだけで要素数を変更すると現在入っている要素を初期化してしまうため、Preserveを付けて要素の初期化を回避しています。
つぎに2つ増やした配列の空き部分に始点の2成分のSPCoord(0)とSPCoord(1)を入れます。
SPCoords(UBound(SPCoords) - 1) = SPCoord(0) SPCoords(UBound(SPCoords)) = SPCoord(1)
UBound()を使い空き部分を指定してその中に入れます。
以上をループさせれば全始点/終点の座標2成分を格納することができます。
取得した座標はローカルウィンドウを見るとわかりやすいです。
下図は断面数「7」とした際のSPCoordsとEPCoordsの中身です。
あとはこれら座標を図面作成時に使うだけです。
3つ目の始点を使いたい場合はSPCoords(4),SPCoords(5)
5つ目の終点を使いたい場合はEPCoords(8),EPCoords(9)
i番目の始点を使いたい場合はSPCoords(2 * i – 2),SPCoords(2 * i – 1)のように表します。
まとめ
今回は「ダクトの断面を一括で作成するマクロ」についての内容でした。
正直なお話、結構レベルが高めのマクロだったため初心者の方には理解できない部分が多く見受けられるかもしれません。(逆を言えばこのマクロの内容が読み取れる方はかなりレベルが高いと思うので自信を持ってください)
今回詳しく解説した、配列の中に配列を入れる、いわゆる「多次元配列」はExcel VBAではよく使われますが、CATIAではあまり使う機会がないと思います。しかし、使えるようにしておけば今回のような少し複雑なマクロにも対応すできる場合があります。
ぜひ多次元配列についても理解を深めてみて下さい。
また、今回のコードが理解できればダクト以外の形状にも応用できることがわかると思います。
自身の作業に合わせた断面作成マクロに書き換えてみるのもいい勉強になると思うので、ぜひそちらにも挑戦してみて下さい。
CATIAマクロを本気で勉強するなら
