選択要素からﾄﾞｷｭﾒﾝﾄを取得する

こちらの続きで応用です。
座標系からXY,YZ,ZXの各平面のﾘﾌｧﾚﾝｽを取得2(InternalName) - C#ATIA

こちらにも、ちょっと関係してます。
ProductからPartDocumentを取得する - C#ATIA

InternalName関数は、ModelElement型から提供されているのが
わかるのですが、ModelElement型も当然AutomationManualに
記載されてないです。
ｵﾌﾞｼﾞｪｸﾄﾌﾞﾗｳｻﾞｰで調べて驚きました。

Documentを持っているじゃないですか。

ModelElementが取得できれば、Documentも取得できるって事ですね。
これを利用した関数を作ってみました。

'AnyObjectからﾄﾞｷｭﾒﾝﾄを取得
Private Function GetDocument(ByVal AO As AnyObject) As Document
    On Error Resume Next
        Set GetDocument = AO.GetItem("ModelElement").Document
    On Error GoTo 0
    If GetDocument Is Nothing Then
        'Topological,Geometry的なもの(CATSelectionFilter)はこちらで処理
        Set GetDocument = GetParent_Of_LikeT(AO, "Document")
    End If
End Function

'Like_T型のParent取得
Private Function GetParent_Of_LikeT(ByVal AnyOj As AnyObject, ByVal T$) As AnyObject
    If TypeName(AnyOj) = TypeName(AnyOj.Parent) Then
        Set GetParent_Of_LikeT = Nothing
        Exit Function
    End If
    If InStr(1, TypeName(AnyOj), T) > 0 Then
        Set GetParent_Of_LikeT = AnyOj
    Else
        Set GetParent_Of_LikeT = GetParent_Of_LikeT(AnyOj.Parent, T)
    End If
End Function

試したところ、全てのAnyObjectからModelElementが取得出来るわけでは
ありませんでした。　ﾎﾞﾃﾞｨの面や境界等、ﾄﾎﾟﾛｼﾞｶﾙ的な要素では
取得できませんでした。 (表現しにくいのですが・・・)
GetDocument関数では、一度ModelElementで取得を試み、例外が発生した
場合は、Parentを駆け上がって行く様にしています。

これを使ったｻﾝﾌﾟﾙです。

'vba
Sub GetDocument_Test()
    '選択
    Dim Filter As Variant: Filter = Array("AnyObject")
    Dim AO As AnyObject: Set AO = SelectItem("ﾄﾞｷｭﾒﾝﾄを取得する要素を選択", Filter)
    If AO Is Nothing Then Exit Sub
    
    'ﾄﾞｷｭﾒﾝﾄの取得
    Set Doc = GetDocument(AO)
    
    'ﾒｯｾｰｼﾞ
    Dim Msg$
    Msg = "選択した" + Filter(0) + "は" + _
          "「 " + TypeName(AO) + " 」型で、" + vbNewLine + _
          "「 " + Doc.Name + " 」の構成要素です。" + vbNewLine + _
          "「 " + Doc.FullName + " 」" + vbNewLine + _
          "が、該当するファイルです。"
    MsgBox Msg
End Sub

'選択
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

選択要素からﾄﾞｷｭﾒﾝﾄを取得させています。
PartやProductだけではなく、Drawでも試す事が可能で、かなり汎用的に
なっていると思います。


ﾗｲｾﾝｽが無いので試せないのですが、他の種類のﾄﾞｷｭﾒﾝﾄも取得できる
のではないかと思います。