穴軸とパイプ面作成マクロ[Type A]｜CATIAマクロの作成方法

今回の記事は「お問い合わせ」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。

●プロダクトファイル開いた状態で
　ツリーにぶら下がっているパートをアクティブにしてマクロを実行させたいです。
　
①穴軸とパイプ面作成　タイプA
　　選択　　　　　　　　　　
　　　円のエッジ選択　（円はボディ＆サーフェスエッジ）　
　　　　↓
　　結果
　　　点　と　円の軸線作成　と　作成された軸線に対してスイープ（中心と半径）　
　
　・　A、Bの軸線及び面直線は点から両端で作成　（例　始点-10mmm,終点10mm)
　・　線片側長さとスイープ直径はダイアログで数値を入力　
（線片側長さは10と入力すれば始点-10mmm,終点10mm　全長は20mm,　
　　　スイープは入力時には直径の数値を入れたいです。）
　・　作成された線やスイープは作成後に履歴により寸法変更もしたいです。

複数のマクロ案を頂いたので、それぞれ別ページでまとめていきます。
(上記お問い合わせ内容に番号やタイプがついているのは複数案頂いたためです)

今回のマクロはユーザーが選択したオブジェクトを使って形状を作成するだけなので、作り方さえわかれば他の形状作成系マクロもすぐに使いこなせるようになります。

またCATProduct上で実行することを想定していますが、これにはちょっとしたテクニックが必要になるのでぜひここで押さえておきましょう。

※本ページの内容は「穴軸とパイプ面作成マクロ[Type B]」とほとんど同じです。
　コピペ部分もあるのでTypeAを理解している方は、流し読みでも理解できると思います。

1. マクロの機能
2. サンプルコード
3. コード解説
4. まとめ

マクロの機能

今回作成したマクロは
『ユーザーが選択した円エッジに対して軸線とパイプ面を作成するマクロ』です。

具体的な機能は以下のとおりです。

マクロの機能まとめ・選択したエッジ(円)に対して軸線とパイプ面を作成する
・軸線の長さとパイプ面の半径は作成前にインプットボックスで指定が可能
・作成した形状は全てツリー第1階層に作成する新規形状セットにまとめる

サンプルコード

マクロのサンプルコードは以下のとおりです。

Option Explicit

Sub CATMain()

    Dim SEL
    Set SEL = CATIA.ActiveDocument.Selection
    
    Dim VPS As VisPropertySet
    Set VPS = SEL.VisProperties
    
    Dim filter
    Dim Msg As String
    Dim status As String
    
    filter = Array("Edge")
    Msg = "エッジ(円)を選択して下さい。"
    
label1:
    
    status = SEL.SelectElement2(filter, 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 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
    
    
    Dim UserLength As String
    UserLength = InputBox("軸線の長さを入力して下さい。", "長さ入力", 10)
    If UserLength = "" Then
        Exit Sub
    End If
    
    Dim UserDiameter As String
    UserDiameter = InputBox("パイプ面の直径を入力して下さい。", "直径入力", 5)
    If UserDiameter = "" Then
        Exit Sub
    End If
    
    Dim PT As Part
    Set PT = DOC.Part
    
    Dim HB As HybridBody
    Set HB = PT.HybridBodies.Add
    HB.Name = "穴軸とパイプ面作成(タイプA)"
    
    Dim HSF As HybridShapeFactory
    Set HSF = PT.HybridShapeFactory
    
    
    '① 選択されたエッジの中心点作成
    
    Dim CtrPoint As Point
    Set CtrPoint = HSF.AddNewPointCenter(SelEdge)
    
    HB.AppendHybridShape CtrPoint
    PT.Update
    
    
    '② 選択されたエッジを通る平面を作成
    
    Dim NormPlane As Plane
    Set NormPlane = HSF.AddNewPlane1Curve(SelEdge)
    
    HB.AppendHybridShape NormPlane
    PT.Update
    
    
    '③ ①を通り②に直交方向の直線を作成
    
    Dim RefPlane As Reference
    Set RefPlane = PT.CreateReferenceFromObject(NormPlane)
    
    Dim RefPoint As Reference
    Set RefPoint = PT.CreateReferenceFromObject(CtrPoint)
    
    Dim AxisLine As Line
    Set AxisLine = HSF.AddNewLineNormal(RefPlane, RefPoint, UserLength, -1 * UserLength, False)
    
    HB.AppendHybridShape AxisLine
    PT.Update
    
    
    '④ ③を中心とするスイープを作成
    
    Dim RefLine As Reference
    Set RefLine = PT.CreateReferenceFromObject(AxisLine)
    
    Dim PipeSweep As HybridShapeSweepCircle
    Set PipeSweep = HSF.AddNewSweepCircle(RefLine)
    
    PipeSweep.Mode = 6
    PipeSweep.SmoothActivity = False
    PipeSweep.GuideDeviationActivity = False
    PipeSweep.SetRadius 1, UserDiameter / 2
    PipeSweep.SetbackValue = 0.02
    PipeSweep.FillTwistedAreas = 1
    PipeSweep.C0VerticesMode = True
    
    HB.AppendHybridShape PipeSweep
    PT.Update
    
    
    SEL.Add NormPlane
    VPS.SetShow catVisPropertyNoShowAttr
    SEL.Clear
    
    Exit Sub

ErrLabel:
    MsgBox "エッジは円を選択してください。"
    SEL.Clear
    Resume label1
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

Option Explicit

Sub CATMain()

Dim SEL

Set SEL = CATIA.ActiveDocument.Selection

Dim VPS As VisPropertySet

Set VPS = SEL.VisProperties

Dim filter

Dim Msg As String

Dim status As String

filter = Array("Edge")

Msg = "エッジ(円)を選択して下さい。"

label1:

status = SEL.SelectElement2(filter, 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 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

Dim UserLength As String

UserLength = InputBox("軸線の長さを入力して下さい。", "長さ入力", 10)

If UserLength = "" Then

Exit Sub

End If

Dim UserDiameter As String

UserDiameter = InputBox("パイプ面の直径を入力して下さい。", "直径入力", 5)

If UserDiameter = "" Then

Exit Sub

End If

Dim PT As Part

Set PT = DOC.Part

Dim HB As HybridBody

Set HB = PT.HybridBodies.Add

HB.Name = "穴軸とパイプ面作成(タイプA)"

Dim HSF As HybridShapeFactory

Set HSF = PT.HybridShapeFactory

'① 選択されたエッジの中心点作成

Dim CtrPoint As Point

Set CtrPoint = HSF.AddNewPointCenter(SelEdge)

HB.AppendHybridShape CtrPoint

PT.Update

'② 選択されたエッジを通る平面を作成

Dim NormPlane As Plane

Set NormPlane = HSF.AddNewPlane1Curve(SelEdge)

HB.AppendHybridShape NormPlane

PT.Update

'③ ①を通り②に直交方向の直線を作成

Dim RefPlane As Reference

Set RefPlane = PT.CreateReferenceFromObject(NormPlane)

Dim RefPoint As Reference

Set RefPoint = PT.CreateReferenceFromObject(CtrPoint)

Dim AxisLine As Line

Set AxisLine = HSF.AddNewLineNormal(RefPlane, RefPoint, UserLength, -1 * UserLength, False)

HB.AppendHybridShape AxisLine

PT.Update

'④ ③を中心とするスイープを作成

Dim RefLine As Reference

Set RefLine = PT.CreateReferenceFromObject(AxisLine)

Dim PipeSweep As HybridShapeSweepCircle

Set PipeSweep = HSF.AddNewSweepCircle(RefLine)

PipeSweep.Mode = 6

PipeSweep.SmoothActivity = False

PipeSweep.GuideDeviationActivity = False

PipeSweep.SetRadius 1, UserDiameter / 2

PipeSweep.SetbackValue = 0.02

PipeSweep.FillTwistedAreas = 1

PipeSweep.C0VerticesMode = True

HB.AppendHybridShape PipeSweep

PT.Update

SEL.Add NormPlane

VPS.SetShow catVisPropertyNoShowAttr

SEL.Clear

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 filter
    Dim Msg As String
    Dim status As String
    
    filter = Array("Edge")
    Msg = "エッジ(円)を選択して下さい。"
    
label1:
    
    status = SEL.SelectElement2(filter, 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 SEL

Set SEL = CATIA.ActiveDocument.Selection

Dim VPS As VisPropertySet

Set VPS = SEL.VisProperties

Dim filter

Dim Msg As String

Dim status As String

filter = Array("Edge")

Msg = "エッジ(円)を選択して下さい。"

label1:

status = SEL.SelectElement2(filter, 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

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]キーでマクロの中断もできます)

ユーザー選択のエッジが正円と確認できれば以降で形状作成の処理を行います。
この部分は初めにもいった通り、同じような処理の繰り返しなので割愛します。
(コードのコメント文を見れば何をやっているかある程度理解できると思います)

まとめ

今回は「ユーザーが選択した円エッジに対して軸線とパイプ面を作成するマクロ」についての内容でした。

CATProduct上でCATPartの処理を行うには、今回やったようなテクニックが必要になります。
やっていること自体はかなり単純なものなので、他の場面にもすぐに応用できるようになると思います。

また、ユーザーが選択したエッジが正円かを確認する方法も、あえてエラーを発生させることで判断しています。
少し無理矢理感も否めませんが、他にも「選択されたエッジの両端に点を作成し、その距離を測る」という方法もあります。こちらの場合は、距離が「０」であれば円、「０」以外は円でないということがわかります。ただ円は円でも正円とは確定できないので今回の方法で行いました。

自身の知っているコードだけでもうまく使えば、今回のようにちょっとした「どうしよう」に対応することができます。ぜひ様々なサンプルコードを見て、盗める部分だけ盗んで自分のものにして書き換えていきましょう。
　

目次へ戻る