要素にパラメータの値を反映する(式を編集)｜CATIAマクロの作成方法

今回の記事はマクロ案募集でいただいた内容です。
今回頂いた質問の内容は以下のとおりです。

マクロ案: マクロで作成する要素にパラメータの値を反映する。

（例）球を作成する場合

Dim hybridShapeSphere1 As HybridShapeSphere
Set hybridShapeSphere1 = _
Part1.HybridShapeFactory. AddNewSphere(Ref1, Nothing, 5#, -45#, 45#, 0#, 180#)

Ref1：中心点
5#：半径5ｍｍ

この半径の部分にパラメータの値を
参照させることは可能でしょうか？
（パラメータの数値によって球の大きさが変わる）

簡単にいえば「式の編集(Edit Formula)」をマクロで行いたいということだと思います。
頂いたメールには上記の内容に加え、具体的にこういったマクロを作成したいという要望があったため、今回はそのマクロのコードを紹介していきます。

1. 作成するマクロの内容
2. 完成コード
3. コード解説
- 3.1. 式の作成
4. まとめ

作成するマクロの内容

今回作成するマクロの内容は、以下のような処理を行うマクロです。

① 中心点を選択
② 参照点を選択
③ 2点間の距離を測定(パラメータ化)
④ ①の中心点を中心とした球を作成
→ 半径は③で作成したパラメータの数値

最終的には以下のようになります。

式で2点間の距離と球の半径が紐づいているため点の座標を変更した場合、それに伴って球の大きさも自動で変更されていきます。

完成コード

完成コードは以下のとおりです。
送っていただいたコードが非常にしっかりしていたので数行ほど追加するだけで正常に動作しました。

'球作成マクロ
Private partDocument1 As PartDocument
Private Part1 As Part
'-------------------------------------------------------------------------------------------------------------------------------'
Sub CATMain()
'準備
Set partDocument1 = CATIA.ActiveDocument
Set Part1 = partDocument1.Part

'ﾕｰｻﾞｰによる2点の選択
Dim Filter(0) As Variant
Filter(0) = "Point"
Dim Ref1 As Reference
Set Ref1 = SelectItemReference(Filter, "中心点を選択")

Filter(0) = "Point"
Dim Ref2 As Reference
Set Ref2 = SelectItemReference(Filter, "参照点を選択")

'球作成
Dim hybridShapeSphere1 As HybridShapeSphere
Set hybridShapeSphere1 = CreateShape(Ref1, Ref2)

End Sub
'-------------------------------------------------------------------------------------------------------------------------------'
'***SelectElement2***
Private Function SelectItemReference(Filter, msg As String) As Reference
Dim Status As String
Dim selection1 'As Selection
Set selection1 = partDocument1.Selection
With selection1
.Clear
Status = .SelectElement2(Filter, msg, False)
If Status = "Cancel" Then
Call MsgBox("中止します")
End
End If
Set SelectItemReference = .Item(1).Reference
.Clear
End With
Set SEL = Nothing
End Function
'-------------------------------------------------------------------------------------------------------------------------------'
'***球作成***
Private Function CreateShape(Ref1 As Reference , Ref2 As Reference) As HybridShapeSphere

Dim HBs As HybridBodies
Set HBs = Part1.InWorkObject

Dim hybridBody1 As HybridBody
Set hybridBody1 = HBs

'ﾊﾟﾗﾒｰﾀ.1作成
Dim length1 As Parameter
Set length1 = Part1.Parameters.CreateDimension("", "LENGTH", 0#)

'式を作成する為の名前を取得
Dim CorrectName1$: CorrectName1 = Part1.Parameters.GetNameToUseInRelation(Ref1)
Dim CorrectName2$: CorrectName2 = Part1.Parameters.GetNameToUseInRelation(Ref2)

'式作成①(ﾊﾟﾗﾒｰﾀ.1 = 2点間の距離)
Dim formula1 As Formula
Set formula1 = Part1.Relations.CreateFormula("SPHERE", "", length1, "distance(`" & CorrectName1 & "`,`" & CorrectName2 & "`)")

'球作成
Dim hybridShapeSphere1 As HybridShapeSphere
Set hybridShapeSphere1 = Part1.HybridShapeFactory.AddNewSphere(Ref1, Nothing, length1.Value, -45#, 45#, 0#, 180#)

hybridShapeSphere1.Limitation = 1
hybridBody1.AppendHybridShape hybridShapeSphere1

Part1.InWorkObject = hybridShapeSphere1

'ﾊﾟﾗﾒｰﾀ.1の名称取得
Dim ParmName As String
ParmName = Right(length1.Name, InStr(StrReverse(length1.Name), "\") - 1)　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' "　←※1 　                    　                 　　　　　　　　                 　

'式作成②(球の半径 = ﾊﾟﾗﾒｰﾀ.1)
Dim formula2 As Formula
Set formula2 = Part1.Relations.CreateFormula("RADIUS", "", hybridShapeSphere1.Radius, "`" & ParmName & "`")

Part1.Update

End Function

'球作成マクロ

Private partDocument1 As PartDocument

Private Part1 As Part

'-------------------------------------------------------------------------------------------------------------------------------'

Sub CATMain()

'準備

Set partDocument1 = CATIA.ActiveDocument

Set Part1 = partDocument1.Part

'ﾕｰｻﾞｰによる2点の選択

Dim Filter(0) As Variant

Filter(0) = "Point"

Dim Ref1 As Reference

Set Ref1 = SelectItemReference(Filter, "中心点を選択")

Filter(0) = "Point"

Dim Ref2 As Reference

Set Ref2 = SelectItemReference(Filter, "参照点を選択")

'球作成

Dim hybridShapeSphere1 As HybridShapeSphere

Set hybridShapeSphere1 = CreateShape(Ref1, Ref2)

End Sub

'-------------------------------------------------------------------------------------------------------------------------------'

'***SelectElement2***

Private Function SelectItemReference(Filter, msg As String) As Reference

Dim Status As String

Dim selection1 'As Selection

Set selection1 = partDocument1.Selection

With selection1

.Clear

Status = .SelectElement2(Filter, msg, False)

If Status = "Cancel" Then

Call MsgBox("中止します")

End

End If

Set SelectItemReference = .Item(1).Reference

.Clear

End With

Set SEL = Nothing

End Function

'-------------------------------------------------------------------------------------------------------------------------------'

'***球作成***

Private Function CreateShape(Ref1 As Reference , Ref2 As Reference) As HybridShapeSphere

Dim HBs As HybridBodies

Set HBs = Part1.InWorkObject

Dim hybridBody1 As HybridBody

Set hybridBody1 = HBs

'ﾊﾟﾗﾒｰﾀ.1作成

Dim length1 As Parameter

Set length1 = Part1.Parameters.CreateDimension("", "LENGTH", 0#)

'式を作成する為の名前を取得

Dim CorrectName1$: CorrectName1 = Part1.Parameters.GetNameToUseInRelation(Ref1)

Dim CorrectName2$: CorrectName2 = Part1.Parameters.GetNameToUseInRelation(Ref2)

'式作成①(ﾊﾟﾗﾒｰﾀ.1 = 2点間の距離)

Dim formula1 As Formula

Set formula1 = Part1.Relations.CreateFormula("SPHERE", "", length1, "distance(`" & CorrectName1 & "`,`" & CorrectName2 & "`)")

'球作成

Dim hybridShapeSphere1 As HybridShapeSphere

Set hybridShapeSphere1 = Part1.HybridShapeFactory.AddNewSphere(Ref1, Nothing, length1.Value, -45#, 45#, 0#, 180#)

hybridShapeSphere1.Limitation = 1

hybridBody1.AppendHybridShape hybridShapeSphere1

Part1.InWorkObject = hybridShapeSphere1

'ﾊﾟﾗﾒｰﾀ.1の名称取得

Dim ParmName As String

ParmName = Right(length1.Name, InStr(StrReverse(length1.Name), "\") - 1)　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　' "　←※1 　　　　　　　　　　　

'式作成②(球の半径 = ﾊﾟﾗﾒｰﾀ.1)

Dim formula2 As Formula

Set formula2 = Part1.Relations.CreateFormula("RADIUS", "", hybridShapeSphere1.Radius, "`" & ParmName & "`")

Part1.Update

End Function

※1 サイトでの表示の関係上「’ “」を書いておかないと色がおかしくなるので書いています。
　　コードとは無関係なので実際のコードでは76行目の「’ “　←※1」は消してください。

コード解説

今回のマクロでの一番の肝は「式の作成」です。
そのためここでは式の作成をメインに解説していきます。

ここで解説する内容のコードで以下のような式を作成することができます。

式の作成

今回のマクロで一番重要なのは「式の作成」の部分です。
式の作成はCATIAのコマンドでいえば「式を編集(Edit Formula)」で、複数のパラメータの数値を計算式で表すことのできる機能です。

VBAで式を作成するには以下のように書きます。

式の作成構文

Dim formula1 As Formula ‘「formula1」という名前の変数を宣言
Set formula1 = _
Part1.Relations.CreateFormula(iName, iComment, iOutputParameter, iFormulaBody)

iName → 作成する式の名前を入力
iComment → 作成する式のコメントを入力(プロパティ内のコメント)
iOutputParameter → 作成する式の結果をアウトプットするパラメータの入力
iFormulaBody → 作成する式(文字列)を入力

※Part1 ⇒ CATIA.ActiveDocument.Part

今回の場合は上記の構文を使って以下の2つの式を作成しました。

① パラメータ.1 = 2点間の距離
② 球の半径 = パラメータ.1

式自体は非常にシンプルで「2点間の距離」と「球の半径」を、「パラメータ.1」をかませてイコール関係にしているだけです。「パラメータ.1」は2点間の距離を入れておくための箱とイメージしてもらえれば大丈夫です。
　

式作成①(パラメータ.1 = 2点間の距離)

はじめに「パラメータ.1 = 2点間の距離」という式の書き方を見ていきましょう。

まずはパラメータ.1を作成します。
ParametersコレクションのCreateDimensionメソッドで”長さ”のパラメータを作成します。

Lengthパラメータの作成

Dim length1 As Parameter
Set length1 = Part1.Parameters.CreateDimension(“”, “LENGTH”, 0#)

　
つぎにこのパラメータ.1の値が選択した2点間の距離となるような式を作成します。

式作成①

Dim formula1 As Formula
Set formula1 = Part1.Relations.CreateFormula (“SPHERE”, “” , _
length1 , “distance(‘” & CorrectName1 & “‘,‘” & CorrectName2 & “‘)”)

今回は2点間の距離を取得したいので、「distance(ﾎﾞﾃﾞｨｰ,ﾎﾞﾃﾞｨｰ)」を利用します。
上記のように書くことでパラメータ.1の値に選択した2点間の距離が入ります。

式の書き方の調べ方(クリックで詳細表示)

おそらく式の部分をどのように書けばいいのかわからないということが頻繁にあります。
という訳で式の書き方を自力で調べる方法も見ていきましょう。

今回使う「長さ」のパラメータを1つ手動で作成し、値を右クリックして「式の編集(Edit Formula)」を選択します。すると以下のようなウィンドウが立ち上がります。

このウィンドウの左側の「辞書(Dictionary)」から「測定(Measure)」を選択します。
すると右側に測定関係で使用可能な式の書き方一覧が出てきます。
今回は2点間の距離なので「distance(ﾎﾞﾃﾞｨｰ,ﾎﾞﾃﾞｨｰ):長さ」が利用できそうです。

この「ﾎﾞﾃﾞｨｰ」の部分に距離を測定したい1つの要素名を入力します。
このとき要素名の前後には半角アポストロフィー[`]が必要です。
(イメージ：‘形状ｾｯﾄ\点.1‘) 　←表示の都合上アポストロフィーは全角になっています。

　
今回の場合は「GetNameToUseInRelationメソッド」を使って2点の名前を取得しています。
1つ目の点は「CorrentName1」に
2つ目の点は「CorrentName2」に名前が入っています。

式の部分は文字列で入力するため単純に「”distance(” & CorrentName1 & “,” & CorrentName2 & “)」と書きたいところですが、「GetNameToUseInRelationメソッド」で取得した名称にはアポストロフィーが含まれていません。

ということで「“distance(‘” & CorrectName1 & “‘,‘” & CorrectName2 & “‘)”」というように書いて、両要素名の前後にアポストロフィーを記す必要があります。(※表示の都合上アポストロフィーは全角になっています)

式作成②(球の半径 = パラメータ.1)

つぎに「作成した球(hybridShapeSphere1)＝パラメータ.1の値」という式を見ていきましょう。
ここは先ほどの式よりは単純です。
数値がイコール関係の場合は式を書く必要はなく、式の部分に要素名を書くだけです。

式作成②

Dim formula2 As Formula
Set formula2 = Part1.Relations.CreateFormula _
(“RADIUS”, “”, hybridShapeSphere1.Radius, “‘” & ParmName & “‘”)

作成する式の結果をアウトプットするパラメータの位置には作成した球の半径を表す「hybridShapeSphere1.Radius」を入力しておくことで、作成した球の半径とパラメータ.1の数値を紐づけることができます。

ただ上記のコードで少し厄介なのが、パラメータ名を式①とおなじく「GetNameToUseInRelationメソッド」で取得しようとしてもうまく実行できないという点です。
たとえば式の部分には「長さ.1」というような名称を入れたいわけなのですが、
取得される名称は「Part1\長さ.1」というように無駄な文字列もまとめて取得してしまいます。

というわけで今回はRight関数というものを使って必要な部分だけを取り出して取得しています。
Right関数はExcelマクロでよく使用されます。
そのため検索すれば多くの情報が出てくるため、詳しくはそれらを参照ください。

パラメータを取得

Dim ParmName As String
ParmName = Right(length1.Name, InStr(StrReverse(length1.Name), “\”) – 1)　

上記のコードでは、簡単にいうと「取得した名前の一番右側の\マークより右側にある文字列を取得」という処理を行っています。つまりは「Part1\長さ.1」という文字列の場合は「長さ.1」だけを取得することができます。