CATIA V5 点群抽出マクロ

内容

Partファイル中にある点群の座標(X,Y,Z)をエクセルに吐き出すマクロ

使用方法

抽出したい点群を一つのPartファイルにまとめ、アクティブにする。
CATIAからVisual Basic エディターを開く。
→　「ツール」　⇒　「マクロ」　⇒　「Visual Basic エディター」
コードウィンドウに下記のコードをコピペし実行する。

Sub CATMain()
 
　'---Excelの設定(エラー処理) ---

　On Error Resume Next                           'エラーを無視して続行するようにする
 
　Dim appExcel As Excel.Application               'Excelを取得
　Set appExcel = GetObject(, "EXCEL.Application") 'オブジェクト生成
 
　If Err.Number <> 0 Then                         'Excelが起動していない(エラーが出た場合)
　　Err.Clear
    Set appExcel = CreateObject("Excel.Application")  'Excelを起動
　End If

　On Error GoTo 0

　'---Excelの設定(記載場所の準備) ---

　appExcel.Visible = True
　Dim WB As Workbook
　Set WB = appExcel.Workbooks.Add          'ExcelワークブックをWBと定義する
 
　Dim WS As Worksheet
　Set WS = WB.Sheets(1)                    'Excelの1つ目にあるシートをWSと定義する
　ActiveSheet.Name = "CATIA_Point"         'シートの名前を変更
 
  WS.Cells(1, 1).Value = "PT"                  'ExcelのA1に「PT」を入力
  WS.Cells(1, 2).Value = "座標"                'ExcelのB1に「座標」を入力
  
  WS.Cells(2, 1).Value = "名前"                'ExcelのA2に「名前」を入力
  WS.Cells(2, 2).Value = "X"                   'ExcelのB2に「X」を入力
  WS.Cells(2, 3).Value = "Y"                   'ExcelのC2に「Y」を入力
  WS.Cells(2, 4).Value = "Z"                   'ExcelのD2に「Z」を入力

　'--- CATIAの定義 ---

　Dim partDocument1 As PartDocument
　Set partDocument1 = CATIA.ActiveDocument
 
　Dim SEL As Selection
　Set SEL = partDocument1.Selection         
 
　'--- 点群を取得 ---
 
　SEL.Search ("CATPrtSearch.Point,all")                       　　 '⇒　ドキュメント内のすべての点を選択　※非表示の点も選択
　'SEL.Search ("CATPrtSearch.Point,scr")                          '⇒ 画面に表示された点のみ選択する場合
　'SEL.Search ("CATPrtSearch.Point.Color='(255,0,255)',all")      '⇒　マゼンタ色の点のみ選択する場合
　'SEL.Search ("CATPrtSearch.Point.Color='(255,0,255)',scr")　　　 '⇒　画面に表示されたマゼンタ色の点のみ選択する場合

　'--- 点の座標を配列に格納 ---
 
　Dim SELCount As Integer  '点群の個数
　SELCount = SEL.Count 
 
　Dim myArray(2)
　Dim i As Integer

　For i = 1 To SELCount
 
　　Dim SELPoint As AnyObject
　　Set SELPoint = SEL.Item(i).Value
   
　　'--- 点の座標を取得して配列に代入 ---
  　SELPoint.GetCoordinates myArray
 
　　Dim XP As Double
　　Dim YP As Double
　　Dim ZP As Double
 
　　XP = myArray(0)                                'XPにX座標を代入
　　YP = myArray(1)                                'YPにY座標を代入
　　ZP = myArray(2)                                'ZPにZ座標を代入
 
  　WS.Cells(i + 2, 1).Value = SELPoint.Name    'ExcelのA列に点の名前を入力
  　WS.Cells(i + 2, 2).Value = XP               'ExcelのB列に点のX座標を入力
  　WS.Cells(i + 2, 3).Value = YP               'ExcelのC列に点のY座標を入力
  　WS.Cells(i + 2, 4).Value = ZP               'ExcelのD列に点のZ座標を入力
  
　Next i
 
End Sub

Sub CATMain()

　'---Excelの設定(エラー処理) ---

　On Error Resume Next 'エラーを無視して続行するようにする

　Dim appExcel As Excel.Application 'Excelを取得

　Set appExcel = GetObject(, "EXCEL.Application") 'オブジェクト生成

　If Err.Number <> 0 Then 'Excelが起動していない(エラーが出た場合)

　　Err.Clear

Set appExcel = CreateObject("Excel.Application") 'Excelを起動

　End If

　On Error GoTo 0

　'---Excelの設定(記載場所の準備) ---

　appExcel.Visible = True

　Dim WB As Workbook

　Set WB = appExcel.Workbooks.Add 'ExcelワークブックをWBと定義する

　Dim WS As Worksheet

　Set WS = WB.Sheets(1) 'Excelの1つ目にあるシートをWSと定義する

　ActiveSheet.Name = "CATIA_Point" 'シートの名前を変更

WS.Cells(1, 1).Value = "PT" 'ExcelのA1に「PT」を入力

WS.Cells(1, 2).Value = "座標" 'ExcelのB1に「座標」を入力

WS.Cells(2, 1).Value = "名前" 'ExcelのA2に「名前」を入力

WS.Cells(2, 2).Value = "X" 'ExcelのB2に「X」を入力

WS.Cells(2, 3).Value = "Y" 'ExcelのC2に「Y」を入力

WS.Cells(2, 4).Value = "Z" 'ExcelのD2に「Z」を入力

　'--- CATIAの定義 ---

　Dim partDocument1 As PartDocument

　Set partDocument1 = CATIA.ActiveDocument

　Dim SEL As Selection

　Set SEL = partDocument1.Selection

　'--- 点群を取得 ---

　SEL.Search ("CATPrtSearch.Point,all") 　　 '⇒　ドキュメント内のすべての点を選択　※非表示の点も選択

　'SEL.Search ("CATPrtSearch.Point,scr") '⇒ 画面に表示された点のみ選択する場合

　'SEL.Search ("CATPrtSearch.Point.Color='(255,0,255)',all") '⇒　マゼンタ色の点のみ選択する場合

　'SEL.Search ("CATPrtSearch.Point.Color='(255,0,255)',scr")　　　 '⇒　画面に表示されたマゼンタ色の点のみ選択する場合

　'--- 点の座標を配列に格納 ---

　Dim SELCount As Integer '点群の個数

　SELCount = SEL.Count

　Dim myArray(2)

　Dim i As Integer

　For i = 1 To SELCount

　　Dim SELPoint As AnyObject

　　Set SELPoint = SEL.Item(i).Value

　　'--- 点の座標を取得して配列に代入 ---

　SELPoint.GetCoordinates myArray

　　Dim XP As Double

　　Dim YP As Double

　　Dim ZP As Double

　　XP = myArray(0) 'XPにX座標を代入

　　YP = myArray(1) 'YPにY座標を代入

　　ZP = myArray(2) 'ZPにZ座標を代入

　WS.Cells(i + 2, 1).Value = SELPoint.Name 'ExcelのA列に点の名前を入力

　WS.Cells(i + 2, 2).Value = XP 'ExcelのB列に点のX座標を入力

　WS.Cells(i + 2, 3).Value = YP 'ExcelのC列に点のY座標を入力

　WS.Cells(i + 2, 4).Value = ZP 'ExcelのD列に点のZ座標を入力

　Next i

End Sub