AnsweredAssumed Answered

Select by Location with ArcObjects, VBA and ArcGIS 10.3

Question asked by kaiapel on Jul 20, 2015

Hi Community,

 

I have an old VBA tool collection (wrote in VBA and works well up to ArcGIS 10.2). Now I have upgraded to ArcGIS 10.3.1 and it throws an error.

It use the Mouse-Down_Procedure to get attributes from the clicked object. The error throwns at Set pMxApp = Application

 

Erronumber: 13

ErrDescription: Type mismatch

 

CODE:

'##########################################################################################################

Private Sub ClickMe_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)

'from Sample Select By Location

Dim pMxApp As IMxApplication

Dim pMxDoc As IMxDocument

Dim pMap As IMap

Dim pActiveView As IActiveView

Dim pPoint As IPoint

Dim pFeature As IFeature

Dim pEnvelope As IEnvelope

Dim pFS As IFeatureSelection

Dim pFCursor As IFeatureCursor

Dim pLayer As IFeatureLayer

Dim sURL As String 'Hyperlink

Dim sUser As String

 

'On Error GoTo ClickMe_MouseDown_Error

 

'set parameters

Set pMxApp = Application 'that doesn't works in ArcMap 10.3

Set pMxDoc = ThisDocument

Set pMap = pMxDoc.FocusMap

Set pActiveView = pMap

 

'set Layer to select object from

For i = 0 To pMap.LayerCount - 1

    Debug.Print pMap.Layer(i).Name

    If pMap.Layer(i).Name = "LayerA" Then

        Set pLayer = pMap.Layer(i)

    End If

Next i

 

Set pEnvelope = pMxDoc.CurrentLocation.Envelope

pEnvelope.Expand 10, pMxDoc.SearchTolerance, False 'pMxDoc.SearchTolerance

'Refresh the old selection to erase it

pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing

'Perform the selection using a point created on mouse down

pMap.SelectByShape pEnvelope, pMxApp.SelectionEnvironment, True '

'Refresh again to draw the new selection

pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing

 

'here have to check NULL-Value before!

If Not pFeature Is Nothing Then

     'Build URL String If found NULL then "no data"

     If IsNull(pFeature.Value(pFeature.Fields.FindField("Username"))) = False Then

          sUser= pFeature.Value(pFeature.Fields.FindField("Username"))

    Else

           sUser= "no data"

    End If

          .......

 

End if

 

Set pFeature = Nothing

Set pPoint = Nothing

Set pActiveView = Nothing

Set pMxDoc = Nothing

 

Exit Sub

 

ClickMe_MouseDown_Error:

If Err.Number = 91 Or Err.Number = 94 Then

    Exit Sub

Else

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ClickMe_MouseDown of VBA Dokument ThisDocument"

End If

'############################################################################################################

 

Did anyone can someone give me a hint? I need to select a feature from MouseDown (point) and parse the attribute table for getting all the information from this clicked point to display in an own form....

 

thx at all

 

Kai

Outcomes