GIS二次开发经典代码.doc

1、保存栅格数据（注意：保存的时候不要忘记要将栅格数据保存到栅格数据集工作空间中，同时还有栅格的扩展名一定要加上。） 内容来自GIS公园 Public Sub SaveRaster() Dim pMxDoc As IMxDocument Dim pMap As IMap Set pMxDoc = Application.Document Set pMap = pMxDoc.FocusMap pMap.DeleteLayer pMap.Layer(0) Dim pRasterDataset As IRasterDataset Dim pWks As IRasterWorkspace Dim pWksFact As IWorkspaceFactory Set pWksFact = New RasterWorkspaceFactory Set pWks = pWksFact.OpenFromFile(D:ProjectsZLStemp, 0) Dim pRBC As IRasterBandCollection Set pRasterDataset = pWks.OpenRasterDataset(test) Dim pRBC As IRasterBandCollection Dim pRLayer As IRasterLayer Set pRLayer = New RasterLayer pRLayer.CreateFromDataset pRasterDataset Dim pRaster As IRaster Set pRaster = pRLayer.Raster Set pRBC = pRaster Dim pDs As IDataset Set pDs = pRBC.SaveAs(test, pWks, TIFF) copyright pMap.AddLayer pRLayerEnd Sub2、根据已有数据字段，创建shape文件，并将数据插入到shape文件中（delphi代码） GIS公园 function CreateNewShape(pCursor: IFeatureCursor; pFCls: IFeatureClass; pPath: WideString; pNewFClsName:WideString): IFeatureClass;var pShapeFieldName, ConfigKeyword: WideString; pNewFCls: IFeatureClass; pFeature: IFeature; pNewFCursor: IFeatureCursor; pFeatureBuffer: IFeatureBuffer; pFields: IFields; pShape: IGeometry; pGeoType: esriGeometryType; pWFact: IWorkspaceFactory; pWorkspace: IWorkspace; pWorkspaceEdit: IWorkspaceEdit; pFWks: IFeatureWorkspace; pDataset: IDataset; pCLSID: IUID; pEXTCLSID: IUID; pNewID: OleVariant; bl: wordbool; i, pFieldCount: integer; pValue: OleVariant;begin ConfigKeyword := ; /Determine the appropriate geometry type corresponding the the feature type if pCLSID = nil then begin pFCls.Get_CLSID(pCLSID); 本文来GIS公园 pFCls.Get_ShapeType(pGeoType); end; /create fields collection if pFields = nil then begin pFCls.Get_Fields(pFields); end; /get geometry field name pFCls.Get_ShapeFieldName(pShapeFieldName); pEXTCLSID := nil; pWFact:=CoshapefileWorkspaceFactory.create as IWorkspaceFactory; pWFact.OpenFromFile(pPath, 0, pWorkspace); pFWks := pWorkspace as IFeatureWorkspace; bl := NameExits(pWorkspace, pNewFClsName); /create shapefile in the temp folder if not bl then begin pFWks.CreateFeatureClass(pNewFClsName, pFields, pCLSID, pEXTCLSID, pGeoType, pShapeFieldName,ConfigKeyword, pNewFCls); end else begin pFWks.OpenFeatureClass(pNewFClsName, pNewFCls); pDataset := pNewFCls as IDataset; pDataset.Delete; copyright pFWks.CreateFeatureClass(pNewFClsName, pFields, pCLSID, pEXTCLSID, pGeoType, pShapeFieldName,ConfigKeyword, pNewFCls); end; /Add the features to this ShapeFile pWorkspaceEdit := pWorkspace as IWorkspaceEdit; pWorkspaceEdit.StartEditing(true); pWorkspaceEdit.StartEditOperation; pNewFCls.CreateFeatureBuffer(pFeatureBuffer); pNewFCls.Insert(true, pNewFCursor); pCursor.NextFeature(pFeature); pFeature.Get_Fields(pFields); pFields.Get_FieldCount(pFieldCount); while not (pFeature = nil) do begin for i := 0 to pFieldCount - 1 do begin pFeature.Get_Value(i, pValue); pFeatureBuffer.Set_Value(i, pValue); end; 内容来自GIS公园 pFeature.Get_Shape(pShape); pFeatureBuffer.Set_Shape(pShape); pNewFCursor.InsertFeature(pFeatureBuffer, pNewID); pCursor.NextFeature(pFeature); end; pNewFCursor.Flush; pWorkspaceEdit.StopEditOperation; pWorkspaceEdit.StopEditing(true); 内容来自GIS公园 /Get Resault CreateNewShape := pNewFCls;end; 内容来自GIS公园 3、渲染栅格图层Public Sub SetRasterRenderer() Dim NumOfClass As Integer NumOfClass = 5 Get Map Dim pMxDoc As IMxDocument Set pMxDoc = ThisDocument Dim pMap As IMap Set pMap = pMxDoc.FocusMap Get raster input from layer Dim pRLayer As IRasterLayer Set pRLayer = pMap.Layer(0) Dim pRaster As IRaster Set pRaster = pRLayer.Raster Create classfy renderer and QI RasterRenderer interface Dim pClassRen As IRasterClassifyColorRampRenderer Set pClassRen = New RasterClassifyColorRampRenderer Dim pRasRen As IRasterRenderer Set pRasRen = pClassRen copyright Set raster for the render and update Set pRasRen.Raster = pRaster pClassRen.ClassCount = NumOfClass pRasRen.Update Create a color ramp to use Dim pRamp As IAlgorithmicColorRamp Set pRamp = New AlgorithmicColorRamp pRamp.Size = NumOfClass Dim pFColor As IColor Dim pTColor As IColor Set pFColor = New RgbColor Set pTColor = New RgbColor pFColor.RGB = RGB(10, 100, 10) pTColor.RGB = RGB(60, 0, 60) pRamp.FromColor = pFColor pRamp.ToColor = pTColor pRamp.CreateRamp True Create symbol for the classes Dim pFSymbol As IFillSymbol Set pFSymbol = New SimpleFillSymbol loop through the classes and apply the color and label Dim i As Integer For i = 0 To pClassRen.ClassCount - 1 pFSymbol.Color = pRamp.Color(i) pClassRen.Symbol(i) = pFSymbol pClassRen.Label(i) = Class & CStr(i) Next i Update the renderer and plug into layer pRasRen.Update Set pRLayer.Renderer = pClassRen pMxDoc.ActiveView.Refresh pMxD