Excelからポイントとスプラインを作るマクロを紹介します。
点のコマンドで入力するのは手間なのでExcelから入力出来ると楽です
点のコマンドで入力するのは手間なのでExcelから入力出来ると楽です
目次
Excelからポイントとスプラインを作るマクロ
ポイント座標をCATIAに点コマンドで入力するのは手間なので楽したいときのマクロです。
ExcelにXYZの座標を各セルに入力してマクロを実行すれば
CATIAのpartファイルに点とスプラインが作れます。
Excelで入力できるのでかなり楽です。
CSVファイルのデータが支給された場合も数値コピペすればOK
形状セットが新規制作されて点とスプラインが作られます。
ポイントのinput
Excelに点の座標を入力します
スプラインを複数作る場合は StartCurve と EndCurve で閉じます
Excelからプログラム実行
準備としてCATIA を起動してPart ファイルを開いておきます。
マクロ実行はExcelから操作します
「表示」⇒ 「マクロ」⇒ 「マクロの表示」 ⇨ マクロを選択して「実行」
制作タイプを選択
選択ボックスが表示されるので
「① 点のみ」か「② 点＋スプライン」を選択可能です。「1 or 2 を選択」
マクロの編集
Excel 「表示」⇒ 「マクロ」⇒ 「マクロの表示」
⇨ マクロを選択して「編集」
Visual Basic でコードを編集します
参考 コード
サンプルのマクロはCATIAをインストールした下記フォルダーにある GSD_PointSplineLoftFromExcel.xls を参考にしています。
C:\Program Files\Dassault Systemes\B27\win_b64\code\command\GSD_PointSplineLoftFromExcel.xls
（B27はインストール時の設定によります）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 |
'//============================================================================ '// COPYRIGHT 3Draku '//============================================================================ '// Generative Shape Design '// point & splines Creation tool '//============================================================================ Const Cst_iSTARTCurve As Integer = 1 Const Cst_iENDCurve As Integer = 11 Const Cst_iSTARTCoord As Integer = 3 Const Cst_iENDCoord As Integer = 33 Const Cst_iERRORCool As Integer = 99 Const Cst_iEND As Integer = 9999 Const Cst_strSTARTCurve As String = "StartCurve" Const Cst_strENDCurve As String = "EndCurve" Const Cst_strSTARTCoord As String = "StartCoord" Const Cst_strENDCoord As String = "EndCoord" Const Cst_strEND As String = "End" '------------------------------------------------------------------------ '作成する要素の種類を定義するには（1：ポイントのみを作成） '2：ポイントとスプラインを作成します '------------------------------------------------------------------------ Function GetTypeFile() As Integer Dim strInput As String, strMsg As String choice = 0 While (choice < 1 Or choice > 2) strMsg = "作成するタイプを数字で入力してください (1 for 点, 2 for 点 and スプライン):" strInput = InputBox(Prompt:=strMsg, _ Title:="User Info", XPos:=2000, YPos:=2000) '選択の検証 choice = CInt(strInput) If (choice < 1 Or choice > 2) Then MsgBox "無効な値：1または2の数字を入力してください" End If Wend GetTypeFile = choice End Function '------------------------------------------------------------------------ 'アクティブセルを取得する '------------------------------------------------------------------------ Function GetCell(iindex As Integer, column As Integer) As String Dim Chain As String Sheets("input").Select If (column = 1) Then Chain = "A" + CStr(iindex) ElseIf (column = 2) Then Chain = "B" + CStr(iindex) ElseIf (column = 3) Then Chain = "C" + CStr(iindex) End If Range(Chain).Select GetCell = ActiveCell.Value End Function Function GetCellA(iRang As Integer) As String GetCellA = GetCell(iRang, 1) End Function Function GetCellB(iRang As Integer) As String GetCellB = GetCell(iRang, 2) End Function Function GetCellC(iRang As Integer) As String GetCellC = GetCell(iRang, 3) End Function '------------------------------------------------------------------------ 'パラメータファイルの構文 '------------------------ 'StartCurve -> スプラインを定義する点のリストを開始 ' double , double , double ' double , double , double -> スプラインを定義するために必要なだけの点 'EndCurve -> スプラインを定義する点のリストを終了 ' ' '例: '-------- 'StartCurve ' -10.89, 10 , 46.78 '1.56, 4, 6 'EndCurve -> 2点で構成されるスプライン ＝ 直線になります '------------------------------------------------------------------------ Sub ChainAnalysis(ByRef iRang As Integer, ByRef X As Double, ByRef Y As Double, ByRef Z As Double, ByRef iValid As Integer) Dim Chain As String Dim Chain2 As String Dim Chain3 As String Chain = GetCellA(iRang) Select Case Chain Case Cst_strSTARTCurve iValid = Cst_iSTARTCurve Case Cst_strENDCurve iValid = Cst_iENDCurve Case Cst_strSTARTCoord iValid = Cst_iSTARTCoord Case Cst_strENDCoord iValid = Cst_iENDCoord Case Cst_strEND iValid = Cst_iEND Case Else iValid = 0 End Select If (iValid <> 0) Then Exit Sub End If 'Conversion string -> double Chain2 = GetCellB(iRang) Chain3 = GetCellC(iRang) If ((Len(Chain) > 0) And (Len(Chain2) > 0) And (Len(Chain3) > 0)) Then X = CDbl(Chain) Y = CDbl(Chain2) Z = CDbl(Chain3) Else iValid = Cst_iERRORCool X = 0# Y = 0# Z = 0# End If End Sub '------------------------------------------------------------------------ ' CATIAアプリケーションを入手する '------------------------------------------------------------------------ 'Remark: ' When KO, update CATIA registers with: ' CNEXT /unregserver ' CNEXT /regserver '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Function GetCATIA() As Object Set CATIA = GetObject(, "CATIA.Application") If CATIA Is Nothing Then Set CATIA = CreateObject("CATIA.Application") CATIA.Visible = True End If Set GetCATIA = CATIA End Function '------------------------------------------------------------------------ ' Get CATIADocument '------------------------------------------------------------------------ Function GetCATIAPartDocument() As Object Set CATIA = GetCATIA Dim MyPartDocument As Object Set MyPartDocument = CATIA.ActiveDocument If MyPartDocument Is Nothing Then MsgBox "Catiaのアクティブドキュメントが見つかりません " End If Set GetCATIAPartDocument = MyPartDocument End Function '------------------------------------------------------------------------ ' パラメータファイルからすべての使用可能なポイントを作成します '------------------------------------------------------------------------ Sub CreationPoint() 'Get CATIA Dim PtDoc As Object Set PtDoc = GetCATIAPartDocument ' Get the HybridBody Dim myHBody As Object Set myHBody = PtDoc.Part.HybridBodies.Item("Import From Excel") Dim iLigne As Integer Dim iValid As Integer Dim X As Double Dim Y As Double Dim Z As Double Dim Point As Object iLigne = 1 'Analyze file While iValid <> Cst_iEND 'Read a line ChainAnalysis iLigne, X, Y, Z, iValid iLigne = iLigne + 1 'Not on a startcurve or endcurve -> valid point If (iValid = 0) Then Set Point = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X, Y, Z) myHBody.AppendHybridShape Point End If Wend 'Model update PtDoc.Part.Update End Sub '------------------------------------------------------------------------ ' パラメータファイルからすべての使用可能なポイントとスプラインを作成します '------------------------------------------------------------------------ '制限: ' ============================> スプラインあたり500ポイント以下 '------------------------------------------------------------------------ Sub CreationSpline() 'スプラインあたりのポイントの制限数 Const NBMaxPtParSpline As Integer = 500 'Get CATIA Dim PtDoc As Object Set PtDoc = GetCATIAPartDocument 'Get HybridBody Dim myHBody As Object Set myHBody = PtDoc.Part.HybridBodies.Item("Import From Excel") Dim iRang As Integer Dim iValid As Integer Dim X1 As Double Dim Y1 As Double Dim Z1 As Double Dim index As Integer Dim PassingPtArray(1 To NBMaxPtParSpline) As Object Dim spline As Object Dim ReferenceOnPoint As Object Dim SplineCtrPt As Object iValid = 0 iRang = 1 'Analyze file While iValid <> Cst_iEND 'reinitialization of point array of the spline index = 0 'Remove records before StartCurve While ((iValid <> Cst_iSTARTCurve) And (iValid <> Cst_iEND)) ChainAnalysis iRang, X1, Y1, Z1, iValid iRang = iRang + 1 Wend If (iValid <> Cst_iEND) Then 'Read until endcurve -> Spline completed While ((iValid <> Cst_iENDCurve) And (iValid <> Cst_iEND)) ChainAnalysis iRang, X1, Y1, Z1, iValid iRang = iRang + 1 'valid point If (iValid = 0) Then index = index + 1 If (index > NBMaxPtParSpline) Then MsgBox "スプラインの点が多すぎます。 ポイントを削除しました" Else Set PassingPtArray(index) = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X1, Y1, Z1) myHBody.AppendHybridShape PassingPtArray(index) End If End If Wend 'スプラインの作成を開始 '十分なポイントはありますか？ If (index < 2) Then MsgBox "スプラインの点が足りません。 スプラインを削除しました" Else Set spline = PtDoc.Part.HybridShapeFactory.AddNewSpline spline.SetSplineType 0 spline.SetClosing 0 'Creates and adds points to the spline For i = 1 To index Set ReferenceOnPoint = PtDoc.Part.CreateReferenceFromObject(PassingPtArray(i)) ' ---- Version Before V5R12 ' Set SplineCtrPt = PtDoc.Part.HybridShapeFactory.AddNewControlPoint(ReferenceOnPoint) ' spline.AddControlPoint SplineCtrPt ' ---- Since V5R12 spline.AddPointWithConstraintExplicit ReferenceOnPoint, Nothing, -1, 1, Nothing, 0 Next i myHBody.AppendHybridShape spline End If End If Wend PtDoc.Part.Update End Sub Sub LookForNextSpline(ByRef iRang As Integer, ByRef spline As Object, ByRef iValid As Integer, ByRef iOKSpline) 'スプラインあたりのポイントの制限数 Const NBMaxPtParSpline As Integer = 500 'Get CATIA Dim PtDoc As Object Set PtDoc = GetCATIAPartDocument 'Get HybridBody Dim myHBody As Object Set myHBody = PtDoc.Part.HybridBodies.Item("Import From Excel") Dim X1 As Double Dim Y1 As Double Dim Z1 As Double Dim index As Integer Dim PassingPtArray(1 To NBMaxPtParSpline) As Object Dim ReferenceOnPoint As Object Dim SplineCtrPt As Object iValid = 0 iOKSpline = 0 'スプラインの点配列の再初期化 index = 0 'StartCurveの前にレコードを削除する While ((iValid <> Cst_iSTARTCurve) And (iValid <> Cst_iEND)) ChainAnalysis iRang, X1, Y1, Z1, iValid iRang = iRang + 1 Wend If (iValid <> Cst_iEND) Then 'Read until endcurve -> Spline completed While ((iValid <> Cst_iENDCurve) And (iValid <> Cst_iEND)) ChainAnalysis iRang, X1, Y1, Z1, iValid iRang = iRang + 1 'valid point If (iValid = 0) Then index = index + 1 If (index > NBMaxPtParSpline) Then MsgBox "スプラインの点が多すぎます。 ポイントを削除しました" Else Set PassingPtArray(index) = PtDoc.Part.HybridShapeFactory.AddNewPointCoord(X1, Y1, Z1) myHBody.AppendHybridShape PassingPtArray(index) End If End If Wend 'スプラインの作成を開始 '十分なポイントはありますか？ If (index < 2) Then MsgBox "スプラインの点が足りません。 スプラインを削除しました" Else Set spline = PtDoc.Part.HybridShapeFactory.AddNewSpline 'Creates and adds points to the spline For i = 1 To index Set ReferenceOnPoint = PtDoc.Part.CreateReferenceFromObject(PassingPtArray(i)) ' ---- Version Before V5R12 ' Set SplineCtrPt = PtDoc.Part.HybridShapeFactory.AddNewControlPoint(ReferenceOnPoint) ' spline.AddControlPoint SplineCtrPt ' ---- Since V5R12 spline.AddPointWithConstraintExplicit ReferenceOnPoint, Nothing, -1, 1#, Nothing, 0# Next i myHBody.AppendHybridShape spline spline.SetSplineType 0 spline.SetClosing 0 iOKSpline = 1 End If End If End Sub '------------------------------------------------------------------------ 'Main program '------------------------------------------------------------------------ Sub Main() '作成する要素の種類を定義: ' Points --> 1 ' Splines + Points --> 2 Dim TypeFile As Integer TypeFile = GetTypeFile ' V5R12-作成されたジオメトリ用に専用のopenBodyを作成する ' CATIAアクティブドキュメントを取得 '警告：アクティブドキュメントはパーツドキュメントである必要があります Dim PtDoc As Object Set PtDoc = GetCATIAPartDocument ' Dim myHBody As HybridBody Set myHBody = PtDoc.Part.HybridBodies.Add() Set referencebody = PtDoc.Part.CreateReferenceFromObject(myHBody) PtDoc.Part.HybridShapeFactory.ChangeFeatureName referencebody, "Import From Excel" If TypeFile = 1 Then CreationPoint ElseIf TypeFile = 2 Then CreationSpline End If End Sub |
参考書籍
Excelのマクロ VBA について 詳しく勉強したい方はExcelのマクロの書籍を購入してみましょう。
 |
価格:2,618円 |
初めての人は完成されたマクロをカスタムすることから始めましょう。
綺麗なマクロを作るのは経験が必要ですが
とりあえずマクロをまねして編集から始めると理解しやすいです
どこを編集すると結果どうなるかを少し変更して実行を繰り返すことで早く理解することができます。
何をすればエラーになるかを理解することが重要です。
CATIA V5 のマクロについては詳しく勉強したい方は下記をおすすめ
できれば電子書籍を購入しましょう コピペできるので便利です
 |
CATIA V5Macro Programming with Visual Basic Script【電子書籍】[ Dieter R. Ziethen ] 価格:11,989円 |
Excel VBAサンプル ダウンロード
今回のマクロサンプルをダウンロードできます。
