Viewpoint3Dで表示を動かす2

こちらのｺﾒﾝﾄで御質問頂いた "画面中心に表示させる"
方法のｻﾝﾌﾟﾙです。
ｸﾘｯｸした面に法線を作成する - C#ATIA

と言っても、過去にﾃｽﾄしたｺｰﾄﾞを64bitで動くように
修正しただけなのですが･･･
Viewpoint3Dで表示を動かす - C#ATIA

'vba test_Viewpoint3D ver0.0.2
'3Dｶﾒﾗのﾃｽﾄ

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Private Const DefaultSpeed = 5000

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&
    Dim IptSpeed As Variant: IptSpeed = DefaultSpeed
    Msg = "再生を開始します(再生中ESCｷｰでｽﾋﾟｰﾄﾞ再設定)" + vbNewLine _
        + "再生ｽﾋﾟｰﾄﾞを半角数字で入力して下さい" + vbNewLine _
        + "(大きいほど遅いです / 0以下 - 終了)"
    Do
        IptSpeed = InputBox(Msg, , IptSpeed)
        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

Viewer3Dｸﾗｽ内のViewpoint3Dﾌﾟﾛﾊﾟﾃｨを操作することになります。
正確に細かな事はわかっておりませんが
・中心となる座標値
・向く方向の3Dﾍﾞｸﾄﾙ
・上方向となる3Dﾍﾞｸﾄﾙ
を調整する事で上記のﾏｸﾛを実行しています。

このﾏｸﾛ自体が役立つとは思えませんが、実際に実行した際は
このような感じになります。