AnsweredAssumed Answered

Help with Run time error 91

Question asked by edunker on Feb 4, 2016
Latest reply on Feb 19, 2016 by edunker

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

            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

Outcomes