aevb.zip_contour_等值线

Private Sub Command4_Click() Dim pOutRasLayer As IRasterLayer Dim pMap As iMap Dim pFeatCla As IFeatureClass Set pMap = MainFrm.MapControl1.Map Dim pInterpolationOp As IInterpolationOp Set pInterpolationOp = New RasterInterpolationOp ' Create the input point object Dim pInputDataset As IGeoDataset Dim pFeatLayer As IFeatureLayer ' Calls function to open the point dataset from disk Dim MIndex As Long For MIndex = 0 To pMap.LayerCount - 1 If pMap.Layer(MIndex).Name = "雨量站" Then Set pFeatLayer = pMap.Layer(MIndex) End If Next MIndex Set pFeatCla = pFeatLayer.FeatureClass Dim pFieldEdit As IFieldEdit Dim pFeature As IFeature Dim pField As IField Set pField = New esriGeoDatabase.Field Set pFieldEdit = pField With pFieldEdit .Name = "降雨量" .Type = esriFieldTypeDouble .Length = 12 .IsNullable = False .DefaultValue = 1111 End With pFeatCla.AddField pField '添加那个要用的字段进去 Dim ii As Integer For ii = 0 To pFeatCla.FeatureCount(Nothing) - 1 Set pFeature = pFeatCla.GetFeature(ii) pFeature.Value(4) = StaticRainTotal(CStr(Stops(ii)), 1999) / 5 这里是我自己写的一个函数 从数据库中得到的年平均将雨量 pFeature.Store Next ii Set pInputDataset = pFeatLayer ' Define the search radius Dim pRadius As IRasterRadius Set pRadius = New RasterRadius pRadius.SetVariable 12 'Create FeatureClassDescriptor using a value field Dim pFCDescriptor As IFeatureClassDescriptor Set pFCDescriptor = New FeatureClassDescriptor pFCDescriptor.Create pFeatLayer.FeatureClass, Nothing, "降雨量" 'Set cellsize for output raster in the environment Dim dCellSize As Double dCellSize = 20 Dim pEnv As IRasterAnalysisEnvironment Set pEnv = pInterpolationOp pEnv.SetCellSize esriRasterEnvValue, dCellSize 'Perform the interpolation Dim pOutRaster As IRaster Set pOutRaster = pInterpolationOp.IDW(pFCDescriptor, 2, pRadius) 'Add output into ArcMap as a raster layer Set pOutRasLayer = New RasterLayer pOutRasLayer.CreateFromRaster pOutRaster pMap.AddLayer pOutRasLayer 'frmMain.MapControl1.AddLayer pOutRasLayer Dim pGeoDataSet As IGeoDataset Set pGeoDataSet = pOutRaster Dim pWorkspaceFactory As IWorkspaceFactory Dim pShpWorkspace As IWorkspace Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pShpWorkspace = pWorkspaceFactory.OpenFromFile("c:\", 0) Dim pSurfaceOp2 As ISurfaceOp2 Dim pRasterAnalysisEnvironment As IRasterAnalysisEnvironment Set pSurfaceOp2 = New RasterSurfaceOp Set pRasterAnalysisEnvironment = pSurfaceOp2 'Qi pRasterAnalysisEnvironment.Reset pRasterAnalysisEnvironment.SetCellSize esriRasterEnvValue, dCellSize Set pRasterAnalysisEnvironment.OutWorkspace = pShpWorkspace Dim dInterval As Double dInterval = 50 Dim pOutputDataSet As IGeoDataset Set pOutputDataSet = pSurfaceOp2.Contour(pGeoDataSet, dInterval) Dim pFeatureClass As IFeatureClass Dim pFeatureLayer As IFeatureLayer Set pFeatureClass = pOutputDataSet Set pFeatureLayer = New FeatureLayer Set pFeatureLayer.FeatureClass = pFeatureClass Dim pGeoFeatureLayer As IGeoFeatureLayer Set pGeoFeatureLayer = pFeatureLayer With pGeoFeatureLayer .DisplayAnnotation = True .DisplayField = "Contour" .Name = "wdmContour" End With pMap.AddLayer pGeoFeatureLayer MainFrm.MapControl1.Refresh Dim lFieldnumber As Long Dim pFields As IFields Set pFields = pFeatCla.Fields lFieldnumber = pFields.FindField("降雨量") Dim pField1 As IField Set pField1 = pFields.Field(lFieldnumber) pFeatCla.DeleteField pField MainFrm.MapControl1.Refresh End sub