CATDrawing内の長穴に対して軸線を作成するマクロ｜CATIAマクロの作成方法
今回の記事はお問い合わせよりいただいた内容です。
送って頂いた内容は以下のようなマクロです。
CATDrawing マクロで長穴に“中心線”を作図することは可能でしょうか?
本来はCATPartやCATProductから投影した長穴に対して軸線を作成したいというご要望でしたが、投影された形状はマクロでは「DrawingView」として取得されてしまうためうまくマクロが作成できません。そこでここではCATDrawing内で作成された形状である「長穴」に対して軸線を作成するマクロを紹介していきます。
軸線は中高で学習した直線や座標、2点間の距離などの公式を使い計算によって求めています。あまり覚えていないという方は、中高校生時代の数学の教科書や数学のサイトなどを見ながら本ページを見ることをオススメします。
マクロの機能
今回作成したマクロはCATDrawing内で作成された形状である「長穴」に対して軸線を作成するマクロです。長穴の2つの円弧部を選択することで、その長穴の軸線を作成します。
具体的な機能は以下のとおりです。
・長穴はCATDrawing内で作成された形状に限る(投影形状は不可)
・軸線は長穴のあるビュー内に作成される
サンプルコード
マクロのコードは以下のとおりです。
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
コード解説
モジュールレベル変数の定義
Dim vw As DrawingView 'ｱｸﾃｨﾌﾞﾋﾞｭｰ Dim r As Double '円弧のR値
まずはモジュールレベル変数の定義を行います。
これは今後出てくる複数の関数にまたがって変数を使用するためです。
アクティブドキュメント/Selection/VisPropertySet定義
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オブジェクトは、軸線の線種を変更するために定義しています。
長穴円弧部の中心座標取得
'長穴円弧部の中心座標取得
Dim arc1_coord()
arc1_coord = GetSelArcCoord("長穴の円弧(1つ目)を選択して下さい。")
Dim arc2_coord()
arc2_coord = GetSelArcCoord("長穴の円弧(2つ目)を選択して下さい。")
次に円弧の中心座標を取得します。
2つの円弧の中心座標が求まれば片方の軸線は作成可能になります。
(簡単にいうと円弧の中心点を結んだ線が軸線であるため)
ここでは「GetSelArcCoord関数」というオリジナル関数を作っています。
この関数では「SelectElement2メソッド」を使って”円弧の中心座標の取得” 、“円弧のR値の取得" 、“円弧のあるビューの取得"を行っています。
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
軸線延長の指定
'軸線延長の指定
Dim L As Double
L = r / 2 + r
先の2つの円弧を結んだ直線では軸線としては短いです。
そこで次に軸線を長穴からどれだけはみ出させるかの"量"を指定していきます。
ここで指定した長さだけ長穴からはみ出した軸線を作成することができます。
サンプルコードでは「r/2」つまりは円弧の半径の半分だけはみ出すようにしています。
(「r/2+r」の「+r」は不足分の長さなので延長量をしているのは「r/2」の部分です)
軸線1の作成
'軸線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の作成
'軸線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の場合)にうまく計算ができないため、そこだけ条件分岐で専用の処理を書いています。
軸線の線種変更
'軸線の線種変更
sel.Add line1
sel.Add line2
vps.SetRealLineType 4, 1
最後に作成した2つの軸線の線種を変更します。
詳しくはVisPropertySetオブジェクトページで解説しているので合わせて確認してみてください。
線の太さや色を変更することもできるので、任意のものに書き換えてください。
まとめ
今回はCATDrawing内の長穴に対して軸線を作成するマクロについての内容でした。
マクロの内容としては一見簡単にできそうですが、実はかなり面倒な処理が必要になってきます。これはデフォルトで存在しているコマンドの内部で行われている処理を自分で書いているようなものです。
例えば座標変換(Axis to Axis)コマンドは普通に使えば、かなり簡単に使うことのできるコマンドですが、この機能をマクロで再現しようとすると座標変換の計算(行列計算)を全て書く必要が出てきます。
内部で行われている計算内容を考えなければならないためより深く"仕組み"を理解することはできますが、その分、数学知識も必要なのでそちらの勉強も行っていくことをオススメします。
CATIAマクロを本気で勉強するなら
