Viewpoint3Dで表示を動かす

こちらのﾏｸﾛを視野に入れて、ｶﾒﾗ関係のﾃｽﾄをしてみました。

Productの構成要素の表示/非表示 - C#ATIA

ｶﾒﾗ関係の処理をやった事が無いので。

ﾃｽﾄをしているうちにｱﾆﾒｰｼｮﾝっぽい事が出来そうな気が
してきたので、そんなｻﾝﾌﾟﾙになりました。

'vba
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Const DefaultSpeed = 500

Sub CATMain()
    Dim Msg$
    Dim Filter As Variant: Filter = Array("AnyObject")
    
    'ｽﾀｰﾄView
    Msg = "開始するﾋﾞｭｰの状態しに、何かｸﾘｯｸしてください(ESC/中止)"
    If IsNothing(SelectItem(Msg, Filter)) Then Exit Sub
    Dim StartScene As Variant: StartScene = GetScene3D(GetViewPnt3D())
    
    'ｴﾝﾄﾞView
    Msg = "終了するﾋﾞｭｰの状態しに、何かｸﾘｯｸしてください(ESC/中止)"
    If IsNothing(SelectItem(Msg, Filter)) Then Exit Sub
    Dim EndScene As Variant: EndScene = GetScene3D(GetViewPnt3D())
    
    'ｱﾆﾒｰｼｮﾝ開始
    Call UpdateScene(StartScene)
    Dim SceneSpeed&: SceneSpeed = DefaultSpeed
    Dim IptSpeed As Variant
    Msg = "再生を開始します(再生中ESCｷｰでｽﾋﾟｰﾄﾞ再設定)" + vbNewLine _
        + "再生ｽﾋﾟｰﾄﾞを半角数字で入力して下さい" + vbNewLine _
        + "(大きいほど遅いです / 0以下 - 終了)"
    Do
        IptSpeed = InputBox(Msg, , SceneSpeed)
        If Not IsNumeric(IptSpeed) Then Exit Do
        SceneSpeed = CLng(IptSpeed)
        If SceneSpeed <= 0 Then Exit Do
        
        Call ShowAnimation(StartScene, EndScene, SceneSpeed)
    Loop
End Sub

'表示開始
Private Sub ShowAnimation(ByVal SScene As Variant, ByVal EScene As Variant, ByVal Speed&)
    '情報取得
    Dim AryCount&: AryCount = UBound(SScene)
    
    '増分
    Dim i&
    Dim Step() As Variant: ReDim Step(AryCount)
    For i = 0 To AryCount
        Step(i) = (EScene(i) - SScene(i)) / Speed
    Next
    
    '更新
    Dim j&
    Dim state() As Variant: ReDim state(AryCount)
    For i = 0 To Speed
        For j = 0 To AryCount
            state(j) = SScene(j) + (Step(j) * i)
        Next
        If CheckEvents Then 'ESCｷｰ
            Call UpdateScene(SScene)
            Exit For
        End If
        Call UpdateScene(state)
    Next
End Sub

'ESCｷｰ判定 -WinAPI GetInputState関数が機能しない
Private Function CheckEvents() As Boolean
    DoEvents
    CheckEvents = GetAsyncKeyState(vbKeyEscape)
End Function

'表示のUpdate
Private Sub UpdateScene(ByVal Scene As Variant)
    Dim Viewer As Viewer3D: Set Viewer = CATIA.ActiveWindow.ActiveViewer
    Dim VPnt3D As Variant 'Viewpoint3D '
    Set VPnt3D = Viewer.Viewpoint3D
    
    Dim Ary As Variant
    Ary = GetRangeAry(Scene, 0, 2)
    Call VPnt3D.PutOrigin(Ary)
    
    Ary = GetRangeAry(Scene, 3, 5)
    Call VPnt3D.PutSightDirection(Ary)
    
    Ary = GetRangeAry(Scene, 6, 8)
    Call VPnt3D.PutUpDirection(Ary)
    
    VPnt3D.FieldOfView = Scene(9)
    VPnt3D.FocusDistance = Scene(10)
    
    Call Viewer.Update
End Sub

'Viewpoint3Dからｼｰﾝ取得
Private Function GetScene3D(ViewPnt3D As Viewpoint3D) As Variant
    Dim vp As Variant: Set vp = ViewPnt3D
    
    Dim origin(2) As Variant: Call vp.GetOrigin(origin)
    
    Dim sight(2) As Variant: Call vp.GetSightDirection(sight)
    GetScene3D = JoinArray(origin, sight)
    
    Dim up(2) As Variant: Call vp.GetUpDirection(up)
    GetScene3D = JoinArray(GetScene3D, up)
    
    Dim FieldOfView(0) As Variant: FieldOfView(0) = vp.FieldOfView
    GetScene3D = JoinArray(GetScene3D, FieldOfView)
    
    Dim FocusDist(0) As Variant: FocusDist(0) = vp.FocusDistance
    GetScene3D = JoinArray(GetScene3D, FocusDist)
End Function

'現状の視点取得
Private Function GetViewPnt3D() As Viewpoint3D
    Set GetViewPnt3D = CATIA.ActiveWindow.ActiveViewer.Viewpoint3D
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

'Nothing 書き方に統一感が無い為
Private Function IsNothing(ByVal OJ As Variant) As Boolean
    IsNothing = OJ Is Nothing
End Function

'配列の連結
Private Function JoinArray(ByVal Ary1 As Variant, ByVal Ary2 As Variant)
    If Not IsArray(Ary1) Or Not IsArray(Ary2) Then Exit Function
    Dim StCount&: StCount = UBound(Ary1)
    ReDim Preserve Ary1(UBound(Ary1) + UBound(Ary2) + 1)
    Dim i&
    For i = StCount + 1 To UBound(Ary1)
        Ary1(i) = Ary2(i - StCount - 1)
    Next
    JoinArray = Ary1
End Function

'配列の抽出
Private Function GetRangeAry(ByVal Ary As Variant, StartIdx&, ByVal EndIdx&) As Variant
    If Not IsArray(Ary) Then Exit Function
    If EndIdx - StartIdx < 0 Then Exit Function
    If StartIdx < 0 Then Exit Function
    If EndIdx > UBound(Ary) Then Exit Function
    
    Dim RngAry() As Variant: ReDim RngAry(EndIdx - StartIdx)
    Dim i&
    For i = StartIdx To EndIdx
        RngAry(i - StartIdx) = Ary(i)
    Next
    GetRangeAry = RngAry
End Function

ﾏｸﾛ実行後、開始となる表示状態で何かをｸﾘｯｸ。　続いて終了となる
表示状態で何かをｸﾘｯｸ。　InputBoxが表示されるのでｽﾋﾟｰﾄﾞを入力
すると、開始から終了の状態までを入力した値分に分割して表示します。
(その為、大きい数値が遅く、小さい数値が速くなってしまっています)

CATIAの現在の表示状態は、ActiveViewer.Viewpoint3D(GetViewPnt3D関数)
での取得で、Viewpoint3Dｸﾗｽが直接関係しているようです。

GetScene3D関数の部分で、細かな数値を取得しているのですが、
Viewpoint3Dｸﾗｽの「GetOrigin」「GetSightDirection」「GetUpDirection」
「FieldOfView「FocusDistance」の5つ(配列として保持しているので11個)
だけ取得しているのですが、まだ何か必要なのかなぁ？

ｽﾋﾟｰﾄﾞが遅すぎるとｲﾗｲﾗするので、表示中にESCｷｰを押すとｽﾋﾟｰﾄﾞの
再設定が可能になるようにしました。　CheckEvents関数部分が
それに該当しているのですが、こちらのｻｲﾄを参考にWinAPIの
GetInputState関数を利用したかったのですが