woodrow.fields

set prasterprops issue when using a userform

Discussion created by woodrow.fields on Sep 21, 2011
Hello, I have run into an interesting problem.  I am trying loop through rasters to see if a raster intersects a polygon by looking at their extents.  If they don't intersect, I delete the raster.  Otherwise, I clip it and mosaic it.  The rasters are in .tif format. 

when the code sets the raster properties the first time things are ok, but on the second iteration through the loop setting the raster properties the program just starts spinning its wheels and doesn't throw an error or continue.

All of this is done through a form..so when they press Go, the macro is invoked.  Oddly enough, if I run the script as just a macro it works fine.  Are there any thoughts?  I don't understand why it wouldn't work through a form and it works as a stand alone macro.

I would use extract by mask but the tool changes the format of the tif making it un-usable in the program I am importing to.  Copy raster seems to work though for some reason.  So I copy the .tif with the extent of the polygon.  Code snippet below.  Any help would be greatly appreciated.

Dim pFWS As IFeatureWorkspace
Dim pWSF As IWorkspaceFactory
Set pWSF = New ShapefileWorkspaceFactory
Set pFWS = pWSF.OpenFromFile(impact_area_path, 0)

Dim pfeatureclass As IFeatureClass
Set pfeatureclass = pFWS.OpenFeatureClass(impact_area)

Dim pfeature As IFeature
Set pfeature = pfeatureclass.GetFeature(0)
L = pfeature.Extent.LowerLeft.X
b = pfeature.Extent.LowerLeft.Y
R = pfeature.Extent.LowerRight.X
T = pfeature.Extent.UpperLeft.Y
Dim ext As String
ext = L & " " & b & " " & R & " " & T
'gp.Extent = "" 'left, bottom, right, top

Dim pRWS As IRasterWorkspace
Set pWSF = New RasterWorkspaceFactory
Set pRWS = pWSF.OpenFromFile(OutDir, 0)
Dim pRaster As IRaster
Dim prastprops As IRasterProps

Dim intLoop As Integer
For intLoop = 0 To paths.ListCount - 1
gp.ProjectRaster_management paths.List(intLoop, 0), OutDir & "\" & "a_" & intLoop & "_P.tif", cs, "NEAREST", "", "NAD_1983_To_WGS_1984_1", "", ""
Next

gp.Extent = ext 'left, bottom, right, top
'have to mosaic one at a time to make sure that it actually works.
i = 1
For intLoop = 0 To paths.ListCount - 1
    Set pRaster = pRWS.OpenRasterDataset("a_" & intLoop & "_P.tif").CreateDefaultRaster
''''''''''''''this is where the problem arises when intLoop = 1''''''''''''''''''
    Set prastprops = pRaster
'
    L1 = prastprops.Extent.LowerLeft.X
    b1 = prastprops.Extent.LowerLeft.Y
    R1 = prastprops.Extent.UpperRight.X
    T1 = prastprops.Extent.UpperRight.Y
    Projected = OutDir & "\a_" & intLoop & "_P.tif"
    Clipped = OutDir & "\a_" & intLoop & "_C.tif"
    If L1 >= R Or T1 <= b Or b1 >= T Or R1 <= L Then
        gp.Delete_management Projected, "RasterDataset"
    Else
        gp.CopyRaster_management Projected, Clipped, "", "", "", "NONE", "NONE", ""
        If i = 1 Then
            gp.MosaicToNewRaster_management Clipped, OutDir & "\", Name, "", "8_BIT_UNSIGNED", "", "1", "MAXIMUM", "FIRST"
        Else
            gp.mosaic_management Clipped, OutDir & "\" & Name, "MAXIMUM", "FIRST", "", "", "NONE", "0", "NONE"
        End If
        gp.Delete_management Clipped, "RasterDataset"
        gp.Delete_management Projected, "RasterDataset"
        i = i + 1
    End If
    Set pRaster = Nothing
    Set prastprops = Nothing
Next

Outcomes