Как правильно программно создать растр?
Во первых растр не создается?
Во вторых, ... см. ниже
В чем ошибка?
Private Sub cmdSpline_Click()
Dim pIOP As IInterpolationOp
Set pIOP = New RasterInterpolationOp
Dim pGeoDS As IGeoDataset, pInputGDS As IGeoDataset
Dim pOrigin As IPoint, nCols As Long, nRows As Long, _
nCellX As Double, nCellY As Double
Dim pSR As ISpatialReference, pEnv As IEnvelope
Set pEnv = pPL.AreaOfInterest ' точешный слой
nCellX = 12
nCellY = 12
nCols = pEnv.Width / nCellX
nRows = pEnv.Height / nCellY
Set pSR = GetLayerSourceSpatialRef(pPL)
Set pOrigin = pEnv.LowerLeft
Set pGeoDS = CreateRasterDS(sPLPath, "spline1", "tiff", pOrigin, _
nCols, nRows, nCellX, nCellY, PT_DOUBLE, pSR)
Set pGeoDS = CreateRasterSurf(sPLPath, "spline1", "tiff", pOrigin, _
nCols, nRows, nCellX, nCellY, PT_DOUBLE, pSR, True)
Set pInputGDS = pPL
' Во вторых, ... след. строка сообщает "Cold not get featureclass"
Set pGeoDS = pIOP.Spline(pInputGDS, esriGeoAnalysisTensionSpline, 5, 50)
MsgBox "finish!!!"
End Sub
Public Function CreateRasterSurf(sDir As String, sName As String, sFormat As String, _
pOrigin As IPoint, nCol As Long, nRow As Long, cellsizeX As Double, cellsizeY As Double, _
ePixelType As rstPixelType, pSR As ISpatialReference2, bPerm As Boolean) As IRasterDataset
Dim rWksFac As IWorkspaceFactory
Set rWksFac = New RasterWorkspaceFactory
Dim wks As IWorkspace
Set wks = rWksFac.OpenFromFile(sDir, 0)
Dim rWks As IRasterWorkspace2
Set rWks = wks
Dim numbands As Long
numbands = 1
Dim pRDS As IRasterDataset
Set pRDS = rWks.CreateRasterDataset(sName, sFormat, pOrigin, nCol, nRow, cellsizeX, cellsizeY, numbands, ePixelType, pSR, bPerm)
Set CreateRasterSurf = pRDS
End Function
Public Function CreateRasterDS(ByVal sDir As String, ByVal sName As String, _
sType As String, pOrigin As IPoint, nCols As Long, nRows As Long, _
nCellX As Double, nCellY As Double, eRSTPixelType As rstPixelType, _
Optional pSR As ISpatialReference, Optional nNumBands = 1, _
Optional bIsPermanent As Boolean = True) As IRasterDataset
On Error GoTo CreateRasterDS_ERR
' Create RasterWorkspace
Dim pRWS As IRasterWorkspace2
Dim pWSF As IWorkspaceFactory
Set pWSF = New RasterWorkspaceFactory
Dim sParentDir As String
Dim sSubDir As String
If Right(sDir, 1) = "\" Then sDir = Mid(sDir, 1, Len(sDir) - 1)
sParentDir = priv_FileDir(sDir)
sSubDir = priv_FileName(sDir)
Dim pPropSet As IPropertySet
Dim pWSName As IWorkspaceName
Dim pName As IName
If Right(sParentDir, 1) <> "\" Then sParentDir = sParentDir & "\"
Set pName = pWSF.Create(sParentDir, sSubDir, pPropSet, 0)
Set pRWS = pName.Open()
Dim pRDS As IRasterDataset
Dim pSRef As ISpatialReference
If Not pSR Is Nothing Then
Set pSRef = pSR
Else
Set pSRef = New UnknownCoordinateSystem
End If
Dim pDelRDS As IDataset
Set pDelRDS = pRWS.OpenRasterDataset(sName)
If Not pDelRDS Is Nothing Then pDelRDS.Delete
Set pRDS = pRWS.CreateRasterDataset(sName, sType, pOrigin, nCols, nRows, nCellX, nCellY, nNumBands, eRSTPixelType, pSRef, bIsPermanent)
Set CreateRasterDS = pRDS
Exit Function
CreateRasterDS_ERR:
Debug.Print Err.Description
Resume Next
End Function
