AO中的动态标注程序

Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
Dim pActiveView As IActiveView
Dim pDoc As IMxDocument, pMap As IMap
Dim pGeoLayer As IGeoFeatureLayer
Dim pAnnoProps As IAnnotateLayerPropertiesCollection
Dim pLabelEngine As ILabelEngineLayerProperties

Dim pPoint As IPoint
Dim pFeature As IFeature
 
Set pDoc = Application.Document
Set pMap = pDoc.FocusMap
Set pActiveView = pDoc.FocusMap

Dim ILoop As Integer

'定位“标注点”层
For ILoop = 0 To pMap.LayerCount - 1
       If pMap.Layer(ILoop).Name = "SDE.标注点" Then
         Set pGeoLayer = pMap.Layer(ILoop)
         Exit For
       End If
Next ILoop

Set pAnnoProps = pGeoLayer.AnnotationProperties
pAnnoProps.QueryItem 0, pLabelEngine
 
  '创建查找点
  Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  '调用FindFeature
  Set pFeature = FindFeature(pDoc.SearchTolerance, pPoint, pDoc.FocusMap)
  If Not pFeature Is Nothing Then
    If pFeature.Class.AliasName = "SDE.统计项" Then
        '为pLabelEngine表达式赋值
        pLabelEngine.Expression = "[SDE.内蒙古盟市级区划_科技统计标注.F" & pFeature.oid & "]"
        Set pAnnoLayerProps = pLabelEngine
        '清空标注
        pAnnoProps.Clear
        '添加当前标注
        pAnnoProps.Add pAnnoLayerProps
        pGeoLayer.DisplayAnnotation = True
        pGeoLayer.DisplayField = pLabelEngine.Expression
        '刷新
        pActiveView.Refresh
    End If
 End If

End Sub

Public Function SearchFeatureLayer(pFeatureLayer As esriCarto.IFeatureLayer, _
                             searchGeometry As esriGeometry.IGeometry, _
                             spatialRelation As esriGeoDatabase.esriSpatialRelEnum, _
                             Optional whereClause As String = "" _
                             ) As esriGeoDatabase.IFeatureCursor

  Dim pSpatialFilter As esriGeoDatabase.ISpatialFilter
  Dim pFeatureCursor As esriGeoDatabase.IFeatureCursor

  '建立空间查询过滤器
  Set pSpatialFilter = New esriGeoDatabase.SpatialFilter

  '设置过滤器属性
  Dim pFeatureClass As IFeatureClass
  Set pFeatureClass = pFeatureLayer.FeatureClass
  pSpatialFilter.GeometryField = pFeatureClass.ShapeFieldName
  Set pSpatialFilter.Geometry = searchGeometry
  pSpatialFilter.SpatialRel = spatialRelation
  pSpatialFilter.whereClause = whereClause

  '执行查询得到当前指针结果
  Set pFeatureCursor = pFeatureLayer.Search(pSpatialFilter, True)

  '返回指针
  Set SearchFeatureLayer = pFeatureCursor

End Function

 

Private Function FindFeature(SearchTol As Double, pPoint As IPoint, pMap As IMap) As IFeature
  Dim pEnvelope As IEnvelope
  Dim pSpatialFilter As ISpatialFilter
  Dim pEnumLayer As IEnumLayer
  Dim pFeatureLayer As IFeatureLayer
  Dim pFeatureClass As IFeatureClass
  Dim pFeatureCursor As IFeatureCursor
  Dim pFeature As IFeature
  Dim pUID As New UID
  Dim ShapeFieldName As String
 
  If pMap.LayerCount = 0 Then Exit Function
 

  Set pEnvelope = pPoint.Envelope
  pEnvelope.Expand SearchTol, SearchTol, False
 
  '创建一个 spatial filter
  Set pSpatialFilter = New SpatialFilter
  Set pSpatialFilter.Geometry = pEnvelope
  pSpatialFilter.SpatialRel = esriSpatialRelIntersects

  '查找feature layer 并返回首个 feature
  pUID = "{40A9E885-5533-11D0-98BE-00805F7CED21}" 'IFeatureLayer
  Set pEnumLayer = pMap.Layers(pUID, False)
  pEnumLayer.Reset
  Set pFeatureLayer = pEnumLayer.Next
  Do While Not pFeatureLayer Is Nothing
    '只对可查找的层进行查找
    If pFeatureLayer.Selectable Then
      ShapeFieldName = pFeatureLayer.FeatureClass.ShapeFieldName
      Set pSpatialFilter.OutputSpatialReference(ShapeFieldName) = pMap.SpatialReference
      pSpatialFilter.GeometryField = pFeatureLayer.FeatureClass.ShapeFieldName
      Set pFeatureClass = pFeatureLayer.FeatureClass
      Set pFeatureCursor = pFeatureClass.Search(pSpatialFilter, False)  '进行查找
      Set pFeature = pFeatureCursor.NextFeature  '返回首个 feature
      If Not pFeature Is Nothing Then
        Set FindFeature = pFeature  ' feature非法
        Exit Do
      End If
    End If
    Set pFeatureLayer = pEnumLayer.Next
  Loop
End Function