選択した曲線上に点を作成するマクロ｜CATIAマクロの作成方法

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

 件名: curve上に端から2mmのところにポイントを作成するマクロ

メッセージ本文:
　測定ポイントを作成する工程です。
　ダイアログで2と入力後、マウスを動かすと数値も動いてしまいます。
　また端から2mmなので作成したい側でないときがあります。
　その時はreverseしたいです。
　英語環境で作業をしています。

お問い合わせ頂いた内容的にダイアログを使って手動と同じように作成しようとしていますが、CATIA VBAには曲線上に点を作成するための「AddNewPointOnCurveFromDistanceメソッド」が存在します。これを使うことでダイアログボックスを開くことなく、任意の曲線上に点を作成することが可能になります。

今回のように形状を作成する場合は「ShapeFactoryオブジェクト」「HybridShapeFactoryオブジェクト」のいずれかを使えば、ほとんどの形状を作成することができるのである程度のメソッドは押さえておくと後々役に立つと思います。

マクロの機能

今回作成したのは選択した曲線上に点を作成するマクロです。
お問い合わせ頂いた内容の通り、点タイプ「曲線上」の「曲線上の距離」で、曲線の端から2mm地点に点を作成します。

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

一応、メッセージボックスで点の位置を確認していますが、ツリー上に作成された点をダブルクリックしてダイアログから反転することもできるので、メッセージボックスの部分は削除しても問題ないかもしれません。

サンプルコード

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

Option Explicit
Sub CATMain()

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義
    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
       MsgBox "このマクロはPartDocument専用です。" & vbLf & _
              "CATPartに切り替えて実行してください。"
       Exit Sub
    End If
    
    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:                        Set sel = doc.Selection
    sel.Clear
    
 '曲線を取得
    Dim res As String
    Dim filter: filter = Array("MonoDimFeatEdge")   'MonoDimFeatEdge：曲線ｴｯｼﾞ
    res = sel.SelectElement2(filter, "曲線のエッジを選択して下さい。", False)
    If res <> "Normal" Then
        MsgBox "キャンセルしました。"
        Exit Sub
    End If

    Dim crv As HybridShape
    Set crv = sel.Item(1).Value.Parent              'ｴｯｼﾞの親を取得
    sel.Clear
    
 'ｱｸﾃｨﾌﾞの形状ｾｯﾄを取得
    Dim hb As HybridBody
    Set hb = pt.InWorkObject
    
 '曲線上に点を作成
    Dim ref_crv As Reference
    Set ref_crv = pt.CreateReferenceFromObject(crv)
    
    Dim p As Point
    Set p = hsf.AddNewPointOnCurveFromDistance(ref_crv, 2, False)
    
    hb.AppendHybridShape p
    pt.Update
    
 'ﾒｯｾｰｼﾞﾎﾞｯｸｽで方向の反転を確認
    res = MsgBox("反転しますか？", vbYesNo)
    If res = vbYes Then
        With sel
            .Add p
            .Delete '作成済みの点を削除
        End With
        
     '曲線の方向を反転して点を作成
        Set p = hsf.AddNewPointOnCurveFromDistance(ref_crv, 2, True)
        hb.AppendHybridShape p
        pt.Update

    End If
    
End Sub

コード解説

ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義

 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義
    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
       MsgBox "このマクロはPartDocument専用です。" & vbLf & _
              "CATPartに切り替えて実行してください。"
       Exit Sub
    End If
    
    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:                        Set sel = doc.Selection
    sel.Clear

まずはじめにアクティブドキュメントを定義をします。
今回のマクロはCATPartのみ有効なものなので、アクティブドキュメントがCATPart以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。つまり、アクティブドキュメントがCATPartの場合のみ変数「doc」にアクティブドキュメントを代入し、マクロの処理を続けます。

アクティブドキュメントが定義できたら、以降で必要になる変数をまとめて定義します。
「Partオブジェクト」「HybridShapeFactoryオブジェクト」「Selectionオブジェクト」を定義します。最後に現在の選択状態をすべて解除するため「sel.Clear」と書いています。　
　

曲線を取得

 '曲線を取得
    Dim res As String
    Dim filter: filter = Array("MonoDimFeatEdge")   'MonoDimFeatEdge：曲線ｴｯｼﾞ
    res = sel.SelectElement2(filter, "曲線のエッジを選択して下さい。", False)
    If res <> "Normal" Then
        MsgBox "キャンセルしました。"
        Exit Sub
    End If

    Dim crv As HybridShape
    Set crv = sel.Item(1).Value.Parent              'ｴｯｼﾞの親を取得
    sel.Clear

つぎに曲線を取得します。最終的にここで取得した曲線上に点を作成します。

曲線は「Selectionオブジェクト」の「SelectElement2メソッド」を使ってユーザー選択により取得します。選択フィルターとして「MonoDimFeatEdge」を指定しています。(詳しくはCATIA VBAでのサブエレメント(内部要素) 参照)

「MonoDimFeatEdge」はワイヤー形状のエッジを表すオブジェクトです。選択フィルターとして"曲線"を指定するのがすこし難しいため、ここでは"曲線のエッジ"としています。

ただ、選択により取得できるオブジェクトは"エッジ"なので、最終的には「sel.Item(1).Value.Parent」と「Parent」を付けることでエッジの親、つまりは曲線本体を取得しにいく必要があるので注意しましょう。
　

ｱｸﾃｨﾌﾞの形状ｾｯﾄを取得

 'ｱｸﾃｨﾌﾞの形状ｾｯﾄを取得
    Dim hb As HybridBody
    Set hb = pt.InWorkObject

つぎにアクティブ状態(作業オブジェクト)の形状セットを取得します。このとき形状セット以外のオブジェクトがアクティブになっているとタイプ不一致でエラーが発生します。

作業オブジェクトは「Partオブジェクト」の「InWorkObjectプロパティ」で表されます。
 

選択した曲線と同じ形状ｾｯﾄを取得

 '曲線上に点を作成
    Dim ref_crv As Reference
    Set ref_crv = pt.CreateReferenceFromObject(crv)
    
    Dim p As Point
    Set p = hsf.AddNewPointOnCurveFromDistance(ref_crv, 2, False)
    
    hb.AppendHybridShape p
    pt.Update

つぎに曲線上に点を作成します。
曲線上に点を作成するには「HybridShapeFactoryオブジェクト」の「AddNewPointOnCurveFromDistanceメソッド」を使います。

iCrvには曲線をReferenceにして入力します。
iLongには端から何mm地点に点を作成するかの数値を入力します。
iOrientationには「True」もしくは「Flase」を入力します。
「True」の場合、デフォルト位置ではなく反転位置に点が作成されます。

上記のコードにより点が作成されるので、前項で取得した形状セットに「AppendHybridShape」すれば点の作成は完了です。
　

選択した曲線と同じ形状ｾｯﾄを取得

 'ﾒｯｾｰｼﾞﾎﾞｯｸｽで方向の反転を確認
    res = MsgBox("反転しますか？", vbYesNo)
    If res = vbYes Then
        With sel
            .Add p
            .Delete '作成済みの点を削除
        End With
        
     '曲線の方向を反転して点を作成
        Set p = hsf.AddNewPointOnCurveFromDistance(ref_crv, 2, True)
        hb.AppendHybridShape p
        pt.Update

    End If

最後に作成した位置に対して"反転位置に作成するか"を確認します。

反転位置に作成する場合は、前項で作成した点を削除して反転位置に作り直します。
これは先ほどの「AddNewPointOnCurveFromDistanceメソッド」のiOrientationを「True」にするだけで、それ以外は全く同じことをしています。

まとめ

今回は選択した曲線上に点を作成するマクロについての内容でした。

今回のコードで最も重要なのは下記の点を作成するコードです。
メソッド名が長くとっつきずらく感じますが3つの材料だけで点が作成できる簡単なメソッドです。

上記以外にも「ShapeFactoryオブジェクト」「HybridShapeFactoryオブジェクト」のメソッドを使えば、あらかたの形状は作成できるので「マクロの記録」と併用していろいろな形状を作成できるようにしておくことをオススメします。
　　

サンプルマクロ集に戻る
目次へ戻る

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

Vb Scripting for Catia V5: How to Program Catia Macros

created by Rinker

• Kindle
• Amazon
• 楽天市場
• Yahooショッピング

CATIA V5: Macro Programming with Visual Basic Script

created by Rinker

McGraw-Hill Education

• Kindle
• Amazon
• 楽天市場
• Yahooショッピング