Display Scene With Suggested Exaggeration

Created:12/6/2001
Description:

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:
  1. Copy and paste the following code into an ArcScene VBA session and call the macro 'DisplaySceneWithSuggestedExaggeration'.
'
' 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
  
  If TypeOf Application.Document Is ISxDocument Then
      Dim pSxDoc As ISxDocument
      Set pSxDoc = Application.Document
      pSxDoc.Scene.SceneGraph.RefreshViewers
  Else
      Dim pMxDoc As IMxDocument
      Set pMxDoc = Application.Document
      pMxDoc.ActiveView.Refresh
  End If
  
  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