用AO实现identify功能代码?

我想自己用代码实现IDENTIFY功能,可是在使用时发现如果点面状地物时,能显示属性,而点线状和点状地物时却显示找不到地物,代码如下:
  Dim pPoint As IPoint
  Set pPoint = frmMain.MapControl1.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  Dim pLayer As ILayer
  Dim pFeatLayer As IFeatureLayer
  Dim pIdentify As IIdentify
  Dim pArray As IArray
  Dim i As Integer
  For i = 0 To frmMain.MapControl1.LayerCount - 1
    Set pLayer = frmMain.MapControl1.Layer(i)
    Set pFeatLayer = pLayer
    Set pIdentify = pFeatLayer
    Set pArray = pIdentify.Identify(pPoint)
    If Not pArray Is Nothing Then
      MsgBox pArray.Count              '-----------代码只能在面状地物时显示pArray.Count
    End If
  Next


<P>请求哪位大侠帮我解决一下,谢谢</P>

<P>这是一个自定义窗口显示对象列表和属性的代码，自己看看，不一定对你有用，应该可以了解一点东西</P><P>Option Explicit
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 Const WM_CLOSE = ;H10</P><P>Private m_pColFeatureSelection As Collection
Private m_pMap As IMap                 ' Current Focused map
Private m_pApp As IApplication         ' Hook to the application object
Private m_pf As IFeature
Private Const CELLWIDTH = 10 '10byte width of each column in export file
'程序入口
Public Sub Init(pApp As IApplication, ColSelection As Collection)
   On Error GoTo ErrorHandler
  Dim pMxDoc As IMxDocument
  
  Set m_pApp = pApp
  Set pMxDoc = m_pApp.Document
  Set m_pMap = pMxDoc.FocusMap
  Set m_pColFeatureSelection = Nothing
  Set m_pColFeatureSelection = ColSelection
  
  Dim pf As IFeature
   Dim bhavePoly As Boolean
   bhavePoly = False
  Dim i As Integer
   For i = 1 To m_pColFeatureSelection.count
     Set pf = m_pColFeatureSelection.Item(i)
        If pf.Shape.GeometryType = esriGeometryPolygon Then
          bhavePoly = True
          Exit For
        End If
   Next i</P><P>  If bhavePoly = True Then BtnExport.Enabled = False
  
    Call InitDispAttri</P><P>  Exit Sub
ErrorHandler:
  MsgBox "An error has occured while setting the connection point" ; vbCr ; vbCr ; _
         "Details : " ; err.Description, vbExclamation + vbOKOnly, "Error"
End Sub</P><P>
Private Sub BtnClear_Click()
  Call MSFlexGridAtt.Clear
  Call ClearAllSelectedObjects
  BtnExport.Enabled = False
End Sub</P><P>Private Sub BtnExport_Click()
  Dim fso As New FileSystemObject, tsp As TextStream, tsl As TextStream
 On Error GoTo ERR_Handler
   Set fso = CreateObject("Scripting.FileSystemObject")
    
    If fso.FileExists("c:\PipesearchPoints.txt") Then
       Call fso.CopyFile("c:\PipesearchPoints.txt", "c:\PipesearchPoints.bak")
    End If
    If fso.FileExists("c:\PipesearchLines.txt") Then
       Call fso.CopyFile("c:\PipesearchLines.txt", "c:\PipesearchLines.bak")
    End If
  
  
  
   Set tsp = fso.CreateTextFile("c:\PipesearchPoints.txt", True)
   Set tsl = fso.CreateTextFile("c:\PipesearchLines.txt", True)
'CELLWIDTH is 10
tsp.WriteLine "FID       ID        管点编码  管点类别   X坐标     Y坐标     井盖高程  井深      道路名称  开/关     源/尾     坐标    "
tsl.WriteLine "FID       ID        管段编码  类别      材质      规格      管径      流向      起点点号  起点埋深  终点点号  终点埋深  道路名称  敷设方式  开/关     长度      坐标对    "</P><P>     Dim i, count As Integer
      Dim pf As IFeature
       count = m_pColFeatureSelection.count
     For i = 1 To count
        Set pf = m_pColFeatureSelection.Item(i)
         ExportpftoFile pf, tsp, tsl
     Next i</P><P>
tsp.Close
tsl.Close
    MsgBox "输出结束"
    Exit Sub
ERR_Handler:
    MsgBox "请确认文档案编辑器未打开c:\PipesearchPoints.txt 或 c:\PipesearchLines.txt，关闭之", vbCritical
End Sub</P><P>Private Sub BtnOK_Click()
  Unload Me
  Dim i As Integer
  For i = m_pColFeatureSelection.count To 1 Step -1
    m_pColFeatureSelection.Remove i
  Next i
End Sub</P><P>Private Sub FlashTimer_Timer()
If m_pf Is Nothing Then Exit Sub
Dim pcol As New Collection
Dim pflash As New CFlash
 pcol.Add m_pf
 Call pflash.Init(m_pApp, pcol)
 Call pflash.FlashFeatures
End Sub</P><P>
Private Sub Form_Activate()
  'Init FlexGrid
  
LblCount.Caption = "共：" ; LstObject.ListCount
End Sub</P><P>'双击显示对象属性
Private Sub LstObject_DblClick()
Dim pf As IFeature
Dim penf As IEnumFeature
 Dim i As Integer
 
 
  For i = 1 To m_pColFeatureSelection.count
     Set pf = m_pColFeatureSelection.Item(i)
        If pf.OID = LstObject.List(LstObject.ListIndex) Then
          Exit For
        End If
   Next i
    
Dim pMxDoc As IMxDocument
Set pMxDoc = m_pApp.Document
'refresh the screen to remove old flash
  'move the feature to view center
   Dim pExtent As IEnvelope
   Set pExtent = pf.Extent
    pExtent.Expand 20, 20, False
    pMxDoc.ActiveView.Extent = pExtent
  Call pMxDoc.ActiveView.refresh
Set m_pf = pf
' Call FlashFeature(pf, pMxDoc)
'init flexgrid
DoInitialSettingsFlexGrid
 
    MSFlexGridAtt.Rows = 1
  Me.refresh
 '显示图形坐标
 Call IObject_Inspect(pf)
 '显示属性
 Call DisplayAttri(pf)
End Sub</P><P>Private Sub Form_Load()
 ' Call InitDispAttri
 Set m_pf = Nothing</P><P>End Sub</P><P>'显示对象属性
Private Function DisplayAttri(pf As IFeature)
Dim str As String
Dim pfield As ifield
Dim i As Integer
    For i = 0 To pf.Fields.FieldCount - 1
        Set pfield = pf.Fields.Field(i)
         str = pfield.AliasName
         If Not (pfield.Type = esriFieldTypeBlob Or pfield.Type = esriFieldTypeGeometry) Then
            If Not (InStr(1, str, "-") > 0 Or InStr(1, str, "_") > 0 Or InStr(1, str, "#") > 0) Then
               If Not (str = "LENGTH" Or str = "AREA" Or str = "PERIMETER") Then
                 str = str ; Chr(9) ; pf.Value(i)
                   MSFlexGridAtt.AddItem str
               End If
            End If
         End If</P><P>    Next i
End Function
'显示多边形图形坐标及多边形的异或显示
Private Sub ReportPolygons(pFeature As IFeature)
On Error GoTo err:
'This routine sets the Flex Grid Control column values for
'a polygon feature
Dim pPoly As IPolygon, pArea As IArea, pCurve As ICurve
Dim str As String
 Dim IPC As IPointCollection</P><P> Dim ip As IPoint
 Dim i As Integer</P><P>  Set pPoly = pFeature.Shape
  Set pCurve = pPoly
  Set pArea = pPoly
  'Report Area First
  Set IPC = pPoly</P><P>
  str = "面积" ; Chr(9) ; Round(pArea.Area, 4)
    MSFlexGridAtt.AddItem str</P><P>  'Then Perimeter
  Set pCurve = pPoly
  str = "周长" ; Chr(9) ; Round(pCurve.Length, 4)
     MSFlexGridAtt.AddItem str
  Set ip = IPC.Point(0)
  str = "坐标对"
  str = str ; Chr(9) ; "(" ; Round(ip.X, 4) ; "," ; Round(ip.Y, 4) ; ")"
     MSFlexGridAtt.AddItem str</P><P> For i = 1 To IPC.PointCount - 1
   Set ip = IPC.Point(i)
    str = "坐标对"
   str = str ; Chr(9) ; "(" ; Round(ip.X, 4) ; "," ; Round(ip.Y, 4) ; ")"</P><P>     MSFlexGridAtt.AddItem str
  Next i</P><P>  Exit Sub
err:
  MsgBox "ReportPolygons: " ; err.Description
End Sub
Private Sub ReportPolylines(pFeature As IFeature)
On Error GoTo err:
'This routine sets the Flex Grid Control column values for
'a polyline feature
 Dim pCurve As ICurve
 Dim IPC As IPointCollection
 Dim ip As IPoint
 Dim i As Integer</P><P> Dim str As String
  Set pCurve = pFeature.Shape
  Set IPC = pCurve</P><P>
  'Report Length First
  str = "长度" ; Chr(9) ; Round(pCurve.Length, 4)
 MSFlexGridAtt.AddItem str</P><P> Set ip = IPC.Point(0)
 str = "坐标对"
 str = str ; Chr(9) ; "(" ; Round(ip.X, 4) ; "," ; Round(ip.Y, 4) ; ")"
 MSFlexGridAtt.AddItem str</P><P>   For i = 1 To IPC.PointCount - 1
     Set ip = IPC.Point(i)</P><P>    str = "坐标对"
    str = str ; Chr(9) ; "(" ; Round(ip.X, 4) ; "," ; Round(ip.Y, 4) ; ")"
    MSFlexGridAtt.AddItem str</P><P>   Next i</P><P>  Exit Sub
err:
  MsgBox "ReportPolylines: " ; err.Description
End Sub</P><P>Private Sub ReportPoints(pFeature As IFeature)
On Error GoTo err:
'This routine sets the Flex Grid Control column values for
'a point feature
Dim pPt As IPoint
Dim str As String
 Set pPt = pFeature.Shape</P><P>  'Report X and Y coordinate locations
  str = "坐标"
  'Report Start Point next
  str = str ; Chr(9) ; "(" ; Round(pPt.X, 4) ; "," ; Round(pPt.Y, 4) ; ") "
    MSFlexGridAtt.AddItem str</P><P>   Exit Sub
err:
  MsgBox "ReportPoints: " ; err.Description
End Sub</P><P>
Private Sub IObject_Inspect(pFeature As IFeature)
   On Error GoTo err:
  'Set the column headings
  
  
  Select Case pFeature.Shape.GeometryType
  Case esriGeometryPolygon
    'Do this for Polygons
    ReportPolygons pFeature
  Case esriGeometryPolyline
    'Do this for polylines
    ReportPolylines pFeature
  Case esriGeometryPoint
    'Do this for points
    ReportPoints pFeature
  End Select</P><P>  Exit Sub
err:
  MsgBox "IObjectInspector_Inspect: " ; err.Description
End Sub</P><P>
'清空已选中的图形对象</P><P>Private Sub Form_Unload(Cancel As Integer)
 Dim i, count As Integer
  count = m_pColFeatureSelection.count
      For i = count To 1 Step -1
        m_pColFeatureSelection.Remove i
       Next
   Set m_pf = Nothing</P><P>End Sub
'ArcMap 结束时,释放内存
Private Sub Form_Terminate()
 'Set m_pColFeatureSelection = Nothing
End Sub</P><P>Private Sub ClearAllSelectedObjects()
 Dim i, count As Integer
 count = m_pColFeatureSelection.count
If count = LstObject.SelCount Then
  LstObject.Clear
   For i = count To 1 Step -1
      m_pColFeatureSelection.Remove i
   Next
   Set m_pf = Nothing
  Exit Sub
End If
Dim bcon As Boolean
bcon = True
Do While bcon = True
  For i = 0 To count - 1
    bcon = False
    If LstObject.Selected(i) = True Then
     m_pColFeatureSelection.Remove (i + 1)
      LstObject.RemoveItem i
      count = m_pColFeatureSelection.count
      bcon = True
     Exit For
    End If
   Next i
Loop
  Call LstObject.refresh
End Sub
Private Sub InitDispAttri()</P><P>'取得选择集
Dim pf As IFeature
Dim iret As Integer
'当选择集为空时，发送Windows消息,关闭属性Form</P><P> If m_pColFeatureSelection.count < 1 Then
    MsgBox "应用系统选择集为空，请先选管点或管线"
 iret = PostMessage(Me.hwnd, WM_CLOSE, 0, 0)
    Exit Sub
  End If
Me.Caption = "对象属性显示窗口"</P><P>LstObject.Clear
MSFlexGridAtt.Clear
Dim i As Integer
    For i = 1 To m_pColFeatureSelection.count
        Set pf = m_pColFeatureSelection.Item(i)
      
        LstObject.AddItem (pf.OID)
    
    Next i
    
 Set pf = m_pColFeatureSelection.Item(m_pColFeatureSelection.count)
 LstObject.Selected(m_pColFeatureSelection.count - 1) = True
  MSFlexGridAtt.Clear
   'refresh the screen to remove old flash
   Dim pMxDoc As IMxDocument
  Set pMxDoc = m_pApp.Document
   Call pMxDoc.ActiveView.refresh</P><P>Set m_pf = pf
'init flexgrid</P><P>Call DoInitialSettingsFlexGrid
 
 MSFlexGridAtt.Rows = 1
 '显示图形坐标
 Call IObject_Inspect(pf)
 '显示属性
 Call DisplayAttri(pf)</P><P>End Sub</P><P>
Private Sub ExportpftoFile(pFeature As IFeature, tsp As TextStream, tsl As TextStream)
    On Error GoTo err:
  'Set the column headings
  
  
  Select Case pFeature.Shape.GeometryType
  'Case esriGeometryPolygon
    'Do this for Polygons
   ' ExportPolygonstoFile pFeature, ts
  Case esriGeometryPolyline
    'Do this for polylines
    ExportPolylinestoFile pFeature, tsl
  Case esriGeometryPoint
    'Do this for points
    ExportPointstoFile pFeature, tsp
  End Select</P><P>  Exit Sub
err:
  MsgBox "IObjectInspector_Inspect: " ; err.Description</P><P>End Sub
Private Sub ExportPolygonstoFile(pFeature As IFeature, ts As TextStream)
   On Error GoTo err:
'This routine sets the Flex Grid Control column values for
'a polygon feature
Dim pPoly As IPolygon, pArea As IArea, pCurve As ICurve
Dim str As String
 Dim IPC As IPointCollection</P><P> Dim ip As IPoint
 Dim i As Integer</P><P>  Set pPoly = pFeature.Shape
  Set pCurve = pPoly
  Set pArea = pPoly
  'Report Area First
  Set IPC = pPoly</P><P>
  str = " " ; pArea.Area ; "  "</P><P>  'Then Perimeter
  Set pCurve = pPoly
  str = str ; " " ; Round(pCurve.Length, 4) ; "  "
 Set ip = IPC.Point(0)
 str = str ; " "
 str = str ; "(" ; Round(ip.X, 4) ; "," ; Round(ip.Y, 4) ; ")" ; "  "</P><P> For i = 1 To IPC.PointCount - 1
   Set ip = IPC.Point(i)
   str = str ; "(" ; Round(ip.X, 4) ; "," ; Round(ip.Y, 4) ; ")" ; "  "
  Next i</P><P> Call ExportAttritofile(pFeature, str, ts)</P><P>
  Exit Sub
err:
  MsgBox "ReportPolygons: " ; err.Description</P><P>
End Sub</P><P>Private Sub ExportPolylinestoFile(pFeature As IFeature, ts As TextStream)
    On Error GoTo err:
'This routine sets the Flex Grid Control column values for
'a polyline feature
 Dim pCurve As ICurve
 Dim IPC As IPointCollection
 Dim ip As IPoint
 Dim i As Integer
 
 Dim str As String
  Set pCurve = pFeature.Shape
  Set IPC = pCurve
  
  
  'Report Length First
  str = "" ; Round(pCurve.Length, 4)
  
 Set ip = IPC.Point(0)
 str = str ; " "
 str = str ; "(" ; Round(ip.X, 4) ; "," ; Round(ip.Y, 4) ; ")" ; "  "
  
   For i = 1 To IPC.PointCount - 1
     Set ip = IPC.Point(i)
     str = str ; "(" ; Round(ip.X, 4) ; "," ; Round(ip.Y, 4) ; ")" ; "  "
   Next i
  
   Call ExportAttritofile(pFeature, str, ts)
  
  Exit Sub
err:
  MsgBox "ReportPolylines: " ; err.Description
  
End Sub
Private Sub ExportPointstoFile(pFeature As IFeature, ts As TextStream)
   Dim pPt As IPoint
Dim str As String
 Set pPt = pFeature.Shape
  'Report X and Y coordinate locations
  str = " "
  'Report Start Point next
  str = str ; "(" ; Round(pPt.X, 4) ; "," ; Round(pPt.Y, 4) ; ") " ; "  "
   Call ExportAttritofile(pFeature, str, ts)</P><P>End Sub</P><P>Private Function ExportAttritofile(pf As IFeature, str As String, ts As TextStream)
Dim pfield As ifield
Dim i As Integer
Dim ilen As Long
Dim str1, strname As String
Dim strtemp As String
Dim iGJ, iGG, iKS, iGS, iDY, iLX As Long
iGJ = pf.Fields.FindField("GJ")
iGG = pf.Fields.FindField("GG")
'do not export KS DY GS fields
iKS = pf.Fields.FindField("KS")
iGS = pf.Fields.FindField("GS")
iDY = pf.Fields.FindField("DY")
iLX = pf.Fields.FindField("LX")</P><P>  str1 = ""
    For i = 0 To pf.Fields.FieldCount - 1
        Set pfield = pf.Fields.Field(i)
         strname = pfield.AliasName
    If Not (i = iDY Or i = iGS Or i = iKS) Then
         If Not (pfield.Type = esriFieldTypeBlob Or pfield.Type = esriFieldTypeGeometry) Then
            If Not (InStr(1, strname, "-") > 0 Or InStr(1, strname, "_") > 0 Or InStr(1, strname, "#") > 0) Then
               If Not (strname = "LENGTH" Or strname = "AREA" Or strname = "PERIMETER") Then
                  If IsNull(pf.Value(i)) = True Then
                   strtemp = " "
                   Else
                   strtemp = pf.Value(i)
                  End If
                  If iGG < 0 And i = iGJ Then
                      str1 = str1 ; Space(CELLWIDTH)
                  End If
                  str1 = str1 ; Trim(strtemp)
                  ilen = DSLen(Trim(strtemp))
                  
                  If ilen < CELLWIDTH Then
                    str1 = str1 ; Space(CELLWIDTH - ilen)
                  End If
                  If iLX < 0 And i = iGJ Then
                      str1 = str1 ; Space(CELLWIDTH)
                  End If
                End If
            End If
         End If
     End If
    Next i
    str = str1 ; str
  ts.WriteLine str
End Function</P><P>Sub DoInitialSettingsFlexGrid()
       Dim i%
    MSFlexGridAtt.Row = 0
    MSFlexGridAtt.Cols = 2
    MSFlexGridAtt.ColAlignment(0) = 7
    
    
     MSFlexGridAtt.FixedRows = 1
          
      
    
      MSFlexGridAtt.FixedRows = 1
      MSFlexGridAtt.AllowUserResizing = flexResizeColumns
      MSFlexGridAtt.MergeCells = flexMergeRestrictColumns
    For i = 0 To MSFlexGridAtt.Cols - 1
    
         MSFlexGridAtt.col = i
         MSFlexGridAtt.CellFontSize = 14
         If i = 0 Then
           MSFlexGridAtt.CellAlignment = 7
           Else
           MSFlexGridAtt.CellAlignment = 1
         End If
         MSFlexGridAtt.MergeCol(i) = True     ' 允许0列到3列的合并
         MSFlexGridAtt.ColWidth(i) = 3490    ' 设置列宽度
         MSFlexGridAtt.ColWidth(0) = 1100
        
    Next i
    
        
         MSFlexGridAtt.col = 0
           MSFlexGridAtt.CellFontSize = 9
        
        ' MSFlexGridAtt.CellFontName = Screen.Fonts(2)
           MSFlexGridAtt.Text = " 名  称  "
        
        
           MSFlexGridAtt.col = 1
           MSFlexGridAtt.CellFontSize = 9
           MSFlexGridAtt.Text = "           属  性  值"
    
     </P><P>End Sub</P><P>
 </P>