已经困惑很久的问题（TinToRaster数据转换），请高手指点，不胜感激！

[xxbtop]

'***************************************
'*目的：Tin To Raster数据转换
'*输入：Tin数据
'*输出：Raster数据
'*日期：xxb/06/04/13
'***************************************
Imports ESRI.ArcGIS.Analyst3D
Imports ESRI.ArcGIS.SceneControl
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.DataSourcesFile
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.DataSourcesRaster
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.Framework
Imports stdole


Public Class Form1
Inherits System.Windows.Forms.Form
Private pGDS As IGeoDataset


#Region " Windows 窗体设计器生成的代码 "

Public Sub New()
MyBase.New()

'该调用是 Windows 窗体设计器所必需的。
InitializeComponent()

'在 InitializeComponent() 调用之后添加任何初始化

End Sub

'窗体重写 dispose 以清理组件列表。
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub

'Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer

'注意: 以下过程是 Windows 窗体设计器所必需的
'可以使用 Windows 窗体设计器修改此过程。
'不要使用代码编辑器修改它。
Friend WithEvents Button1 As System.Windows.Forms.Button
Friend WithEvents AxSceneControl1 As AxesriSceneControl.AxSceneControl
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
Me.Button1 = New System.Windows.Forms.Button
Me.AxSceneControl1 = New AxesriSceneControl.AxSceneControl
CType(Me.AxSceneControl1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'Button1
'
Me.Button1.Location = New System.Drawing.Point(136, 8)
Me.Button1.Name = "Button1"
Me.Button1.Size = New System.Drawing.Size(280, 24)
Me.Button1.TabIndex = 0
Me.Button1.Text = "TinToRaster"
'
'AxSceneControl1
'
Me.AxSceneControl1.Location = New System.Drawing.Point(8, 40)
Me.AxSceneControl1.Name = "AxSceneControl1"
Me.AxSceneControl1.OcxState = CType(resources.GetObject("AxSceneControl1.OcxState"), System.Windows.Forms.AxHost.State)
Me.AxSceneControl1.Size = New System.Drawing.Size(544, 368)
Me.AxSceneControl1.TabIndex = 1
'
'Form1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
Me.ClientSize = New System.Drawing.Size(560, 414)
Me.Controls.Add(Me.AxSceneControl1)
Me.Controls.Add(Me.Button1)
Me.Name = "Form1"
Me.Text = "Form1"
CType(Me.AxSceneControl1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)

End Sub

#End Region

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

'***************************************
'*目的：加载Tin类型地表数据
'***************************************
Dim pWorkspaceFactory As IWorkspaceFactory
Dim pWorkspace As ITinWorkspace
pWorkspaceFactory = New TinWorkspaceFactory
pWorkspace = pWorkspaceFactory.OpenFromFile("F:\GisTestEnvi\DataSource\Data\Terraindata", 0)

'***************************************************************
'*目的：判断一个地表数据是不是tin,定义TinToRaster()函数的tin数据
'***************************************************************
Dim pTin As ITinAdvanced
If pWorkspace.IsTin("tin1") Then
pTin = pWorkspace.OpenTin("tin1")
End If

'定义TinToRaster()函数参数pExtent
pGDS = pTin
Dim pExtent As IEnvelope
pExtent = pGDS.Extent

'定义TinToRaster()函数参数eMethod
Dim eMethod As esriRasterizationType
eMethod = esriRasterizationType.esriDegreeAspectAsRaster

'定义TinToRaster()函数参数sDir,sName,cellsize
Dim sDir As String = "F:\GisTestEnvi\DataAim"
Dim sName As String = "data"
Dim cellsize As Double = 8.42

Dim pRDS As IRasterDataset
pRDS = TinToRaster(pTin, eMethod, sDir, sName, rstPixelType.PT_FLOAT, cellsize, pExtent, True)
MsgBox("ok")

'***************************************************************
'*目的：添加Raster数据到Arcsence控件上
'***************************************************************
Dim pSgraph As ISceneGraph
Dim pScene As IScene
pScene = AxSceneControl1.Scene
pSgraph = pScene.SceneGraph

' 打开Raster数据集取得Raster数据
Dim raster As IRaster = pRDS.CreateDefaultRaster()

' 添加Raster数据到Raster层上
Dim pRasterLayer As IRasterLayer
pRasterLayer = New RasterLayerClass
pRasterLayer.CreateFromRaster(raster)
' 不是Raster数据就返回
If pRasterLayer Is Nothing Then
Return
End If

pScene.ClearLayers()
pScene.AddLayer(pRasterLayer, True) '显示



End Sub

[xxbtop]

Public Function TinToRaster(ByVal pTin As ITinAdvanced, ByVal eRastConvType As esriRasterizationType, _
ByVal sDir As String, ByVal sName As String, ByVal ePixelType As rstPixelType, ByVal cellsize As Double, ByVal pExtent As IEnvelope, _
ByVal bPerm As Boolean) As IRasterDataset

' The origin used by CreateRasterDataset is the lower left cell corner.
' The extent passed is that of the TIN's.
' Define the raster origin and number of rows and columns so that the raster
' is of sufficient extent to capture area defined by passed envelope. The cell
' center is located at the origin.
Dim pOrigin As IPoint
pOrigin = pExtent.LowerLeft
pOrigin.x = pOrigin.x - (cellsize * 0.5)
pOrigin.y = pOrigin.y - (cellsize * 0.5)

Dim nCol As Long, nRow As Long
nCol = Int(pExtent.Width / cellsize) + 1
nRow = Int(pExtent.Height / cellsize) + 1

MsgBox(nCol)
MsgBox(nRow)


Dim pGDS As IGeoDataset
pGDS = pTin
Dim pSR As ISpatialReference2
pSR = pGDS.SpatialReference

Dim pRDS As IRasterDataset
pRDS = CreateRasterSurf(sDir, sName, "GRID", pOrigin, nCol, nRow, cellsize, cellsize, ePixelType, pSR, bPerm)

Application.DoEvents()

Dim pRawPixels As IRawPixels
pRawPixels = GetRawPixels(pRDS, 0)

Dim pCache As stdole.IUnknown
pCache = pRawPixels.AcquireCache

Dim pTinSurf As ITinSurface
pTinSurf = pTin

Dim pRasterProps As IRasterProps
pRasterProps = pRawPixels

Dim nodataFloat As Single
Dim nodataInt As Long

Dim dZMin As Double
dZMin = pTin.Extent.zmin

Dim vNoData As Object
If (ePixelType = rstPixelType.PT_FLOAT) Then
vNoData = CSng(dZMin - 1)
Else
vNoData = CLng(dZMin - 1)
End If

pRasterProps.NoDataValue = vNoData

Dim pOffset As IPnt
pOffset = New DblPnt

' Set blocksize. Restrict how large it is as not to consume too much memory for
' big output datasets.
Dim lMaxBlockX As Long
lMaxBlockX = 2048
If (nCol < lMaxBlockX) Then
lMaxBlockX = nCol
End If

Dim lMaxBlockY As Long
lMaxBlockY = 2048
If (nRow < lMaxBlockY) Then
lMaxBlockY = nRow
End If

Dim pBlockSize As IPnt
pBlockSize = New DblPnt
pBlockSize.X = lMaxBlockX
pBlockSize.Y = lMaxBlockY

Dim pPixelBlock As IPixelBlock3
pPixelBlock = pRawPixels.CreatePixelBlock(pBlockSize)

Dim blockArray As Object
blockArray = pPixelBlock.PixelDataByRef(0)

' Set up cancel tracking and progress bar
'Dim pCancel As ITrackCancel
'pCancel = New CancelTracker
'pCancel.CancelOnClick = False
'pCancel.CancelOnKeyPress = True
'Dim pApp As IApplication
'pApp = New AppRef
'Dim pProg As IStepProgressor
'pProg = pApp.StatusBar.ProgressBar
'pCancel.Progressor = pProg
'Dim lBlockCount As Long
'lBlockCount = Int((nCol / lMaxBlockX) + 0.49) * Int((nRow / lMaxBlockY) + 0.49)
'pProg.Message = "Rasterizing. Press ESC to cancel..."
'pProg.Position = 0
'If (lBlockCount = 1) Then ' tin querypixelblock can do the tracking/progressing with 1 block
' pProg.Show()
' pTin.TrackCancel = pCancel
'Else ' more than 1 block requires this routine, rather than tin function, to track/progress
' pProg.MinRange = 0
' pProg.MaxRange = lBlockCount
' pProg.StepValue = 1
' pProg.Show()
'End If
Application.DoEvents() ' make sure the bar and the text get updated on screen

Dim pBlockOrigin As IPoint
pBlockOrigin = New Point

Dim lColOffset As Long
Dim lRowOffset As Long

' Left to right, top to bottom, iteration of pixel blocks.
For lRowOffset = 0 To (nRow - 1) Step lMaxBlockY

For lColOffset = 0 To (nCol - 1) Step lMaxBlockX

' See if pixelblock needs to be resized in X for last column chunk.
' RawPixel.Write will clip the pixelblock if it's too big, so the resize
' isn't absolutely necessary, but resizing will eliminate unecessary
' effort for TIN's QueryPixelBlock.
If ((nCol - lColOffset) < lMaxBlockX) Then
pBlockSize.X = (nCol - lColOffset)
pPixelBlock = pRawPixels.CreatePixelBlock(pBlockSize)
blockArray = pPixelBlock.PixelDataByRef(0)
End If

' QueryPixelBlock takes an origin representing the upper left cell center.
' Calculate that cell center's position here. Calculate it based on the
' raster's origin (lower left) and current row/col offset.
pBlockOrigin.X = pOrigin.X + (lColOffset * cellsize) + (cellsize * 0.5)
pBlockOrigin.Y = pOrigin.Y + ((nRow - lRowOffset) * cellsize) - (cellsize * 0.5)

pTinSurf.QueryPixelBlock(pBlockOrigin.X, pBlockOrigin.Y, cellsize, cellsize, eRastConvType, vNoData, blockArray)

pOffset.X = lColOffset
pOffset.Y = lRowOffset

' The offset for 'write' is the upper left of the pixel block by col/row number.
' Base is 0.
pRawPixels.Write(pOffset, pPixelBlock)

'If (lBlockCount > 1) Then
' If (Not pCancel.Continue) Then GoTo Cancel
'Else
' If (pTin.ProcessCancelled) Then GoTo Cancel
'End If

Next lColOffset

' See if pixelblock size needs to be reset for columns
Dim bReset As Boolean
bReset = False
If (pBlockSize.X <> lMaxBlockX) Then
pBlockSize.X = lMaxBlockX
bReset = True
End If

' See if pixelblock size needs to be reset for rows
If ((nRow - lRowOffset) < lMaxBlockY) Then
pBlockSize.Y = (nRow - lRowOffset)
bReset = True
End If

If (bReset) Then
pPixelBlock = pRawPixels.CreatePixelBlock(pBlockSize)
blockArray = pPixelBlock.PixelDataByRef(0)
End If

Next lRowOffset

'pProg.Message = "Returning cache..."
pRawPixels.ReturnCache(pCache)
pCache = Nothing

' need this for some reason with temporary integer grids
'If (Not bPerm) And (ePixelType = PT_LONG) Then
' pProg.Message = "Stats..."
' Dim pBand As iRasterBand
' Set pBand = pRawPixels
' Dim pStats As IRasterStatistics
' Set pStats = pBand.Statistics
' pStats.Recalculate
'End If

'If (bPerm) Then
' flush edits to disk by freeing all pointers
'pProg.Message = "Freeing and opening..."
pRDS = Nothing
pRawPixels = Nothing
pPixelBlock = Nothing
pRasterProps = Nothing
blockArray = 0
pRDS = OpenRasterDataset(sDir, sName)
'End If

'pApp.StatusBar.HideProgressBar()

'If (lBlockCount = 1) Then
' pTin.TrackCancel = Nothing
'End If

TinToRaster = pRDS
Exit Function

Cancel:
'pApp.StatusBar.HideProgressBar()
TinToRaster = Nothing
End Function

[xxbtop]

'***************************************
'*目的：返回Raster数据集
'*输入：Raster数据路径和文件名
'***************************************
Public Function OpenRasterDataset(ByVal sDir As String, ByVal sName As String) As IRasterDataset
On Error GoTo EH
Dim pRW As IRasterWorkspace
pRW = OpenRasterWorkspace(sDir)
OpenRasterDataset = pRW.OpenRasterDataset(sName)
EH:
End Function
'***************************************
'*目的：返回Raster工作间
'*输入：Raster数据路径
'***************************************
Public Function OpenRasterWorkspace(ByVal sDir As String) As IRasterWorkspace
On Error GoTo EH
Dim pWF As IWorkspaceFactory
pWF = New RasterWorkspaceFactory
OpenRasterWorkspace = pWF.OpenFromFile(sDir, 0)
EH:
End Function
'***************************************
'*目的：返回IRawPixels
'*输入：Raster数据集
'***************************************
Public Function GetRawPixels(ByVal pRDS As IRasterDataset, ByVal band As Long) As IRawPixels
Dim pBandCollection As IRasterBandCollection
pBandCollection = pRDS

Dim pRasterBand As IRasterBand
pRasterBand = pBandCollection.Item(band)

GetRawPixels = pRasterBand
End Function
'***************************************
'*目的：创建Raster数据集
'*输入：Raster数据
'***************************************
Public Function CreateRasterSurf(ByVal sDir As String, ByVal sName As String, ByVal sFormat As String, _
ByVal pOrigin As IPoint, ByVal nCol As Long, ByVal nRow As Long, ByVal cellsizeX As Double, ByVal cellsizeY As Double, _
ByVal ePixelType As rstPixelType, ByVal pSR As ISpatialReference2, ByVal bPerm As Boolean) As IRasterDataset

Dim rWksFac As IWorkspaceFactory
rWksFac = New RasterWorkspaceFactory

Dim wks As IWorkspace
wks = rWksFac.OpenFromFile(sDir, 0)

Dim rWks As IRasterWorkspace2
rWks = wks

Dim numbands As Long
numbands = 1

Dim pRDS As IRasterDataset
pRDS = rWks.CreateRasterDataset(sName, sFormat, pOrigin, nCol, nRow, cellsizeX, cellsizeY, numbands, ePixelType, pSR, bPerm)

CreateRasterSurf = pRDS
End Function

End Class

[xxbtop]

所有代码都在上面，请路过的高手指点下错在那里，为什么转出来的数据是黑色一块？非常感激啊！！！！