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
Hi Ethan,
Interesting question.
Which lines are 84 and 86?
Leo.
Line 84 is:
Set pSpatialFilter.Geometry = pGeom
and Line 86 is:
SpatialFilter.SpatialRel = esriSpatialRelContains
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
Okay so the line switched because of extra line spaces its now line 93 and line 95.