1.
Sub MyMacro() Dim pMxDocument As IMxDocument ‘地图文档 Set pMxDocument = Application.Document ‘获取当前应用程序的文档 MsgBox pMxDocument.FocusMap.name ‘显示当前地图的名称End Sub2.
Sub MyMacro() Dim pMxDocument As IMxDocument ‘地图文档 Dim pMaps As IMaps ‘地图集 Dim pMap As IMap ‘地图 Set pMxDocument = Application.Document ‘获取当前应用程序的文档 Set pMaps = pMxDocument.Maps ‘获取当前地图文档的地图集 If pMaps.Count > 1 Then ‘如果该地图集的地图数大于1 Set pMap = pMaps.Item(1) ‘获取该地图集中的第一幅地图 MsgBox pMap.name ‘显示该地图的名称 End IfEnd Sub3.
Sub MyMacro() Dim pMxDocument As IMxDocument ‘地图文档 Dim pMap As IMap ‘地图 Dim lCount As Long Dim lIndex As Long Set pMxDocument = Application.Document ‘获取当前应用程序的文档 Set pMap = pMxDocument.FocusMap ‘获取当前地图 lCount = 0 For lIndex = 0 To (pMap.LayerCount – 1) If TypeOf pMap.Layer(lIndex) Is IFeatureLayer Then ‘如果当前地图的第lIndex层的类型是IFeatureLayer lCount = lCount + 1 ‘计数器加1 End If Next lIndex MsgBox "Number of the feature layers " & _ "in the active map: " & lCount ‘显示当前地图的要素层的总数End Sub4.
Sub MyMacro() Dim pMxDocument As IMxDocument ‘获取当前应用程序的文档 Dim pMaps As IMaps ‘地图集 Dim pMap As IMap ‘地图 On Error GoTo SUB_ERROR ‘错误处理 Set pMxDocument = Application.Document ‘获取当前应用程序的文档 Set pMaps = pMxDocument.Maps ‘获取当前地图文档的地图集 Set pMap = pMaps.Item(1) ‘获取该地图集中的第一幅地图 MsgBox pMap.name ‘显示该地图的名称 Exit SubSUB_ERROR: ‘行标签 MsgBox "Error: " & Err.Number & "-" & Err.Descripttion ‘显示错误数和错误信息End Sub5.
‘是图层可视Public Sub MakeLayerVisible() Dim pMxDocument As IMxDocument ‘地图文档 Dim pMap As IMap ‘地图 Dim pFeatureLayer As IFeatureLayer ‘要素层 Dim pActiveView As IActiveView ‘活动视图 Dim pContentsView As IContentsView ‘窗口内容表 ‘获取地图的第一层 Set pMxDocument = ThisDocument ‘获取当前应用程序的文档 Set pMap = pMxDocument.FocusMap ‘获取当前地图 Set pFeatureLayer = pMap.Layer(0) ‘获取当前地图的第一层 ‘如果要素层不可见，则使其可见 If Not pFeatureLayer.Visible Then pFeatureLayer.Visible = True End If ‘刷新地图 Set pActiveView = pMap ‘将当前地图设为活动地图 pActiveView.Refresh ‘刷新 ‘刷新窗口内容表 Set pContentsView = pMxDocument.CurrentContentsView ‘获取当前地图文档的窗口内容表 pContentsView.Refresh pFeatureLayer ‘刷新End Sub6.
‘按NAME查询要素Private Function GetCountyFeature(pFeatureLayer As IFeatureLayer, strCountyName As String) As IFeature ‘查找要素类 Dim pFeatureClass As IFeatureClass ‘要素类 Dim pQueryFilter As IQueryFilter ‘查询过滤器 Dim pFeatureCursor As IFeatureCursor Set pFeatureClass = pFeatureLayer.FeatureClass ‘从要素层获取要素类 Set pQueryFilter = New QueryFilter ‘创建一个新的查询过滤器 pQueryFilter.WhereClause = "NAME = ‘" & strCountyName & "’" ‘按郡名查找 Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False) ‘获取查询到的要素对象 ‘获取要素 Dim pFeature As IFeature ‘要素 Set pFeature = pFeatureCursor.NextFeature ‘获取查询结果的下一个要素 If pFeature Is Nothing Then ‘如果该要素不存在 Set GetCountyFeature = Nothing ‘返回值设为空 Else Set GetCountyFeature = pFeature ‘将该要素设为返回值 End IfEnd Function7.
‘放大/缩小Sub MyZoom() Dim pDoc As IMxDocument ‘地图文档 Dim pActiveView As IActiveView ‘活动地图 Dim pEnv As IEnvelope ‘显示范围 Set pDoc = Application.Document ‘获取当前文档，等同于ThisDoucument Set pActiveView = pDoc.activeView ‘获取当前活动地图 Set pEnv = pActiveView.Extent ‘获取当前显示范围 pEnv.Expand 0.5, 0.5, True ‘按比例放大两倍，把0.5改为2则为缩小一半 pActiveView.Extent = pEnv ‘更新显示范围 pActiveView.Refresh ‘刷新 End Sub MxApplication代表ArcMap本身，只管理一个文档MxDocument（ArcMap是单文档界面）。MxDocument管理一组Map对象和一个PageLayout对象。在数据视图下，ActiveView是一个Map；而在页面视图下，ActiveView是PageLayout。无论在何种视图下，总是只有一个FocusMap，显示操作都是对ActiveView进行。
8.
‘全图：Sub FullExtentPlus() Dim pDoc As IMxDocument ‘地图文档 Dim pActiveView As IActiveView ‘活动地图 Set pDoc = Application.Document ‘获取当前地图文档 Set pActiveView = pDoc.activeView ‘获取当前活动地图 pActiveView.Extent = pDoc.activeView.FullExtent ‘全图显示 pActiveView.Refresh ‘刷新当前视图End Sub9.’清除图层Private Sub ClearLayers() Dim pDoc As IMxDocument ‘地图文档 Dim pActiveView As IActiveView ‘活动地图 Dim pMap As IMap ‘地图 Set pDoc = Application.Document ‘获取当前地图文档 Set pActiveView = pDoc.activeView ‘获取当前活动地图 If TypeOf pActiveView Is IMap Then ‘如果当前活动地图为数据视图模式 Set pMap = pActiveView ‘获取当前地图 pMap.ClearLayers ‘清除所有图层 pDoc.UpdateContents ‘更新窗口内容表 pActiveView.Refresh ‘刷新End IfEnd Sub
10.’查找图层Function FindLayer(map As IMap, name As String) As ILayer Dim i As Integer For i = 0 To map.LayerCount – 1 ‘第一层的索引为1 If map.Layer(i).name = name Then ‘如果第i层的名称为name Set FindLayer = map.Layer(i) ‘获取并返回该层 Exit Function End If NextEnd Function11.’添加图层Sub AddLayer() Dim wksFact As IWorkspaceFactory ‘工作空间管理器 Dim wks As IFeatureWorkspace ‘要素工作空间 Dim fc As IFeatureClass ‘要素类 Dim lyr As IFeatureLayer ‘要素层 Dim ds As IDataset ‘数据集 Dim mxDoc As IMxDocument ‘地图文档 Dim map As IMap ‘地图 Set wksFact = New ShapefileWorkspaceFactory ‘创建Shape工作空间管理器 Set wks = wksFact.OpenFromFile(“c:\Data\shp”, 0) ‘获取工作空间 Set fc = wks.OpenFeatureClass(“BigCypress”) ‘获取要素类 Set lyr = New FeatureLayer ‘创建要素层 Set lyr.FeatureClass = fc ‘向要素层中添加要素类 Set ds = fc ‘获取数据集 lyr.name = ds.name ‘用要素类的名称命名要素层 Set pDoc = Application.Document ‘获取当前地图文档 Set mxmap = mxDoc.FocusMap ‘获取当前地图 map.AddLayer lyr ‘添加图层End Sub12.’添加文本Private Sub Hello() Dim pDoc As IMxDocument ‘地图文档 Dim pActiveView As IActiveView ‘活动地图 Dim sym As ITextSymbol ‘文本符号 Dim bnds As IArea ‘面 Set pDoc = Application.Document ‘获取当前地图文档 Set pActiveView = pDoc.activeView ‘获取当前活动地图 Set sym = New TextSymbol ‘创建文本符号 sym.Font.size = 18 ‘设置字体大小 With pActiveView.ScreenDisplay ‘对显示屏操作 Set bnds = .DisplayTransformation.VisibleBounds ‘获取可视范围 .StartDrawing .hDC, esriNoScreenCache .SetSymbol sym ‘设置要绘制的符号 .DrawText bnds.Centroid, "Hello" ‘添加文本 .FinishDrawing ‘完成绘制 End WithEnd Sub13.’选择要素Sub SelectFeatures() Dim mxDoc As IMxDocument ‘地图文档 Dim lyr As IFeatureLayer ‘要素层 Dim sel As IFeatureSelection ‘选择集 Dim filter As IQueryFilter ‘查询过滤器 Dim selEvents As ISelectionEvents ‘？？？ Set mxDoc = Application.Document ‘获取当前地图文档 Set lyr = FindLayer(mxDoc.FocusMap, "BUILDING") ‘调用FindLayer函数查找图层 Set sel = lyr ‘将找到的图层设为选择集 Set filter = New QueryFilter ‘创建查询过滤器 filter.WhereClause = "BDNAME =’实验楼A’" ‘设置where子句 sel.SelectFeatures filter, esriSelectionResultNew, False ‘选中满足条件的要素 mxDoc.activeView.PartialRefresh esriViewGeoSelection, Nothing, Nothing ‘绘出选中的要素 Set selEvents = mxDoc.FocusMap ‘？？？ selEvents.SelectionChanged ‘通知系统选择已经改变了End Sub14.’监听Dim WithEvents g_Map As mapPrivate Sub UIButtonControl1_Click() Dim mxDoc As IMxDocument ‘地图文档 Dim lyr As IFeatureLayer ‘要素层 Dim sel As IFeatureSelection ‘选择集 Dim filter As IQueryFilter ‘查询过滤器 Dim selEvents As ISelectionEvents ‘？？？ Set g_Map = mxDoc.FocusMap ‘获取当前地图 Set mxDoc = Application.Document ‘获取当前地图文档 Set lyr = FindLayer(mxDoc.FocusMap, "BUILDING") ‘调用FindLayer函数查找图层 Set sel = lyr ‘将找到的图层设为选择集 Set filter = New QueryFilter ‘创建查询过滤器 filter.WhereClause = "BDNAME =’实验楼A’" ‘设置where子句 sel.SelectFeatures filter, esriSelectionResultNew, False ‘选中满足条件的要素 mxDoc.activeView.PartialRefresh esriViewGeoSelection, Nothing, Nothing ‘绘出选中的要素 Set selEvents = mxDoc.FocusMap ‘？？？ selEvents.SelectionChanged ‘通知系统选择已经改变了End Sub
15.’查找图层Function FindLayer(map As IMap, name As String) As ILayer Dim i As Integer For i = 0 To map.LayerCount – 1 ‘第一层的索引为1 If map.Layer(i).name = name Then ‘如果第i层的名称为name Set FindLayer = map.Layer(i) ‘获取并返回该层 Exit Function End If Next End Function Private Sub g_Map_SelectionChanged() Dim activeView As IActiveView ‘活动地图 Dim featureEnum As IEnumFeature ‘列举的要素？ Dim feat As IFeature ‘要素 Dim index As Long Dim Msg As String Set activeView = g_Map ‘获取当前地图 Set featureEnum = activeView.Selection ‘列举所选的要素 featureEnum.Reset ‘还原至初始顺序 Set feat = featureEnum.Next ‘获取选择集中第一个要素 Do While Not feat Is Nothing ‘如果要素存在 index = feat.Fields.FindField(“Name”) ‘获取Name字段的索引值 If index <> -1 Then MsgBox Msg & Chr(13) & Chr(10) & feat.Value(index) ‘显示该要素的Name Set feat = featureEnum.Next ‘移至选择集中的下一个要素 LoopEnd Sub
来源：http://www.cnblogs.com/atravellers/archive/2010/01/13/1646606.html
才能做到人在旅途，感悟人生，享受人生。
