Any help would be greatly appreciated. I've been staring at this code for a while and can't figure out what's wrong.
I'm trying to export a raster layer as a .tif file clipped to the extent of the dataframe. When I run the code I don't get any error messages, but the .tif file that it starts to generate grows to well over 1 gig and doesn't show any sign of stopping. When I export the data through ArcMap (right-click on raster layer and choose Data -> Export Data...) on the same extent, the resulting file is only a few megs. This makes me think that my code is trying to export the full extent of the layer instead of clipping it to the current visible extent. Any ideas on what I'm doing wrong?
Thanks, in advance.
Scott
P.S. "Setup" gets run with the OpenDocument event and "ExportToTif" gets run with a UI button.
| Code: |
Option Explicit
Private pAV As IActiveView
Private pRLExport As IRasterLayerExport
Private pWorkspace As IRasterWorkspace
Public Sub Setup()
' get layer
Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Set pAV = pMap 'QI
Dim pLayer As ILayer
Set pLayer = FindLayer("Aerials", pMap)
Dim pRasterLayer As IRasterLayer
Set pRasterLayer = pLayer
' get raster layer export coclass
Set pRLExport = New RasterLayerExport
Set pRLExport.RasterLayer = pRasterLayer
' get workspace
Dim pWsFact As IWorkspaceFactory
Set pWsFact = New RasterWorkspaceFactory
Set pWorkspace = pWsFact.OpenFromFile("C:\Temp", 0)
End Sub
Public Sub ExportToTif()
' set extent
pRLExport.Extent = pAV.Extent.Envelope
' export
Dim pRDataset As IRasterDataset
Set pRDataset = New RasterDataset
Set pRDataset = pRLExport.Export(pWorkspace, "testname.tif", "TIFF")
End Sub
Private Function FindLayer(strSearch As String, pMap As IMap) As ILayer
Dim intPosition As Integer
Dim strName As String
Dim i As Integer
Dim bFound As Boolean
'loop through all layers
For i = 0 To pMap.LayerCount - 1
strName = pMap.Layer(i).Name
If (strName = strSearch) Then
intPosition = i
bFound = True
End If
Next i
'check to see if layer was found
If Not bFound = True Then
MsgBox strSearch & " layer not found.", vbCritical, "Error"
Set FindLayer = Nothing
Exit Function
End If
'get layer
Set FindLayer = pMap.Layer(intPosition)
End Function
|