【正文】 Envelope = Set pINRasterProp = theRaster XCellSize = / YCellSize = / Set pEnvelop = CheckEnvelop(, pREnvelope, XCellSize, YCellSize) 39。Fit envelop the cell position of Raster Dim pPolygon As IPolygon Dim pRBnd As IRaster Dim pCOPBands As IRasterBandCollection Dim pRasterProp As IRasterProps Set pRasterProp = New Raster = pEnvelop = Int( / YCellSize) = Int( / XCellSize) Set pINRasterProp = Nothing Set pOutBands = pRasterProp Set pPolygon = Dim i As Integer For i = 0 To 1 Set pInGeoData = (i) Set pOutGeoData = (pInGeoData, pPolygon, True) Set pRBnd = pOutGeoData Set pCOPBands = pRBnd (0), i Next If Not pOutGeoData Is Nothing Then Set pRaster = pOutGeoData Exit Function Else MsgBox nothing End If ErrHand: MsgBox RasterExtraction amp。 End FunctionPublic Function CheckEnvelop(DEnv As IEnvelope, REnv As IEnvelope, CX As Double, CY As Double) As IEnvelopeSet CheckEnvelop = New Envelope = (Int(( ) / CX) * CX) + = ((Int(( ) / CX) + 1) * CX) + = (Int(( ) / CY) * CY) = ((Int(( ) / CY) + 1) * CY)End FunctionPublic Function GetPolygon() As IGeometry Dim pFWS As IFeatureWorkspace Dim pWorkspaceFactory As IWorkspaceFactory Set pWorkspaceFactory = New ShapefileWorkspaceFactory Set pFWS = (d:\gisdata\bjdata, 0) Dim pFeatureClass As IFeatureClass Set pFeatureClass = () Dim pCursor As IFeatureCursor Set pCursor = (Nothing, False) Set pFeat = Dim theGeoCol As IGeometryCollection Set GetPolygon = Nothing If = esriGeometry2Dimension Then Set theGeoCol = If = 1 Then Set GetPolygon = (0) End If End If Set pFWS = Nothing Exit FunctionErrHand: MsgBox GetPolygon amp。 End FunctionPublic Function OpenRasterDataset(sPath As String, sRasterName As String) As IRasterDataset 39。Return RasterDataset Object given a file name and its directory On Error GoTo ERH Dim pWSFact As IWorkspaceFactory Dim pRasterWS As IRasterWorkspace Set pWSFact = New RasterWorkspaceFactory If (sPath) Then Set pRasterWS = (sPath, 0) Set OpenRasterDataset = (sRasterName) Exit Function Set pWSFact = Nothing End If ERH: MsgBox Failed in opening raster dataset. amp。 End FunctionPrivate Function UsingRasterClassifyColorRampRenderer(pRLayer As IRasterLayer) 39。 39。 We39。re going to create StatsHistogram Dim pRaster As IRaster Set pRaster = 39。 Create classfy renderer and QI RasterRenderer interface Dim pClassRen As IRasterClassifyColorRampRenderer Set pClassRen = New RasterClassifyColorRampRenderer Dim pRasRen As IRasterRenderer Set pRasRen = pClassRen 39。 Set raster for the render and update Set = pRaster = 3 39。 Create a color ramp to use Dim pRamp As IAlgorithmicColorRamp Set pRamp = New AlgorithmicColorRamp = 3 True 39。 Create symbol for the classes Dim pFSymbol As IFillSymbol Set pFSymbol = New SimpleFillSymbol 39。 loop through the classes and apply the color and label Dim i As Integer For i = 0 To 1 = (i) (i) = pFSymbol (i) = Class amp。 CStr(i) Next i Set = pClassRen Set pRaster = Nothing Set pRasRen = Nothing Set pClassRen = Nothing Set pRamp = Nothing Set pFSymbol = NothingEnd FunctionPublic Function CreateContourFromRaster(sRasterPath As String, sRasterName As String, strShpPath As String, strShpName As String, dInterval As Double, pMap As IMap) Dim pRasterDataset As IRasterDataset Set pRasterDataset = OpenRasterDataset(sRasterPath, sRasterName) Dim pShpWS As IWorkspace Set pShpWS = SetFeatureShapeWorkspace(strShpPath) Dim pSurfaceOp As ISurfaceOp Set pSurfaceOp = New RasterSurfaceOp Dim pRasterAEnv As IRasterAnalysisEnvironment Set pRasterAEnv = pSurfaceOp Set = pShpWS 39。 Creates a geodataset to store the results of the operation Dim pOutput As IGeoDataset CheckSpatialAnalystLicense Set pOutput = (pRasterDataset, dInterval) Dim pFeatureClass As IFeatureClass Set pFeatureClass = pOutput Dim pFLayer As IFeatureLayer Set pFLayer = New FeatureLayer Set = pFeatureClass Dim pGeoFL As IGeoFeatureLayer Set pGeoFL = pFLayer = True = CONTOUR pFLayer Dim pDa As IDataset Set pDa = pOutput If Then strShpName End If End FunctionFunction DeleteIfExists(sPath, sName As String) 39。 Create RasterWorkSpaceFactory Dim pWSF As IWorkspaceFactory Set pWSF = New RasterWorkspaceFactory 39。 Get RasterWorkspace Dim pRasterWS As IRasterWorkspace If (sPath) Then Set pRasterWS = (sPath, 0) End If Dim pRDS As IRasterDataset Set pRDS = New RasterDataset Set pRDS = (sName) If Not pRDS Is Nothing Then Dim pDS As IDataset Set pDS = pRDS End IfEnd Function 關(guān)于IIdentify定義時(shí)只能找到面而不能找到點(diǎn)和線的問題編號(hào)：000082相關(guān)產(chǎn)品及版本：Ar