Sub ExtractionOfRaster()
Dim app As IApplication
Set app = Application
Dim pMxDocument As IMxDocument
Set pMxDocument = Application.Document
Dim pMap As IMap
Set pMap = pMxDocument.FocusMap
Dim pFeatureLayer As IFeatureLayer
Set pFeatureLayer = pMap.Layer(0)
Dim pRasterLayer As IRasterLayer
Set pRasterLayer = pMap.Layer(1)
Dim pFeatureClass As IFeatureClass
Set pFeatureClass = pFeatureLayer.FeatureClass
Dim pPolygon As IPolygon
Set pPolygon = pFeatureClass.GetFeature(0).Shape
Dim pExtractionOp As IExtractionOp
Set pExtractionOp = New RasterExtractionOp
Dim pInputDataset As IGeoDataset
Set pInputDataset = pRasterLayer.Raster
Dim pOutputDataset As IGeoDataset
Set pOutputDataset = pExtractionOp.Polygon(pInputDataset, pPolygon, False) 'false表示保留shapefile以外的部分，ture表示保留shapefile以内的部分
Dim pWS As IWorkspace
Dim pWSF As IWorkspaceFactory
Set pWSF = New RasterWorkspaceFactory
Set pWS = pWSF.OpenFromFile("c:\temp", 0) '结果数据的输出目录
Dim pRWS As IRasterWorkspace2 ' 用来create rasterdataset
Set pRWS = pWS
Dim pSaveAs As ISaveAs
Set pSaveAs = pOutputDataset
Dim outdataset As IDataset
Set outdataset = pSaveAs.SaveAs("new2.tif", pRWS, "TIFF")
MsgBox "GOOD!"
End Sub