Latest Contributions by EthanDunker

Hello, I am new to ArcMap VBA coding and was wondering if there is any good websites to help me understand what I am doing wrong. I have a basic knowledge of VBA for coding in access. thanks in advance ... View more

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 ... View more