CATDrawing内の長穴に対して軸線を作成するマクロ｜CATIAマクロの作成方法
今回の記事はお問い合わせよりいただいた内容です。
送って頂いた内容は以下のようなマクロです。
CATDrawing マクロで長穴に“中心線”を作図することは可能でしょうか?
本来はCATPartやCATProductから投影した長穴に対して軸線を作成したいというご要望でしたが、投影された形状はマクロでは「DrawingView」として取得されてしまうためうまくマクロが作成できません。そこでここではCATDrawing内で作成された形状である「長穴」に対して軸線を作成するマクロを紹介していきます。
軸線は中高で学習した直線や座標、2点間の距離などの公式を使い計算によって求めています。あまり覚えていないという方は、中高校生時代の数学の教科書や数学のサイトなどを見ながら本ページを見ることをオススメします。
マクロの機能
今回作成したマクロはCATDrawing内で作成された形状である「長穴」に対して軸線を作成するマクロです。長穴の2つの円弧部を選択することで、その長穴の軸線を作成します。
具体的な機能は以下のとおりです。
・長穴はCATDrawing内で作成された形状に限る(投影形状は不可)
・軸線は長穴のあるビュー内に作成される
サンプルコード
マクロのコードは以下のとおりです。
|
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 |
Option Explicit Dim vw As DrawingView 'ｱｸﾃｨﾌﾞﾋﾞｭｰ Dim r As Double '円弧のR値 '―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――― Sub CATMain() 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義 If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then MsgBox "このマクロはDrawingDocument専用です。" & vbLf & _ "CATDrawingに切り替えて実行してください。" Exit Sub End If Dim doc As DrawingDocument: Set doc = CATIA.ActiveDocument Dim sel As Selection: Set sel = doc.Selection Dim vps As VisPropertySet: Set vps = sel.VisProperties '長穴円弧部の中心座標取得 Dim arc1_coord() arc1_coord = GetSelArcCoord("長穴の円弧(1つ目)を選択して下さい。") Dim arc2_coord() arc2_coord = GetSelArcCoord("長穴の円弧(2つ目)を選択して下さい。") '軸線延長の指定 Dim L As Double L = r / 2 + r '軸線1 作成 vw.Activate Dim fac2d As Factory2D: Set fac2d = vw.Factory2D Dim coord1() As Double, coord2() As Double, ctr_coord(1) As Double Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double x1 = arc1_coord(0) y1 = arc1_coord(1) x2 = arc2_coord(0) y2 = arc2_coord(1) ctr_coord(0) = (x1 + x2) / 2 ctr_coord(1) = (y1 + y2) / 2 coord1 = ExtendLineCoord(x1, y1, x2, y2, L) coord2 = ExtendLineCoord(x2, y2, x1, y1, L) Dim line1 As Line2D Set line1 = fac2d.CreateLine(coord1(0), coord1(1), coord2(0), coord2(1)) '軸線2 作成 Dim norm_line() norm_line = Normal_Line(ctr_coord(0), ctr_coord(1), x2, y2) Dim coord3() As Double, coord4() As Double Dim x3 As Double, y3 As Double If norm_line(0) = 0 Then '長穴がY軸方向の場合 ReDim coord3(1) ReDim coord4(1) coord3(0) = ctr_coord(0) + L coord3(1) = norm_line(1) coord4(0) = ctr_coord(0) - L coord4(1) = norm_line(1) ElseIf norm_line(1) = 0 Then '長穴がX軸方向の場合 ReDim coord3(1) ReDim coord4(1) coord3(0) = norm_line(0) coord3(1) = ctr_coord(1) + L coord4(0) = norm_line(0) coord4(1) = ctr_coord(1) - L Else '長穴が傾いている場合 x3 = ctr_coord(0) + 0.1 y3 = norm_line(0) * x3 + norm_line(1) coord3 = ExtendLineCoord(ctr_coord(0), ctr_coord(1), x3, y3, L) x3 = ctr_coord(0) - 0.1 y3 = norm_line(0) * x3 + norm_line(1) coord4 = ExtendLineCoord(ctr_coord(0), ctr_coord(1), x3, y3, L) End If Dim line2 As Line2D Set line2 = fac2d.CreateLine(coord3(0), coord3(1), coord4(0), coord4(1)) '軸線の線種変更 sel.Add line1 sel.Add line2 vps.SetRealLineType 4, 1 End Sub '―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――― Private Function GetSelArcCoord(msg As String) As Variant() Dim sel 'As Selection Set sel = CATIA.ActiveDocument.Selection Dim filter(): filter = Array("Circle2D") Dim status As String status = sel.SelectElement2(filter, msg, False) If status <> "Normal" Then MsgBox "キャンセルしました。" End End If Dim arc 'As Circle2D Set arc = sel.Item(1).Value sel.Clear r = arc.Radius Dim arc_coord(1) arc.GetCenter arc_coord Dim obj As AnyObject: Set obj = arc Do Set obj = obj.Parent Loop Until TypeName(obj) = "DrawingView" Set vw = obj GetSelArcCoord = arc_coord() End Function '―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――― Private Function ExtendLineCoord(ByVal x1 As Double, ByVal y1 As Double, _ ByVal x2 As Double, ByVal y2 As Double, _ ByVal L As Double) As Double() Dim coord(1) As Double Dim xy As Double xy = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2) coord(0) = (-L * x1 + (xy + L) * x2) / xy coord(1) = (-L * y1 + (xy + L) * y2) / xy ExtendLineCoord = coord() End Function '―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――― Private Function Normal_Line(x1, y1, x2, y2) Dim Slope As Double If x2 - x1 <> 0 Then Slope = (y2 - y1) / (x2 - x1) Else Slope = 0 End If Dim NormalSlope Dim NormalIntercept If y2 - y1 = 0 Then Normal_Line = Array(x1, 0) ElseIf Slope <> 0 Then NormalSlope = -1 / Slope NormalIntercept = y1 - (NormalSlope * x1) Normal_Line = Array(NormalSlope, NormalIntercept) ElseIf x2 - x1 = 0 Then Normal_Line = Array(0, y1) End If End Function |
コード解説
モジュールレベル変数の定義
|
1 2 |
Dim vw As DrawingView 'ｱｸﾃｨﾌﾞﾋﾞｭｰ Dim r As Double '円弧のR値 |
まずはモジュールレベル変数の定義を行います。
これは今後出てくる複数の関数にまたがって変数を使用するためです。
アクティブドキュメント/Selection/VisPropertySet定義
|
1 2 3 4 5 6 7 8 9 10 11 12 |
Sub CATMain() 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義 If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then MsgBox "このマクロはDrawingDocument専用です。" & vbLf & _ "CATDrawingに切り替えて実行してください。" Exit Sub End If Dim doc As DrawingDocument: Set doc = CATIA.ActiveDocument Dim sel As Selection: Set sel = doc.Selection Dim vps As VisPropertySet: Set vps = sel.VisProperties |
続いてSubプロシージャのコードです。
まず初めにアクティブドキュメント / Selection / VisPropertySetの定義を行います。
VisPropertySetオブジェクトは、軸線の線種を変更するために定義しています。
長穴円弧部の中心座標取得
|
1 2 3 4 5 6 |
'長穴円弧部の中心座標取得 Dim arc1_coord() arc1_coord = GetSelArcCoord("長穴の円弧(1つ目)を選択して下さい。") Dim arc2_coord() arc2_coord = GetSelArcCoord("長穴の円弧(2つ目)を選択して下さい。") |
次に円弧の中心座標を取得します。
2つの円弧の中心座標が求まれば片方の軸線は作成可能になります。
(簡単にいうと円弧の中心点を結んだ線が軸線であるため)
ここでは「GetSelArcCoord関数」というオリジナル関数を作っています。
この関数では「SelectElement2メソッド」を使って”円弧の中心座標の取得” 、“円弧のR値の取得” 、“円弧のあるビューの取得”を行っています。
|
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 |
Private Function GetSelArcCoord(msg As String) As Variant() Dim sel 'As Selection Set sel = CATIA.ActiveDocument.Selection Dim filter(): filter = Array("Circle2D") Dim status As String status = sel.SelectElement2(filter, msg, False) If status <> "Normal" Then MsgBox "キャンセルしました。" End End If Dim arc 'As Circle2D Set arc = sel.Item(1).Value sel.Clear '円弧のR値の取得 r = arc.Radius '円弧の中心座標の取得 Dim arc_coord(1) arc.GetCenter arc_coord '円弧のあるﾋﾞｭｰの取得 Dim obj As AnyObject: Set obj = arc Do Set obj = obj.Parent Loop Until TypeName(obj) = "DrawingView" Set vw = obj GetSelArcCoord = arc_coord() End Function |
軸線延長の指定
|
1 2 3 |
'軸線延長の指定 Dim L As Double L = r / 2 + r |
先の2つの円弧を結んだ直線では軸線としては短いです。
そこで次に軸線を長穴からどれだけはみ出させるかの”量”を指定していきます。
ここで指定した長さだけ長穴からはみ出した軸線を作成することができます。
サンプルコードでは「r/2」つまりは円弧の半径の半分だけはみ出すようにしています。
(「r/2+r」の「+r」は不足分の長さなので延長量をしているのは「r/2」の部分です)
軸線1の作成
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
'軸線1 作成 vw.Activate Dim fac2d As Factory2D: Set fac2d = vw.Factory2D Dim coord1() As Double, coord2() As Double, ctr_coord(1) As Double Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double x1 = arc1_coord(0) y1 = arc1_coord(1) x2 = arc2_coord(0) y2 = arc2_coord(1) ctr_coord(0) = (x1 + x2) / 2 ctr_coord(1) = (y1 + y2) / 2 coord1 = ExtendLineCoord(x1, y1, x2, y2, L) coord2 = ExtendLineCoord(x2, y2, x1, y1, L) Dim line1 As Line2D Set line1 = fac2d.CreateLine(coord1(0), coord1(1), coord2(0), coord2(1)) |
円弧の中心座標、延長量が決まったので実際に軸線を作成します。
直線の作成は「Factory2Dオブジェクト」の「CreateLineメソッド」を使います。
使い方は簡単で以下のように書けばOKです。
fac2d.CreateLine(始点のX座標, 始点のY座標, 終点のX座標, 終点のY座標)
ここでは円弧の中心座標から指定した延長量の位置の座標を取得する「ExtendLineCoord関数」を作成し、始点と終点の座標を計算しています。
引数は「x1」「y1」「x2」「y2」「L」の5つのDouble型の値です。
この関数を使うことで、(x1, y1)と(x2, y2)の2点を通る直線上にあり、(x2, y2)側に「L」の長さだけ延長した位置の座標を取得することができます。これを2つの円弧の中心座標に対して行うことで、任意の長さの軸線を作成することができます。
軸線2の作成
|
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 |
'軸線2 作成 Dim norm_line() norm_line = Normal_Line(ctr_coord(0), ctr_coord(1), x2, y2) Dim coord3() As Double, coord4() As Double Dim x3 As Double, y3 As Double If norm_line(0) = 0 Then '長穴がY軸方向の場合 ReDim coord3(1) ReDim coord4(1) coord3(0) = ctr_coord(0) + L coord3(1) = norm_line(1) coord4(0) = ctr_coord(0) - L coord4(1) = norm_line(1) ElseIf norm_line(1) = 0 Then '長穴がX軸方向の場合 ReDim coord3(1) ReDim coord4(1) coord3(0) = norm_line(0) coord3(1) = ctr_coord(1) + L coord4(0) = norm_line(0) coord4(1) = ctr_coord(1) - L Else '長穴が傾いている場合 x3 = ctr_coord(0) + 0.1 y3 = norm_line(0) * x3 + norm_line(1) coord3 = ExtendLineCoord(ctr_coord(0), ctr_coord(1), x3, y3, L) x3 = ctr_coord(0) - 0.1 y3 = norm_line(0) * x3 + norm_line(1) coord4 = ExtendLineCoord(ctr_coord(0), ctr_coord(1), x3, y3, L) End If Dim line2 As Line2D Set line2 = fac2d.CreateLine(coord3(0), coord3(1), coord4(0), coord4(1) |
次にもう一方の軸線を作成します。
このコードは長くなるので割愛しますが、やっていることは「先程作った軸線に対して90度の直線を作成する」というだけのことです。
上記コードの場合、長穴がX平行,Y平行の場合(つまりは傾きが0の場合)にうまく計算ができないため、そこだけ条件分岐で専用の処理を書いています。
軸線の線種変更
|
1 2 3 4 |
'軸線の線種変更 sel.Add line1 sel.Add line2 vps.SetRealLineType 4, 1 |
最後に作成した2つの軸線の線種を変更します。
詳しくはVisPropertySetオブジェクトページで解説しているので合わせて確認してみてください。
線の太さや色を変更することもできるので、任意のものに書き換えてください。
まとめ
今回はCATDrawing内の長穴に対して軸線を作成するマクロについての内容でした。
マクロの内容としては一見簡単にできそうですが、実はかなり面倒な処理が必要になってきます。これはデフォルトで存在しているコマンドの内部で行われている処理を自分で書いているようなものです。
例えば座標変換(Axis to Axis)コマンドは普通に使えば、かなり簡単に使うことのできるコマンドですが、この機能をマクロで再現しようとすると座標変換の計算(行列計算)を全て書く必要が出てきます。
内部で行われている計算内容を考えなければならないためより深く”仕組み”を理解することはできますが、その分、数学知識も必要なのでそちらの勉強も行っていくことをオススメします。
CATIAマクロを本気で勉強するなら
