穴中心線(座標軸線)作成マクロ｜CATIAマクロの作成方法
今回の記事は「お問い合わせ」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。
●プロダクトファイル開いた状態で
ツリーにぶら下がっているパートをアクティブにしてマクロを実行させたいです。③穴中心線（座標軸線）作成
選択
円のエッジ選択 （円はボディ＆サーフェスエッジ）
XY方向を決める直線を選択（入力しない場合は主座標の方向）
↓
結果
点 と 円の軸線作成 と ＸＹ方向線作成・ 軸線及びＸＹ方向線は点から両端で作成 （例 始点-10mmm,終点10mm)
・ 線片側長さはダイアログで数値を入力
（線片側長さは10と入力すれば始点-10mmm,終点10mm 全長は20mm)
・ 作成された線は作成後に履歴により出来れば寸法変更もしたいです 。
複数のマクロ案を頂いたので、それぞれ別ページでまとめていきます。
(上記お問い合わせ内容に番号やタイプがついているのは複数案頂いたためです)
そのため、似たようなマクロを別ページでも作成していることもあり、内容がほとんど同じ部分も出てくるので予めご了承ください。
マクロの機能
今回作成したマクロは
『ユーザーが選択した円エッジに対して穴中心線(座標軸線)を作成するマクロ』です。
具体的な機能は以下のとおりです。
・円エッジに対して選択された直線の方向での軸線を作成する
・直線が選択されなかった場合は絶対座標の方向を使用する
・作成した形状は全てツリー第1階層に作成する新規形状セットにまとめる
サンプルコード
マクロのサンプルコードは以下のとおりです。
Option Explicit
Sub CATMain()
Dim SEL
Set SEL = CATIA.ActiveDocument.Selection
Dim VPS As VisPropertySet
Set VPS = SEL.VisProperties
Dim filter1
Dim filter2
Dim msg As String
Dim Status As String
Dim check As Boolean
check = False
filter1 = Array("Edge")
msg = "エッジ(円)を選択して下さい。"
label1:
Status = SEL.SelectElement2(filter1, msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルします。"
Exit Sub
End If
Dim SelEdge As Edge
Set SelEdge = SEL.Item(1).Value
SEL.Clear
'エッジを含むCATPart(PartDocumrnt)を取得
Dim tmp_Obj
Set tmp_Obj = SelEdge
Do Until TypeName(tmp_Obj) = "PartDocument"
Set tmp_Obj = tmp_Obj.Parent
Loop
Dim Doc As PartDocument
Set Doc = tmp_Obj
Dim PT As Part
Set PT = Doc.Part
Dim HSF As HybridShapeFactory
Set HSF = PT.HybridShapeFactory
'選択されたエッジが円か確認
Dim SPA As Workbench
Set SPA = Doc.GetWorkbench("SPAWorkbench")
Dim ConfMeasure
Set ConfMeasure = SPA.GetMeasurable(SelEdge)
On Error GoTo ErrLabel
Dim getvalues(2) As Variant
ConfMeasure.GetCenter getvalues
On Error GoTo 0
filter2 = Array("Line", "RectilinearMonoDimFeatEdge", "RectilinearBiDimFeatEdge", "RectilinearTriDimFeatEdge")
msg = "直線(軸方向)を選択して下さい。([Esc]キーを押すと絶対座標系を軸方向にします。)"
Status = SEL.SelectElement2(filter2, msg, False)
If Status = "Normal" Then
Dim SelLine As AnyObject
Dim RefDir As Reference
Dim HSDir As HybridShapeDirection
If TypeName(SEL.Item(1).Value) <> "Line" Then
Set SelLine = SEL.Item(1).Value
Set HSDir = HSF.AddNewDirection(SelLine)
Else
Set SelLine = SEL.Item(1).Value
Set RefDir = PT.CreateReferenceFromObject(SelLine)
Set HSDir = HSF.AddNewDirection(RefDir)
End If
check = True
End If
SEL.Clear
Dim UserLength As String
UserLength = InputBox("軸線の長さを入力して下さい。", "長さ入力", 10)
If UserLength = "" Then
Exit Sub
End If
Dim HB As HybridBody
Set HB = PT.HybridBodies.Add
HB.Name = "穴中心線(座標軸線)"
'① 選択されたエッジの中心点作成
Dim CtrPoint As Point
Set CtrPoint = HSF.AddNewPointCenter(SelEdge)
HB.AppendHybridShape CtrPoint
PT.Update
'② 選択されたエッジを通る平面を作成(回転軸取得用)
Dim AxisPlane As Plane
Set AxisPlane = HSF.AddNewPlane1Curve(SelEdge)
HB.AppendHybridShape AxisPlane
PT.Update
'③ ①を通り②に垂直方向の直線を作成
Dim RefPlane As Reference
Set RefPlane = PT.CreateReferenceFromObject(AxisPlane)
Dim RefPoint As Reference
Set RefPoint = PT.CreateReferenceFromObject(CtrPoint)
Dim AxisLine1 As Line
Set AxisLine1 = HSF.AddNewLineNormal(RefPlane, RefPoint, UserLength, -1 * UserLength, False)
HB.AppendHybridShape AxisLine1
PT.Update
Dim AxisLine2 As Line
Dim AxisLine3 As Line
Dim RefAxisLine1 As Reference
Dim RefAxisLine2 As Reference
If check = True Then '軸方向が選択された場合
'④ ①を通り選択した直線方向の直線を作成
Set AxisLine2 = HSF.AddNewLinePtDir(RefPoint, HSDir, UserLength, -1 * UserLength, False)
HB.AppendHybridShape AxisLine2
PT.Update
'⑤ ④の直線を②を軸に90deg回転した位置に直線を作成
Set RefAxisLine2 = PT.CreateReferenceFromObject(AxisLine2)
Set AxisLine3 = HSF.AddNewLineAngle(RefAxisLine2, RefPlane, RefPoint, True, UserLength, -1 * UserLength, 90, False)
HB.AppendHybridShape AxisLine3
PT.Update
'ex ②の平面を非表示
SEL.Add AxisPlane
VPS.SetShow catVisPropertyNoShowAttr
SEL.Clear
ElseIf check = False Then '軸方向が選択されなかった場合
'④ ①を通るYZ方向の直線を作成
Dim YZPlane As Plane
Set YZPlane = PT.OriginElements.PlaneYZ
Dim RefYZPlane As Reference
Set RefYZPlane = PT.CreateReferenceFromObject(YZPlane)
Set AxisLine2 = HSF.AddNewLineNormal(RefYZPlane, RefPoint, UserLength, -1 * UserLength, False)
HB.AppendHybridShape AxisLine2
PT.Update
'作成方向の確認
Dim ZXPlane As Plane
Set ZXPlane = PT.OriginElements.PlaneZX
Dim RefZXPlane As Reference
Set RefZXPlane = PT.CreateReferenceFromObject(ZXPlane)
Set ConfMeasure = SPA.GetMeasurable(RefZXPlane)
Dim CheckAngle As Double
CheckAngle = ConfMeasure.GetAngleBetween(RefPlane)
Dim HSExtrude As HybridShapeExtrude
If CheckAngle = 0 Then
'⑤ ④からZX方向への押し出しサーフェス作成
Dim ZXDir As HybridShapeDirection
Set ZXDir = HSF.AddNewDirection(RefZXPlane)
Set RefAxisLine2 = PT.CreateReferenceFromObject(AxisLine2)
Set HSExtrude = HSF.AddNewExtrude(RefAxisLine2, UserLength, UserLength, ZXDir)
HB.AppendHybridShape HSExtrude
PT.Update
Else
'⑤ ④からXY方向への押し出しサーフェス作成
Dim XYPlane As Plane
Set XYPlane = PT.OriginElements.PlaneXY
Dim RefXYPlane As Reference
Set RefXYPlane = PT.CreateReferenceFromObject(XYPlane)
Dim XYDir As HybridShapeDirection
Set XYDir = HSF.AddNewDirection(RefXYPlane)
Set RefAxisLine2 = PT.CreateReferenceFromObject(AxisLine2)
Set HSExtrude = HSF.AddNewExtrude(RefAxisLine2, UserLength, UserLength, XYDir)
HB.AppendHybridShape HSExtrude
PT.Update
End If
'⑥ ②と⑤の交差を作成
Dim RefHSExtrude As Reference
Set RefHSExtrude = PT.CreateReferenceFromObject(HSExtrude)
Dim HSIntersect As HybridShapeIntersection
Set HSIntersect = HSF.AddNewIntersection(RefPlane, RefHSExtrude)
HB.AppendHybridShape HSIntersect
PT.Update
'⑦ ③と⑥を通る平面を作成
Set RefAxisLine1 = PT.CreateReferenceFromObject(AxisLine1)
Dim RefHSIntersect As Reference
Set RefHSIntersect = PT.CreateReferenceFromObject(HSIntersect)
Dim Line2Plane As HybridShapePlane2Lines
Set Line2Plane = HSF.AddNewPlane2Lines(RefAxisLine1, RefHSIntersect)
HB.AppendHybridShape Line2Plane
PT.Update
'⑧ ①を通り⑦に直交方向の直線を作成
Dim RefLine2Plane As Reference
Set RefLine2Plane = PT.CreateReferenceFromObject(Line2Plane)
Set AxisLine3 = HSF.AddNewLineNormal(RefLine2Plane, RefPoint, UserLength, -1 * UserLength, False)
HB.AppendHybridShape AxisLine3
PT.Update
'⑨ ①を通り⑥方向の直線を作成
Dim HSIntersectDir As HybridShapeDirection
Set HSIntersectDir = HSF.AddNewDirection(RefHSIntersect)
Dim AxisLine4 As Line
Set AxisLine4 = HSF.AddNewLinePtDir(RefPoint, HSIntersectDir, UserLength, -1 * UserLength, False)
HB.AppendHybridShape AxisLine4
PT.Update
'ex ②の平面を非表示
With SEL
.Add AxisPlane
.Add HSExtrude
.Add HSIntersect
.Add Line2Plane
.Add AxisLine2
VPS.SetShow catVisPropertyNoShowAttr
.Clear
End With
End If
Exit Sub
ErrLabel:
MsgBox "エッジは円を選択してください。"
SEL.Clear
Resume label1
End Sub
コード解説
形状作成部分のコードは基本的に以下の①〜③を繰り返すだけなのでここでは割愛します。
① 形状の取得
② 取得した形状のReferenceを作成
③ ReferenceとHybridShapeFactoryを使って形状作成
以下では形状作成を行うまでのドキュメントの定義方法、ユーザー選択オブジェクトの確認などの形状作成部分以外のコードを解説していきます。
ドキュメントの定義
まずはドキュメントの定義を行います。
通常は「Set DOC = CATIA.ActiveDocument」のように1行で済ませることのできる「ドキュメントの定義」ですが、お問い合わせの内容によると「プロダクトファイル開いた状態でツリーにぶら下がっているパートをアクティブにしてマクロを実行させたいです。」とのことです。この場合、アクティブドキュメントはCATPartではなくCATProductになってしまうので、単純に「Set DOC = CATIA.ActiveDocument」と書いてしまうと以降の処理でCATPartの処理を行うことができません。
というわけでここでは少し違う方法を使ってドキュメント(CATPart)を定義していきます。
Dim SEL
Set SEL = CATIA.ActiveDocument.Selection
Dim VPS As VisPropertySet
Set VPS = SEL.VisProperties
Dim filter1
Dim filter2
Dim msg As String
Dim Status As String
Dim check As Boolean
check = False
filter1 = Array("Edge")
msg = "エッジ(円)を選択して下さい。"
label1:
Status = SEL.SelectElement2(filter1, msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルします。"
Exit Sub
End If
Dim SelEdge As Edge
Set SelEdge = SEL.Item(1).Value
SEL.Clear
'エッジを含むCATPart(PartDocumrnt)を取得
Dim tmp_Obj
Set tmp_Obj = SelEdge
Do Until TypeName(tmp_Obj) = "PartDocument"
Set tmp_Obj = tmp_Obj.Parent
Loop
Dim Doc As PartDocument
Set Doc = tmp_Obj
まずはドキュメントの定義はせず、ユーザーに「SelectElement2」を使ってエッジを選択させます。
次にこのエッジの親オブジェクトを順々に見ていき、PartDocumentオブジェクトになった時に、そのオブジェクトをドキュメントとして定義します。(コードでいうと「Do〜Loop」の部分)
エッジを選択し親オブジェクトを見ていくと
選択したEdge ＜ HybridShapeSurfaceExplicit ＜ Parameters ＜ Part ＜ PartDocument
といった具合に、必ず「PartDocument」が見つかります。
つまり「Until TypeName(tmp_Obj) = “PartDocument”」と条件をつければ、いつかはPartDocumentオブジェクトを取得できるというわけです。
実際に下のツリー構造で見てもCATPartを扱うPartDocumentオブジェクトは最上位のオブジェクトなので、親を順々に見ていけば必ず見つけることができるということがわかります。
ユーザー選択の円を確認
次にユーザーが選択した円が"正円なのか"を確認していきます。
というのも前項で「SelectElement2」を使ってエッジを取得させましたが、その選択フィルターは"Edge"、つまりはエッジで円でなくても選択できるようになってしまっています。
しかし、以降の形状作成の処理では、ユーザーが選択したエッジは正円である必要があります。
([点]コマンドの[円/球/楕円の中心]を使って作成するため)
Dim SPA As Workbench
Set SPA = Doc.GetWorkbench("SPAWorkbench")
Dim ConfMeasure
Set ConfMeasure = SPA.GetMeasurable(SelEdge)
On Error GoTo ErrLabel
Dim getvalues(2) As Variant
ConfMeasure.GetCenter getvalues
On Error GoTo 0
'-----------------------------------------------------------------------
' 省略
'-----------------------------------------------------------------------
ErrLabel:
MsgBox "エッジは円を選択してください。"
SEL.Clear
Resume label1
End Sub
上記のコードでは「Measurableオブジェクト」の「GetCenterメソッド」を使って、ユーザーが選択したエッジの中心点の座標を取得しています。
ここでユーザーが選択したエッジが正円でない場合は、中心座標の取得ができないため「GetCenterメソッド」の行でエラーが発生します。つまり言い換えればここでエラーが発生した場合、ユーザーの選択したエッジは正円でないことがわかります。
ここではエラーが出た場合に「On Error GoTo ErrLabel」を使って「ErrLabel:」に処理を飛ばすようにします。これにより、ユーザーに正円エッジを選択するよう促すことが可能になります。
あとは「ErrLabel:」から前項の「label1:」に処理を飛ばすことで、正円が選択されるまではユーザーの選択フェーズが永遠と続くような仕様になっています。(もちろん[Esc]キーでマクロの中断もできます)
ユーザ－による直線選択(処理の分岐)
エッジが正円と確認出来たら、軸線の方向を指定するための直線をユーザーに選択させます。
ここでお問い合わせの内容を見ると「XY方向を決める直線を選択（入力しない場合は主座標の方向）」とのことなので、ユーザー選択のフェーズで[Esc]キーが押されたら「主座標の方向(絶対座標)」を使うように処理分岐をするようにします。
ここではブーリアン型の変数「check」を使って直線が選択された場合に「True」にすることで、以降の形状作成部分のコードで分岐できるようにしています。
filter2 = Array("Line", "RectilinearMonoDimFeatEdge", "RectilinearBiDimFeatEdge", "RectilinearTriDimFeatEdge")
msg = "直線(軸方向)を選択して下さい。([Esc]キーを押すと絶対座標系を軸方向にします。)"
Status = SEL.SelectElement2(filter2, msg, False)
If Status = "Normal" Then
Dim SelLine As AnyObject
Dim RefDir As Reference
Dim HSDir As HybridShapeDirection
If TypeName(SEL.Item(1).Value) <> "Line" Then
Set SelLine = SEL.Item(1).Value
Set HSDir = HSF.AddNewDirection(SelLine)
Else
Set SelLine = SEL.Item(1).Value
Set RefDir = PT.CreateReferenceFromObject(SelLine)
Set HSDir = HSF.AddNewDirection(RefDir)
End If
check = True
End If
先のエッジと同じく「SelectElement2」を使って、ユーザーに直線を選択させるようにしますが、ここではフィルターに「Line」だけでなくサブエレメントである「直線エッジ」も選択できるように「RectilinearMonoDimFeatEdge」「RectilinearBiDimFeatEdge」「RectilinearTriDimFeatEdge」もいれています。
(上記3つのオブジェクトについては「CATIA VBAでのサブエレメント(内部要素)」を参照下さい)
ここで1つだけ注意する点があります。
それは、直線(Line)が選択された場合と、直線エッジ(Rectilinear~)が選択された場合に少し処理を変える必要があるという点です。
基本的にCATIAマクロでは形状を作成する時に、その材料となる形状(直線や点などの通常のコマンドで作成できるもの)のオブジェクトはReferenceオブジェクトに変換する必要があります。しかし、その材料がサブエレメントの場合はReferenceオブジェクトに変換する必要がありません。(というよりも変換自体ができません)
今回の場合、初めに「HSDir」という方向を扱うための「HybridShapeDirection」を定義していきます。このオブジェクトの材料となるのはユーザーが選択した直線(もしくは直線エッジ)です。
直線が選択された場合はその直線をReferenceオブジェクトに変換し、そのReferenceオブジェクトを使うことで方向を定義することができます。
Set SelLine = SEL.Item(1).Value 'ユーザー選択の「直線」を取得
Set RefDir = PT.CreateReferenceFromObject(SelLine) '「直線」をReferenceオブジェクトに変換
Set HSDir = HSF.AddNewDirection(RefDir) '方向の定義
しかし直線エッジが選択された場合はReferenceオブジェクトに変換できないので、以下のように直線が選択された場合ではReferenceオブジェクトに変換していた部分を端折る必要があります。
Set SelLine = SEL.Item(1).Value 'ユーザー選択の「直線エッジ」を取得
Set HSDir = HSF.AddNewDirection(SelLine) '方向の定義
このように「SelectElement系」のメソッドでのフィルターに「形状のオブジェクト」と「サブエレメントのオブジェクト」をまとめる場合は、上記のように処理を分ける必要があるので注意しましょう。
「HSDir」が定義できれば以降で形状作成の処理を行います。
この部分は初めにもいった通り、同じような処理の繰り返しなので割愛します。
(コードのコメント文を見れば何をやっているかある程度理解できると思います)
まとめ
今回は「穴中心線(座標軸線)作成マクロ」についての内容でした。
今回は詳細な履歴の内容も教えて頂いたので、形状作成の流れはそれに従っています。
ただ、CATIAでの形状作成の方法はいくつもあり、これが絶対に正解という訳ではありません。
形状作成についてはコードの書き方さえ理解すれば、あとは手動と同じ考え方です。
(形状を作成し、その形状を使って新しい形状を作成していく)
VBAでの形状作成ははじめは少し苦戦するかもしれませんが、理解できればコードすら覚える必要がなくなるほどワンパターンなことに気が付きます。本サイトのサンプルマクロをいくつか見ればパターンがつかめると思うので参考にしてみて下さい。
最後に今回のマクロで学べる、他のマクロでも流用できる部分をまとめると。
コード解説でもあった「CATProduct時に選択されたエッジのあるPartDocumentを取得する方法」と「SelectElement2でのフィルターで形状オブジェクトとサブエレメントオブジェクトがまとまっている場合には処理分岐をさせる」という2点です。
CATIAマクロではどちらも使う場面は出てくると思うので、頭の片隅に入れておきましょう。
CATIAマクロを本気で勉強するなら
