Excelの表から座標を取得し点とスプラインを作成するマクロ|CATIAマクロの作成方法

今回は「お問い合わせ」より頂いた内容です。
頂いた内容は以下のとおりです。

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

マクロ案: 
以前、Excelの表から座標を取得し点を作成という記事が有りましたがこれに、作成した点を基にスプラインを使った曲線を描くマクロを作成頂けないでしょうか?可能であればスプラインを閉じるかどうかの選択できるマクロも組み込んで頂けないでしょうか?

今回は以前作成したExcelの表から座標を取得し点を作成するマクロの続編です。
お問い合わせ頂いた内容と同じく「Excelの表から座標を取得し点を作成」ページで紹介しているサンプルマクロに、スプライン作成の処理を追加していきます。そのため前回内容を見ていない方は先に目を通しておくことをオススメします。

今回はExcel上でスプラインを閉じるか閉じないかも設定できるよう、下画像のようなテンプレ(フォーマット)を使います。ぜひ本ページのコード内容を理解して、自身の環境にあった使いやすいテンプレでできるようコードを書き換えてみて下さい。

前回内容に引き続きCATIAマクロでExcelファイルを扱うため、Excelライブラリを読み込ませる必要があるので予め設定しておいてください

 

マクロの機能

タイトルのとおり本ページで紹介するマクロの機能は
「Excelの表から座標を取得し点とそれらを通るスプラインを作成する」というものです。

Excelに書かれている「X座標」「Y座標」「Z座標」という文字を読み取って取得する列を指定しているわけではなく、「B列」「C列」「D列」の値を取得するという処理を行っています。行の上から順に隙間なくつめていけば、基本作成する点の個数に制限はありません。

そのためExcelファイルの方で1行ずれて記入した場合、うまくマクロが作動しません。
Excelファイルが上図と同じテンプレであること前提のマクロとなっているため注意して下さい。
(※B列にX座標,C列にY座標,D列にZ座標 それぞれの座標値は2行目以降に記入されているものに限る)

マクロの機能をまとめると以下のとおりです。

 icon-wrench マクロの機能まとめ ・選択したExcelの表から座標値を取得し、CATIAで同座標位置に点を作成
・作成する点の名前はExcelのA列に書かれている文字列
・作成した点はすべて新規作成される形状セットにまとまる

・新規形状セットはマクロ実行時にアクティブな形状セットの中に作成される
  (パーツボディーがアクティブの場合はツリーの第一階層に作成される)
・新規形状セットの名前は選択したExcelのファイル名
———————————- 今回の追加機能 ———————————
・点と同じ形状セット内にすべての点を通るスプラインを作成
・スプラインが通る点の順番はExcel行の上から順
・「E2」セルに「close」と書いてある場合のみ、スプラインは閉じて作成される
テンプレ内容を変更したい場合は
前回と同じく、以下で紹介するコードを少し書き換えれば対応できますよ!

 

サンプルコード

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

Option Explicit
Sub CATMain()

    If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
        MsgBox "CATPartに切り替えてからマクロを実行してください。"
        Exit Sub
    End If
    
    Dim doc As PartDocument
    Set doc = CATIA.ActiveDocument
    
    Dim pt As Part
    Set pt = doc.Part
    
    
    Dim myExcel As Excel.Application
    Set myExcel = CreateObject("Excel.Application")
    
    Dim fn As String
    fn = myExcel.Getopenfilename(FileFilter:="Excelファイル,*.xlsx")
    If fn <> "False" Then
        Dim wb As Workbook
        Set wb = Workbooks.Open(fn)
    Else
        MsgBox "キャンセルされました"
        Exit Sub
    End If
    
    Dim ws As Worksheet
    Set ws = wb.Sheets(1)
    
    
    Dim act_obj As AnyObject
    If TypeName(pt.InWorkObject) = "HybridBody" Then
        Set act_obj = pt.InWorkObject
    Else
        Set act_obj = pt
    End If
    
    Dim hbs As HybridBodies
    Set hbs = act_obj.HybridBodies
    
    Dim new_hb As HybridBody
    Set new_hb = hbs.Add
    new_hb.Name = wb.Name
    
    
    Dim MaxRow As Integer
    MaxRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    Dim i As Integer
    For i = 2 To MaxRow
    
        Dim point_name As String
        point_name = ws.Cells(i, 1).Value
    
        Dim Xvalue As Single
        Xvalue = ws.Cells(i, 2).Value
        
        Dim Yvalue As Single
        Yvalue = ws.Cells(i, 3).Value
        
        Dim Zvalue As Single
        Zvalue = ws.Cells(i, 4).Value
    
        
        Dim new_point As HybridShapePointCoord
        Set new_point = pt.HybridShapeFactory.AddNewPointCoord(Xvalue, Yvalue, Zvalue)
        
        new_hb.AppendHybridShape new_point
        
        new_point.Name = point_name
        pt.Update
    
    Next i

 '------- 追加処理 ------------
    
 'スプライン作成
    Dim hs_spline As HybridShapeSpline
    Set hs_spline = pt.HybridShapeFactory.AddNewSpline
    
 '形状セット内の点(HybridShape)ループ
    Dim hs As HybridShape
    For Each hs In new_hb.HybridShapes
    
     '点のReferenceを作成
        Dim ref_point As Reference
        Set ref_point = pt.CreateReferenceFromObject(hs)
        
     'スプラインに点を追加
        hs_spline.AddPoint ref_point
    
    Next hs
    
 'E2セルの値が「close」の場合にスプラインを閉じる
    If ws.Cells(2, 5).Value = "close" Then
        hs_spline.SetClosing 1
    End If
    
 '形状セットにスプラインを追加
    new_hb.AppendHybridShape hs_spline
    pt.Update
    
 'Excelブックを閉じる
    wb.Close False
    
    MsgBox "完了しました。"

End Sub

はじめの方のコードは「Excelの表から座標を取得し点を作成」と同じです。(変数名は変えていますが)。点作成部分のコードの解説は前回ページでしているので、コード解説は今回追加したスプラインに関する処理部分の解説をしていきます。

 

コード解説 

スプライン作成

 'スプライン作成
    Dim hs_spline As HybridShapeSpline
    Set hs_spline = pt.HybridShapeFactory.AddNewSpline

まずは"空"のスプラインを作成します。

基本的にVBAによって形状を作成する時は作成に必要な材料(たとえば始点となる点や基準となる方向など)が必要ですが、スプラインを作成する「AddNewSplineメソッド」ではそれが必要ありません

一旦何も定義されていない「スプライン」という"存在"だけを作っているイメージです。
この空のスプラインに対して「HybridShapeSplineオブジェクト」のメソッドを使って、点や接線方向などを追加指定していくことで任意のスプラインを作成することができます。
  

形状セット内の点(HybridShape)ループ

 '形状セット内の点(HybridShape)ループ
    Dim hs As HybridShape
    For Each hs In new_hb.HybridShapes
    
     '点のReferenceを作成
        Dim ref_point As Reference
        Set ref_point = pt.CreateReferenceFromObject(hs)
        
     'スプラインに点を追加
        hs_spline.AddPoint ref_point
    
    Next hs

つぎに先にもいっていた通り、空のスプラインに「点の追加」をしていきます。

点の追加自体は点のReferenceを作成し、「AddPointメソッド」を使うだけです。
AddPointメソッドではスプラインの後ろに順々に追加されていきます。

今回は点が複数あるので、この処理をループで処理をしています。
新規作成した形状セット「new_hb」内には点しか作成されていないので、「new_hb.HybridShapes」のItemはすべて作成された点しか入っていない状態です。

つまり、「For Each hs In new_hb.HybridShapes」としてループすれば、ループ毎に「hs」には作成した点が入れ替わって入っていくという処理になっています。あとはこの「hs」を使ってスプラインに「AddPoint」していくだけです。
 

スプラインを閉じる設定

 'E2セルの値が「close」の場合にスプラインを閉じる
    If ws.Cells(2, 5).Value = "close" Then
        hs_spline.SetClosing 1
    End If

Excelファイルの「E2」セルに「close」と書かれていたらスプラインを閉じる設定にします。

スプラインは作成した段階では閉じない設定になっています。
これを閉じる設定にするには「HybridShapeSplineオブジェクト」の「SetClosingメソッド」を使います。引数として「1」を渡せばスプラインが閉じる設定に変わります。
 

形状セットにスプラインを追加

 '形状セットにスプラインを追加
    new_hb.AppendHybridShape hs_spline
    pt.Update

作成したスプラインを点のまとまった形状セットに追加します。
点作成の時と同じく「AppendHybridShapeメソッド」を使って上記のように書きます。

最後に「pt.Update」でPart全体に更新をかけて完了です。

 

まとめ

今回はExcelの表から座標を取得し点とそれらを通るスプラインを作成するマクロについての内容でした。

VBAで作成する形状として「スプライン」は少しだけ特別です。
空のスプラインを作成してから点や接線方向などを設定していくという流れです。

サンプルコードということもあり読み込むExcelファイルのテンプレは今回のような単純なものになりましたが、個人的にデザインがあまり好みではない(closeだけ浮いてる感?があるところとか)ので自身の環境に合わせて書き換えることをオススメします。

 

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

 

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

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