Excelの表から座標を取得し点を作成｜CATIAマクロの作成方法
今回はマクロ案募集で頂いた内容です。
頂いた内容は以下のとおりです。
ワークベンチ: GSDワークベンチ
マクロ案: Excelの表からX,Y,Zの数値（小数点含む）を取得して、
その数値を使い点を作成する事は可能でしょうか？また表ごとに形状セットを分けるため
マクロ実行ごとに形状セットも作成したいです。
上記の内容と合わせて、こういったイメージというコードも記載されていました。
そのコードの内容から察するに、恐らくExcelの表は以下のようなテンプレになっていると思います。
今回はExcelの表が上のようなテンプレであること前提に、すべての座標を取得しCATIAで点を作成するサンプルマクロを紹介していきます。
マクロの機能
タイトルのとおり本ページで紹介するマクロの機能は
「Excelの表から座標を取得し点を作成する」というものです。
Excelに書かれている「X座標」「Y座標」「Z座標」という文字を読み取って取得する列を指定しているわけではなく、「B列」「C列」「D列」の値を取得するという処理を行っています。
そのためExcelファイルの方で1行ずれて記入した場合、うまくマクロが作動しません。
Excelファイルが上図と同じテンプレであること前提のマクロとなっているため注意して下さい。
(※B列にX座標,C列にY座標,D列にZ座標 それぞれの座標値は2行目以降に記入されているものに限る)
マクロの機能をまとめると以下のとおりです。
・作成する点の名前はExcelのA列に書かれている文字列
・作成した点はすべて新規作成される形状セットにまとまる
・新規形状セットはマクロ実行時にアクティブな形状セットの中に作成される
(ﾊﾟｰﾂﾎﾞﾃﾞｨｰがアクティブの場合はツリーの第一階層に作成される)
・新規形状セットの名前は選択したExcelのファイル名
以下で紹介するコードを少し書き換えれば対応できますよ！
サンプルコード
マクロのコードは下記のとおりです。
マクロを実行すると「ファイルを開く」ウィンドウが立ち上がります。
ここで開いたExcelファイルの表を読み取りCATIA内で点を作成します。
|
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 |
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 OpenFileName As String OpenFileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx") If OpenFileName <> "False" Then Dim WB As Workbook Set WB = Workbooks.Open(OpenFileName) Else MsgBox "キャンセルされました" Exit Sub End If Dim WS As Worksheet Set WS = WB.Sheets(1) Dim ActiveObject As AnyObject If TypeName(PT.InWorkObject) = "HybridBody" Then Set ActiveObject = PT.InWorkObject Else Set ActiveObject = PT End If Dim HBs As HybridBodies Set HBs = ActiveObject.HybridBodies Dim NewHB As HybridBody Set NewHB = HBs.Add NewHB.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 PointName As String PointName = 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 NewPoint As HybridShapePointCoord Set NewPoint = PT.HybridShapeFactory.AddNewPointCoord(Xvalue, Yvalue, Zvalue) NewHB.AppendHybridShape NewPoint NewPoint.Name = PointName PT.Update Next i WB.Close False MsgBox "完了しました。" End Sub |
コード解説
本マクロのコードを上から順に部分ごとにわけて解説していきます。
※コード内でもコメントで解説をしているのでそちらも参照ください。
アクティブドキュメントの定義
|
1 2 3 4 5 6 7 8 9 10 |
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then 'アクティブドキュメントが"PartDocument"でない場合 MsgBox "CATPartに切り替えてからマクロを実行してください。" Exit Sub End If Dim DOC As PartDocument Set DOC = CATIA.ActiveDocument Dim PT As Part Set PT = DOC.Part |
まずはじめにアクティブドキュメントの定義をします。
今回のマクロはCATPartでのみ有効なものなので、アクティブドキュメントがCATPart以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
条件分岐の先、つまりはアクティブドキュメントがCATPartの場合は変数「DOC」にアクティブドキュメントを代入します。
あわせてアクティブドキュメントのPartも変数「PT」に代入します。
Excelの定義
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
Dim myExcel As Excel.Application Set myExcel = CreateObject("Excel.Application") Dim OpenFileName As String OpenFileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx") If OpenFileName <> "False" Then Dim WB As Workbook Set WB = Workbooks.Open(OpenFileName) Else MsgBox "キャンセルされました" Exit Sub End If Dim WS As Worksheet Set WS = WB.Sheets(1) |
CATIAマクロ上でExcel VBAを使用できるようにExcelを定義します。
上記コードでExcelが定義できない場合は、参照設定がされていない可能性があります。
詳しくは下記ページの「Excelマクロのライブラリを読み込む」の項を一読ください。
https://liclog.net/export-excel-macro-vba-catia-v5/
Excelを定義後は「GetOpenFilenameメソッド」を使って、
出力元となるExcelファイル(ブック)をユーザーに選択させ、変数「WB」として代入します。
変数「WB」を定義したら、WBの1つ目のシートを変数「WS」に代入します。
このWSに書かれている座標値をもとに点が作成されます。
作業オブジェクトの取得/形状セットの作成
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Dim ActiveObject As AnyObject If TypeName(PT.InWorkObject) = "HybridBody" Then '作業オブジェクトが"形状セット"の場合 Set ActiveObject = PT.InWorkObject '形状セットをActiveObjectに代入 Else '作業オブジェクトが"形状セット"でない場合 Set ActiveObject = PT 'PartをActiveObjectに代入 End If Dim HBs As HybridBodies Set HBs = ActiveObject.HybridBodies 'ActiveObjectのHybridBodiesコレクションを取得 Dim NewHB As HybridBody Set NewHB = HBs.Add 'HBs内に新規形状セット作成 NewHB.Name = WB.Name '形状セットの名称をWBと同じにする |
作成した点をひとまとめにするための形状セットを作成します。
まずは形状セットをどこに作成するかを決めるため作業オブジェクト(アクティブ状態のオブジェクト)を取得します。
作業オブジェクトは「PT.InWorkObject」で表すことができます。
この作業オブジェクト以下に「HybridBodiesコレクション」の「Addメソッド」を使って形状セットを新規作成します。
このとき、作業オブジェクトが形状セットの場合はその形状セット内に
形状セットでない場合はツリーの第一階層(PT直下)に作成するように条件分岐させています。
座標の取得/点の作成
|
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 |
Dim MaxRow As Integer MaxRow = WS.Cells(Rows.Count, 1).End(xlUp).Row 'A列の中で値がある一番下の行数を取得 Dim i As Integer For i = 2 To MaxRow Dim PointName As String PointName = WS.Cells(i, 1).Value 'i行目A列の値を取得 Dim Xvalue As Single Xvalue = WS.Cells(i, 2).Value 'i行目B列の値を取得 Dim Yvalue As Single Yvalue = WS.Cells(i, 3).Value 'i行目C列の値を取得 Dim Zvalue As Single Zvalue = WS.Cells(i, 4).Value 'i行目D列の値を取得 Dim NewPoint As HybridShapePointCoord Set NewPoint = PT.HybridShapeFactory.AddNewPointCoord(Xvalue, Yvalue, Zvalue) '点の作成 NewHB.AppendHybridShape NewPoint '作成した点を形状セットの中に入れる NewPoint.Name = PointName '点の名前を変更 PT.Update 'Part更新 Next i |
座標を取得し、点を作成という処理を繰り返すためループ文を使います。
まずは何回ループを回すのかを考えます。
上表の場合、ループとしては2行目～11行目までを行いたいです。
これをループ文としてあらわすと「For i = 2 To 11 ～ Next i」となります。
ただ、始まりが2行目なのは決まっているのでいいですが、終わりが11行目とは限りません。
という訳で値の入っている一番下のセルを取得し、その行を取得します。
Cells(Rows.Count, 1).End(xlUp).Row
値のある一番下の行を取得するには上記のコードを使用します。
Excelマクロではよく使う構文なので詳しく知りたい方は検索してみて下さい。
上記コードで取得した行数を整数型の変数「MaxRow」に入れておきます。
あとはこの変数を使って「For i = 2 To MaxRow ～ Next i」とループを回せば値のあるすべての行を順に処理していくことができます。
ループの中身は値の取得と点の作成だけの単純なコードなので解説は割愛します。
(簡単な説明はコード内のコメントを確認ください)
まとめ
今回はExcelに書かれている座標を取得しCATIA内で点を作成するマクロについての内容でした。
基本的な処理の考え方は今回説明した内容でいいと思うので、あとは自身の環境に合わせて書き換えていく必要があると思います。
たとえば今回の場合Excelファイルの書き方は決められており、少しでも間違っているとエラーが発生しマクロが正常に動作しません。
使う環境や場合を考え、自身でカスタマイズすることでより深くVBAを学ぶこともできると思うのでぜひ勉強を続けて下さい。
CATIAマクロを本気で勉強するなら
