How to display the extent of selected layers

This function calculates an envelope around the extent of selected layers in the scene's Table of Contents, and displays a message box with the extent boundary coordinates. The intent of this sample is to demonstrate programmatic interaction with layer properties.
How to use

Copy and paste the following code into an ArcScene VBA session and call the macro 'DisplayExtentOfSelectedLayers'.
[VBA]

        ' Declare module level variables

Private m_SxDoc As ISxDocument
Private m_Scene As IScene

' display a message box containing the x, y, and z extents
'

Public Sub DisplayExtentOfSelectedLayers()
    
    On Error GoTo DisplayExtentOfSelectedLayers_ERR
    
    ' Set the variables
    SetVariables
    
    Dim pLayerArray As IArray
    
    ' get the selected layers; exit if there are none:
    Set pLayerArray = GetDocLayers(True)
    If pLayerArray Is Nothing Then Exit Sub
    If pLayerArray.Count < 1 Then Exit Sub
    
    Dim i As Integer
    Dim pLayer As ILayer
    Dim xMax As Double, xMin As Double, yMin As Double, yMax As Double
    Dim zmax As Double, zmin As Double
    Dim pExtent As IEnvelope
    
    ' set the new extent boundary to the first one:
    Set pLayer = pLayerArray.Element(0)
    With pLayer.AreaOfInterest
        xMin = .xMin
        xMax = .xMax
        yMin = .yMin
        yMax = .yMax
        
        ' need to ask the scenegraph for the z information:
        Dim pSG As ISceneGraph
        Set pSG = m_Scene.SceneGraph
        Set pExtent = pSG.OwnerExtent(pLayer, False)
        zmax = pExtent.zmax
        zmin = pExtent.zmin
        
    End With
    
    For i = 1 To pLayerArray.Count - 1
        Set pLayer = pLayerArray.Element(i)
        With pLayer.AreaOfInterest
            If .xMax > xMax Then xMax = .xMax
            If .xMin < xMin Then xMin = .xMin
            If .yMax > yMax Then yMax = .yMax
            If .yMin < yMin Then yMin = .yMin
            
            If bInScene Then
                Set pExtent = m_Scene.SceneGraph.OwnerExtent(pLayer, False)
                If pExtent.zmax > zmax Then zmax = pExtent.zmax
                If pExtent.zmin < zmin Then zmin = pExtent.zmin
            End If
            
        End With
    Next
    
    Dim sMsg As String
    sMsg = "Extent of " & pLayerArray.Count & " selected layer(s):" & vbCrLf
    sMsg = sMsg & "===================" & vbCrLf
    sMsg = sMsg & "XMin: " & xMin & vbCrLf
    sMsg = sMsg & "XMax: " & xMax & vbCrLf
    sMsg = sMsg & "YMin: " & yMin & vbCrLf
    sMsg = sMsg & "YMax: " & yMax & vbCrLf
    sMsg = sMsg & "ZMin: " & zmin & vbCrLf
    sMsg = sMsg & "ZMax: " & zmax & vbCrLf
    sMsg = sMsg & "==================="
    MsgBox sMsg
    
    Exit Sub
    
DisplayExtentOfSelectedLayers_ERR:
    Debug.Print "DisplayExtentOfSelectedLayers_ERR: " & Err.Description
    Debug.Assert 0
    
End Sub

' Set the module level variables

Private Sub SetVariables()
    
    Set m_SxDoc = ThisDocument
    Set m_Scene = m_SxDoc.Scene
    
End Sub

'
' return an IEnumLayer of layers in current document
'

Private Function GetDocLayers(Optional bOnlySelected As Boolean) As IArray
    
    Dim pTOC As IContentsView
    Dim i As Integer
    Dim ppSet As ISet
    Dim p
    Dim pLayers As IArray
    Dim pLayer As ILayer
    
    On Error GoTo GetDocLayers_ERR
    
    Set GetDocLayers = New esriSystem.Array
    
    If Not bOnlySelected Then
        Set pLayers = New esriSystem.Array
        For i = 0 To m_Scene.LayerCount - 1
            pLayers.Add m_Scene.Layer(i)
        Next
        Set GetDocLayers = pLayers
        Exit Function
    Else
        Dim pSxTOC As ISxContentsView
        Set pSxTOC = m_SxDoc.ContentsView(0)
    End If
    
    If Not pTOC Is Nothing Then
        If IsNull(pTOC.SelectedItem) Then Exit Function
        Set p = pTOC.SelectedItem
    ElseIf Not pSxTOC Is Nothing Then
        If IsNull(pSxTOC.SelectedItem) Then Exit Function
        Set p = pSxTOC.SelectedItem
    End If
    
    Set pLayers = New esriSystem.Array
    
    If TypeOf p Is ISet Then
        Set ppSet = p
        ppSet.Reset
        For i = 0 To ppSet.Count
            Set pLayer = ppSet.Next
            If Not pLayer Is Nothing Then
                pLayers.Add pLayer
            End If
        Next
    ElseIf TypeOf p Is ILayer Then
        Set pLayer = p
        pLayers.Add pLayer
    End If
    
    Set GetDocLayers = pLayers
    
    Exit Function
    
GetDocLayers_ERR:
    Debug.Print "GetDocLayers_ERR: " & Err.Description
    Debug.Assert 0
    
End Function