CATPartで選択した折れ線の点情報(座標,R値)をCATDrawingのテーブルに出力するマクロ｜CATIAマクロの作成方法
今回は「マクロ案」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。
ワークベンチ:CATPart → CATDrawing
マクロ案:
CatPartで作成した折れ線の折れ点座標テーブル化
CatPartで作成した折れ線を選択するとCATDrawing上にテーブルを作成し、
各折れ点のXYZ座標が自動的にテーブルに入り表示できるように したいです。
各折れ点の座標の他に折れ点にかけてあるRの大きさも出力結果に表示されるようにしたいです。 ↓イメージ
折れ点 Rの大きさ X座標 Y座標 Z座標
a
b
c
マクロの機能
今回作成したのは選択した折れ線(Polyline)の各点の座標とR値をCATDrawingのテーブルに出力するマクロです。マクロとしてはCATDrawingで使うマクロです。正面視を投影する時にCATPartに切り替えて選択するようなイメージで、マクロ実行後にCATDrawingからCATPartに切り替えて「折れ線」を選択することで情報の出力ができます
このマクロの機能をまとめると下記の通りです。
・アクティブドキュメントがCATDrawingの状態で使用可能
・テーブル出力先はアクティブなビューもしくはシートの原点(0,0)
サンプルコード
マクロのコードは下記のとおりです。
CATDrawingで実行後、CATPartに切り替えて「折れ線」を選択すればテーブルに出力ができます。
Option Explicit
Sub CATMain()
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
MsgBox "このマクロはDrawingDocument専用です。" & vbLf & _
"CATDrawingに切り替えて実行してください。"
Exit Sub
End If
Dim doc1 As DrawingDocument
Set doc1 = CATIA.ActiveDocument 'CATDrawng
'ﾕｰｻﾞｰ選択で折れ線(Polyline)を選択
Dim sel 'As Selection
Set sel = doc1.Selection
Dim doc2 As Document 'CATPart
Dim filter
filter = Array("HybridShapePolyline")
Dim msg1 As String
Dim msg2 As String
msg1 = "CATPartに切り替えて下さい。"
msg2 = "折れ線(Polyline)を選択して下さい。"
Dim state As String
state = sel.SelectElement4(filter, msg1, msg2, False, doc2)
If state <> "Normal" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
Dim poly As HybridShapePolyline
Set poly = doc2.Selection.Item(1).Value
'CATPart処理 ***************************
'折れ線(Polyline)の各点座標などを取得
Dim hsf As HybridShapeFactory
Set hsf = doc2.Part.HybridShapeFactory
Dim i As Long
Dim names() As String
Dim rs()
Dim cx()
Dim cy()
Dim cz()
ReDim names(poly.NumberOfElements)
ReDim rs(poly.NumberOfElements)
ReDim cx(poly.NumberOfElements)
ReDim cy(poly.NumberOfElements)
ReDim cz(poly.NumberOfElements)
For i = 1 To poly.NumberOfElements
Dim ref As Reference
Dim r As Length
Call poly.GetElement(i, ref, r)
Dim p As Point
Set p = hsf.GSMGetObjectFromReference(ref)
names(i) = p.Name 'pの名称
cx(i) = p.x.Value 'pのX座標
cy(i) = p.y.Value 'pのY座標
cz(i) = p.z.Value 'pのZ座標
On Error Resume Next
rs(i) = r.Value 'p地点のR値
On Error GoTo 0
Next i
'CATDrawing処理 ***********************
'ｱｸﾃｨﾌﾞｼｰﾄ定義
Dim sht As DrawingSheet
Set sht = doc1.Sheets.ActiveSheet
'ｱｸﾃｨﾌﾞﾋﾞｭｰ定義
Dim vw As DrawingView
Set vw = sht.Views.ActiveView
'ﾃｰﾌﾞﾙ作成
Dim tbl As DrawingTable
Set tbl = vw.Tables.Add(0, 0, poly.NumberOfElements + 1, 5, 6, 20)
'ﾃｰﾌﾞﾙに値を出力
Dim j As Long
tbl.SetCellString 1, 1, "折れ点"
tbl.SetCellString 1, 2, "R値"
tbl.SetCellString 1, 3, "X座標"
tbl.SetCellString 1, 4, "Y座標"
tbl.SetCellString 1, 5, "Z座標"
For i = 2 To tbl.NumberOfRows
For j = 1 To tbl.NumberOfColumns
Select Case j
Case 1
tbl.SetCellString i, j, names(i - 1)
Case 2
tbl.SetCellString i, j, Str(rs(i - 1))
Case 3
tbl.SetCellString i, j, Str(cx(i - 1))
Case 4
tbl.SetCellString i, j, Str(cy(i - 1))
Case 5
tbl.SetCellString i, j, Str(cz(i - 1))
End Select
Next j
Next i
MsgBox "折れ線の点をテーブルに出力しました。"
End Sub
コード解説
ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
MsgBox "このマクロはDrawingDocument専用です。" & vbLf & _
"CATDrawingに切り替えて実行してください。"
Exit Sub
End If
Dim doc1 As DrawingDocument
Set doc1 = CATIA.ActiveDocument 'CATDrawng
まずはじめにアクティブドキュメントの定義をします。
今回のマクロはCATDrawingでのみ有効なものなので、アクティブドキュメントがCATDrawing以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
条件分岐の先、つまりはアクティブドキュメントがCATDrawingの場合は変数「doc1」にアクティブドキュメントを代入します。
ﾕｰｻﾞｰ選択で折れ線(Polyline)を選択
'ﾕｰｻﾞｰ選択で折れ線(Polyline)を選択
Dim sel 'As Selection
Set sel = doc1.Selection
Dim doc2 As Document 'CATPart
Dim filter
filter = Array("HybridShapePolyline")
Dim msg1 As String
Dim msg2 As String
msg1 = "CATPartに切り替えて下さい。"
msg2 = "折れ線(Polyline)を選択して下さい。"
Dim state As String
state = sel.SelectElement4(filter, msg1, msg2, False, doc2)
If state <> "Normal" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
Dim poly As HybridShapePolyline
Set poly = doc2.Selection.Item(1).Value
つぎにユーザー選択により「折れ線」を取得します。
今回はCATDrawingとCATPartの2つのドキュメントを使用するのでユーザー選択は「SelectElement4メソッド」を使って、CATDrawingからCATPartに切り替えて取得するような処理にしています。
上記コードはほぼSelectElement4メソッドの定型文なので説明は割愛します。
処理内容の詳細は「SelectElement4メソッド」ページで解説しているのでそちらを参照下さい。
上記コードによりユーザーの選択した「折れ線」を「poly」という変数に格納できます。
あとはこの「poly」のプロパティ/メソッドでテーブルに出力する折れ線の情報を取得してきます。
折れ線(Polyline)の各点座標などを取得①
'折れ線(Polyline)の各点座標などを取得
Dim hsf As HybridShapeFactory
Set hsf = doc2.Part.HybridShapeFactory
Dim i As Long
Dim names() As String
Dim rs()
Dim cx()
Dim cy()
Dim cz()
ReDim names(poly.NumberOfElements)
ReDim rs(poly.NumberOfElements)
ReDim cx(poly.NumberOfElements)
ReDim cy(poly.NumberOfElements)
ReDim cz(poly.NumberOfElements)
つぎにテーブルに出力する「点の座標(X,Y,Z)」「点の名称」「点のR値」を取得します。
ここでは各情報を配列としてそれぞれを点の数だけ取得しています。
点の数は「poly.NumberOfElements」で取得できるので、配列の数も点の数だけ作ります。
(配列は0スタートなので実際は点の数+1個分の配列になっています)
names() ：点の名称格納用
rs() ：点のR値格納用
cx() ：点のX座標格納用
cy() ：点のY座標格納用
cz() ：点のZ座標格納用
上記のように配列に座標などの情報をそれぞれ格納していけば、今後の処理で扱いやすい扱いやすい"情報のかたまり"が作り出せます。たとえば「cx(i)」「rs(i)」のように書くことで、折れ線の i 番目のX座標、R値を取り出すことができるようになります。
'折れ線(Polyline)の各点座標などを取得②
For i = 1 To poly.NumberOfElements
Dim ref As Reference
Dim r As Length
Call poly.GetElement(i, ref, r)
Dim p As Point
Set p = hsf.GSMGetObjectFromReference(ref)
names(i) = p.Name 'pの名称
cx(i) = p.x.Value 'pのX座標
cy(i) = p.y.Value 'pのY座標
cz(i) = p.z.Value 'pのZ座標
On Error Resume Next
rs(i) = r.Value 'p地点のR値
On Error GoTo 0
Next i
前項で準備した配列に点の情報を順番に格納していきます。
点の情報はHybridShapePolylineオブジェクトの「GetElementメソッド」で取得できます。
GetElementメソッドは下記のように書きます。実行することで引数として渡した変数に結果が返ってくるメソッドとなっています。
Dim ref As Reference '点取得用(Referenceオブジェクト)
Dim r As Length 'R取得用(Lengthオブジェクト)
Call poly.GetElement(i, ref, r)
上記コードを実行することで「poly」の「i」番目の点の「リファレンス(ref)」とR値などの情報を持つ「Lengthパラメータ(r)」を取得することができます。
これらを使って座標やR値などを配列に格納していきます。
点は「Referenceオブジェクト」で取得されますがこのままでは座標が取得できません。
そこで「Referenceオブジェクト」を普段取得時などで扱う「Pointオブジェクト」に変換します。
Referenceの変換には「HybridShapeFactoryオブジェクト」の「GSMGetObjectFromReferenceメソッド」を使い、下記のように書きます。
Dim p As Point
Set p = hsf.GSMGetObjectFromReference(ref)
「Pointオブジェクト」からは「p.x.Value」のように書くことで各座標にアクセスできます。
また点の名前も「p.Name」で取得可能です。
R値は取得した「Lengthオブジェクト」の「Valueプロパティ」を使えばアクセスできます。
(R値の取得はRがかかっていない場合にNothingとして取得されますが、そのままだと配列に格納できずエラーとなるため「On Error Resume Next」を使って一時的にエラーを無視しています)
あとは、これらの点の各情報を先ほど用意した配列に順に格納しているだけです。
ｱｸﾃｨﾌﾞｼｰﾄ/ｱｸﾃｨﾌﾞﾋﾞｭｰ定義&ﾃｰﾌﾞﾙ作成
'ｱｸﾃｨﾌﾞｼｰﾄ定義
Dim sht As DrawingSheet
Set sht = doc1.Sheets.ActiveSheet
'ｱｸﾃｨﾌﾞﾋﾞｭｰ定義
Dim vw As DrawingView
Set vw = sht.Views.ActiveView
'ﾃｰﾌﾞﾙ作成
Dim tbl As DrawingTable
Set tbl = vw.Tables.Add(0, 0, poly.NumberOfElements + 1, 5, 6, 20)
点の情報が取得できたらあとはCATDrawingに戻り、テーブルにそれらを出力していくだけです。
まずは出力するテーブルを作成していきます。
アクティブシートとアクティブビューの定義は定型文なので説明は割愛します。
テーブルの作成は「DrawingTabelsオブジェクト」の「Addメソッド」を使います。
Addメソッドの引数は下記のようになっています。任意で書き換えて下さい。
Dim tbl As DrawingTable
Set tbl = vw.Tables.Add(X座標,Y座標,行数,列数,セル高さ,セル幅)
現状では原点に作成するようにしていますが「IndicateOrSelectElement2Dメソッド」でユーザーのクリックした地点の座標を取得してテーブル作成時に利用することで、テーブルを作成する位置もユーザーが選択できるようなマクロにすることができます。
ﾃｰﾌﾞﾙに値を出力
'ﾃｰﾌﾞﾙに値を出力
Dim j As Long
tbl.SetCellString 1, 1, "折れ点"
tbl.SetCellString 1, 2, "R値"
tbl.SetCellString 1, 3, "X座標"
tbl.SetCellString 1, 4, "Y座標"
tbl.SetCellString 1, 5, "Z座標"
For i = 2 To tbl.NumberOfRows
For j = 1 To tbl.NumberOfColumns
Select Case j
Case 1
tbl.SetCellString i, j, names(i - 1)
Case 2
tbl.SetCellString i, j, Str(rs(i - 1))
Case 3
tbl.SetCellString i, j, Str(cx(i - 1))
Case 4
tbl.SetCellString i, j, Str(cy(i - 1))
Case 5
tbl.SetCellString i, j, Str(cz(i - 1))
End Select
Next j
Next i
空のテーブルが作成できたので最後にこれまで集めた点の情報を書き出していきます。
DrawingTableとExcelの番地の考え方は同じでどちらも「(行数,列数)」で表すことができます。
テーブルへの値の入力は「DrawingTableオブジェクト」の「SetCellStringメソッド」を使います。
Dim MyTable As DrawingTable
MyTable.SetCellString 列番,行番, 入力する値
後は上記の構文を使って各配列にまとめた情報を順に対応するセルに出力するだけです。
ただ配列は0スタートなので「names(i – 1)」のように調整する必要があるので注意して下さい。
まとめ
今回は選択した折れ線(Polyline)の各点の座標とR値をCATDrawingのテーブルに出力するマクロについての内容でした。
こういった情報を何かに出力するマクロは「情報を取得するフェーズ」と「出力するフェーズ」に分けるとわかりやすいです。
今回のマクロの内容は、1つの大きなループ内で取得も出力もまとめることもできます。ただ、今回のように処理を分けることで書いている自分も理解しやすいですし、のちのち機能を足すときも簡単に拡張することができます。
取得する情報が膨大でなければ処理時間の違いも大差ないので、処理ごとにブロック分けすることで自分も自分以外の人も扱いやすいものになると思います。
CATIAマクロを本気で勉強するなら
