进行属性查询的时候资料

1、在 ArcMap 中，进行属性查询的时候， Arcmap 中提供了选中字段的属性的 Unique Value。这样就可以从列表中选择了。以前也遇到类似问题，一直不知道怎么做，好在当时使用的 ArcSDE Oracle 数据，使用了一个 SQL 语句解决了。不过要是 Coverage 就没有办法了。其实 AO 中提供了这样的功能了，可通过 IDataStatistics 来实现，做了一个函数，参数为图层和字段，返回该图层该字段的所有 Unique Value1.' 下面程序段是用来列出ArcMap中 , 指定图层和字段中, 所有Unique ValuePublic Function li

2、stUniqueValue(pLayer As IFeatureLayer, pFieldName As String)As String()Dim pCursor As ICursorSet pCursor = pLayer.Search(Nothing, False)Dim pDataStat As IDataStatisticsDim pValue As VariantSet pDataStat = New DataStatisticspDataStat.Field = pFieldNameSet pDataStat.Cursor = pCursorDim pEnumVar As IEn

3、umVariantSimpleSet pEnumVar = pDataStat.UniqueValuespValue = pEnumVar.NextDim i As Long'Dim count As Long'count = pDataStat.UniqueValueCounti = 0Dim value(200) As String ' 数 组 的 长 度 按 说 应 该 使 用 pDataStat.UniqueValueCount 来控制，但是编译只能使用'常数 ,不能使用变量Do Until IsEmpty(pValue)value(i) = pValu

4、ei = i + 1pValue = pEnumVar.NextLooplistUniqueV alue = value()End Function2.打开图层属性表(ArcMap VBA)'下面程序段是用来列出ArcMap 中 ,指定图层和字段中,所有 Unique ValuePublic Sub OpenFeatureLayerTable()Dim pMxDoc As IMxDocumentDim pMap As IMapDim pLayer As IFeatureLayerDim pTable As ITableWindowSet pMxDoc = ThisDocumentSet

5、 pMap = pMxDoc.FocusMapSet pLayer = pMap.Layer(0)'Instantiate the Table windowSet pTable = New TableWindow'Associate the table and a feature layerSet pTable.FeatureLayer = pLayerSet pTable.Application = Application'Open the tablepTable.Show TrueEnd Sub13.AO 中加载 SDE 中的 Raster 数据(ArcMap VB

6、A/VB AO)Public Function GetRasterFromSDE(sServer As String, sInstance As String, _ sUser As String, sPassword As String, sSDERaster As String, Optional version AsString = "SDE.DEFAULT") As IRasterDataset'加载栅格函数' sServer,sInstance,sDB,sUser,sPasswd: ArcSDE connection info' sSDER

7、aster: the ArcSDE raster dataset nameDim pSDEWs As IWorkspaceNameDim pSDEPropertySet As IPropertySetDim pSDERasterDataset As IRasterDatasetDim pDsName As IDatasetNameDim pName As IName' Dim sQualifiedName As String' Get connection propertysetSet pSDEPropertySet = New PropertySetWith pSDEProp

8、ertySet.SetProperty "Server", sServer.SetProperty "Instance", sInstance' .SetProperty "Database", sDB.SetProperty "User", sUser.SetProperty "Password", sPassword.SetProperty "Version", versionEnd With' Get workspacenameSet pSDEWs =

9、New WorkspaceName pSDEWs.ConnectionProperties = pSDEPropertySet pSDEWs.WorkspaceFactoryProgID = "esricore.sdeworkspacefactory"' Get raster dataset nameSet pDsName = New RasterDatasetNamepDsName.Name = sSDERasterSet pDsName.WorkspaceName = pSDEWsSet pName = pDsName' Open ArcSDE rast

10、er datasetSet pSDERasterDataset = pName.Open' CleanupSet GetRasterFromSDE = pSDERasterDatasetSet pSDEWs = NothingSet pSDERasterDataset = NothingSet pSDEPropertySet = NothingSet pName = NothingSet pDsName = NothingEnd Function4.AO 中直接加载 ArcSDE 矢量数据Public Function addSDEData(Server As String, Inst

11、ance As String, User As String, _Password As String, featureClass As String, Optional version As String = "SDE.DEFAULT")On Error GoTo EHDim pWorkspaceFactory As IWorkspaceFactoryDim pWorkspace As IFeatureWorkspaceDim pPropSet As IPropertySetDim pClass As IFeatureClassDim pLayer As IFeature

12、LayerDim pMxDoc As IMxDocument2Set pWorkspaceFactory = New SdeWorkspaceFactory Set pPropSet = New PropertySetWith pPropSet ' 设置 ArcSDE 连接属性.SetProperty "SERVER", Server.SetProperty "INSTANCE", Instance.SetProperty "USER", User.SetProperty "PASSWORD", Passw

13、ord.SetProperty "VERSION", version ' 可选，缺省为 SDE.DEFAULT 版本 End WithSet pWorkspace = pWorkspaceFactory.Open(pPropSet, 0)Set pClass = pWorkspace.OpenFeatureClass(featureClass)Set pLayer = New FeatureLayerSet pLayer.featureClass = pClasspLayer.Name = pClass.AliasNameSet pMxDoc = ThisDocum

14、entpMxDoc.AddLayer pLayerEH:MsgBox Err.Description, vbInformation, "加载数据错误"End Function5.对选中要素进行属性统计Public Sub SumSelectedFeatures()Dim pMxDoc As IMxDocumentDim pmap As IMapDim player As IFeatureLayerDim pFcc As IFeatureClassDim pFields As IFieldsDim pNumFields As IFieldsDim numAreaField A

15、s DoubleDim pField As IFieldSet pMxDoc = ThisDocumentSet pmap = pMxDoc.FocusMapSet player = pmap.Layer(0)Set pFcc = player.FeatureClassSet pFields = pFcc.Fields'Get a field to SumSet pNumFields = pFieldsnumAreaField = pFields.FindField("pop1997") ' <-Enter a field here 'Chec

16、k for a valid field index numberIf numAreaField < 0 ThenMsgBox "Please enter a Valid field name", vbCritical, "Field Doesn't Exist"Exit SubEnd IfSet pField = pFields.Field(numAreaField)'*Other useful field stuff*'.FindField("AREA")'MsgBox numAreaField

17、'MsgBox pField.Name'MsgBox pFields.FieldCount'MsgBox player.Name'Get the selected recordsDim pFeatureSelection As IFeatureSelection3Set pFeatureSelection = playerDim pSelected As ISelectionSetSet pSelected = pFeatureSelection.SelectionSetDim pCursor As ICursorpSelected.Search Nothing

18、, False, pCursorDim pfeature As IFeatureDim counter As Integercounter = 0Dim sumAREA As DoublesumAREA = 0Set pfeature = pCursor.NextRowDo Until pfeature Is Nothingcounter = counter + 1sumAREA = sumAREA + pfeature.Value(numAreaField)Set pfeature = pCursor.NextRowLoopMsgBox "Total " & pF

19、ield.Name & " is: " & sumAREA 'MsgBox counter & " Selected records"End Sub6.在 ArcMap LayOut中增加文字Private pMxApp As IMxApplicationPrivate pMxDoc As IMxDocumentPrivate pDisp As IScreenDisplayPrivate pEnv As IEnvelopePrivate pPoint As IPointPrivate pColor As IRgbColor

20、Private pLayout As IPageLayoutPrivate pMapSurround As IMapSurroundPrivate pNSurround As INorthArrowPrivate pGContainer As IGraphicsContainerPrivate pEnumLayer As IEnumLayerPrivate pFLayer As ILayerPrivate pBLayer As ILayerPublic Sub AddTextToLayout()'Button to place text on the layout''R

21、eference App, Doc, Disp, Layout, and GraphicContainerSet pMxApp = ApplicationSet pMxDoc = DocumentSet pDisp = pMxApp.DisplaySet pLayout = pMxDoc.ActiveViewSet pGContainer = pLayout'Create a TextElementDim pTxtElement As ITextElementSet pTxtElement = New TextElement'Create a TextSymbol and a

22、fontDim pTxtSym As ITextSymbolSet pTxtSym = New TextSymbolDim pFont As IFontDispSet pFont = New StdType.StdFont'Set some properties of the fontpFont.Name = "Courier"pFont.Bold = TruepFont.Italic = TruepFont.Size = 304'Set the TextSymbol's FONT property with the font pTxtSym.Fon

23、t = pFont'Set the TextElement's SYMBOL property with the TextSymbol 'Set the TextElement's TEXT property with the desired text pTxtElement.Symbol = pTxtSympTxtElement.Text = "This is a test"'Create an Envelope to define the TextElement's GEOMETRY'Create a Point

24、to define the Envelope's LL and UR (extent)Set pEnv = New EnvelopeSet pPoint = New PointpPoint.x = 2 'first define LL coordspPoint.y = 8 '<-these are page unitspEnv.LowerLeft = pPointpPoint.x = 7 'now define UR coordspPoint.y = 10pEnv.UpperRight = pPoint'Create a pointer to th

25、e IElement interface, QIDim pElement As IElementSet pElement = pTxtElement'Set the Element's GEOMETRY property with the Envelope pElement.Geometry = pEnv'Prepare display for drawing (Activate), AddElement to the 'GraphicsContainer, then DrawEnd Sub7.VB+AO 增加 shapefile数据Private Sub Fo

26、rm_Load()Dim pWorkspaceFactory As IWorkspaceFactoryDim pWorkspace As IFeatureWorkspaceDim pFClass As IFeatureClassDim pLayer As IFeatureLayerSet pWorkspaceFactory = New ShapefileWorkspaceFactory '获取目录Set pWorkspace = pWorkspaceFactory.OpenFromFile("D:data", 0)'获取 shapefile 名Set pFC

27、lass = pWorkspace.OpenFeatureClass("result")Set pLayer = New FeatureLayerSet pLayer.FeatureClass = pFClassMapControl1.AddLayer pLayerMapControl1.RefreshEnd Sub8.VBA 增加 Raster 数据Public Sub AddRasterLayer()Dim pMxDocument As IMxDocumentDim pMap As IMapDim pLayer As IRasterLayerDim pWF As IWo

28、rkspaceFactoryDim pW As IWorkspace5Dim pFW As IRasterWorkspace' 分别读取图层一 ,图层二到 FeatureClass 和 Table 中Dim pDataset As IDatasetDim pWorkspaceFactory As IWorkspaceFactoryDim pRDataset As IRasterDatasetDim pWorkspace1 As IFeatureWorkspaceSet pWF = New RasterWorkspaceFactoryDim pWorkspace2 As IFeature

29、Workspace'Enter path to workspace that contains your gridDim pFirstFeatClass As IFeatureClassSet pW = pWF.OpenFromFile("C:data")Dim pSecondFeatClass As IFeatureClass'QIDim pFirstTable As ITableSet pFW = pWDim pSecondTable As ITable'Enter Name of Grid folderDim pFeatLayer1 As IF

30、eatureLayerSet pRDataset = pFW.OpenRasterDataset("LakeDepth")Set pFeatLayer1 = New FeatureLayer'Use the grid to create a raster layerDim pFeatLayer2 As IFeatureLayerDim pRLayer As IRasterLayerSet pFeatLayer2 = New FeatureLayerSet pRLayer = New RasterLayerSet pWorkspaceFactory = New Sha

31、pefileWorkspaceFactorypRLayer.CreateFromDataset pRDatasetSet pWorkspace1 = pWorkspaceFactory.OpenFromFile(pathLayer1, 0)'Add the raster layer to a mapSet pWorkspace2 = pWorkspaceFactory.OpenFromFile(pathLayer2, 0)Set pMxDocument = ThisDocumentSet pFirstFeatClass = pWorkspace1.OpenFeatureClass(na

32、meLayer1)Set pMap = pMxDocument.FocusMapSet pSecondFeatClass = pWorkspace2.OpenFeatureClass(nameLayer2)pMxDocument.AddLayer pRLayerSet pFeatLayer1.FeatureClass = pFirstFeatClass'Set the layer nameSet pFirstTable = pFeatLayer1'Set the display extentSet pFeatLayer2.FeatureClass = pSecondFeatCl

33、assEnd SubSet pSecondTable = pFeatLayer2' 检查错误9.Merge Layer (VB+AO)If pFirstTable Is Nothing ThenMsgBox "Table QI failed"'兔八哥以前写的，现在也放这吧Exit FunctionPublic Function Merge(pathLayer1 As String, pathLayer2 As String,End IfpathMergeResult As String, _If pSecondTable Is Nothing Thennam

34、eLayer1 As String, nameLayer2 As String, nameMergeResult As String)MsgBox "Table QI failed"6Exit FunctionEnd If' 定义输出要素类名称和 shape 类型Dim pFeatClassName As IFeatureClassNameSet pFeatClassName = New FeatureClassNameWith pFeatClassName.FeatureType = esriFTSimple.ShapeFieldName = "Shap

35、e".ShapeType = pFirstFeatClass.ShapeTypeEnd With' 定义输出 shapefile 位置与名称Dim pNewWSName As IWorkspaceNameSet pNewWSName = New WorkspaceNameWith pNewWSName.WorkspaceFactoryProgID = "esriCore.ShapefileWorkspaceFactory".PathName = pathMergeResultEnd WithDim pDatasetName As IDatasetNameS

36、et pDatasetName = pFeatClassNamepDatasetName.Name = nameMergeResultSet pDatasetName.WorkspaceName = pNewWSName' 定义 Merge 参数Dim inputArray As IArraySet inputArray = New esriCore.ArrayinputArray.Add pFirstTableinputArray.Add pSecondTable' 进行 Merge 操作Dim pBGP As IBasicGeoprocessorSet pBGP = New

37、 BasicGeoprocessorDim pOutputFeatClass As IFeatureClassSet pOutputFeatClass = pBGP.Merge(inputArray, pFirstTable, pFeatClassName)End Function10.GraphicsLayer中增加一个点Public Sub AddPointToGraphicsLayer()Dim pMxDoc As IMxDocumentSet pMxDoc = ThisDocumentDim pMxApp As IMxApplicationSet pMxApp = Applicatio

38、nDim pMap As IMapSet pMap = pMxDoc.FocusMap'Instantiate the composite graphics layerDim pCGLayer As ICompositeGraphicsLayerSet pCGLayer = New CompositeGraphicsLayer'QI for ILayer to set the layer's nameDim pLayer As ILayerSet pLayer = pCGLayerpLayer.Name = "TestPoint"'Add t

39、he layer to the mappMap.AddLayer pCGLayer'Set some x and y values or read them from somewhereDim x As DoubleDim y As Doublex = 2007y = 200'Make a pointDim pPnt As IPointSet pPnt = New PointpPnt.x = xpPnt.y = y'Set color and symbol for the point, BlueDim pColor As IRgbColorSet pColor = Ne

40、w RgbColorpColor.Blue = 255pColor.Green = 0pColor.Red = 0Dim pSimpleMarkerSymbol As ISimpleMarkerSymbolSet pSimpleMarkerSymbol = New SimpleMarkerSymbolWith pSimpleMarkerSymbol.Style = esriSMSCircle.Size = 4.Color = pColorEnd With'Create a marker elementDim pMarkerElement As IMarkerElement Set pM

41、arkerElement = New MarkerElement pMarkerElement.Symbol = pSimpleMarkerSymbol Dim pElement As IElementSet pElement = pMarkerElementpElement.Geometry = pPnt'Get the graphics layer and screen displayDim pGrLayer As IGraphicsLayerSet pGrLayer = pCGLayerDim pScreenDisplay As IScreenDisplaySet pScreen

42、Display = pMxApp.Display'Add the marker element ot the layer graphics containerDim pGraphicCont As IGraphicsContainerSet pGraphicCont = pGrLayerpGraphicCont.AddElement pMarkerElement, 0With pScreenDisplay.ActiveCache = 0.StartDrawing pScreenDisplay.hDC, 0.SetSymbol pSimpleMarkerSymbolpElement.Dr

43、aw pScreenDisplay, Nothing.FinishDrawingEnd With'Refresh/redraw the display with the new pointEnd Sub11. 对 ArcMap 显示区域大小进行缩放'本例用来对 ArcMap 显示区域进行放达 2 倍 ,修改 2 为你需要的放大比例 Private Sub UIButtonControl1_Click()Dim pMxApp As IMxApplicationDim pMxDoc As IMxDocumentDim pDisp As IScreenDisplayDim pPoin

44、t As IPointDim pCenterPoint As IPoint'获得当前Display8Set pMxApp = ApplicationSet pDisp = pMxApp.DisplaySet pMxDoc = Document'获取当前显示区域Dim pCurrentEnv As IEnvelopeDim pEnv As IEnvelope'设置显示范围为当前的1/2pEnv.Height = pCurrentEnv.Height / 2pEnv.Width = pCurrentEnv.Width / 2'设置新的显示区域的中心为原来显示区域中心

45、Set pPoint = New PointSet pCenterPoint = New PointpEnv.CenterAt pCenterPoint'设置视图显示区域End Sub12. 复制一个 FeatureClass'复制一个FeatureClassPublic Function hCopyFC(ByVal myinstr As String, ByVal myoutstr As String) As BooleanDim hOUTshwsname As IWorkspaceNameDim hOutshDSName As IDatasetNameDim hInWork

46、spaceName As IWorkspaceNameDim hDatasetName As IDatasetNameDim htoshape As IFeatureDataConverterDim htname As IFeatureClassNameDim houttname As IFeatureClassNameSet hInWorkspaceName = New WorkspaceName hInWorkspaceName.PathName = strdir + "templatetemplate.mdb" ' 数据模板Set htname = New F

47、eatureClassNameSet hDatasetName = htnameSet hDatasetName.WorkspaceName = hInWorkspaceName hDatasetName.Name = myinstrSet hOUTshwsname = New WorkspaceName hOUTshwsname.PathName = strpathname '当前数据路径Set houttname = New FeatureClassNameSet hOutshDSName = houttnameSet hOutshDSName.WorkspaceName = hO

48、UTshwsname hOutshDSName.Name = myoutstrSet htoshape = New FeatureDataConverterhtoshape.ConvertFeatureClasshDatasetName,Nothing,Nothing,hOutshDSName, Nothing, Nothing, "", _ 1000, 0 Set hInWorkspaceName = NothingSet htname = NothingSet hOUTshwsname = Nothing9Set houttname = NothingNext iSet

49、 htoshape = NothingSet pNewPolyline = pNewPointCollEnd FunctionElseSet pNewPolyline = Nothing13. 对指定直线的所有节点坐标进行平移End IfSet test_Polyline = pNewPolylineEnd Function'对直线的所有节点坐标进行平移new_x = (original_x1.2) + 5Public Function test_Polyline(pPolyline As IPolyline) As IPolyline14. 对 ArcMap 目录表中的图层进行排序D

50、im pNewPolyline As IPolylineDim pPointColl As IPointCollectionDim pNewPointColl As IPointCollection'对目录表中的图层进行排序Dim pPoint As IPointSub SortLayers()Dim pNewPoint As IPoint' 获取地图文档Dim dX As Double, dY As DoubleDim pMxDoc As IMxDocumentDim dNew_X As DoubleSet pMxDoc = ThisDocumentDim i As Long

51、' TOC 对象Set pNewPointColl = New PolylineDim pTOC As IContentsViewIf (Not pPolyline.IsEmpty) ThenSet pTOC = pMxDoc.CurrentContentsViewSet pPointColl = pPolylineDim pMap As IMapFor i = 0 To pPointColl.PointCount - 1Set pMap = pMxDoc.FocusMapSet pPoint = pPointColl.Point(i)Dim pLayer As ILayerdX =

52、pPoint.xDim i As VariantdY = pPoint.y' 图层排序dNew_X = (dX 1.2) + 5For i = 0 To pMap.LayerCount - 1Set pNewPoint = New esriCore.PointSet pLayer = pMxDoc.FocusMap.Layer(i)pNewPoint.PutCoords dNew_X, dYSelect Case pLayer.NamepNewPointColl.AddPoint pNewPointCase "Situs Addresses"10pMap.MoveL

53、ayer pLayer, 0Case "Spot Elevations"pMap.MoveLayer pLayer, 1Case "Sewer Network Junctions"pMap.MoveLayer pLayer, 2Case "Manholes"pMap.MoveLayer pLayer, 3Case "Contours"pMap.MoveLayer pLayer, 4Case "Sewer Lines"pMap.MoveLayer pLayer, 5Case "Stree

54、t Centerlines".'兔八哥懒得敲了Case "DEM"pMap.MoveLayer pLayer, 19Case "Hillshade Grid"pMap.MoveLayer pLayer, 20End SelectNext i' 刷新目录表End Sub15. 在 ArcGIS 中使用绘制的圆形选择要素'使用绘制的圆形选择要素，算是弥补ESRI 选择只能简单使用面的遗憾吧Private Function UIToolControl1_Message() As StringUIToolControl1_Mes

55、sage = "Select features by dragging a circle"End FunctionPrivate Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)Dim pMxApp As IMxApplicationDim pMxDoc As IMxDocumentDim pActiveView As IActiveViewDim pRubberCirc As IRubberBandDim pCircArc As ICircularArcDim pGeo As IGeometryDim pMap As IMapDim pMapPoint As WKSPointDim pDevPoint As tagPOINTDim pDisplayTransformation As IDispl