Hi,I guess this should work. You can exclude killifexistsraster function if you want, because it deletes the output raster without warning when you try it again.Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pRasterLayer As IRasterLayer
Dim pRaster As IRaster
Dim pGeometryProc As IRasterGeometryProc
pMxDoc = My.ArcMap.Application.Document
pMap = pMxDoc.FocusMap
pRasterLayer = pMap.Layer(0)
pRaster = pRasterLayer.Raster
pGeometryProc = New RasterGeometryProc
pGeometryProc.Resample(rstResamplingTypes.RSP_NearestNeighbor, 7, pRaster)
Dim pDataset As IDataset
pDataset = pRasterLayer
Dim pWS As IWorkspace
pWS = pDataset.Workspace
Dim str As String
str = pWS.PathName
killifexistsRaster("try", str)
Dim RasterDataset As IRasterDataset
Dim pRasBandCol As IRasterBandCollection
pRasBandCol = pRaster
'pDS = pRasBandCol.SaveAs("try3", pWS, "GRID")
RasterDataset = pRasBandCol.SaveAs("try", pWS, "GRID")
'***********************************
Dim pRasterLy As IRasterLayer
pRasterLy = New RasterLayer
' pRasterLayer.CreateFromRaster(pRaster)
pRasterLy.CreateFromDataset(RasterDataset)
pMap.AddLayer(pRasterLy)
pMxDoc.ActiveView.Refresh()
'***********************************
SaveAsWithoutBuildingPyramids(pRaster)
End Sub
Sub SaveAsWithoutBuildingPyramids(ByVal pRaster As IRaster) 'Or as IRasterDataset)
killifexistsRaster("tryexp", "C:\temp")
Dim pSaveAs2 As ISaveAs2
pSaveAs2 = pRaster
Dim pStorageDef As IRasterStorageDef2
pStorageDef = New RasterStorageDef
pStorageDef.PyramidLevel = 0
Dim pWs As IWorkspace
pWs = SetRasterWorkspace("c:\temp")
pSaveAs2.SaveAs("try_exp", pWs, "GRID")
End Sub
Public Function SetRasterWorkspace(ByVal sPath As String) As IRasterWorkspace
Dim pWsFact As IWorkspaceFactory
pWsFact = New RasterWorkspaceFactory
SetRasterWorkspace = pWsFact.OpenFromFile(sPath, 0)
End Function
Public Function killifexistsRaster(ByVal RasterName As String, ByVal strFolder As String)
'''''' Delete raster from disk
Dim pRWSF As IWorkspaceFactory
pRWSF = New RasterWorkspaceFactory
Dim pRWS As IRasterWorkspace
pRWS = pRWSF.OpenFromFile(strFolder, 0)
Dim pRasterDS As IRasterDataset
On Error Resume Next
pRasterDS = pRWS.OpenRasterDataset(RasterName)
If Not pRasterDS Is Nothing Then
Dim pDS As IDataset
pDS = pRasterDS
If pDS.CanDelete Then pDS.Delete()
End If
System.IO.Directory.Delete(strFolder & "\" & RasterName, True)
DeleteFolder(strFolder & "\" & RasterName)
End Function
Public Function DeleteFolder(ByVal strPath As String) As Boolean
Dim objDir As New IO.DirectoryInfo(strPath)
Try
objDir.Delete(True)
Return True
Catch
Return False
End Try
End Function