四角穴中心線(座標軸線)作成マクロ|CATIAマクロの作成方法
今回の記事は「お問い合わせ」より頂いた内容です。
今回の内容は以前作成した「穴中心線(座標軸線)作成マクロ」の派生マクロです。
そのためコードの内容がほとんど同じなので、本ページでコード解説はほとんど行っていません。
コードの内容を理解したい方は上記マクロのページを参照下さい。
マクロの機能
今回作成したマクロは
『ユーザーが選択した長円エッジに対して穴中心線(座標軸線)を作成するマクロ』です。
具体的な機能は以下のとおりです。
・選択された四角穴エッジに対して軸線を作成する
・作成した形状は全てツリー第1階層に作成する新規形状セットにまとめる
サンプルコード
マクロのサンプルコードは以下のとおりです。
Option Explicit
Sub CATMain()
Dim SEL
Set SEL = CATIA.ActiveDocument.Selection
Dim VPS As VisPropertySet
Set VPS = SEL.VisProperties
Dim filter1
Dim filter2
Dim msg As String
Dim Status As String
filter1 = Array("RectilinearBiDimFeatEdge")
msg = "エッジ1(直線)を選択してください。"
Status = SEL.SelectElement2(filter1, msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルします。"
Exit Sub
End If
Dim SelEdge1 As BiDimFeatEdge
Set SelEdge1 = SEL.Item(1).Value
SEL.Clear
filter2 = Array("RectilinearBiDimFeatEdge")
msg = "エッジ2(直線)を選択してください。"
Status = SEL.SelectElement2(filter2, msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルします。"
Exit Sub
End If
Dim SelEdge2 As BiDimFeatEdge
Set SelEdge2 = SEL.Item(1).Value
SEL.Clear
'SELPointを含むCATPart(PartDocumrnt)を取得
Dim tmp_Obj
Set tmp_Obj = SelEdge1
Do Until TypeName(tmp_Obj) = "PartDocument"
Set tmp_Obj = tmp_Obj.Parent
Loop
Dim Doc As PartDocument
Set Doc = tmp_Obj
Dim SPA As Workbench
Set SPA = Doc.GetWorkbench("SPAWorkbench")
Dim ConfMeasure
Dim Edge1Length As Double
Dim Edge2Length As Double
Set ConfMeasure = SPA.GetMeasurable(SelEdge1)
Edge1Length = ConfMeasure.Length
Set ConfMeasure = SPA.GetMeasurable(SelEdge2)
Edge2Length = ConfMeasure.Length
Dim ConfAngle As Double
ConfAngle = ConfMeasure.GetAngleBetween(SelEdge1)
ConfAngle = Format(ConfAngle, "0.000")
Dim ConfDistance As Double
ConfDistance = ConfMeasure.GetMinimumDistance(SelEdge1)
ConfDistance = Format(ConfDistance, "0.000")
If ConfAngle <> 90 Or ConfDistance <> 0 Then
MsgBox "選択されたエッジが有効ではないためマクロを中断します。" & vbLf & "四角穴の長辺/短辺エッジを選択して下さい。"
Exit Sub
End If
Dim PT As Part
Set PT = Doc.Part
Dim HB As HybridBody
Set HB = PT.HybridBodies.Add
HB.Name = "四角穴中心線(座標軸線)"
Dim HSF As HybridShapeFactory
Set HSF = PT.HybridShapeFactory
'① 選択されたエッジの中心点を作成
Dim CtrPoint1 As Point
Set CtrPoint1 = HSF.AddNewPointOnCurveFromPercent(SelEdge1, 0.5, False)
HB.AppendHybridShape CtrPoint1
PT.Update
Dim CtrPoint2 As Point
Set CtrPoint2 = HSF.AddNewPointOnCurveFromPercent(SelEdge2, 0.5, False)
HB.AppendHybridShape CtrPoint2
PT.Update
'② ①を始点に選択したエッジ方向の直線を作成
Dim HSdir1 As HybridShapeDirection
Dim HSdir2 As HybridShapeDirection
Set HSdir1 = HSF.AddNewDirection(SelEdge1)
Set HSdir2 = HSF.AddNewDirection(SelEdge2)
Dim RefCtrPoint1 As Reference
Dim RefCtrPoint2 As Reference
Set RefCtrPoint1 = PT.CreateReferenceFromObject(CtrPoint1)
Set RefCtrPoint2 = PT.CreateReferenceFromObject(CtrPoint2)
Dim Line1 As HybridShapeLinePtDir
Set Line1 = HSF.AddNewLinePtDir(RefCtrPoint1, HSdir2, Edge2Length, -1 * Edge2Length, False)
HB.AppendHybridShape Line1
PT.Update
Dim Line2 As HybridShapeLinePtDir
Set Line2 = HSF.AddNewLinePtDir(RefCtrPoint2, HSdir1, Edge1Length, -1 * Edge1Length, False)
HB.AppendHybridShape Line2
PT.Update
'③ ②の2直線の交点を作成
Dim RefLine1 As Reference
Dim RefLine2 As Reference
Set RefLine1 = PT.CreateReferenceFromObject(Line1)
Set RefLine2 = PT.CreateReferenceFromObject(Line2)
Dim SectPoint As HybridShapeIntersection
Set SectPoint = HSF.AddNewIntersection(RefLine1, RefLine2)
HB.AppendHybridShape SectPoint
PT.Update
'④ ③を始点にエッジ方向に直線を作成
Dim RefSectPoint As Reference
Set RefSectPoint = PT.CreateReferenceFromObject(SectPoint)
Dim AxisLine1 As Line
Set AxisLine1 = HSF.AddNewLinePtDir(RefSectPoint, HSdir1, (Edge1Length / 2) + 5, -1 * ((Edge1Length / 2) + 5), False)
HB.AppendHybridShape AxisLine1
PT.Update
Dim AxisLine2 As Line
Set AxisLine2 = HSF.AddNewLinePtDir(RefSectPoint, HSdir2, (Edge2Length / 2) + 5, -1 * ((Edge2Length / 2) + 5), False)
HB.AppendHybridShape AxisLine2
PT.Update
'⑤ ④の2直線を通る平面を作成
Dim RefAxisLine1 As Reference
Dim RefAxisLine2 As Reference
Set RefAxisLine1 = PT.CreateReferenceFromObject(AxisLine1)
Set RefAxisLine2 = PT.CreateReferenceFromObject(AxisLine2)
Dim NormPlane As HybridShapePlane2Lines
Set NormPlane = HSF.AddNewPlane2Lines(RefAxisLine1, RefAxisLine2)
HB.AppendHybridShape NormPlane
PT.Update
'⑥ ③を始点とし⑤に直交方向の直線を作成
Dim HSDir3 As HybridShapeDirection
Set HSDir3 = HSF.AddNewDirection(NormPlane)
Dim AxisLine3 As Line
Set AxisLine3 = HSF.AddNewLinePtDir(RefSectPoint, HSDir3, 10, -10, False)
HB.AppendHybridShape AxisLine3
PT.Update
With SEL
.Add CtrPoint1
.Add CtrPoint2
.Add Line1
.Add Line2
.Add NormPlane
End With
VPS.SetShow catVisPropertyNoShowAttr
SEL.Clear
End Sub
コード解説
基本的には冒頭でもいったとおり「穴中心線(座標軸線)作成マクロ」と同じような内容が多いため、共通部分は割愛しています。
ユーザー選択のエッジを確認
ユーザーが選択した四角穴の長辺エッジと短辺エッジが、本当に四角穴エッジなのかを確認します。
Dim ConfMeasure
Dim Edge1Length As Double
Dim Edge2Length As Double
Set ConfMeasure = SPA.GetMeasurable(SelEdge1)
Edge1Length = ConfMeasure.Length
Set ConfMeasure = SPA.GetMeasurable(SelEdge2)
Edge2Length = ConfMeasure.Length
Dim ConfAngle As Double
ConfAngle = ConfMeasure.GetAngleBetween(SelEdge1)
ConfAngle = Format(ConfAngle, "0.000")
Dim ConfDistance As Double
ConfDistance = ConfMeasure.GetMinimumDistance(SelEdge1)
ConfDistance = Format(ConfDistance, "0.000")
If ConfAngle <> 90 Or ConfDistance <> 0 Then
MsgBox "選択されたエッジが有効ではないためマクロを中断します。" & vbLf & "四角穴の長辺/短辺エッジを選択して下さい。"
Exit Sub
End If
ここでは選択された2つのエッジが90°かつ最短距離が0の場合を四角穴エッジと認識するようにしています。
このとき取得した2つのエッジの角度「ConfAngle」と最短距離「ConfDistance」はFormat関数を使って有効数字を小数点第3位となるように変換しています。
ConfAngle = Format(ConfAngle, “0.000") ’角度
ConfDistance = Format(ConfDistance, “0.000") ’最短距離
これは「Measurableオブジェクト」で取得した値がかなり細かいものとなってしまうためです。
最終的に取得した値を「If ConfAngle <> 90 Or ConfDistance <> 0 Then」で条件分岐させるのですが、取得した値が「90.0000000054」や「0.00000000013」のようにコンピュータの計算上の誤差による“微小のズレ"によってうまくいかない場合が出てきます。
この問題を解決させるためにCATIAのデフォルト設定と同じ有効数字に変換させているという訳です。
まとめ
今回は「四角穴中心線(座標軸線)作成マクロ」についての内容でした。
基本的には以前作成した「穴中心線(座標軸線)作成マクロ」と同じようなコードとなっています。
VBAでの形状作成は「HybridShapeFactory」(GSDの場合)を使って、ほとんど同じことの繰り返しなのでコードが長くなってもやっていること自体は単純です。今回のマクロもユーザーに2つの直線エッジを選択させ、そのエッジを使って形状作成をしているだけです。
VBAで形状作成を作成したい場合は「HybridShapeFactory」(GSDの場合)もしくは「ShapeFactory」(パートデザインの場合)さえ押さえておけば問題ありません。
CATIAマクロを本気で勉強するなら









