Help with Run time error 91

EthanDunker · ‎02-04-2016

I am trying to create a button for ArcMap and I get Run time error 91 object variable or with block variable not set. I know the problem is one line 84 & 86. If I take them out the code runs, but it returns all my locations from the table. Also if you change the SEARCH_THRESHHOLD to 10000000, the code run with line 84 and 86 in there, but the same thing happens, it returns all my locations. I have the same code in another ArcMap and it works just fine. So I don't know what the problem is. Is there a setting I need to change in ArcMap itself? I am using ArcMap 10.3.1.

Here is the code:

Option Explicit

Const dbpath = "C:\Users\edunker\Documents\"

Const dbname = "WorkOrderDatabase.accdb"

'Const coord_file = "currcoords.dat"

'Const signshp_path = "s:\Highway\Signs\signdb\"

'Const signshp_file = "signsall"

Const GPS_BAUD = 4800

Const GPS_PORT = 1

Const SEARCH_THRESHHOLD = 10

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

Dim pMxDoc As IMxDocument

Dim pGPSPoint As IPoint

Dim pCursorPoint As IPoint

Set pCursorPoint = New Point

Dim pLocationFeat As IFeature

Dim pSignFClass As IFeatureClass

Set pMxDoc = ThisDocument

pCursorPoint.x = pMxDoc.CurrentLocation.x

pCursorPoint.y = pMxDoc.CurrentLocation.y

Dim pGeometry As IGeometry

Set pGeometry = pCursorPoint

Dim pTopoOperator As ITopologicalOperator

Set pTopoOperator = pCursorPoint

Dim dblSearchDistance As Double

dblSearchDistance = SEARCH_THRESHHOLD

Dim pBufferGeometry As IGeometry

Set pBufferGeometry = pTopoOperator.Buffer(dblSearchDistance)

Set pLocationFeat = GetSelectedLocation(pBufferGeometry)

If pLocationFeat Is Nothing Then Exit Sub

Shell "c:\Program Files (x86)\Microsoft Office\Office14\msaccess.exe " & dbpath & dbname & " /cmd Locationedit=" & pLocationFeat.Value(pLocationFeat.Fields.FindField("LocationID")), vbMaximizedFocus

End Sub

Public Function GetSelectedLocation(pGeom As IGeometry) As IFeature

Dim pMxDoc As IMxDocument

Set pMxDoc = ThisDocument

Dim pMap As IMap

Set pMap = pMxDoc.FocusMap

Dim strRoadNumber As String

Dim strLocationType As String

Dim strLocationID As String

'Dim strOrientation As String

Dim i As Long

Dim pFLayer As IFeatureLayer

Dim pFClass As IFeatureClass

Dim pID As New esriSystem.UID ' New esriCore.UID

Dim pAllFLayers As IEnumLayer

pID.Value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}"

Set pAllFLayers = pMap.Layers(, True)

Set pFLayer = pAllFLayers.Next

Do Until pFLayer Is Nothing

If pFLayer.Name = "LocationData" Then Exit Do

Set pFLayer = pAllFLayers.Next

Loop

Set pFClass = pFLayer.FeatureClass

Dim pScratchWorkspace As IWorkspace

Dim pScratchWorkspaceFactory As IScratchWorkspaceFactory

Set pScratchWorkspaceFactory = New ScratchWorkspaceFactory

Set pScratchWorkspace = pScratchWorkspaceFactory.DefaultScratchWorkspace

Dim pSpatialFilter As ISpatialFilter

Set pSpatialFilter = New SpatialFilter

'Set pSpatialFilter.Geometry = pGeom

'pSpatialFilter.GeometryField = "SHAPE"

'pSpatialFilter.SpatialRel = esriSpatialRelContains

Dim pFeatureCursor As IFeatureCursor

Set pFeatureCursor = pFClass.Search(pSpatialFilter, False)

Dim pFeat As IFeature

Dim pTempFeat As IFeature

Set pFeat = pFeatureCursor.NextFeature

strRoadNumber = pFeat.Value(pFeat.Table.FindField("RoadNumber"))

strLocationType = pFeat.Value(pFeat.Table.FindField("LocationType"))

strLocationID = pFeat.Value(pFeat.Table.FindField("LocationID"))

'strOrientation = pFeat.Value(pFeat.Table.FindField("ORIENTATIO"))

If pFeat Is Nothing Then

MsgBox "You must select a Location", vbCritical

Set GetSelectedLocation = Nothing

Exit Function

End If

If pFeat.Fields.FindField("LocationID") = -1 Then

MsgBox "You must select a sign to position first", vbCritical

Set GetSelectedLocation = Nothing

Exit Function

End If

Set pTempFeat = pFeatureCursor.NextFeature

If Not pTempFeat Is Nothing Then

Set pFeat = pTempFeat

Load frmMultiplePoint

frmMultiplePoint.lstLocation.Clear

frmMultiplePoint.lstLocation.AddItem

frmMultiplePoint.lstLocation.List(0, 0) = strRoadNumber

frmMultiplePoint.lstLocation.List(0, 1) = strLocationType

frmMultiplePoint.lstLocation.List(0, 2) = strLocationID

'frmMultiplePoint.lstLocation.List(0, 3) = strOrientation

Do While Not pFeat Is Nothing

strRoadNumber = pFeat.Value(pFeat.Table.FindField("RoadNumber"))

strLocationType = pFeat.Value(pFeat.Table.FindField("LocationType"))

strLocationID = pFeat.Value(pFeat.Table.FindField("LocationID"))

'strOrientation = pFeat.Value(pFeat.Table.FindField("ORIENTATIO"))

frmMultiplePoint.lstLocation.AddItem

frmMultiplePoint.lstLocation.List(frmMultiplePoint.lstLocation.ListCount - 1, 0) = strRoadNumber

frmMultiplePoint.lstLocation.List(frmMultiplePoint.lstLocation.ListCount - 1, 1) = strLocationType

frmMultiplePoint.lstLocation.List(frmMultiplePoint.lstLocation.ListCount - 1, 2) = strLocationID

'frmMultiplePoint.lstSigns.List(frmMultiplePoint.lstSigns.ListCount - 1, 3) = strOrientation

Set pFeat = pFeatureCursor.NextFeature

Loop

frmMultiplePoint.Show

If frmMultiplePoint.Tag = "OK" Then

Set pFeatureCursor = pFClass.Search(pSpatialFilter, False)

For i = 0 To frmMultiplePoint.lstLocation.ListIndex

Set pFeat = pFeatureCursor.NextFeature

Else 'frmMultiplePoint.Tag = "CANCEL"

Set GetSelectedLocation = Nothing

Exit Function

End If

Set GetSelectedLocation = pFeat

End Function

deleted-user-bTT1-4SKF1c0 · ‎02-11-2016

Hi Ethan,

Interesting question.

Which lines are 84 and 86?

Leo.

EthanDunker · ‎02-16-2016

Line 84 is:

Set pSpatialFilter.Geometry = pGeom

and Line 86 is:

SpatialFilter.SpatialRel = esriSpatialRelContains

curtvprice · ‎02-19-2016

Option Explicit
Const dbpath = "C:\Users\edunker\Documents\"
Const dbname = "WorkOrderDatabase.accdb"
'Const coord_file = "currcoords.dat"


'Const signshp_path = "s:\Highway\Signs\signdb\"
'Const signshp_file = "signsall"


Const GPS_BAUD = 4800
Const GPS_PORT = 1


Const SEARCH_THRESHHOLD = 10


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


Dim pMxDoc As IMxDocument
    Dim pGPSPoint As IPoint
    Dim pCursorPoint As IPoint
    Set pCursorPoint = New Point
   
    Dim pLocationFeat As IFeature
    Dim pSignFClass As IFeatureClass
    Set pMxDoc = ThisDocument


    pCursorPoint.x = pMxDoc.CurrentLocation.x
    pCursorPoint.y = pMxDoc.CurrentLocation.y
   
    Dim pGeometry As IGeometry
    Set pGeometry = pCursorPoint
   
    Dim pTopoOperator As ITopologicalOperator
    Set pTopoOperator = pCursorPoint
   
    Dim dblSearchDistance As Double
    dblSearchDistance = SEARCH_THRESHHOLD
   
    Dim pBufferGeometry As IGeometry
    Set pBufferGeometry = pTopoOperator.Buffer(dblSearchDistance)
   
    Set pLocationFeat = GetSelectedLocation(pBufferGeometry)
   
    If pLocationFeat Is Nothing Then Exit Sub
   
    Shell "c:\Program Files (x86)\Microsoft Office\Office14\msaccess.exe " & dbpath & dbname & " /cmd Locationedit=" & pLocationFeat.Value(pLocationFeat.Fields.FindField("LocationID")), vbMaximizedFocus
   
End Sub


Public Function GetSelectedLocation(pGeom As IGeometry) As IFeature
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap


    Dim strRoadNumber As String
    Dim strLocationType As String
    Dim strLocationID As String
    'Dim strOrientation As String
    Dim i As Long
   
    Dim pFLayer As IFeatureLayer
    Dim pFClass As IFeatureClass
   
    Dim pID As New esriSystem.UID ' New esriCore.UID
    Dim pAllFLayers As IEnumLayer
   
    pID.Value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}"
    Set pAllFLayers = pMap.Layers(, True)
    Set pFLayer = pAllFLayers.Next
    Do Until pFLayer Is Nothing
        If pFLayer.Name = "LocationData" Then Exit Do
        Set pFLayer = pAllFLayers.Next
    Loop


    Set pFClass = pFLayer.FeatureClass
   
    Dim pScratchWorkspace As IWorkspace
    Dim pScratchWorkspaceFactory As IScratchWorkspaceFactory
    Set pScratchWorkspaceFactory = New ScratchWorkspaceFactory
    Set pScratchWorkspace = pScratchWorkspaceFactory.DefaultScratchWorkspace
   
    Dim pSpatialFilter As ISpatialFilter
    Set pSpatialFilter = New SpatialFilter
   
    Set pSpatialFilter.Geometry = pGeom                ' <------
    pSpatialFilter.GeometryField = "SHAPE"             ' <------ fail, error 91
    pSpatialFilter.SpatialRel = esriSpatialRelContains ' <------
   
    Dim pFeatureCursor As IFeatureCursor
    Set pFeatureCursor = pFClass.Search(pSpatialFilter, False)
   
    Dim pFeat As IFeature
    Dim pTempFeat As IFeature
    Set pFeat = pFeatureCursor.NextFeature


    strRoadNumber = pFeat.Value(pFeat.Table.FindField("RoadNumber"))
    strLocationType = pFeat.Value(pFeat.Table.FindField("LocationType"))
    strLocationID = pFeat.Value(pFeat.Table.FindField("LocationID"))
    'strOrientation = pFeat.Value(pFeat.Table.FindField("ORIENTATIO"))


    If pFeat Is Nothing Then
        MsgBox "You must select a Location", vbCritical
        Set GetSelectedLocation = Nothing
        Exit Function
    End If
   
    If pFeat.Fields.FindField("LocationID") = -1 Then
        MsgBox "You must select a sign to position first", vbCritical
        Set GetSelectedLocation = Nothing
        Exit Function
    End If
   
    Set pTempFeat = pFeatureCursor.NextFeature
    If Not pTempFeat Is Nothing Then
        Set pFeat = pTempFeat
        Load frmMultiplePoint
        frmMultiplePoint.lstLocation.Clear
       
        frmMultiplePoint.lstLocation.AddItem
       
        frmMultiplePoint.lstLocation.List(0, 0) = strRoadNumber
        frmMultiplePoint.lstLocation.List(0, 1) = strLocationType
        frmMultiplePoint.lstLocation.List(0, 2) = strLocationID
        'frmMultiplePoint.lstLocation.List(0, 3) = strOrientation
       
        Do While Not pFeat Is Nothing
            strRoadNumber = pFeat.Value(pFeat.Table.FindField("RoadNumber"))
            strLocationType = pFeat.Value(pFeat.Table.FindField("LocationType"))
            strLocationID = pFeat.Value(pFeat.Table.FindField("LocationID"))
            'strOrientation = pFeat.Value(pFeat.Table.FindField("ORIENTATIO"))
           
            frmMultiplePoint.lstLocation.AddItem
            frmMultiplePoint.lstLocation.List(frmMultiplePoint.lstLocation.ListCount - 1, 0) = strRoadNumber
            frmMultiplePoint.lstLocation.List(frmMultiplePoint.lstLocation.ListCount - 1, 1) = strLocationType
            frmMultiplePoint.lstLocation.List(frmMultiplePoint.lstLocation.ListCount - 1, 2) = strLocationID
            'frmMultiplePoint.lstSigns.List(frmMultiplePoint.lstSigns.ListCount - 1, 3) = strOrientation
           
            Set pFeat = pFeatureCursor.NextFeature
        Loop
        frmMultiplePoint.Show
       
        If frmMultiplePoint.Tag = "OK" Then
            Set pFeatureCursor = pFClass.Search(pSpatialFilter, False)


            For i = 0 To frmMultiplePoint.lstLocation.ListIndex
                Set pFeat = pFeatureCursor.NextFeature
            Next
           
            MsgBox "Selecting Location with ID: " & pFeat.Value(pFeat.Table.FindField("LocationID")), vbInformation, "Success"
        Else 'frmMultiplePoint.Tag = "CANCEL"
            Set GetSelectedLocation = Nothing
            Exit Function
        End If
    End If
   
    Set GetSelectedLocation = pFeat
End Function

Posting Code blocks in the new GeoNet

EthanDunker · ‎02-19-2016

Okay so the line switched because of extra line spaces its now line 93 and line 95.