C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

座標系からXY,YZ,ZXの各平面のリファレンスを取得2(InternalName)

こちらの続きです。
座標系からXY,YZ,ZXの各平面のリファレンスを取得 - C#ATIA

形状セット内の座標系の場合、前回のサンプルではNGでした。
NGだった理由は2点有ります。
・ParentプロパティがNothingで、追いかけられない。
・BrepNameを何と指定して良いのか、わからない。
です。

別の事で海外のサイトを調べていたら、上手く取得する方法がわかり
修正したところかなりシンプルになりました。

'vba
'座標系の各平面のレファレンスの取得
'Return : 0-XY,1-YZ,2-ZY のレファレンス
Private Function GetAxisPlaneRefs(ByVal Ax As AxisSystem, ByVal Pt As Part) As Variant ' Reference()
    Dim PlaneRef(2) As Reference
    For i = 0 To UBound(PlaneRef)
        Set PlaneRef(i) = Pt.CreateReferenceFromBRepName(GetAxisPlaneBrepName(Ax, i), Ax)
    Next
    GetAxisPlaneRefs = PlaneRef
End Function

'座標系BrepNameの取得 - InternalName版
' PlaneN0 : 0-XY,1-YZ,2-ZYの何れか
Private Function GetAxisPlaneBrepName$(ByVal Ax As AxisSystem, ByVal PlaneNo&)
    Dim IntName$: IntName = Ax.GetItem("ModelElement").InternalName
    GetAxisPlaneBrepName = "RSur:(Face:(Brp:(" + IntName + ";" + CStr(PlaneNo + 1) + ");None:();Cf11:());" + _
                           "WithPermanentBody;WithoutBuildError;WithSelectingFeatureSupport;MFBRepVersion_CXR15)"
End Function

選択された座標系からBrepNameを取得する為に、全座標系から名前・原点・XYベクトル
全てが一致するものを探し回る為の処理をしていたのですが、

    Dim IntName$: IntName = Ax.GetItem("ModelElement").InternalName

この処理だけで可能だと判りました。

InternalNameはTree上やプロパティで表示される名前ではなく、CATIAが内部的に
使用しているオブジェクトの名前のようです。(それがBrepNameにも使用されている様です)
その為、DisplayName(Referenceクラスで利用できる)の様にユーザーに変更される
可能性が無い為、オブジェクトの一致を判断したりするのに利用できそうな予感です。

InternalName関数・・・こんなのAutomationManualに記載されてないです。
オブジェクトブラウザーで検索すればHitしますが、こんなの知らなきゃ検索できないです。
よくこんなの見つけるよなぁ。


これを利用したサンプルもGetAxisPlaneRefs関数の呼び出しだけの変更ですが、
再度記載しておきます。

Sub GetAxisPlaneRefs_Test()
    '点の選択
    Dim Pnt As AnyObject: Set Pnt = SelectItem("点を選択", Array("Point"))
    If Pnt Is Nothing Then Exit Sub
    
    '座標系の選択
    Dim Ax As AxisSystem: Set Ax = SelectItem("座標系を選択", Array("AxisSystem"))
    If Ax Is Nothing Then Exit Sub
    
    '点のリファレンス取得
    Dim Pt As Part: Set Pt = CATIA.ActiveDocument.Part
    Dim PntRef As Reference: Set PntRef = Pt.CreateReferenceFromObject(Pnt)
    
    '座標系平面のリファレンス取得
    Dim AxPlnRefs As Variant: AxPlnRefs = GetAxisPlaneRefs(Ax, Pt)
    
    '形状セット作成
    Dim HB As HybridBody: Set HB = Pt.HybridBodies.Add()
    
    '押し出し作成
    Dim i&
    For i = 0 To UBound(AxPlnRefs)
        Call HB.AppendHybridShape(InitExtrude(Pt, PntRef, AxPlnRefs(i)))
    Next
End Sub

'押し出し作成
Private Function InitExtrude(ByVal Pt As Part, ByVal OriRef As Reference, _
                             ByVal Dir As Reference) As HybridShapeExtrude
    Dim Fact As HybridShapeFactory: Set Fact = Pt.HybridShapeFactory
    Dim Extrude As HybridShapeExtrude
    Set Extrude = Fact.AddNewExtrude(OriRef, 100#, 0#, Fact.AddNewDirection(Dir))
    Extrude.SymmetricalExtension = 0
    Call Pt.UpdateObject(Extrude)
    Set InitExtrude = Extrude
End Function

'選択
Private Function SelectItem(ByVal Msg$, ByVal Filter As Variant) As AnyObject
    Dim Sel As Variant: Set Sel = CATIA.ActiveDocument.Selection
    Sel.Clear
    Select Case Sel.SelectElement2(Filter, Msg, False)
        Case "Cancel", "Undo", "Redo"
            Exit Function
    End Select
    Set SelectItem = Sel.Item(1).Value
    Sel.Clear
End Function

実行結果は前回と同様です。