穴の名称を呼び径に変換するマクロ｜CATIAマクロの作成方法
今回の記事は「お問い合わせ」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。
件名: ねじ穴の色分け・フィーチャ名
メッセージ本文:
ねじ穴のフィーチャ名は<穴.1>ですが、これをねじの呼び<M4.1>で表記することは可能でしょうか？
また、色も自動でM4は青・M5は黄色など設定することは可能でしょうか？
今回のマクロは「穴の呼び径」さえ取得できれば、名称を置き換えるだけの単純な処理で済みます。穴の呼び径(ねじ切り)は「ThreadDiameterオブジェクト」の「Valueプロパティ」より取得することが出来るためコード自体は非常に簡単なものとなっています。
ただ色付けに関してはどのようにしてユーザーに使ってもらうのかによって大きくコード内容が変わってくるため、ここでは詳しい変更方法は割愛します。
オブジェクトの色の変更自体は「VisVisPropertySetオブジェクト」の「SetRealColorメソッド」を使うだけなのであまり難しいものではありません。
また、色付けに関しては「指定した穴径別に色付けするマクロ」でも同じようなことをしているのでそちらもあわせて参照下さい。
マクロの機能
今回作成したのは穴の名称をその穴の呼び径に変更するマクロです。
具体的な機能は以下のとおりです。
(ex. 「穴.1」→「M8.1」, 「穴」→「M8」, 「ABC.1」→「M8.1」,「ABC」→「M8」)
サンプルコード
マクロのコードは以下のとおりです。
|
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 |
Sub CATMain() 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ/Selectionの定義 If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then MsgBox "このマクロはPartDocument専用です。" & vbLf & _ "CATPartに切り替えて実行してください。" Exit Sub End If Dim doc As PartDocument: Set doc = CATIA.ActiveDocument Dim sel: Set sel = doc.Selection sel.Clear 'ﾄﾞｷｭﾒﾝﾄ内の穴をすべて取得 sel.Search ("ﾊﾟｰﾄ･ﾃﾞｻﾞｲﾝ.穴,all") Dim holes As Collection Set holes = New Collection Dim i As Integer For i = 1 To sel.Count holes.Add sel.Item(i).Value Next i sel.Clear '穴名称変更 Dim h As hole For Each h In holes '現状の穴名称のﾄﾞｯﾄ[.]以降の文字列を取得 Dim no As Integer Dim num As String no = InStrRev(h.Name, ".") If no <> 0 Then num = Right(h.Name, Len(h.Name) - (no - 1)) Else num = "" End If 'ねじ切りの呼びの値を取得 Dim dia As Integer dia = h.ThreadDiameter.Value '穴名称の設定 h.Name = "M" & dia & num Next h End Sub |
コード解説
ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ/Selectionの定義
|
1 2 3 4 5 6 7 8 9 10 |
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ等の定義 If TypeName(CATIA.ActiveDocument) <> "PartDocument" Then MsgBox "このマクロはPartDocument専用です。" & vbLf & _ "CATPartに切り替えて実行してください。" Exit Sub End If Dim doc As PartDocument: Set doc = CATIA.ActiveDocument Dim sel: Set sel = doc.Selection sel.Clear |
まずはじめにアクティブドキュメントを定義をします。
今回のマクロはCATPartのみ有効なものなので、アクティブドキュメントがCATPart以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。つまり、アクティブドキュメントがCATPartの場合のみ変数「doc」にアクティブドキュメントを代入し、マクロの処理を続けます。
アクティブドキュメントが定義できたら、「Selectionオブジェクト」を定義します。
Selectionオブジェクトが定義できたら以降の処理に影響が出ないよう「sel.Clear」で選択状態を解除しておきます。
ﾄﾞｷｭﾒﾝﾄ内の穴をすべて取得
|
1 2 3 4 5 6 7 8 9 10 11 |
'ﾄﾞｷｭﾒﾝﾄ内の穴をすべて取得 sel.Search ("ﾊﾟｰﾄ･ﾃﾞｻﾞｲﾝ.穴,all") Dim holes As Collection Set holes = New Collection Dim i As Integer For i = 1 To sel.Count holes.Add sel.Item(i).Value Next i sel.Clear |
つぎにアクティブドキュメント内にある全ての「穴」を取得します。
「Selectionオブジェクト」の「Searchメソッド」を使って「穴」を全選択し、それらを全て「holes」というコレクションに格納していきます。(詳しくは選択しているオブジェクトを一時保管する方法を参照下さい)
あとは「holes」内ループをしていけば全ての穴に対して処理を行うことが可能になります。
ｱｸﾃｨﾌﾞの形状ｾｯﾄを取得
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
'穴名称変更 Dim h As hole For Each h In holes '現状の穴名称のﾄﾞｯﾄ[.]以降の文字列を取得 Dim no As Integer Dim num As String no = InStrRev(h.Name, ".") If no <> 0 Then num = Right(h.Name, Len(h.Name) - (no - 1)) Else num = "" End If 'ねじ切りの呼びの値を取得 Dim dia As Integer dia = h.ThreadDiameter.Value '穴名称の設定 h.Name = "M" & dia & num Next h |
最後に「holes」内ループをして、全ての穴に対して呼び径の取得と名称変更を行なっていきます。
お問い合わせ内容的に「.1」「.2」のような連番はそのまま残しておくようなので、ループ内の処理としては初めにその連番部分のみを文字列として取得します。最終的には穴の名称この連番の文字列を使っては「呼び径＋連番部分」となります。このとき、連番部分が存在しない場合は名称変更後も連番は付きません。
穴の呼び径は「Holeオブジェクト.ThreadDiameter.Value」で取得することができます。
ただこれで取得できるのは「8」や「10」といった数値のみです。
そのため最終的には「M」という文字列を追加する必要があります。
まとめ
今回は穴の名称をその穴の呼び径に変更するマクロについての内容でした。
今回のコードで最も重要なのは下記の穴の呼び径を取得するためのコードです。
Holeオブジェクト.ThreadDiameter.Value
Holeオブジェクトには呼び径以外にも様々な値を持っているため、ヘルプを参考に何が取得できるか色々調べてみてもおもしろいと思います。
オンラインヘルプ→r1 Hole(Object) – Catia V5 CATIADOC
CATIAマクロを本気で勉強するなら
