TIN TO RASTER

 

 

 

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 ITinSurface
    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