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」と書いてある場合のみ、スプラインは閉じて作成される
前回と同じく、以下で紹介するコードを少し書き換えれば対応できますよ！
サンプルコード
マクロのコードは下記のとおりです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 |
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の表から座標を取得し点を作成」と同じです。(変数名は変えていますが)。点作成部分のコードの解説は前回ページでしているので、コード解説は今回追加したスプラインに関する処理部分の解説をしていきます。
コード解説
ｽﾌﾟﾗｲﾝ作成
|
1 2 3 |
'ｽﾌﾟﾗｲﾝ作成 Dim hs_spline As HybridShapeSpline Set hs_spline = pt.HybridShapeFactory.AddNewSpline |
まずは”空”のスプラインを作成します。
基本的にVBAによって形状を作成する時は作成に必要な材料(たとえば始点となる点や基準となる方向など)が必要ですが、スプラインを作成する「AddNewSplineメソッド」ではそれが必要ありません。
一旦何も定義されていない「スプライン」という”存在”だけを作っているイメージです。
この空のスプラインに対して「HybridShapeSplineオブジェクト」のメソッドを使って、点や接線方向などを追加指定していくことで任意のスプラインを作成することができます。
形状ｾｯﾄ内の点(HybridShape)ﾙｰﾌﾟ
|
1 2 3 4 5 6 7 8 9 10 11 12 |
'形状ｾｯﾄ内の点(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」していくだけです。
ｽﾌﾟﾗｲﾝを閉じる設定
|
1 2 3 4 |
'E2ｾﾙの値が「close」の場合にｽﾌﾟﾗｲﾝを閉じる If ws.Cells(2, 5).Value = "close" Then hs_spline.SetClosing 1 End If |
Excelファイルの「E2」セルに「close」と書かれていたらスプラインを閉じる設定にします。
スプラインは作成した段階では閉じない設定になっています。
これを閉じる設定にするには「HybridShapeSplineオブジェクト」の「SetClosingメソッド」を使います。引数として「１」を渡せばスプラインが閉じる設定に変わります。
形状ｾｯﾄにｽﾌﾟﾗｲﾝを追加
|
1 2 3 |
'形状ｾｯﾄにｽﾌﾟﾗｲﾝを追加 new_hb.AppendHybridShape hs_spline pt.Update |
作成したスプラインを点のまとまった形状セットに追加します。
点作成の時と同じく「AppendHybridShapeメソッド」を使って上記のように書きます。
最後に「pt.Update」でPart全体に更新をかけて完了です。
まとめ
今回はExcelの表から座標を取得し点とそれらを通るスプラインを作成するマクロについての内容でした。
VBAで作成する形状として「スプライン」は少しだけ特別です。
空のスプラインを作成してから点や接線方向などを設定していくという流れです。
サンプルコードということもあり読み込むExcelファイルのテンプレは今回のような単純なものになりましたが、個人的にデザインがあまり好みではない(closeだけ浮いてる感？があるところとか)ので自身の環境に合わせて書き換えることをオススメします。
CATIAマクロを本気で勉強するなら
