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内で点を作成します。
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
コード解説
本マクロのコードを上から順に部分ごとにわけて解説していきます。
※コード内でもコメントで解説をしているのでそちらも参照ください。
アクティブドキュメントの定義
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の定義
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に書かれている座標値をもとに点が作成されます。
作業オブジェクトの取得/形状セットの作成
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直下)に作成するように条件分岐させています。
座標の取得/点の作成
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マクロを本気で勉強するなら
