CATPartの点座標をExcelに転記して書き換えるマクロ｜CATIAマクロの作成方法
今回はマクロ案より頂いた内容です。
送って頂いた内容は以下のようなマクロです。
ワークベンチ: CATPartとExcel
マクロ案:
CATPart上にある形状セット内の点（例えば点a、点b、点c…etc.）の座標（X,Y,Z）を
Excelで座標入力した値に置き換えれるようなマクロの動きはできないでしょうか？
点の名称はCATPartの形状セット内とExcelはお互いに一致しているものとします。 動きとしては以下のようなイメージをしております。
CATPart形状セット内に元々、点（
座標入力によって作られた点）が作られている
↓
（ExcelにCATPart形状セット内の点座標を書き込む）
※この部分はあってもなくてもいいです
↓
Excelにて各点の座標値を入力
↓
Excelで作成した座標値を読み込んでCATPart形状セット内の同じ名称の点の座標値を書き換えていく
本ページのマクロは「Excelに点座標を出力するマクロ」「Excelの値から点座標を書き換えるマクロ」というような2つのマクロではなく、両機能をあわせもった1つのマクロとしています。
マクロの機能
今回作成したマクロは『CATPartの点座標をExcelに転記して書き換えるマクロ』です。
具体的な機能は以下のとおりです。
・操作手順は下記を参照
② 形状セット選択 (前提条件：座標より作成された点のみが格納されている)
③ Excelが開き、各点の座標が出力される
④ Excel内の座標を任意の値に書き換える
⑤ 書き換え後、UserFormの「Run」をクリック
→ [Cancel][x]が押された場合はExcelを閉じマクロ終了
⑥ 各点の座標がExcel上で書き換えた座標に更新される
UserFormはExcelの後ろに隠れて表示されているかたちになっているため、わかりづらい場合は任意でUserFormとExcelの表示する位置を書き換えて下さい。
サンプルコード
マクロのサンプルコードは以下のとおりです。
標準モジュールだけでなくUserFormのコードもあるので注意して下さい。
UserFormの名称は「UserForm1」で設定しておいてください。
※CommandButtonはコード上で自動生成するので予め作成しておく必要はありません。
また、本サンプルコードではCATIA VBAでExcelにアクセスするため事前設定が必要です。
詳しくは「CATIAマクロでExcelを操作する方法」ページを参照下さい。
標準モジュールコード
Option Explicit
Public cancel_flg As Boolean
Sub CATMain()
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
MsgBox "このマクロはProductDocument専用です。" & vbLf & _
"CATPartに切り替えて実行してください。"
Exit Sub
End If
Dim doc As PartDocument
Set doc = CATIA.ActiveDocument
Dim sel 'As Selection
Set sel = doc.Selection
Dim pt As Part
Set pt = doc.Part
Dim hsf As HybridShapeFactory
Set hsf = pt.HybridShapeFactory
'形状ｾｯﾄ取得
Dim filter: filter = Array("HybridBody")
Dim res As String
res = sel.SelectElement2(filter, "Select Geometrical Set", False)
If res <> "Normal" Then
MsgBox "Canceled"
Exit Sub
End If
Dim hb As HybridBody
Set hb = sel.Item(1).Value
sel.Clear
'点(HybridShapePointCoord)取得
Dim ps As Collection
Set ps = New Collection
Dim hs
For Each hs In hb.HybridShapes
Dim p As HybridShapePointCoord
Set p = hs
ps.Add p
Next hs
'点の座標を配列に格納
Dim p_names()
Dim x_coord()
Dim y_coord()
Dim z_coord()
ReDim p_names(ps.Count) '名称格納
ReDim x_coord(ps.Count) 'x座標格納
ReDim y_coord(ps.Count) 'y座標格納
ReDim z_coord(ps.Count) 'z座標格納
Dim i As Long
For i = 1 To ps.Count
Set p = ps.Item(i)
p_names(i) = p.Name
x_coord(i) = p.x.Value
y_coord(i) = p.y.Value
z_coord(i) = p.z.Value
Next i
'Excel定義
Dim appExcel As Object
Set appExcel = CreateObject("Excel.Application")
Dim wb As Workbook
Set wb = appExcel.Workbooks.Add
Dim ws As Worksheet
Set ws = wb.Sheets.Item(1)
'Excelに座標出力
With ws
.Cells(1, 1).Value = "名称"
.Cells(1, 2).Value = "X座標"
.Cells(1, 3).Value = "Y座標"
.Cells(1, 4).Value = "Z座標"
For i = 1 To ps.Count
.Cells(i + 1, 1).Value = p_names(i)
.Cells(i + 1, 2).Value = x_coord(i)
.Cells(i + 1, 3).Value = y_coord(i)
.Cells(i + 1, 4).Value = z_coord(i)
Next i
End With
appExcel.Visible = True
'UserForm表示
UserForm1.Show
'UserFormの[x]ﾎﾞﾀﾝ / [Cancel]ﾎﾞﾀﾝを押された場合
If cancel_flg = True Then
appExcel.DisplayAlerts = False
wb.Close
MsgBox "Canceled"
Exit Sub
End If
'点の座標を更新
With ws
.Cells(1, 1).Select
For i = 1 To ps.Count
Set p = ps.Item(i)
p.x.Value = .Cells(i + 1, 2).Value
p.y.Value = .Cells(i + 1, 3).Value
p.z.Value = .Cells(i + 1, 4).Value
pt.UpdateObject p
Next i
End With
'画面更新 & Excelﾌﾞｯｸを閉じる
CATIA.RefreshDisplay = True
appExcel.DisplayAlerts = False
wb.Close
MsgBox "done"
End Sub
UserFormモジュールコード [UserForm1]
Option Explicit
Dim WithEvents cb1 As MSForms.CommandButton
Dim WithEvents cb2 As MSForms.CommandButton
'-----------------------------------------------------------------------------
Private Sub UserForm_Initialize()
'UserFormｻｲｽﾞ変更
With Me
.Width = 95
.Height = 90
End With
'CommandButton作成
Set cb1 = Me.Controls.Add("Forms.CommandButton.1", "cb1", True)
Set cb2 = Me.Controls.Add("Forms.CommandButton.1", "cb2", True)
'CommandButtonｻｲｽﾞ/位置変更
With cb1
.Left = 10
.Top = 10
.Width = 75
.Height = 20
.Caption = "Run"
End With
With cb2
.Left = 10
.Top = 35
.Width = 75
.Height = 20
.Caption = "Cancel"
End With
End Sub
'-----------------------------------------------------------------------------
Private Sub cb1_Click()
Unload Me
End Sub
'-----------------------------------------------------------------------------
Private Sub cb2_Click()
cancel_flg = True
Unload Me
End Sub
'-----------------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then '[x]ボタンを押された場合
cancel_flg = True
Unload Me
End If
End Sub
コード解説
今回は標準モジュールとUserFormの両方にコードがあり長いので、重要部分のみを抜粋して解説していきます。解説が無くわからない部分があればお気軽に「お問い合わせ」よりご連絡ください。
点(HybridShapePointCoord)取得 [標準モジュール]
'点(HybridShapePointCoord)取得
Dim ps As Collection
Set ps = New Collection
Dim hs 'ｵﾌﾞｼﾞｪｸﾄの型は設定不可
For Each hs In hb.HybridShapes
Dim p As HybridShapePointCoord
Set p = hs
ps.Add p
Next hs
ここでは選択した形状セット内にある点を「ps」というコレクションに格納していきます。
このとき「ps.Add hs」とはせずに、いったん変数「p」に入れるという処理を挟みます。
For Each文を使用する時、オブジェクトの型の宣言をすることはできません。
しかし「ps.Add hs」と直接コレクションに格納すると型が間違えて格納される場合があります。
ここでは型の間違いが起きないよう「HybridShapePointCoord」として変数「p」を宣言し、確実にオブジェクトの種類を間違えないようにいったん変数を経由するという処理しています。
点の座標を配列に格納
Dim i As Long
For i = 1 To ps.Count
Set p = ps.Item(i)
p_names(i) = p.Name
x_coord(i) = p.x.Value
y_coord(i) = p.y.Value
z_coord(i) = p.z.Value
Next i
ここでは「ps」コレクション内にある点の「名称」「X座標」「Y座標」「Z座標」をそれぞれ専用の配列に順に格納していっています。Excelに座標出力する時はここで格納したそれぞれの配列の中身を順に書き出していくだけの簡単な処理で済みます。
UserFormの[x]ﾎﾞﾀﾝ / [Cancel]ﾎﾞﾀﾝを押された場合
'UserForm表示
UserForm1.Show
'UserFormの[x]ﾎﾞﾀﾝ / [Cancel]ﾎﾞﾀﾝを押された場合
If cancel_flg = True Then
appExcel.DisplayAlerts = False
wb.Close
MsgBox "Canceled"
Exit Sub
End If
Excel上の座標の書き換えが完了した後は、再度プログラムの処理に戻します。
ここではそのトリガーとしてUserFormのCommandButtonを採用しています。
CommandButtonの[Run]が押されればそのまま処理を継続、
[Cancel]もしくは[x]ボタンが押されたらマクロを中断するようにします。
この処理を取り入れるため標準モジュールの最初にPublicで「cancel_flg」というBoolean型の変数を用意しています。UserFormの表示は「vbModeless」ではない通常表示ため、UserFormが閉じるまで次の処理には進まないようになっています。
そこでUserForm側のコードで[Cancel]もしくは[x]ボタンが押された場合は「cancel_flg」を「True」にするという処理を入れています。つまりUserFormが閉じた時「cancel_flg」がFalse([Run]ボタン押下)の場合のみマクロの処理を継続するような条件分岐をさせているというわけです。
点の座標を更新
'点の座標を更新
With ws
.Cells(1, 1).Select
For i = 1 To ps.Count
Set p = ps.Item(i)
p.x.Value = .Cells(i + 1, 2).Value
p.y.Value = .Cells(i + 1, 3).Value
p.z.Value = .Cells(i + 1, 4).Value
pt.UpdateObject p
Next i
End With
Excel上の座標の書き換えが完了した後は、再度プログラムの処理に戻します。
先に[Cancel]もしくは[x]ボタンが押された場合はマクロの処理が終了されるため、この処理にたどり着くのは[Run]ボタンが押された場合のみとなります。
処理自体は単純で、Excelの該当セルの値を使って点の座標を書き換えているだけです。
まとめ
今回は「CATPartの点座標をExcelに転記して書き換えるマクロ」についてでした。
「Excelに点座標を出力するマクロ」「Excelの値から点座標を書き換えるマクロ」の2つのマクロに分けることもできますが、今回はUserFormを挟むことで"Excelの書き換えフェーズ"を用意しています。
2つのマクロではなく1つのマクロにまとめることで、変数を再定義する必要が無く処理内容が単純にすることができます。使いづらい場合や、Excelファイルを保存したいなどあれば適宜コードを書き換えてみて下さい。
CATIAマクロを本気で勉強するなら
