arcarc
路人甲
路人甲
  • 注册日期2004-01-16
  • 发帖数147
  • QQ
  • 铜币572枚
  • 威望0点
  • 贡献值0点
  • 银元0个
阅读:1698回复:1

[转帖]用Shapefile文件挖GRID文件

楼主#
更多 发布于:2004-04-10 10:24

    
 
   >> AO/MO开发  
  
用Shapefile文件挖GRID文件  
作者: wendy  
   
Sub CutRasByShp(sworkPath As String, pRasLyr As IRasterLayer, sShapeFileName As String, sGridFileName As String, pOutRas1 As IGeoDataset)
sworkPath:打开的GRID文件路径
pRasLyr:要运算的GRID文件IrasterLayer格式数据层
sShapeFileName:用于切GRID文件的Shape文件名
sGridFileName:切后的GRID文件名
pOutRas1:切后的GRID文件的IGeoDataset格式数据层

'用SHP文件挖GRID文件
Sub CutRasByShp(sworkPath As String, pRasLyr As IRasterLayer, sShapeFileName As String, sGridFileName As String, pOutRas1 As IGeoDataset)

Dim pWorkspaceFactory As IWorkspaceFactory
Dim pFeatureWorkspace As IFeatureWorkspace
Dim pFeaLyr As IFeatureLayer
Dim pEnv As IRasterAnalysisEnvironment
Dim pWks As IRasterWorkspace
Dim pWksF As IWorkspaceFactory

'Create a new ShapefileWorkspaceFactory object and open a shapefile folder
Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile(sworkPath, 0)
'Create a new FeatureLayer and assign a shapefile to it
Set pFeaLyr = New FeatureLayer
Set pFeaLyr.FeatureClass = pFeatureWorkspace.OpenFeatureClass(sShapeFileName)
pFeaLyr.Name = pFeaLyr.FeatureClass.AliasName



Dim pTempDS As IGeoDataset
Set pTempDS = pFeaLyr.FeatureClass
' Convert to raster
Dim pConOp As IConversionOp
Set pConOp = New RasterConversionOp
Set pEnv = pConOp
Dim pProp As IRasterProps
Set pProp = pRasLyr.Raster
pEnv.SetCellSize esriRasterEnvValue, pProp.MeanCellSize.X
Dim sPath As String
sPath = sworkPath
' delete the existing file
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(sPath + "\" + "TempCov.img") Then
fs.Deletefile (sPath + "\" + "TempCov.img")
End If
Dim pWs As IWorkspace
Set pWksF = New RasterWorkspaceFactory
Set pWs = pWksF.OpenFromFile(sworkPath, 0)
' Perform conversion
Set pGeoDs = pConOp.ToRasterDataset(pTempDS, "IMAGINE Image", pWs, "TempCov.img")

' perform extraction
Dim pOutRaster As IRaster
Dim pRasBandC As IRasterBandCollection
Dim pExtrOp As IExtractionOp
' Dim pOutRas1 As IGeoDataset

Set pExtrOp = New RasterExtractionOp
Set pOutRaster = pExtrOp.Raster(pRasLyr.Raster, pGeoDs)
Set pRasBandC = pOutRaster
Set pOutRas1 = pRasBandC.SaveAs(sGridFileName, pWs, "GRID")

Set pWs = Nothing
Set pTempDS = Nothing
Set pConOp = Nothing
Set pWorkspaceFactory = Nothing
Set pFeatureWorkspace = Nothing
Set pFeaLyr = Nothing
Set pEnv = Nothing
Set pWks = Nothing
Set pWksF = Nothing

End Sub

 
  
 
喜欢0 评分0
gis1117
  • 注册日期
  • 发帖数
  • QQ
  • 铜币
  • 威望
  • 贡献值
  • 银元
1楼#
发布于:2004-04-10 10:44
不错,good boy
举报 回复(0) 喜欢(0)     评分
wangjh
论坛版主
论坛版主
  • 注册日期2003-08-22
  • 发帖数994
  • QQ55359982
  • 铜币2579枚
  • 威望0点
  • 贡献值0点
  • 银元0个
2楼#
发布于:2004-04-10 15:28
好东东
网 站: www.52xoo.com (3S,信息融合,数字图像处理,模式识别与人工智能等专业电子书、学术文章及源代码共享) E-mail: Jianhong72@163.com QQ: 88128745 (55359982用了近10年,最近被盗了,郁闷!!!)
举报 回复(0) 喜欢(0)     评分
游客

返回顶部