Community
Select to view content in your preferred language

Help with Run time error 91

4654
4
02-04-2016 10:51 AM
EthanDunker
by
Deactivated User
‎02-04-2016 10:51 AM

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

Tags (1)
0 Kudos
4 Replies
deleted-user-bTT1-4SKF1c0
by
Deactivated User
‎02-11-2016 10:21 PM

Hi Ethan,

Interesting question.

Which lines are 84 and 86?

Leo.

0 Kudos
EthanDunker
by
Deactivated User
‎02-16-2016 05:36 AM

Line 84 is:

Set pSpatialFilter.Geometry = pGeom

and Line 86 is:

SpatialFilter.SpatialRel = esriSpatialRelContains

0 Kudos
curtvprice
by MVP Alum
MVP Alum
‎02-19-2016 08:50 AM 
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​

0 Kudos
EthanDunker
by
Deactivated User
‎02-19-2016 10:58 AM

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

0 Kudos