C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

シルエット(事前選択+CATIA.StartCommand)

こちらの続きです。
マクロの活用例?2 - C#ATIA

動画の最初の20秒ぐらいまでの処理を真似てみました。

'VBA シルエット-スプリットテスト
Private Const SilhouetteCommand = "シルエット"

Sub CATMain()
    'Body
    Dim BaseBody As Body
    Set BaseBody = SelectItem("Bodyを選択して下さい", Array("Body"))
    If IsNothing(BaseBody) Then Exit Sub
    
    'Plane
    Dim Direction As Plane
    Set Direction = SelectItem("抜き方向を示す平面を選択して下さい", Array("Plane"))
    If IsNothing(Direction) Then Exit Sub
    
    'Doc Part取得
    Dim PDoc As PartDocument: Set PDoc = CATIA.ActiveDocument
    Dim Pt As Part: Set Pt = PDoc.Part
    
    '形状セット作成
    Dim HB As HybridBody: Set HB = PDoc.Part.HybridBodies.Add
    Pt.InWorkObject = HB
    
    '事前選択
    Dim Sel As Selection: Set Sel = PDoc.Selection
    With Sel
        Call .Clear
        Call .Add(BaseBody)
        Call .Add(Direction)
    End With
    
    'シルエット - オブジェクトが提供されていない?(~R2014)
    Call CATIA.StartCommand(SilhouetteCommand)
    Dim Dmy&: Dmy = HB.HybridShapes.Count 'この行はSendKeysを成功させる為の無駄な処理です
    SendKeys "{ENTER}", True
    Dim Silhouette As AnyObject: Set Silhouette = HB.HybridShapes.Item(1)
    
    'シルエット非表示
    Dim VPS As VisPropertySet: Set VPS = Sel.VisProperties
    With Sel
        Call .Clear
        Call .Add(Silhouette)
    End With
    Call VPS.SetShow(catVisPropertyNoShowAttr)
    Sel.Clear
    
    'Split
    Dim SplitSurf As HybridShapeSplit
    Set SplitSurf = GetSurFSplit(PDoc.Part.HybridShapeFactory, _
                                 GetRef(BaseBody), _
                                 GetRef(Silhouette))
    Call HB.AppendHybridShape(SplitSurf)
    
    '確認・決定
    Dim Msg$: Msg = "この向きでよろしいですか?" + vbNewLine + "はい-決定:いいえ-反転"
    Do
        If MsgBox(Msg, vbYesNo) = vbYes Then Exit Do
        Call InvertSplit(SplitSurf)
        Pt.Update
    Loop
End Sub

'Invert
Private Sub InvertSplit(ByRef SplitSurf As HybridShapeSplit)
    Dim Pt As Part: Set Pt = GetParent_Of_T(SplitSurf, "Part")
    SplitSurf.InvertOrientation
    Call Pt.UpdateObject(SplitSurf)
End Sub

'Reference
Private Function GetRef(ByVal OJ As AnyObject) As Reference
    Dim Pt As Part: Set Pt = GetParent_Of_T(OJ, "Part")
    Set GetRef = Pt.CreateReferenceFromObject(OJ)
End Function

'GSD_Split
Private Function GetSurFSplit(ByVal Fact As HybridShapeFactory, _
                              ByVal BaseRef As Reference, _
                              ByVal CutRef As Reference) As HybridShapeSplit
    Dim SplitSurf As HybridShapeSplit
    Set SplitSurf = Fact.AddNewHybridSplit(BaseRef, CutRef, 1)
    
    Dim Pt As Part: Set Pt = GetParent_Of_T(Fact, "Part")
    Call Pt.UpdateObject(SplitSurf)
    Set GetSurFSplit = SplitSurf
End Function

'**********
'選択
''' @param:Msg-メッセージ
''' @param:Filter-選択フィルター(指定無し時AnyObject)
''' @return:AnyObject
Public Function SelectItem(ByVal Msg$, _
                           Optional ByVal Filter As Variant = Empty) _
                           As AnyObject
    Dim SE As SelectedElement
    Set SE = SelectElement(Msg, Filter)
    
    Set SelectItem = IIf(IsNothing(SE), Empty, SE.Value)
End Function

'選択
''' @param:Msg-メッセージ
''' @param:Filter-選択フィルター(指定無し時AnyObject)
''' @return:SelectedElement
Public Function SelectElement(ByVal Msg$, _
                           Optional ByVal Filter As Variant = Empty) _
                           As SelectedElement
    If IsEmpty(Filter) Then Filter = Array("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 SelectElement = Sel.Item(1)
    Sel.Clear
End Function

'T型のParent取得 Nameでのチェックも必要
''' @param:AOj-AnyObject
''' @param:T-String
''' @return:AnyObject
Public Function GetParent_Of_T(ByVal AOj As AnyObject, ByVal T$) As AnyObject
    If TypeName(AOj) = TypeName(AOj.Parent) And _
       AOj.Name = AOj.Parent.Name Then
        Set GetParent_Of_T = Nothing
        Exit Function
    End If
    If TypeName(AOj) = T Then
        Set GetParent_Of_T = AOj
    Else
        Set GetParent_Of_T = GetParent_Of_T(AOj.Parent, T)
    End If
End Function

'Nothing 書き方に統一感が無い為
''' @param:OJ-Variant(Of Object)
''' @return:Boolean
Public Function IsNothing(ByVal OJ As Variant) As Boolean
    IsNothing = OJ Is Nothing
End Function

Publicな関数は、個人的に作成しているライブラリから抜粋した部分です。
(未だ、破壊的変更が多いため、公開する勇気が出ない・・・)

"シルエット" コマンドはR2012~R2014までを見る限り、オブジェクトが無いような感じします。
無いものはしょうがないので、事前選択とCATIA.StartCommandで代用してみました。
コマンド後 "ENTER" キーを入力する必要があったのですが、SendKeysが思うような
反応をしてくれませんでしたが、1行無意味な処理を入れることで上手く動きました。
何となくですが、WaitやSleepより打率が良い気がします。(個人的な感覚です)

非常に手抜きですがこんな形状で、テストしてみます。
f:id:kandennti:20160607092507p:plain

ボディと抜き方向を指定後、MsgBoxが出ます。
f:id:kandennti:20160607092514p:plain

「いいえ」を選択すると "分割.1" の取得する面が反対側になります。
f:id:kandennti:20160607092524p:plain

例外処理もろくにしていないので、形状によってはエラーが出ると思います。
("複数結果の管理" ダイアログ等も出るので、思わしくないです・・・)

所得するサーフェスの確認部分はMsgBoxを利用したので、CATIAが操作できないのですが、
自作のFormを作成、インスタンスを作ってモードレスダイアログとして表示すれば回転させて
確認も出来るようになるはずです。
(と言うことを、今年になって知りました・・・)

"シルエット" じゃなくて "リフレクトライン" の方が良かったかも。