图层的添加：
1.
Sub MyMacro()
Dim pMxDocument As IMxDocument '地图文档
Set pMxDocument = Application.Document '获取当前应用程序的文档
MsgBox pMxDocument.FocusMap.Name '显示当前地图的名称
End Sub
2.
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 If
End Sub
3.
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 Sub
4.
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 Sub
SUB_ERROR: '行标签
MsgBox "Error: " & Err.Number & "-" & Err.Description '显示错误数和错误信息
End Sub
使图层可见
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 Sub
按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 If
End Function
放大/缩小
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进行。
全图：
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 Sub
清除图层
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 If
End Sub
查找图层
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
添加图层
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 Sub
1.
Sub MyMacro()
Dim pMxDocument As IMxDocument '地图文档
Set pMxDocument = Application.Document '获取当前应用程序的文档
MsgBox pMxDocument.FocusMap.Name '显示当前地图的名称
End Sub
2.
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 If
End Sub
3.
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 Sub
4.
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 Sub
SUB_ERROR: '行标签
MsgBox "Error: " & Err.Number & "-" & Err.Description '显示错误数和错误信息
End Sub
使图层可见
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 Sub
按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 If
End Function
放大/缩小
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进行。
全图：
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 Sub
清除图层
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 If
End Sub
查找图层
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
添加图层
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 Sub
