長穴中心線(座標軸線)作成マクロ|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("BiDimFeatEdge")
msg = "エッジ1(円弧)を選択して下さい。"
label1:
Status = SEL.SelectElement2(filter1, msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルします。"
Exit Sub
End If
Dim SelEdge1 As Edge
Set SelEdge1 = SEL.Item(1).Value
SEL.Clear
'エッジを含む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
Set ConfMeasure = SPA.GetMeasurable(SelEdge1)
Dim check As Boolean
check = False
On Error GoTo ErrLabel
Dim getvalues1(2) As Variant
ConfMeasure.GetCenter getvalues1
On Error GoTo 0
Dim Radius1 As Double
Radius1 = ConfMeasure.Radius
check = True
label2:
filter2 = Array("BiDimFeatEdge")
msg = "エッジ2(円弧)を選択して下さい。"
Status = SEL.SelectElement2(filter2, msg, False)
If Status <> "Normal" Then
MsgBox "キャンセルします。"
Exit Sub
End If
Dim SelEdge2 As Edge
Set SelEdge2 = SEL.Item(1).Value
SEL.Clear
Set ConfMeasure = SPA.GetMeasurable(SelEdge2)
On Error GoTo ErrLabel
Dim getvalues2(2) As Variant
ConfMeasure.GetCenter getvalues1
On Error GoTo 0
Dim Radius2 As Double
Radius2 = ConfMeasure.Radius
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 EdgeCtrPoint1 As Point
Set EdgeCtrPoint1 = HSF.AddNewPointCenter(SelEdge1)
HB.AppendHybridShape EdgeCtrPoint1
PT.Update
Dim EdgeCtrPoint2 As Point
Set EdgeCtrPoint2 = HSF.AddNewPointCenter(SelEdge2)
HB.AppendHybridShape EdgeCtrPoint2
PT.Update
'② 選択されたエッジを通る平面を作成
Dim NormPlane As Plane
Set NormPlane = HSF.AddNewPlane1Curve(SelEdge1)
HB.AppendHybridShape NormPlane
PT.Update
'③ ①の2点を通る直線を作成
Dim RefPoint1 As Reference
Set RefPoint1 = PT.CreateReferenceFromObject(EdgeCtrPoint1)
Dim RefPoint2 As Reference
Set RefPoint2 = PT.CreateReferenceFromObject(EdgeCtrPoint2)
Dim RefPlane As Reference
Set RefPlane = PT.CreateReferenceFromObject(NormPlane)
Dim AxisLine1 As Line
Set AxisLine1 = HSF.AddNewLinePtPtOnSupportExtended(RefPoint1, RefPoint2, RefPlane, Radius1 + 5, Radius2 + 5)
HB.AppendHybridShape AxisLine1
PT.Update
'④ ③で作成した直線の中心点を作成
Dim RefAxisLine1 As Reference
Set RefAxisLine1 = PT.CreateReferenceFromObject(AxisLine1)
Dim CtrPoint As Point
Set CtrPoint = HSF.AddNewPointOnCurveFromPercent(RefAxisLine1, 0.5, False)
HB.AppendHybridShape CtrPoint
PT.Update
'⑤ ④を通り②に直交な直線を作成
Dim RefCtrPoint As Reference
Set RefCtrPoint = PT.CreateReferenceFromObject(CtrPoint)
Dim AxisLine2 As HybridShapeLineNormal
Set AxisLine2 = HSF.AddNewLineNormal(RefPlane, RefCtrPoint, 10, -10, False)
HB.AppendHybridShape AxisLine2
PT.Update
'⑥ ③の直線を⑤の直線を軸に90deg回転した位置に直線を作成
Dim RefAxisLine As Reference
Set RefAxisLine = PT.CreateReferenceFromObject(AxisLine1)
Dim AxisLine3 As Line
Set AxisLine3 = HSF.AddNewLineAngle(RefAxisLine1, RefPlane, RefCtrPoint, True, Radius1 + 5, -1 * (Radius2 + 5), 90, False)
HB.AppendHybridShape AxisLine3
PT.Update
With SEL
.Add EdgeCtrPoint1
.Add EdgeCtrPoint2
.Add NormPlane
End With
VPS.SetShow catVisPropertyNoShowAttr
SEL.Clear
Exit Sub
ErrLabel:
MsgBox "エッジは円弧を選択してください。"
SEL.Clear
If check = False Then
Resume label1
ElseIf check = True Then
Resume label2
End If
End Sub
まとめ
今回は「長穴中心線(座標軸線)作成マクロ」についての内容でした。
基本的には以前作成した「穴中心線(座標軸線)作成マクロ」と同じようなコードとなっています。
VBAでの形状作成は「HybridShapeFactory」(GSDの場合)を使って、ほとんど同じことの繰り返しなのでコードが長くなってもやっていること自体は単純です。今回のマクロもユーザーに2つの直線エッジを選択させ、そのエッジを使って形状作成をしているだけです。
VBAで形状作成を作成したい場合は「HybridShapeFactory」(GSDの場合)もしくは「ShapeFactory」(パートデザインの場合)さえ押さえておけば問題ありません。
CATIAマクロを本気で勉強するなら







