四角穴中心線(座標軸線)作成マクロ｜CATIAマクロの作成方法

今回の記事は「お問い合わせ」より頂いた内容です。

今回の内容は以前作成した「穴中心線(座標軸線)作成マクロ」の派生マクロです。
そのためコードの内容がほとんど同じなので、本ページでコード解説はほとんど行っていません。
コードの内容を理解したい方は上記マクロのページを参照下さい。

マクロの機能

今回作成したマクロは
『ユーザーが選択した長円エッジに対して穴中心線(座標軸線)を作成するマクロ』です。

具体的な機能は以下のとおりです。

サンプルコード

マクロのサンプルコードは以下のとおりです。

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位となるように変換しています。

これは「Measurableオブジェクト」で取得した値がかなり細かいものとなってしまうためです。

最終的に取得した値を「If ConfAngle <> 90 Or ConfDistance <> 0 Then」で条件分岐させるのですが、取得した値が「90.0000000054」や「0.00000000013」のようにコンピュータの計算上の誤差による“微小のズレ"によってうまくいかない場合が出てきます。

この問題を解決させるためにCATIAのデフォルト設定と同じ有効数字に変換させているという訳です。

まとめ

今回は「四角穴中心線(座標軸線)作成マクロ」についての内容でした。
基本的には以前作成した「穴中心線(座標軸線)作成マクロ」と同じようなコードとなっています。

VBAでの形状作成は「HybridShapeFactory」(GSDの場合)を使って、ほとんど同じことの繰り返しなのでコードが長くなってもやっていること自体は単純です。今回のマクロもユーザーに2つの直線エッジを選択させ、そのエッジを使って形状作成をしているだけです。

VBAで形状作成を作成したい場合は「HybridShapeFactory」(GSDの場合)もしくは「ShapeFactory」(パートデザインの場合)さえ押さえておけば問題ありません。
　　

目次へ戻る
 

icon-book CATIAマクロを本気で勉強するなら

Vb Scripting for Catia V5: How to Program Catia Macros

created by Rinker

• Kindle
• Amazon
• 楽天市場
• Yahooショッピング

CATIA V5: Macro Programming with Visual Basic Script

created by Rinker

McGraw-Hill Education

• Kindle
• Amazon
• 楽天市場
• Yahooショッピング