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行目以降に記入されているものに限る)
マクロの機能をまとめると以下のとおりです。
・作成する点の名前は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だけ浮いてる感?があるところとか)ので自身の環境に合わせて書き換えることをオススメします。










