CATPartで選択した折れ線の点情報(座標,R値)をCATDrawingのテーブルに出力するマクロ｜CATIAマクロの作成方法

今回は「マクロ案」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。

ワークベンチ:CATPart → CATDrawing

マクロ案:
CatPartで作成した折れ線の折れ点座標テーブル化
CatPartで作成した折れ線を選択するとCATDrawing上にテーブルを作成し、
各折れ点のXYZ座標が自動的にテーブルに入り表示できるようにしたいです。
各折れ点の座標の他に折れ点にかけてあるRの大きさも出力結果に表示されるようにしたいです。

↓イメージ

折れ点　Rの大きさ　　X座標　　Y座標　　Z座標
a
b
c

1. マクロの機能
2. サンプルコード
3. コード解説
4. まとめ

マクロの機能

今回作成したのは選択した折れ線(Polyline)の各点の座標とR値をCATDrawingのテーブルに出力するマクロです。マクロとしてはCATDrawingで使うマクロです。正面視を投影する時にCATPartに切り替えて選択するようなイメージで、マクロ実行後にCATDrawingからCATPartに切り替えて「折れ線」を選択することで情報の出力ができます

このマクロの機能をまとめると下記の通りです。

マクロの機能まとめ・選択した折れ線(Polyline)の各点の座標とR値をCATDrawingのテーブルに出力する
・アクティブドキュメントが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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

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

'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義

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

'ﾕｰｻﾞｰ選択で折れ線(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)

'折れ線(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

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メソッドは下記のように書きます。実行することで引数として渡した変数に結果が返ってくるメソッドとなっています。

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メソッド」を使い、下記のように書きます。

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)

'ｱｸﾃｨﾌﾞｼｰﾄ定義

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メソッドの引数は下記のようになっています。任意で書き換えて下さい。

DrawingTables[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