ユーザーが選択した曲線をJoinしてCurveSmoothをかけるマクロ|CATIAマクロの作成方法

今回の記事はマクロ案募集でいただいた内容です。
送って頂いた内容は以下のようなマクロです。

ワークベンチ: GSDワークベンチ

マクロ案: 
複数のカーブを選択してJoinとCurve smoothを一括で処理する事は可能でしょうか?
SelectElement3メソッドを使用し、 複数のカーブを選択してJoinを行う際に選択したカーブ毎にreferenceが定義されてしまい、 その場合どのようにループをさせればいいかわかりません。

選択したカーブの数に対応してreferenceの数字を増やし 、
Join後のCurve smoothで使うreferenceにも反映させるイメージで考えています。

合わせて送っていただいたのでコードを確認したところ、上記にも書いてある通り「選択した複数のカーブをJoin(接合)する」という処理が壁になっているようです。コード解説の項ではこの部分をがっつり解説していきます。

 

マクロの機能

今回作成したマクロはタイトルのとおり
『ユーザーが選択した曲線をJoinしてCurveSmoothをかけるマクロ』です。

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

  マクロの機能まとめ ・選択した全ての曲線(Curve)を1つにJoinしCurve Smoothをかける
・JoinとCurve Smoothはアクティブな形状セット内に作成される
・選択した曲線でJoinができない場合はエラーを無視してマクロを完遂させる

上記の機能の通りエラーが出た場合は「On Error Resume Next」で無視させます。
(送って頂いたコードによるとマクロ終了後にエラー部の確認/修正を行うためです)

 

サンプルコード

マクロのサンプルコードは以下のとおりです。
SelectElement3メソッドのツールバーの使い方を知らない方は、
先にSelectElement3メソッドの使い方ページを一読しておくことをオススメします。

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 ActHB As HybridBody
Set ActHB = PT.InWorkObject  'アクティブな形状セットを定義

Dim SEL 'As Selection
Set SEL = DOC.Selection

Dim VPS As VisPropertySet
Set VPS = SEL.VisProperties


'**********************************************************************
'                      ユーザー選択(SelectElement3)
'**********************************************************************

SEL.Clear '事前の選択をクリアする

Dim Filter As Variant
Filter = Array("HybridShapeCurveExplicit") 'フィルターを設定(Curveのみ選択)

Dim msg As String
msg = "カーブを選択してください。" '選択時にステータスバーに表示されるメッセージの指定

Dim Status As String
Status = SEL.SelectElement3(Filter, msg, False, CATMultiSelTriggWhenUserValidatesSelection, True)
If Status <> "Normal" Then
    MsgBox "キャンセルしました。(Joinするカーブを選択してください。)" 'Statusが"Normal"でない場合(つまりは正常に選択されなかった場合)にマクロ中断
    Exit Sub
End If

Dim i As Integer
Dim SELCollection As Collection
Set SELCollection = New Collection

For i = 1 To SEL.Count
    SELCollection.Add SEL.Item(i).Value 'ループを使ってSELCollectionにユーザーが選択したオブジェクトを入れる
Next i


'**********************************************************************
'                             Join作成
'**********************************************************************

On Error Resume Next 'エラーが起きても処理を続行(エラーはマクロ終了後ツリー上で確認・対処する)
 

Dim EmptyRef As Reference 'Join用の空Reference

Dim CurveRef As Reference
Set CurveRef = PT.CreateReferenceFromObject(SELCollection.Item(1))

Dim HSJoin As HybridShapeAssemble
Set HSJoin = HSF.AddNewJoin(CurveRef, EmptyRef)

Dim j As Integer
For j = 2 To SELCollection.Count

    Set CurveRef = PT.CreateReferenceFromObject(SELCollection.Item(j))
    HSJoin.AddElement CurveRef

Next j

HSJoin.SetConnex 1
HSJoin.SetManifold 1
HSJoin.SetSimplify 0
HSJoin.SetSuppressMode 0
HSJoin.SetDeviation 0.001
HSJoin.SetAngularToleranceMode 0
HSJoin.SetAngularTolerance 0.5
HSJoin.SetFederationPropagation 0

ActHB.AppendHybridShape HSJoin  'アクティブな形状内に作成したJoinを入れる

PT.Update


'**********************************************************************
'                           Curve Smooth作成
'**********************************************************************

Dim JoinRef As Reference
Set JoinRef = PT.CreateReferenceFromObject(HSJoin)  'HSJoinをReference化

Dim HSCSmooth As HybridShapeCurveSmooth
Set HSCSmooth = HSF.AddNewCurveSmooth(JoinRef)

HSCSmooth.SetTangencyThreshold 0.5
HSCSmooth.CurvatureThresholdActivity = False
HSCSmooth.MaximumDeviationActivity = True
HSCSmooth.SetMaximumDeviation 0.001
HSCSmooth.TopologySimplificationActivity = True
HSCSmooth.CorrectionMode = 3

ActHB.AppendHybridShape HSCSmooth

PT.Update


'**********************************************************************
'                            整理整頓
'**********************************************************************

SEL.Clear

Dim k As Integer
For k = 1 To SELCollection.Count
    SEL.Add SELCollection.Item(k)     'HSJoinに使ったカーブを全て選択状態にする
Next k

SEL.Add HSJoin                        'HSJoinを選択状態にする
    
VPS.SetShow catVisPropertyNoShowAttr  '選択状態のオブジェクトを全て非表示にする
SEL.Clear

End Sub

 

コード解説

以下では上記で紹介しサンプルコードでどのような処理をしているかをかたまりごとに簡単に解説していきます。ここでは冒頭でもいったとおり「選択した複数のカーブをJoin(接合)する」という処理部分をがっつり解説していきます。
  

必要オブジェクトの準備

まずはマクロで使うオブジェクトを定義していきます。
それぞれ以下のものを定義しています。(コメント部参照)

Dim DOC As PartDocument
Set DOC = CATIA.ActiveDocument 'アクティブなドキュメントを定義

Dim PT As Part
Set PT = DOC.Part 'アクティブなドキュメントのPartを定義

Dim HSF As HybridShapeFactory
Set HSF = PT.HybridShapeFactory 'GSDワークベンチで形状作成を行うためのHybridShapeFactoryオブジェクトを定義

Dim ActHB As HybridBody
Set ActHB = PT.InWorkObject  'アクティブな形状セットを定義

Dim SEL 'As Selection
Set SEL = DOC.Selection 'アクティブなドキュメントの"選択状態"を操作できるSelectionオブジェクトを定義

Dim VPS As VisPropertySet
Set VPS = SEL.VisProperties 'グラフィックプロパティを操作できるVisPropertySetオブジェクトを定義(Hide用)

一部のオブジェクトは本サイトで詳しく解説したページを用意しているので併せて参照ください。
参考『Documentオブジェクト』『Selectionオブジェクト』『VisPropertySetオブジェクト

 

ユーザー選択(SelectElement3)

つぎにユーザー選択部です。
ここではユーザーに複数のカーブを選択させ、選択したカーブをすべて取得していきます。
ユーザーによる複数のオブジェクトのインプットは『SelectElement3メソッド』を使います。

SEL.Clear '事前の選択をクリアする

Dim Filter As Variant
Filter = Array("HybridShapeCurveExplicit") 'フィルターを設定(Curveのみ選択)

Dim msg As String
msg = "カーブを選択してください。" '選択時にステータスバーに表示されるメッセージの指定

Dim Status As String
Status = SEL.SelectElement3(Filter, msg, False, CATMultiSelTriggWhenUserValidatesSelection, True)
If Status <> "Normal" Then
    MsgBox "キャンセルしました。(Joinするカーブを選択してください。)" 'Statusが"Normal"でない場合(つまりは正常に選択されなかった場合)にマクロ中断
    Exit Sub
End If

Dim i As Integer
Dim SELCollection As Collection
Set SELCollection = New Collection

For i = 1 To SEL.Count
    SELCollection.Add SEL.Item(i).Value 'ループを使ってSELCollectionにユーザーが選択したオブジェクトを入れる
Next i

コードの内容はSelectElement3メソッドの使い方ページに詳しく説明しているためそちらを参照下さい。

最終的に『SELCollection』内にユーザーが選択した全てのカーブを入れています。

 

Join作成

つぎにユーザーが選択したカーブ(言い換えればSELCollection内にあるカーブ)をすべてJoinします。

On Error Resume Next 'エラーが起きても処理を続行(エラーはマクロ終了後ツリー上で確認・対処する)
                      '※マクロ完成後[']を削除

Dim EmptyRef As Reference 'Join用の空Reference

Dim CurveRef As Reference
Set CurveRef = PT.CreateReferenceFromObject(SELCollection.Item(1))

Dim HSJoin As HybridShapeAssemble
Set HSJoin = HSF.AddNewJoin(CurveRef, EmptyRef)

Dim j As Integer
For j = 2 To SELCollection.Count

    Set CurveRef = PT.CreateReferenceFromObject(SELCollection.Item(j))
    HSJoin.AddElement CurveRef

Next j

HSJoin.SetConnex 1
HSJoin.SetManifold 1
HSJoin.SetSimplify 0
HSJoin.SetSuppressMode 0
HSJoin.SetDeviation 0.001
HSJoin.SetAngularToleranceMode 0
HSJoin.SetAngularTolerance 0.5
HSJoin.SetFederationPropagation 0

ActHB.AppendHybridShape HSJoin  'アクティブな形状内に作成したJoinを入れる

PT.Update

 
Joinは『AddNewJoinメソッド』を使って以下のように書くことで定義することができます。

 icon-code AddNewJoinメソッド

Dim HSJoin As HybridShapeAssemble
Set HSJoin = HSF.AddNewJoin(Ref1, Ref2'Ref1,Ref2はReferenceオブジェクト

上記のコードの場合は、Ref1Ref2をJoinすることができます。
Ref1Ref2はReferenceオブジェクトである必要があるため、Joinしたいオブジェクトを一旦Referenceオブジェクトに変換する必要があります。

任意のオブジェクトをReferenceオブジェクトに変換するには『CreateReferenceFromObjectメソッド』を使い、以下のように書きます。

 icon-code CreateReferenceFromObjectメソッド

Dim Ref1 As Reference
Set Ref1 = PT.CreateReferenceFromObject(Obj)

上記のコードの場合、Objという変数の中にあるオブジェクトをReferenceオブジェクトとして変換することができます。この変換後のReferenceはRef1で表すことができます。

 
Joinの方法がわかったところで、複数のオブジェクトをJoinする方法を見ていきましょう。
上記で紹介したコードではRef1Ref2の2種類のオブジェクトしかJoinすることができません。

Joinするオブジェクトを増やしたい場合は『AddElementメソッド』を使って以下のように書きます。

 icon-code AddElementメソッド

Dim HSJoin As HybridShapeAssemble
Set HSJoin = HSF.AddNewJoin(Ref1, Ref2'Ref1,Ref2はReferenceオブジェクト
 
HSJoin.AddElement Ref3
HSJoin.AddElement Ref4   '……といった具合にいくつも追加することが可能

上記のコードの場合、Ref1~Ref4の4つのオブジェクトをJoinすることができます。

 
それでは上記の内容を踏まえて以下の部分を見ていきましょう。

Dim EmptyRef As Reference 'Join用の空Reference

Dim CurveRef As Reference
Set CurveRef = PT.CreateReferenceFromObject(SELCollection.Item(1))

Dim HSJoin As HybridShapeAssemble
Set HSJoin = HSF.AddNewJoin(CurveRef, EmptyRef)

Dim j As Integer
For j = 2 To SELCollection.Count

    Set CurveRef = PT.CreateReferenceFromObject(SELCollection.Item(j))
    HSJoin.AddElement CurveRef

Next j

まずは『AddElementメソッド』で追加するためのHybridShapeAssembleオブジェクト(上記コードでいうHSJoin)を作っておきます。

SELCollection内にある1つ目のカーブと2つ目のカーブをReference変換してJoinしてもいいのですが、基本的にはJoinするカーブはループで追加していきたいのでここででは別の方法を使います。

EmptyRef』という空のReferenceオブジェクトを用意しておき、このオブジェクトとSELCollection内にある1つ目のカーブをJoinさせます。

icon-code 1つのオブジェクトのみをJoinする

Dim CurveRef As Reference
Set CurveRef = PT.CreateReferenceFromObject(SELCollection.Item(1))
 
Dim HSJoin As HybridShapeAssemble
Set HSJoin = HSF.AddNewJoin(CurveRef, EmptyRef)

これによりHSJoinの中にはSELCollection内にある1つ目のカーブのみが入った状態になります。
(AddNewJoinを使うときには必ず2つのReferenceオブジェクトを指定する必要があるためこのような回りくどいことをしています)

あとはループと『AddElementメソッド』を使ってSELCollection内にある2つ目以降のカーブをHSJoinに追加していくだけです。

icon-code Joinにオブジェクトを追加していく

Dim j As Integer
For j = 2 To SELCollection.Count
 Set CurveRef = PT.CreateReferenceFromObject(SELCollection.Item(j))
 HSJoin.AddElement CurveRef  'j番目のカーブをHSJoinに追加
Next j

 

Curve Smooth作成

Curve Smoothの作成もJoinの作成とほとんど同じ方法です。
Join作成の内容が理解できれば以下の内容も理解できると思います。
icon-code Curve Smooth作成

Dim JoinRef As Reference
Set JoinRef = PT.CreateReferenceFromObject(HSJoin) 'HSJoinをReference化
 
Dim HSCSmooth As HybridShapeCurveSmooth 
Set HSCSmooth = HSF.AddNewCurveSmooth(JoinRef)

 

整理整頓

ここでは最終アウトプットであるCurve Smooth以外を非表示(Hide)にする処理を行っています。

SEL.Clear

Dim k As Integer
For k = 1 To SELCollection.Count
    SEL.Add SELCollection.Item(k)     'HSJoinに使ったカーブを全て選択状態にする
Next k

SEL.Add HSJoin                        'HSJoinを選択状態にする
    
VPS.SetShow catVisPropertyNoShowAttr  '選択状態のオブジェクトを全て非表示にする
SEL.Clear

オブジェクトの表示/非表示を切り替えるには「VisPropertySetオブジェクト」の「SetShowメソッド」を使います。これは選択状態のオブジェクトを表示状態(Show)もしくは非表示状態(Hide)にすることができるメソッドです。

詳しくは『VisPropertySetオブジェクト』ページを参照下さい。

 

まとめ

今回は「ユーザーが選択した曲線をJoinしてCurveSmoothをかけるマクロ」についての内容でした。

マクロで形状作成を行うときは今回のようにReferenceオブジェクトが密接に関わってきます。
(実際は通常のオブジェクトをReferenceオブジェクトに変換するだけのシンプルなお話ですが)

特にJoin(接合)のように複数のオブジェクトから成るオブジェクトを作成する時は、今回のように1手間,2手間かける必要が出てきます。
「どのタイミングでどのようにReferenceオブジェクトの変換するか」を意識してコードが書けるようになれば、たいていの形状をVBAで作ることができるようになるのでぜひ勉強してみて下さい。
  

目次へ戻る
 

icon-book CATIAマクロを本気で勉強するなら

2024年8月26日CATIA,CATIAマクロ