//使用Iidentify接口，Iarray接口，IfeatureIdentifyObj接口，Iidentifyobj接口。实现ArMap中类似于Identify的功能。（环境是在VBA下 ）

Private Sub UIToolControl1_MouseDown(ByVal button As Long, _
              ByVal shift As Long, ByVal x As Long, ByVal y As Long)
  Dim pMxApp As IMxApplication
  Dim pDoc As IMxDocument
  Dim pMap As IMap
  Dim pIdentify As IIdentify
  Dim pIDArray As IArray
  Dim pFeatIdObj As IFeatureIdentifyObj
  Dim pIdObj As IIdentifyObj
  Dim tol As Long
  Dim pEnv As IEnvelope
  Dim r As tagRECT
 
  Set pMxApp = Application
  Set pDoc = Application.Document
  Set pMap = pDoc.FocusMap
  Set pIdentify = pMap.Layer(0)
  tol = pDoc.SearchTolerancePixels
 
  'consruct a small rectangle out of the x,y coord and the document's pixel tolerance
  r.Left = x - tol 'upper left x, top left is 0,0
  r.Top = y - tol 'upper left y, top left is 0,0
  r.Right = x + tol 'lower right x, top left is 0,0
  r.bottom = y + tol 'lower right y, top left is 0,0
 
  'Tranform the device rectange into a geographic rectangle via the display transformation
  Set pEnv = New Envelope
  pMxApp.Display.DisplayTransformation.TransformRect pEnv, r, esriTransformPosition + esriTransformToMap
 
  'setup the spatial reference on the newly hydrated envelope
  Set pEnv.SpatialReference = pMap.SpatialReference
 
  'identify with the envelope
  Set pIDArray = pIdentify.Identify(pEnv)
 
  'Get the FeatureIdentifyObject
  If Not pIDArray Is Nothing Then
    Set pFeatIdObj = pIDArray.Element(0)
    Set pIdObj = pFeatIdObj
    pIdObj.Flash pMxApp.Display
    'Report info from FeatureIdentifyObject
    MsgBox "Layer: " & pIdObj.Layer.Name & vbNewLine & "Feature: " & pIdObj.Name
  Else
    MsgBox "No feature identified."
  End If
End Sub