Excelの表から取得した値で点とテキストを作成するマクロ|CATIAマクロの作成方法
今回はマクロ案募集で頂いた内容です。
頂いた内容は以下のとおりです。
ワークベンチ:
パートデザインマクロ案:
予め準備した座標値(X,Y,Z)と文字を基に3D上に点を作成し、 合わせて文字も同じ位置に配置する
今回は「Excelの表から座標を取得し点を作成」で紹介したコードを少し修正してサンプルマクロを作成しました。下記のようなExcelファイルを読み込ませ「点」と「テキスト」を作成します。
マクロの機能
今回作成したのはExcelの表から点とテキストを作成するマクロです。
Excelに書かれている「X座標」「Y座標」「Z座標」という文字を読み取って取得する列を指定しているわけではなく、「B列」「C列」「D列」の値を取得するという処理を行っています。
そのためExcelファイルの方で1行ずれて記入した場合、うまくマクロが作動しません。
Excelファイルが上図と同じテンプレであること前提のマクロとなっているため注意して下さい。
(※B列にX座標,C列にY座標,D列にZ座標 それぞれの座標値は2行目以降に記入されているものに限る)
マクロの機能をまとめると以下のとおりです。
・ExcelのE列に書かれている文字列をもとに、選択したビュー上にテキストを作成
→ ※事前にビューを作成しておく必要あり
・作成する点の名前はExcelのA列に書かれている文字列
・作成した点はすべて新規作成される形状セットにまとまる
・形状セットはツリー第1階層に作成される
・新規形状セットの名前は選択したExcelのファイル名
サンプルコード
マクロのコードは下記のとおりです。
マクロを実行してまず始めに注釈セット内にある「ビュー」を選択します。
ここで選択したビュー上にすべてのテキストが作成されます。
※選択するビューは「XY平面」「YZ平面」「ZX平面」を基準としたビューを前提としています。
ビューのサポートや角度等でうまく実行できない場合があるので注意して下さい。
ビュー選択後は「ファイルを開く」ウィンドウが立ち上がります。
ここで開いた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
'Selection定義
Dim sel 'As Selection
Set sel = doc.Selection
sel.Clear
'TPSView定義
Dim filter(): filter = Array("TPSView")
Dim msg As String: msg = "基準とするビューを選択して下さい。"
Dim status As String
status = sel.SelectElement2(filter, msg, False)
If status <> "Normal" Then
MsgBox "キャンセルしました。"
End
End If
Dim tps As TPSView
Set tps = sel.Item(1).Value
'注釈セット定義
Dim annSet As AnnotationSet
If pt.AnnotationSets.Count = 0 Then
Set annSet = pt.AnnotationSets.Add("")
Else
Set annSet = pt.AnnotationSets.Item(1)
End If
'選択されたTPSViewをアクティブに
Dim i As Integer: i = 1
Dim tpsTmp As TPSView
Do
Set tpsTmp = annSet.TPSViews.Item(i)
If tps.Name = tpsTmp.Name Then
annSet.ActiveView = annSet.TPSViews.Item(i)
Exit Do
End If
i = i + 1
Loop
'AnnotationFactory定義
Dim annf As AnnotationFactory
Set annf = annSet.AnnotationFactory
'Excel定義
Dim appExcel As Excel.Application
Set appExcel = 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 hb As HybridBody
Set hb = pt.HybridBodies.Add
hb.Name = wb.Name
'ワークシート最下行取得
Dim MaxRow As Integer
MaxRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To MaxRow
'Excelから値を取得
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 txt As String: txt = ws.Cells(i, 5).Value
'点作成
Dim p As HybridShapePointCoord
Set p = pt.HybridShapeFactory.AddNewPointCoord(Xvalue, Yvalue, Zvalue)
hb.AppendHybridShape p
p.Name = PointName
pt.Update
'UserSurface定義
Dim pRef As Reference
Set pRef = pt.CreateReferenceFromObject(p)
Dim uSurf As UserSurface
Set uSurf = pt.UserSurfaces.Generate(pRef)
'アノテーション作成
Dim ann As Annotation
If tps.Name = "XYビュー" Then
Set ann = annf.CreateEvoluateText(uSurf, Xvalue, Yvalue, 0, False)
ElseIf tps.Name = "YZビュー" Then
Set ann = annf.CreateEvoluateText(uSurf, -Yvalue, Zvalue, 0, False)
ElseIf tps.Name = "ZXビュー" Then
Set ann = annf.CreateEvoluateText(uSurf, Xvalue, Zvalue, 0, False)
End If
ann.Text.Text = txt
ann.Name = txt
Next i
pt.Update
wb.Close False
MsgBox "完了しました。" & vbLf & tps.Name & "ビューを基準にテキストを配置しました。"
End Sub
コード解説
本マクロのコードを上から順に部分ごとにわけて解説していきます。
※コード内でもコメントで解説をしているのでそちらも参照ください。
アクティブドキュメントの定義
'アクティブドキュメント定義
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
まずはじめにアクティブドキュメントの定義をします。
今回のマクロはCATPartでのみ有効なものなので、アクティブドキュメントがCATPart以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
条件分岐の先、つまりはアクティブドキュメントがCATPartの場合は変数「doc」にアクティブドキュメントを代入します。
あわせてアクティブドキュメントのPartも変数「pt」に代入します。
TPSView定義
'Selection定義
Dim sel 'As Selection
Set sel = doc.Selection
sel.Clear
'TPSView定義
Dim filter(): filter = Array("TPSView")
Dim msg As String: msg = "基準とするビューを選択して下さい。"
Dim status As String
status = sel.SelectElement2(filter, msg, False)
If status <> "Normal" Then
MsgBox "キャンセルしました。"
End
End If
Dim tps As TPSView
Set tps = sel.Item(1).Value
次にユーザーが選択した注釈セット内のビュー(TPSViewオブジェクト)を定義します。
「Selectionオブジェクト」の「SelectElement2メソッド」を使ってTPSViewを取得します。
基本的には定型文なので詳しくは上記リンクページを確認して下さい。SelectElement2メソッドを使うには「As Selection」と型を指定していると使えないので注意しましょう。
注釈セット定義
'注釈セット定義
Dim annSet As AnnotationSet
If pt.AnnotationSets.Count = 0 Then
Set annSet = pt.AnnotationSets.Add("")
Else
Set annSet = pt.AnnotationSets.Item(1)
End If
次にユーザーが選択した注釈セットを定義します。
既に注釈セットがある場合はそれを、存在しない場合は新たに注釈セットを作成し「annSet」として定義します。
選択されたTPSViewをアクティブに
'選択されたTPSViewをアクティブに
Dim i As Integer: i = 1
Dim tpsTmp As TPSView
Do
Set tpsTmp = annSet.TPSViews.Item(i)
If tps.Name = tpsTmp.Name Then
annSet.ActiveView = annSet.TPSViews.Item(i)
Exit Do
End If
i = i + 1
Loop
テキストはそのときアクティブ状態のビュー上に作成されるため、選択されたTPSViewをアクティブにします。アクティブビューの切り替えはAnnotationSetオブジェクトの「ActiveViewプロパティ」の中身を変更すれればOKです。
AnnotationSetオブジェクト.ActiveView = TPSViewオブジェクト
AnnotationFactory定義
'AnnotationFactory定義
Dim annf As AnnotationFactory
Set annf = annSet.AnnotationFactory
次に「AnnotationFactory」を定義します。
これは「Factory」「HybridShapeFactory」と同じ部類のオブジェクトで、アノテーションやテキストを作成するために必要なオブジェクトです。
Excelの定義
'Excel定義
Dim appExcel As Excel.Application
Set appExcel = 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マクロのライブラリを読み込む」の項を一読ください。
Excelを定義後は「GetOpenFilenameメソッド」を使って、
出力元となるExcelファイル(ブック)をユーザーに選択させ、変数「wb」として代入します。
変数「wb」を定義したら、wbの1つ目のシートを変数「ws」に代入します。
このWSに書かれている座標値をもとに点が作成されます。
形状セットの作成
'形状セット作成
Dim hb As HybridBody
Set hb = pt.HybridBodies.Add
hb.Name = wb.Name
次に作成した点をひとまとめにするための形状セットを作成します。
形状セットの名前は「wb.Name」、つまり選択したExcelファイルと同じ名前にします。
座標の取得/点とテキストの作成
'ワークシート最下行取得
Dim MaxRow As Integer
MaxRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To MaxRow
'Excelから値を取得
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 txt As String: txt = ws.Cells(i, 5).Value
'点作成
Dim p As HybridShapePointCoord
Set p = pt.HybridShapeFactory.AddNewPointCoord(Xvalue, Yvalue, Zvalue)
hb.AppendHybridShape p
p.Name = PointName
pt.Update
'UserSurface定義
Dim pRef As Reference
Set pRef = pt.CreateReferenceFromObject(p)
Dim uSurf As UserSurface
Set uSurf = pt.UserSurfaces.Generate(pRef)
'アノテーション作成
Dim ann As Annotation
If tps.Name = "XYビュー" Then
Set ann = annf.CreateEvoluateText(uSurf, Xvalue, Yvalue, 0, False)
ElseIf tps.Name = "YZビュー" Then
Set ann = annf.CreateEvoluateText(uSurf, -Yvalue, Zvalue, 0, False)
ElseIf tps.Name = "ZXビュー" Then
Set ann = annf.CreateEvoluateText(uSurf, Xvalue, Zvalue, 0, False)
End If
ann.Text.Text = txt
ann.Name = txt
Next i
座標を取得し、点を作成という処理を繰り返すためループ文を使います。
ここではテキストの作成についてのコード解説をしていきます。
(点の作成については「Excelの表から座標を取得し点を作成」のコード解説を参照下さい)
テキストに作成は「AnnotationFactory」の「CreateEvoluateTextメソッド」を使います。
annf.CreateEvoluateText(ユーザーサーフェス, X座標, Y座標, Z座標, 矢印線の有無)
ユーザーサーフェスには、テキスト作成時に必要なオブジェクトをRefernceとして入力します。
今回のサンプルマクロの場合、このオブジェクトは「点」にあたります。
X座標, Y座標, Z座標にはテキストの座標を入力します。ただ、ここで入力する座標の絶対座標はアクティブ状態のビューによって変化するので注意しましょう。
矢印線の有無には「True」「False」のいずれかを入力します。
「True」の場合は矢印線(Leader)が作成されます。
テキストはビューによって作成方法が少しずつ違ってくるので、サンプルマクロでは「XY」「YZ」「ZX」と条件分けをして作成しています。この部分は自身の環境に合わせて書き換えて下さい。
まとめ
今回はExcelの表から取得した値で点とテキストを作成するマクロについての内容でした。
基本的には「Excelの表から座標を取得し点を作成」で紹介した内容に「AnnotationFactory」の「CreateEvoluateTextメソッド」を使ってテキスト追加の処理をプラスしただけです。
注釈が絡むマクロは少し複雑なのでいろいろ試して徐々に理解していって下さい。









