学步园

  ArcGIS Developer Help  (ESRI.ArcGIS.Analyst3D) 
'
'   format messagebox message with some properties of designated IRasterSurface::RasterBand
'
Public Sub DisplaySelectedRasterBandProperties()
  On Error GoTo DisplaySelectedRasterBandProperties_ERR
   
  Dim pLayer As ILayer
  Dim pSxDoc As ISxDocument
  Dim pMxDoc As IMxDocument
  ' get the document's selected raster layer:
  If TypeOf ThisDocument Is ISxDocument Then
    Set pSxDoc = ThisDocument
    Set pLayer = pSxDoc.SelectedLayer
  ElseIf TypeOf ThisDocument Is IMxDocument Then
    Set pMxDoc = ThisDocument
    Set pLayer = pMxDoc.SelectedLayer
  Else
    Exit Sub
  End If
  ' exit if a raster layer was not found:
  If pLayer Is Nothing Then
    MsgBox "Please select a raster layer in the Table of Contents."
    Exit Sub
  ElseIf Not TypeOf pLayer Is IRasterLayer Then
    MsgBox "Please select a raster layer in the Table of Contents."
    Exit Sub
  End If
 
  ' the name of the selected layer:
  Dim sRasterName As String
  sRasterName = pLayer.name
  ' Query Interface the IRasterLayer from the selected layer:
  Dim pRSurface As IRasterSurface
  Dim pRLayer As IRasterLayer
  Set pRLayer = pLayer
  Dim p3DProp As I3DProperties
  Dim pLE As ILayerExtensions
  Set pLE = pLayer
 
  ' look for 3D properties of layer:
  Dim i As Integer
  For i = 0 To pLE.ExtensionCount - 1
    If TypeOf pLE.Extension(i) Is I3DProperties Then
      Set p3DProp = pLE.Extension(i)
      Exit For
    End If
  Next
  ' We want the IRasterSurface of the layer;
  ' Look first for base surface of layer itself:
  If Not p3DProp Is Nothing Then
    Set pRSurface = p3DProp.BaseSurface
  End If
  ' if base surface of layer is not set, create the IRasterSurface from
  ' the first band of the raster:
  If pRSurface Is Nothing Then
    If Not pRLayer.Raster Is Nothing Then
      Set pRSurface = New RasterSurface
      Dim pBands As IRasterBandCollection
      Set pBands = pRLayer.Raster
      pRSurface.RasterBand = pBands.Item(0)
    End If
  End If
  Dim pRP As IRasterProps
  Dim pR As IRaster
  Dim pRB As IRasterBand
 
  ' Query Interface the raster band:
  Set pRB = pRSurface.RasterBand
  ' if no statistics have been created yet, call method to do this:
  If Not pRB.Statistics.IsValid Then
    pRB.Statistics.Recalculate
  End If
 
  ' QI back to the IRaster to get to certain properties:
  Set pR = pRB.RasterDataset.CreateDefaultRaster
  Set pRP = pR
 
  '  generate the summary message:
  Dim sMsg As String
  sMsg = sRasterName & ":" & vbCrLf
  sMsg = sMsg & "----------------------------------" & vbCrLf
  sMsg = sMsg & "MINIMUM (BAND 1): " & pRB.Statistics.Minimum & vbCrLf
  sMsg = sMsg & "MAXIMUM (BAND 1): " & pRB.Statistics.Maximum & vbCrLf
  sMsg = sMsg & "----------------------------------" & vbCrLf
  sMsg = sMsg & "XMIN: " & pRP.Extent.xMin & vbCrLf
  sMsg = sMsg & "XMAX: " & pRP.Extent.xMax & vbCrLf
  sMsg = sMsg & "YMIN: " & pRP.Extent.yMin & vbCrLf
  sMsg = sMsg & "YMAX: " & pRP.Extent.yMax & vbCrLf
  sMsg = sMsg & "----------------------------------" & vbCrLf
  sMsg = sMsg & "MEAN CELL SIZE X: " & pRP.MeanCellSize.x & vbCrLf
  sMsg = sMsg & "MEAN CELL SIZE Y: " & pRP.MeanCellSize.y & vbCrLf
  sMsg = sMsg & "HEIGHT: " & pRP.Height & vbCrLf
  sMsg = sMsg & "WIDTH: " & pRP.Width & vbCrLf
  sMsg = sMsg & "IS INTEGER: " & pRP.IsInteger & vbCrLf
 
  If Not pRP.SpatialReference Is Nothing Then
    sMsg = sMsg & "SPATIAL REFERENCE: " & pRP.SpatialReference.name & vbCrLf
  Else
    sMsg = sMsg & "SPATIAL REFERENCE: " & vbCrLf
  End If
  sMsg = sMsg & "----------------------------------" & vbCrLf
 
  ' display the resulting message:
  MsgBox sMsg, vbOKOnly, "Raster Properties"
   
  Exit Sub
DisplaySelectedRasterBandProperties_ERR:
  MsgBox "DisplaySelectedRasterBandProperties_ERR: " & err.Description
End Sub