[Visual Basic 6.0]
'
'   get the cumulative envelope\extent of each layer, and
'   add as a graphic:
'
Public Sub Add3DBoundingBoxForSelectedLayers()
  On Error GoTo AddExtentGraphicForSelectedLayers_ERR
  Dim pLayerArray As IArray
  
' return all selected layers:
  Set pLayerArray = GetDocLayers(True)
  
  If pLayerArray Is Nothing Then
    MsgBox "Please select at least one layer in the Table of Contents", , "Add 3D Bounding Box"
    Exit Sub
  End If
  
' QI for the scene:
  Dim pScene As IScene
  Set pScene = GetScene()
  
  Dim pLayer As ILayer
  Dim pExtent As IEnvelope
  Dim i As Integer
  Dim pPoly As IPointCollection
  Dim pPt As IPoint
  Dim xMin As Double, xMax As Double
  Dim yMin As Double, yMax As Double
  Dim zMin As Double, zMax As Double
  
' set flag that the first extent needs to be noted:
  Dim bStart As Boolean
  bStart = True
  
' for each layer, ask the scenegraph for it's 3D extent:
  For i = 0 To pLayerArray.Count - 1
  
    Set pLayer = pLayerArray.Element(i)
    Set pExtent = pScene.SceneGraph.OwnerExtent(pLayer, False)
    
  ' track the cumulative extent:
    If pExtent.xMax > xMax Or bStart Then xMax = pExtent.xMax
    If pExtent.xMin < xMin Or bStart Then xMin = pExtent.xMin
    If pExtent.yMax > yMax Or bStart Then yMax = pExtent.yMax
    If pExtent.yMin < yMin Or bStart Then yMin = pExtent.yMin
    If pExtent.zMax > zMax Or bStart Then zMax = pExtent.zMax
    If pExtent.zMin < zMin Or bStart Then zMin = pExtent.zMin
    
  ' only track if outside the currently stored envelope:
    bStart = False
    
  Next
  
' build a 3D flat polygon:
  Set pPoly = New Polygon
  Set pPt = New Point
  
' set the ZAware flag so the polygon can store Z's
  Dim pZAware As IZAware
  Set pZAware = pPoly
  pZAware.ZAware = True
  
' add the points of the 'footprint':
  Set pPt = New Point
  pPt.X = xMin
  pPt.Y = yMin
  pPt.Z = zMin
  pPoly.AddPoint pPt
  
  Set pPt = New Point
  pPt.X = xMin
  pPt.Y = yMax
  pPt.Z = zMin
  pPoly.AddPoint pPt
  
  Set pPt = New Point
  pPt.X = xMax
  pPt.Y = yMax
  pPt.Z = zMin
  pPoly.AddPoint pPt
  
  Set pPt = New Point
  pPt.X = xMax
  pPt.Y = yMin
  pPt.Z = zMin
  pPoly.AddPoint pPt
  
' close the polygon geometry:
  Dim pPolygon As IPolygon
  Set pPolygon = pPoly
  pPolygon.Close
  
' construct a multipatch from the footprint to the zMax height:
  Dim pMultipatch As IMultiPatch
  Set pMultipatch = New MultiPatch
  Dim pMC As IConstructMultiPatch
  Set pMC = pMultipatch
  
  pMC.ConstructExtrudeAbsolute zMax, pPoly
  
' create a new 3D graphics layer, add our multipatch element to it,
' and set the transparancy so the bounding box does not hide the
' features inside of it:
  Dim pGLayer As IGraphicsLayer
  Set pGLayer = AddNew3DGraphicsLayer("layer bounding box")
  Dim pLayerEffects As ILayerEffects
  Set pLayerEffects = pGLayer
  pLayerEffects.Transparency = 27
  
' finally, add the graphic element to the graphics layer:
  AddGraphic pMultipatch, , , , , pGLayer
  
  Exit Sub
    
AddExtentGraphicForSelectedLayers_ERR:
  MsgBox "AddExtentGraphicForSelectedLayers_ERR: " & Err.Description
  Debug.Assert 0
    
End Sub

'   Add graphic to passed application. App needs to be ArcMap or ArcScene. If ArcMap, the graphic
'   is added to the BasicGraphicsLayer of the ActiveView FocusMap. If ArcScene, the graphic is
'   added to the BasicGraphicsLayer of the scene, unless the graphics container is passed in.
'
Private Sub AddGraphic(pGeom As IGeometry, Optional pSym As ISymbol, Optional bAddToSelection As Boolean = False, Optional bRefresh As Boolean, Optional sElementName As String, Optional pGC3D As IGraphicsContainer3D)
  On Error GoTo EH
    
  If (pGeom.IsEmpty) Then
      Exit Sub
  End If
  Dim pElemProps As IElementProperties
  Dim pElement As IElement
  Dim pFillElement As IFillShapeElement
  
  Select Case pGeom.GeometryType
  Case esriGeometryPoint
    Set pElement = New MarkerElement
    Dim pPointElement As IMarkerElement
    Set pPointElement = pElement
    If (Not pSym Is Nothing) Then
      pPointElement.Symbol = pSym
    Else
      pPointElement.Symbol = GetDefaultSymbol(esriGeometryPoint)
    End If
  Case esriGeometryPolyline
    Set pElement = New LineElement
    Dim pLineElement As ILineElement
    Set pLineElement = pElement
    If (Not pSym Is Nothing) Then
      pLineElement.Symbol = pSym
    Else
      pLineElement.Symbol = GetDefaultSymbol(esriGeometryPolyline)
    End If
  Case esriGeometryPolygon
    Set pElement = New PolygonElement
    
    Set pFillElement = pElement
    If (Not pSym Is Nothing) Then
      pFillElement.Symbol = pSym
    Else
      pFillElement.Symbol = GetDefaultSymbol(esriGeometryPolygon)
    End If
    
  Case esriGeometryMultiPatch
    Set pElement = New MultiPatchElement
    
    Set pFillElement = pElement
    If (Not pSym Is Nothing) Then
      pFillElement.Symbol = pSym
    Else
      pFillElement.Symbol = GetDefaultSymbol(esriGeometryMultiPatch)
    End If
    
  End Select
    
  pElement.Geometry = pGeom
  
  Dim pGLayer As IGraphicsLayer
  If (TypeOf Application Is IMxApplication) Then
      Dim pMxDoc As IMxDocument
      Set pMxDoc = Application.Document
      
      Dim pActiveView As IActiveView
      Set pActiveView = pMxDoc.ActiveView
      
      Set pGLayer = pMxDoc.FocusMap.BasicGraphicsLayer
      
      Dim pGCon As IGraphicsContainer
      Set pGCon = pGLayer
      
      If Len(sElementName) > 0 Then
          
          Set pElemProps = pElement
          pElemProps.Name = sElementName
      End If
      
      pGCon.AddElement pElement, 0
  
      Dim pGCS As IGraphicsContainerSelect
      Set pGCS = pGCon
      If bAddToSelection Then
    '   unselect all other elements before selecting this one
          pGCS.UnselectAllElements
          pGCS.SelectElement pElement
      End If
      
    
'   redraw graphics for entire view extent, rather than just extent of this element, in case there were'   other graphics present that became unselected and lost their selection handles
      pActiveView.PartialRefresh esriViewGraphics, pElement, pActiveView.Extent
  Else
  
    Dim pSxDoc As ISxDocument
    Set pSxDoc = Application.Document
    
    Dim pGCon3D As IGraphicsContainer3D
    
    If pGC3D Is Nothing Then
      Set pGLayer = pSxDoc.Scene.BasicGraphicsLayer
      Set pGCon3D = pGLayer
    Else
      Set pGCon3D = pGC3D
    End If
    
    If Len(sElementName) > 0 Then
      Set pElemProps = pElement
      pElemProps.Name = sElementName
    End If
    pGCon3D.AddElement pElement
  End If
  
  If bRefresh Then
    RefreshDocument
  End If
  
  Exit Sub
  
EH:
    Debug.Print "AddGraphic_ERR: " & Err.Description
    Debug.Assert 0
    Resume Next
    
End Sub
'
'   given type of passed in IApplication and geometry type, return the default symbol
'
Private Function GetDefaultSymbol(eType As esriGeometryType) As ISymbol
  On Error GoTo EH
  
  Dim pDefaults As IBasicDocumentDefaultSymbols
  Dim pSym As ISymbol
  
  If (TypeOf Application Is IMxApplication) Then
    Dim pMxDoc As IMxDocument
    Set pMxDoc = Application.Document
    Set pDefaults = pMxDoc
  Else
    Dim pSxDoc As ISxDocument
    Set pSxDoc = Application.Document
    Set pDefaults = pSxDoc
  End If
  
  Select Case eType
    Case esriGeometryPoint
      Set pSym = pDefaults.MarkerSymbol
    Case esriGeometryPolyline
      Set pSym = pDefaults.LineSymbol
    Case esriGeometryPolygon, esriGeometryMultiPatch
      Set pSym = pDefaults.FillSymbol
  End Select
  
  Set GetDefaultSymbol = pSym
  
  Exit Function
  
EH:
  Debug.Print "GetDefaultSymbol_ERR: " & Err.Description
  Debug.Assert 0
    
End Function
'
'   return an IEnumLayer of layers in current document
'
Private Function GetDocLayers(Optional bOnlySelected As Boolean) As IArray
  Dim pSxDoc As ISxDocument
  Dim pMxDoc As IMxDocument
  Dim pTOC  As IContentsView
  Dim i As Integer
  Dim pScene As IScene
  Dim ppSet As ISet
  Dim p
  Dim pLayers As IArray
  Dim pLayer As ILayer
  
  On Error GoTo GetDocLayers_ERR
  If TypeOf Application.Document Is ISxDocument Then
    Set pSxDoc = Application.Document
    Set pScene = pSxDoc.Scene
    
    If Not bOnlySelected Then
      Set pLayers = New esriSystem.Array
      For i = 0 To pScene.LayerCount - 1
        pLayers.Add pScene.Layer(i)
      Next
      Set GetDocLayers = pLayers
      Exit Function
    Else
      Dim pSxTOC As ISxContentsView
      Set pSxTOC = pSxDoc.ContentsView(0)
    End If
      
  ElseIf TypeOf Application.Document Is IMxDocument Then
    Set pMxDoc = Application.Document
    
    If Not bOnlySelected Then
      Set pLayers = New esriSystem.Array
      For i = 0 To pMxDoc.FocusMap.LayerCount - 1
        pLayers.Add pMxDoc.FocusMap.Layer(i)
      Next
      Set GetDocLayers = pLayers
      Exit Function
    Else
      Set pTOC = pMxDoc.ContentsView(0)
    End If
      
  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
  
  If pLayers.Count > 0 Then
    Set GetDocLayers = pLayers
  End If
  
  Exit Function
    
GetDocLayers_ERR:
  Debug.Print "GetDocLayers_ERR: " & Err.Description
  Debug.Assert 0
End Function
'
'   return the IScene of the current app
'
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
'
' create a new named graphics layer and add to the document
'
Public Function AddNew3DGraphicsLayer(Optional sName As String) As IGraphicsLayer
  
  On Error Resume Next
  
  Dim pGLayer As IGraphicsLayer
  Set pGLayer = New GraphicsLayer3D
  Dim pLayer As ILayer
  Set pLayer = pGLayer
  
  If Len(sName) < 1 Then
    pLayer.Name = InputBox("Name of New Graphics Layer?", "Graphics Layer", "Graphics")
  Else
    pLayer.Name = sName
  End If
  Dim pSxDoc As ISxDocument
  Set pSxDoc = ThisDocument
  pSxDoc.AddLayer pGLayer
  Set AddNew3DGraphicsLayer = pGLayer
  
End Function

[Visual Basic .NET, C#, C++]
No example is available for Visual Basic .NET, C#, or C++. To view a Visual Basic 6.0 example, click the Language Filter button in the upper-left corner of the page.