ArcGIS VBA - VBA+AO入門15例完全註釋版

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.Descripttion '顯示錯誤數和錯誤資訊
End Sub


5.

'是圖層可視
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


6.

'按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


7.

'放大/縮小
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 Sub


9.

'清除圖層
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

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
    Next

End Function


11.

'新增圖層
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


12.

'新增文字
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 With

End Sub


13.

'選擇要素
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 Sub


14.

'監聽

Dim WithEvents g_Map As map

Private 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 '移至選擇集中的下一個要素
    Loop

End Sub

來源：http://www.cnblogs.com/atravellers/archive/2010/01/13/1646606.html