VBA+AO入门例子

代码地址

http://download.csdn.net/detail/kongzhongxing/4547927 

'定义监听
Dim WithEvents g_Map As Map
'图层计数
Private Sub CommandButton1_Click()
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim ICount As Long
Dim iIndex As Long
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
ICount = 0
For iIndex = 0 To (pMap.LayerCount - 1)
  If TypeOf pMap.Layer(iIndex) Is IFeatureLayer Then
  ICount = ICount + 1
  End If
  Next iIndex
MsgBox "Number of the feature layers " & "in the active map :" & ICount
MsgBox "Number of the feature in the active map :" + Str(ICount)


End Sub
'图层的显示
Private Sub CommandButton2_Click()
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pFeatureLayer As IFeatureLayer
Dim pActiveView As IActiveView
Dim pContentsView As IContentsView
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
Dim iIndex As Long
For iIndex = 0 To (pMap.LayerCount - 1)
Set pFeatureLayer = pMap.Layer(iIndex)
  pFeatureLayer.Visible = Not (pFeatureLayer.Visible)
  Set pContentsView = pDoc.CurrentContentsView
  pContentsView.Refresh pFeatureLayer
Next iIndex
Set pActiveView = pMap
pActiveView.Refresh
  
End Sub
'查询要素
Private Sub CommandButton3_Click()
Dim pDoc As IMxDocument
Dim pMap As IMap
Dim pFeatureLayer As IFeatureLayer
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
Set pFeatureLayer = pMap.Layer(0)
MsgBox pFeatureLayer.Name
Dim pFeatureNew As IFeature
Dim pFeatureClass As IFeatureClass '要素类
Dim pQueryFilter As IQueryFilter '查询过滤器
Dim pFeatureCursor As IFeatureCursor '查询结果集
Set pFeatureClass = pFeatureLayer.FeatureClass
Set pQueryFilter = New QueryFilter
pQueryFilter.WhereClause = "ZDSZ = '2110004'"
Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)
Dim pFeature As IFeature
Set pFeature = pFeatureCursor.NextFeature
If pFeature Is Nothing Then
   MsgBox "数据为空呢"
  Set pFeatureNew = Nothing
  Else
  Set pFeatureNew = pFeature
End If


If pFeatureNew Is Nothing Then
MsgBox "数据为空"
Else


MsgBox "数据存在"
End If


End Sub
'地图放大缩小
Private Sub CommandButton4_Click()
Dim pDoc As IMxDocument
Dim pMap As IMap
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
Dim pActiveView As IActiveView
Dim pEnv As IEnvelope '显示范围
Set pActiveView = pDoc.ActivatedView
Set pEnv = pActiveView.Extent '获取当前的显示范围
pEnv.Expand 2, 2, True '改为2为缩小
pActiveView.Extent = pEnv
pActiveView.Refresh




End Sub
'刷新图层列表
Private Sub CommandButton5_Click()
Dim pDoc As IMxDocument
Dim pMap As IMap
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
pMap.ClearLayers
pDoc.UpdateContents '更新图层列表
pDoc.activeView.Refresh '刷新地图视图
End Sub
'添加图层
Private Sub CommandButton6_Click()
Dim wksFact As IWorkspaceFactory '工作空间管理器
Dim wks As IFeatureWorkspace '要素工作空间
Dim pFeaClass As IFeatureClass '要素类
Dim pFeaLyr As IFeatureLayer ' 要素层
Dim ds As IDataset '数据集
Dim pDoc As IMxDocument '地图文档
Dim pMap As IMap '地图
Set wksFact = New ShapefileWorkspaceFactory '创建shape工作空间管理器
Set wks = wksFact.OpenFromFile("F:\国图\国土地图数据\GG_Out\", 0) '确保此路径下存在XZQ.shp
Set pFeaClass = wks.OpenFeatureClass("XZQ") '获取要素类`
Set pFeaLyr = New FeatureLayer '创建要素层
Set pFeaLyr.FeatureClass = pFeaClass '向要素层中添加要素类
Set ds = pFeaClass '获取数据集
pFeaLyr.Name = ds.Name '图层名称以数据集的名称命名
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap
pMap.AddLayer pFeaLyr
pDoc.activeView.Refresh
End Sub
'添加文本
Private Sub CommandButton7_Click()
Dim pDoc As IMxDocument ' 地图文档
Dim pActiveView As IActiveView '活动地图
Dim sym As ITextSymbol '文本符号
Dim bnds As IArea '面
Set pDoc = ThisDocument
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, "WO SHI WENBEN"
  .FinishDrawing
End With


End Sub
'选择要素
Private Sub CommandButton8_Click()
Dim pDoc As IMxDocument
Dim pFeatureLayer As IFeatureLayer
Dim sel As IFeatureSelection '选择器
Dim filter As IQueryFilter '过滤器
Dim selEvents As ISelectionEvents '选择事件
Set pDoc = ThisDocument
Set pFeatureLayer = pDoc.FocusMap.Layer(0)
Set sel = pFeatureLayer '选择的数据集
Set filter = New QueryFilter
filter.WhereClause = "ZDSZ = '2110004'"
sel.SelectFeatures filter, esriSelectionResultNew, False '获取选择的要素
pDoc.ActivatedView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
Set selEvents = pDoc.FocusMap
selEvents.SelectionChanged




End Sub


'监听执行函数
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("DJH")
  If index <> -1 Then MsgBox feat.Value(index)
  Set feat = featureEnum.Next
  Loop
End Sub
'监听
Private Sub CommandButton9_Click()


Dim pDoc As IMxDocument
Dim pFeatureLayer As IFeatureLayer
Dim sel As IFeatureSelection '选择器
Dim filter As IQueryFilter '过滤器
Dim selEvents As ISelectionEvents '选择事件
Set pDoc = ThisDocument
Set g_Map = pDoc.FocusMap
Set pDoc = ThisDocument
Set pFeatureLayer = pDoc.FocusMap.Layer(0)
Set sel = pFeatureLayer '选择的数据集
Set filter = New QueryFilter
filter.WhereClause = "ZDSZ = '2110004'"
sel.SelectFeatures filter, esriSelectionResultNew, False '获取选择的要素
pDoc.ActivatedView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
Set selEvents = pDoc.FocusMap
selEvents.SelectionChanged


End Sub




Private Sub UserForm_Click()


End Sub
'通过名称获得要素
Private Function GetFeatureByName(pFeatureLayer As IFeatureLayer, sFeatureName 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 = "QSXZ = 'A'"
Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)
Dim pFeature As IFeature
Set pFeature = pFeatureCursor.NextFeature
If pFeature Is Nothing Then
   MsgBox "数据为空呢"
  Set GetFeatureByName = Nothing
  Else
  Set GetFeatureByName = pFeature
End If
End Function