wthughes

Click on a feature (mousedown) and get custom attributes in a form

Discussion created by wthughes on Oct 28, 2010
Latest reply on Oct 28, 2010 by wthughes
Here's my code. This used to work ... i think. Please take a look and let me know why I am getting a runtime error 91 ... object variable ... not set.
This code should find attributes for fields from selectable layers. It would be better if I could change it so that it is layer specific.
I use this code to select attributes for two common points and then compare attribute values. The comparing gets handle in the form - basically just subtracts txtbox values.

I recently upgraded to ArcGIS 9.3.1. from 9.2. The geodatabase is 9.1.

Thanks in advance.

Will

Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
Dim pMxDoc As IMxDocument
  Dim pActiveView As IActiveView
  Dim pPoint As IPoint
  Dim pFeature As IFeature
 
  Set pMxDoc = Application.Document
  Set pActiveView = pMxDoc.FocusMap
  'Create a search point
  Set pPoint = pActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  '
  'Pass the point to the FindFeature function along with the Map and search tolerance
  Set pFeature = FindFeature1(pMxDoc.SearchTolerance, pPoint, pMxDoc.FocusMap)
 
  'Message box the feature ID and feature class alias name
 
  If Not pFeature Is Nothing Then MsgBox pFeature.Value(pFeature.Fields.FindField("FACILITYID")) _
  & vbCr & " " & pFeature.Class.AliasName _
  & vbCr & " " & pFeature.Value(pFeature.Fields.FindField("X")) _
  & vbCr & " " & pFeature.Value(pFeature.Fields.FindField("Y")) _
  & vbCr & " " & pFeature.Value(pFeature.Fields.FindField("Z")) _
  & vbCr & " " & pFeature.Value(pFeature.Fields.FindField("Depth")) _
  & vbCr & " " & pFeature.Value(pFeature.Fields.FindField("Invert"))

    Load UserForm2
   
    UserForm2.txtFacID.Value = Format(pFeature.Value(pFeature.Fields.FindField("FACILITYID")), "0.00")
    'UserForm2.txtX.Value = Format(pFeature.Value(pFeature.Fields.FindField("X")), "0.00")
    'UserForm2.txtY.Value = Format(pFeature.Value(pFeature.Fields.FindField("Y")), "0.00")
    'UserForm2.txtZ.Value = Format(pFeature.Value(pFeature.Fields.FindField("Z")), "0.00")
    'UserForm2.txtDepth.Value = Format(pFeature.Value(pFeature.Fields.FindField("Depth")), "0.00")
    'UserForm2.txtInvert.Value = Format(pFeature.Value(pFeature.Fields.FindField("Invert")), "0.00")
   
    UserForm2.Caption = pFeature.Class.AliasName
   
    UserForm2.Show (modal)
   
  


End Sub

Private Function FindFeature1(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
 
  'Expand the points envelope to give better search results
  Set pEnvelope = pPoint.Envelope
  pEnvelope.Expand SearchTol, SearchTol, False
 
  'Create a new spatial filter and use the new envelope as the geometry
  Set pSpatialFilter = New SpatialFilter
  Set pSpatialFilter.Geometry = pEnvelope
  pSpatialFilter.SpatialRel = esriSpatialRelIntersects

  'Search each selectable feature layer for a feature
  'Return the first feature found
  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
    'Only search the selectable layers
    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)  'Do the search
      Set pFeature = pFeatureCursor.NextFeature  'Get the first feature
      If Not pFeature Is Nothing Then
        Set FindFeature1 = pFeature  'Exit if feature is valid
        Exit Do
      End If
    End If
    Set pFeatureLayer = pEnumLayer.Next
  Loop

End Function

Outcomes