Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
Dim pFeatureLayer As IFeatureLayer
Dim pRasterLayer As IRasterLayer
Set pFeatureLayer = pMap.Layer(0)
Set pRasterLayer = pMap.Layer(1)
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = pFeatureLayer.FeatureClass
Dim pInputRaster As IRaster
Set pInputRaster = pRasterLayer.Raster
Dim pInputDataset As IGeoDataset
Set pInputDataset = pInputRaster
Dim pFeatureCursor As IFeatureCursor
Set pFeatureCursor = pFeatureClass.Search(Nothing, False)
Dim pFeature As IFeature
Set pFeature = pFeatureCursor.NextFeature
Dim pFields As IFields
Set pFields = pFeatureClass.Fields
Dim index As Long
index = pFields.FindField("name")
Dim pPolygon As IPolygon
Dim clipRaster As IRaster
Dim pWKSF As IWorkspaceFactory
Set pWKSF = New RasterWorkspaceFactory
Dim pWS As IWorkspace
Set pWS = pWKSF.OpenFromFile("F:\", 0)
Dim pSaveAs As ISaveAs
Do Until pFeature Is Nothing
Set pPolygon = pFeature.Shape
Set clipRaster = ClipRasterByPolgon(pInputDataset, pPolygon)
Set pSaveAs = clipRaster
pSaveAs.SaveAs pFeature.Value(index), pWS, "TIFF"
Set pFeature = pFeatureCursor.NextFeature
Loop
MsgBox "done!"
End Sub
Public Function ClipRasterByPolgon(pInGeoDataset As IGeoDataset, pPolygon As IPolygon) As IRaster
Dim pRaster As IRaster
If TypeOf pInGeoDataset Is IRasterLayer Then
Dim pRasterLayer As IRasterLayer
Set pRasterLayer = pInGeoDataset
Set pRaster = pRasterLayer.Raster
ElseIf TypeOf pInGeoDataset Is IRasterDataset Then
Dim pRasterDataset As IRasterDataset
Set pRasterDataset = pInGeoDataset
Set pRaster = pRasterDataset.CreateDefaultRaster
ElseIf TypeOf pInGeoDataset Is IRaster Then
Set pRaster = pInGeoDataset
Else
Exit Function
End If
Dim pInputDataset As IGeoDataset
Set pInputDataset = pRaster
Dim pExtractionOp As IExtractionOp
Set pExtractionOp = New RasterExtractionOp
Dim pRasterAnalysisEnvironment As IRasterAnalysisEnvironment
Set pRasterAnalysisEnvironment = pExtractionOp
pRasterAnalysisEnvironment.SetCellSize esriRasterEnvValue, GetRasterCellSize(pRaster)
pRasterAnalysisEnvironment.SetExtent esriRasterEnvValue, pPolygon.Envelope
Dim pOutputDataset As IGeoDataset
Set pOutputDataset = pExtractionOp.Polygon(pInputDataset, pPolygon, True)
Set ClipRasterByPolgon = pOutputDataset
End Function
Public Function GetRasterCellSize(pRaster As IRaster) As Double
Dim pProps As IRasterProps
Set pProps = pRaster
GetRasterCellSize = pProps.MeanCellSize.X
End Function
1、 红色代码处理解不是太清楚
2、有时候回报C盘temp下的什么错误，通过找到合适的机子和合适操作系统可以解决
