TinToRaster转换问题
我使用AriGIS9.2 Ao中提供的例子,将Tin转换为Raster,但是结果栅格值总是全部为0.经过分析,ITinSu易做图ce中QueryBlockPixel返回的Block数组中的值为0。
这个问题我都困惑了好久了,请高手指点一下。急!
--------------------编程问答-------------------- lz要干嘛? --------------------编程问答-------------------- 不知,帮顶 --------------------编程问答-------------------- ' Supported pixel types limited to float and long because output currently limited to native ESRI Grid
Public Function TinToRaster(pTin As ITinAdvanced, eRastConvType As esriRasterizationType, _
sDir As String, sName As String, ePixelType As rstPixelType, cellsize As Double, pExtent As IEnvelope, _
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 all the TIN's data area.
Dim pOrigin As IPoint
Set 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 = Round(pExtent.Width / cellsize) + 1
nRow = Round(pExtent.Height / cellsize) + 1
Dim pGDS As IGeoDataset
Set pGDS = pTin
Dim pSR As ISpatialReference2
Set pSR = pGDS.SpatialReference
Dim pRDS As IRasterDataset
Set pRDS = CreateRasterSurf(sDir, sName, "GRID", pOrigin, nCol, nRow, cellsize, cellsize, ePixelType, pSR, bPerm)
Dim pRawPixels As IRawPixels
Set pRawPixels = GetRawPixels(pRDS, 0)
' TODO - this implementation is allocating one block for the entire extent. It may be resource
' intensive. A more resource friendly implementation would use a smaller block size and iterate.
Dim pBlockSize As IPnt
Set pBlockSize = New DblPnt
pBlockSize.X = nCol
pBlockSize.Y = nRow
Dim pPixelBlock As IPixelBlock
Set pPixelBlock = pRawPixels.CreatePixelBlock(pBlockSize)
Dim val
val = pPixelBlock.SafeArray(0)
Dim pTinSurf As ITinSu易做图ce
Set pTinSurf = pTin
Dim pRasterProps As IRasterProps
Set pRasterProps = pRawPixels
Dim nodataFloat As Single
Dim nodataInt As Long
' QueryPixelBlock takes an origin representing the upper left cell center.
' Calculate that cell center's position here.
pOrigin.X = pOrigin.X + (cellsize * 0.5)
pOrigin.Y = pOrigin.Y + (cellsize * nRow) - (cellsize * 0.5)
If (ePixelType = PT_FLOAT) Then
nodataFloat = pRasterProps.NoDataValue
pTinSurf.QueryPixelBlock pOrigin.X, pOrigin.Y, cellsize, cellsize, eRastConvType, nodataFloat, val
Else
nodataInt = pRasterProps.NoDataValue
pTinSurf.QueryPixelBlock pOrigin.X, pOrigin.Y, cellsize, cellsize, eRastConvType, nodataInt, val
End If
If pTin.ProcessCancelled Then GoTo Cancel
Dim pOffset As IPnt
Set pOffset = New DblPnt
pOffset.X = 0
pOffset.Y = 0
pRawPixels.Write pOffset, pPixelBlock
' need this for some reason with temporary integer grids
If (Not bPerm) And (ePixelType = PT_LONG) Then
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
Set pRDS = Nothing
Set pRawPixels = Nothing
Set pPixelBlock = Nothing
Set pRasterProps = Nothing
Set pRDS = OpenRasterDataset(sDir, sName)
End If
Set TinToRaster = pRDS
Exit Function
Cancel:
Set TinToRaster = Nothing
End Function
补充:企业软件 , 地理信息系统