ボリューム化したサーフェスの体積を測定しExcelに出力するマクロ｜CATIAマクロの作成方法
今回は「お問い合わせ」より頂いた内容です。
送って頂いた内容は以下のようなマクロです。
お問い合わせ内容:
1つのcatpartの中にある
複数の閉じた形状（サーフェス）の
体積を取得し、エクセルに書き出したいです。使用目的としては、
エクセル上で取得した体積に、比重をかけて複数の部品の質量を求めたい。
（複数管理をしたいため）→エクセルで保存したいです。
マクロの機能
今回作成したマクロは
『ボリューム化したサーフェスの体積を測定しExcelに出力するマクロ』です。
具体的な機能は以下のとおりです。
※形状セット内は体積を測定するサーフェスのみが入っていることが前提条件
ボリューム化＝クローズサーフェス
・ExcelにはA列にサーフェス名、B列に体積(mm^3)を出力する
・出力したExcelは手動で保存する必要あり
クローズサーフェスが作成できない場合はエラーが発生するので、インプットする形状セット内のサーフェスの形状には注意して下さい。
また「On Error Resume Next」でエラーを無視させることでマクロとしての機能をゴリ押しで使うこともでるので、マクロが動きさえすればいいという場合はサンプルコードの初めに「On Error Resume Next」と書いて使って下さい。
(この場合、エラーが出るサーフェスの体積は「0」として出力されます)
サンプルコード
マクロのサンプルコードは以下のとおりです。
事前にExcelライブラリの設定をしておかないとExcel定義用のコードでエラーが発生するので、まだ設定されていない場合は「CATIAマクロでExcelを操作する方法」ページを参照して設定しておいてください。
Option Explicit
Sub CATMain()
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
MsgBox "このマクロはPartDocument専用です。" & vbLf & _
"CATPartに切り替えて実行してください。"
Exit Sub
End If
Dim doc As PartDocument
Set doc = CATIA.ActiveDocument
Dim pt As Part
Set pt = doc.Part
'ﾕｰｻﾞｰ選択でｻｰﾌｪｽの入った形状ｾｯﾄを取得
Dim sel 'As Selection
Set sel = doc.Selection
sel.Clear
Dim filter
Dim res As String
Dim hb As HybridBody
filter = Array("HybridBody")
res = sel.SelectElement2(filter, "", False)
If res <> "Normal" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
Set hb = sel.Item(1).Value
'体積/名称格納用の配列を用意
Dim vols() As Double
Dim names() As String
ReDim vols(hb.HybridShapes.Count)
ReDim names(hb.HybridShapes.Count)
'体積を測定し配列に格納
Dim sf As ShapeFactory
Dim spa As Workbench
Dim measure As Measurable
Dim hs
Dim vol
Dim ref_hs As Reference
Dim ref_vol As Reference
Dim i As Long
Set sf = pt.ShapeFactory
Set spa = doc.GetWorkbench("SPAWorkbench")
i = 1
For Each hs In hb.HybridShapes
'名称格納(Excel出力用)
names(i) = hs.Name
'ｸﾛｰｽﾞｻｰﾌｪｽ作成
Set ref_hs = pt.CreateReferenceFromObject(hs)
Set vol = sf.AddNewVolumeCloseSurface(ref_hs)
pt.UpdateObject vol
'ｸﾛｰｽﾞｻｰﾌｪｽの体積(mm^3)を測定して配列に格納
Set ref_vol = pt.CreateReferenceFromObject(vol)
Set measure = spa.GetMeasurable(ref_vol)
vols(i) = measure.Volume * 1000000000
'作成したｸﾛｰｽﾞｻｰﾌｪｽを削除
sel.Clear
sel.Add vol
sel.Delete
i = i + 1
Next hs
'Excel定義
Dim Excel As Excel.Application
Set Excel = CreateObject("Excel.Application")
Dim wb As Workbook
Set wb = Excel.Workbooks.Add
Dim ws As Worksheet
Set ws = wb.Sheets(1)
'Excel出力
For i = 1 To UBound(vols)
ws.Cells(i, 1).Value = names(i)
ws.Cells(i, 2).Value = vols(i)
Next i
Excel.Visible = True
End Sub
コード解説
ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then
MsgBox "このマクロはPartDocument専用です。" & vbLf & _
"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も定義しておきます。
これは以降でReferenceを取得するための「CreateReferenceFromObjectメソッド」、
クローズサーフェスを作成するためのに必要な「ShapeFactoryプロパティ」を使うためです。
ﾕｰｻﾞｰ選択でｻｰﾌｪｽの入った形状ｾｯﾄを取得
'ﾕｰｻﾞｰ選択でｻｰﾌｪｽの入った形状ｾｯﾄを取得
Dim sel 'As Selection
Set sel = doc.Selection
sel.Clear
Dim filter
Dim res As String
Dim hb As HybridBody
filter = Array("HybridBody")
res = sel.SelectElement2(filter, "", False)
If res <> "Normal" Then
MsgBox "キャンセルしました。"
Exit Sub
End If
Set hb = sel.Item(1).Value
つぎにユーザー選択で体積を測定するためのサーフェスが入った形状セットを取得します。
ユーザー選択は「Selectionオブジェクト」の「SelectElement2メソッド」を使用します。
上記コードはほぼ定型文なので処理内容の詳細は上記リンクページを参照下さい。
体積/名称格納用の配列を用意
'体積/名称格納用の配列を用意
Dim vols() As Double
Dim names() As String
ReDim vols(hb.HybridShapes.Count)
ReDim names(hb.HybridShapes.Count)
つぎに体積とサーフェスの名称を格納するための配列を用意しておきます。
配列の要素数は「hb.HybridShapes.Count」個、つまりは取得した形状セット内にある「HybrisShapeオブジェクト」の数としています。
配列は「0」スタートなので実際は「hb.HybridShapes.Count – 1」とするべきですが、以降でExcelのセルに出力することも考えると「１」スタートの方が扱いやすいです。そのため、配列としては0もある状態ですが、0は無視して1以降の要素を使うような処理としていきます。
配列「vols()」には形状セット内のサーフェスをボリューム化したときの体積が、
配列「names()」には形状セット内のサーフェスの名称がそれぞれ上から順に格納されていきます。
ﾕｰｻﾞｰ選択でｻｰﾌｪｽの入った形状ｾｯﾄを取得
'体積を測定し配列に格納
Dim sf As ShapeFactory
Dim spa As Workbench
Dim measure As Measurable
Dim hs
Dim vol
Dim ref_hs As Reference
Dim ref_vol As Reference
Dim i As Long
Set sf = pt.ShapeFactory
Set spa = doc.GetWorkbench("SPAWorkbench")
i = 1
For Each hs In hb.HybridShapes
'名称格納(Excel出力用)
names(i) = hs.Name
'ｸﾛｰｽﾞｻｰﾌｪｽ作成
Set ref_hs = pt.CreateReferenceFromObject(hs)
Set vol = sf.AddNewVolumeCloseSurface(ref_hs)
pt.UpdateObject vol
'ｸﾛｰｽﾞｻｰﾌｪｽの体積(mm^3)を測定して配列に格納
Set ref_vol = pt.CreateReferenceFromObject(vol)
Set measure = spa.GetMeasurable(ref_vol)
vols(i) = measure.Volume * 1000000000
'作成したｸﾛｰｽﾞｻｰﾌｪｽを削除
sel.Clear
sel.Add vol
sel.Delete
i = i + 1
Next hs
つぎに本サンプルマクロのメインとなる「体積の測定」をしていきます。
測定した体積は前項の通り、配列「vols()」に順に格納していきます。これにより、Excelに書き出す際はこの配列の中身を順に書き出していくだけの簡単な処理で済みます。
基本の流れは下記の通りです
② サーフェスを使いクローズサーフェスを作成
③ クローズサーフェスの体積を取得 (vols()に格納)
④ クローズサーフェスを削除
※ループ文で①～④を形状セット内のサーフェスに対して順に適用させる
クローズサーフェスの作成は「ShapeFactoryオブジェクト」の「AddNewVolumeCloseSurfaceメソッド」、体積の測定は「Measurableオブジェクト」の「Volumeプロパティ」を使います。
デフォルトでは「立方メートル(m^3)」となっているので、上記コードでは「立方ミリメートル(mm^3)」に変換させた値を配列「vols()」に格納させています。
適宜、自身の環境に合わせて扱いやすい単位に変換させてください。
Excel定義
'Excel定義
Dim Excel As Excel.Application
Set Excel = CreateObject("Excel.Application")
Dim wb As Workbook
Set wb = Excel.Workbooks.Add
Dim ws As Worksheet
Set ws = wb.Sheets(1)
つぎにExcelに出力するために、Excel(アプリケーション)を定義します。
上記コードは定型文のため、詳細は「CATIAマクロでExcelを操作する方法」ページを参照下さい。
※上記コードと合わせてExcelライブラリの設定が必要です
ﾕｰｻﾞｰ選択でｻｰﾌｪｽの入った形状ｾｯﾄを取得
'Excel出力
For i = 1 To UBound(vols)
ws.Cells(i, 1).Value = names(i)
ws.Cells(i, 2).Value = vols(i)
Next i
Excel.Visible = True
最後にこれまで取得した体積の情報をExcelに書き出していきます。
処理としては配列「vols()」に体積、配列「names()」に名称が入っているのでこれらを順にセルに書き出していくだけです。
ここではＡ列にサーフェス名称、Ｂ列に体積(mm^3)を書き出していますが、各配列にデータは入っているので出力のかたちは簡単に書き換えられます。適宜、自身の環境に合わせて書き換えて下さい。
出力後、「Excel.Visible = True」でExcelのウィンドウを画面上に表示して完了です。
まとめ
今回は「ボリューム化したサーフェスの体積を測定しExcelに出力するマクロ」についてでした。
CATIA ⇔ Excelのように別アプリケーションと連携したり、CATPart ⇔ CATDrawingのようにドキュメントが変わったりする場合は、今回のように必要な情報を配列化して抜き出すことでコードがわかりやすくなりますし、あとからコードを書き換えることも簡単になります。
次、マクロを作る機会がある方は、ぜひ配列の考え方も取り入れてみて下さい。
CATIAマクロを本気で勉強するなら
