How to display the scene with suggested exaggeration

In 3D Analyst, a suggested exaggeration factor can be calculated by the scene. This factor is determined by the extents of the data currently in the scene. This macro will retrieve this suggested factor from the scene, apply it, and refresh the scene.

How to use

Copy and paste the following code into an ArcScene VBA session and call the macro 'DisplaySceneWithSuggestedExaggeration'.

[VBA]


        ' ask the scene for the suggested exaggeration factor, and implement it
'

Public Sub DisplaySceneWithSuggestedExaggerationFactor()
    
    On Error GoTo SetExaggerationFactorToSuggested_ERR
    
    Dim pScene As IScene
    Dim nFactor As Double
    Dim nAspectRatio As Double
    
    ' only relavent in ArcScene:
    If Not InScene Then Exit Sub
    
    ' get factor:
    Set pScene = GetScene()
    nAspectRatio = 0.12 ' use the same default as ArcScene
    pScene.SuggestExaggerationFactor nAspectRatio, nFactor
    
    ' set suggested factor:
    pScene.ExaggerationFactor = nFactor
    
    ' refresh scene:
    RefreshDocument
    
    Exit Sub
    
SetExaggerationFactorToSuggested_ERR:
    Debug.Print "SetExaggerationFactorToSuggested_ERR: " & Err.Description
    Debug.Assert 0
    
End Sub

'
' return true if application is ArcScene
'

Private Function InScene() As Boolean
    
    On Error Resume Next
    If TypeOf Application Is ISxApplication Then
        InScene = True
    Else
        InScene = False
    End If
    
    
End Function


Public Sub RefreshDocument(Optional bInvalidateSelection As Boolean)
    
    On Error GoTo RefreshDocument_ERR
    
    Dim pSxDoc As ISxDocument
    Set pSxDoc = Application.Document
    pSxDoc.Scene.SceneGraph.RefreshViewers
    
    Exit Sub
    
RefreshDocument_ERR:
    Debug.Print "RefreshDocument_ERR: " & Err.Description
    Debug.Assert 0
    
End Sub

'
' return the IScene of the current app if it is found
'

Private Function GetScene() As IScene
    On Error GoTo eh
    
    Dim pSxDoc As ISxDocument
    
    If Not TypeOf Application Is ISxApplication Then Exit Function
    
    Set pSxDoc = Application.Document
    Set GetScene = pSxDoc.Scene
    
    Exit Function
    
eh:
    
End Function