Best Solution for old tool to be used in ArcPro

[SujithaPaidi]

Looking for suggestions on turning this VBA script used as an Add-in to Arcmap into a tool (python?) in ArcPro.

Rivermile tool VBA script

'+++ Each route layer (Polyline with Ms) automatically has a route layer extension

  '+++ attached to it when it is added to ArcMap. This example steps through all the

  '+++ layers in the focus map. For each layer that has a route layer extension, the

  '+++ route location(s) at the user-defined mouse click will be displayed in a

  '+++ message box.

  If Not button = 1 Then Exit Sub      '+++ make sure it is the left button

  Debug.Print "x = " & X & "y = " & Y

  Dim pMxApp As IMxApplication

  Dim pMxDoc As IMxDocument

  Dim pMap As IMap

  Dim pActiveView As IActiveView

  Dim pLayer As ILayer

  Dim pFLayer As IFeatureLayer

  Dim pDS As IDataset

  Dim pLayerExt As ILayerExtensions

  Dim pRtLayerExt As IRouteLayerExtension

  Dim pEnvelope As IEnvelope

  Dim pRtLocator As IRouteLocator2

  Dim pRtLoc As IRouteLocation2

  Dim pRMPointLoc As IRouteMeasurePointLocation

  Dim pRMLineLoc As IRouteMeasureLineLocation

  Dim pFeat As IFeature

  Dim pName As IName

  Dim pEnum As IEnumRouteIdentifyResult

  Dim str As String

  Dim i As Long, j As Long

  Dim pEventLayer As ILayer

  Dim pEventFeatureLayer As IFeatureLayer

  Dim pFeatureCursor As IFeatureCursor

  Dim pFeature As IFeature

  Dim pFeatureClass As IFeatureClass

  Dim pQueryFilter As IQueryFilter

  Dim pQueryString As String

  Dim pFMeas As Double

  Dim pFMeasField As Integer

 Dim pTMeas As Double

  Dim pTMeasField As Integer

  Dim pSegLength As Double

  Dim pFromDist As Double

  Dim pPercSeg As Double

  Dim pRivFromField As Integer

  Dim pRivFrom As Double

  Dim pRivToField As Integer

  Dim pRivTo As Double

  Dim pRivSegDist As Double

  Dim pRivMilepoint As Double

  Dim pRivMiles As Double

  Dim pMiles As String

  Dim pCounter As Integer

  Dim pPoint As IPoint

  'PFBC edits - variables for stream names to come up

  Dim pNameField As String

  Dim pName2 As String

  '+++ Get the focus map

  Set pMxApp = Application

  Set pMxDoc = Application.Document

  Set pMap = pMxDoc.FocusMap

  '+++Capture x,y of location clicked

  Set pPoint = pMxDoc.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y)

  '+++ Create an envelope out of the map's current location and expand it by the

  '+++ search tolerance

  Set pEnvelope = pMxDoc.CurrentLocation.Envelope

  pEnvelope.Expand pMxDoc.SearchTolerance, pMxDoc.SearchTolerance, False

  '+++ Step through the layers. For each layer that has a route layer extension

  '+++ get the route location(s) where the mouse was clicked.

  For i = 0 To pMap.LayerCount - 1

    Set pLayer = pMap.Layer(i)

    If TypeOf pLayer Is IFeatureLayer Then

      Set pFLayer = pLayer

      Set pDS = pFLayer.FeatureClass

      ' Only have the NHDFline information show up in the string, this removes reference to event table and junctions

      If pDS.BrowseName = "NHDFlowline" Then

        'str = str + pDS.BrowseName + ":" + vbCrLf

        Set pLayerExt = pFLayer

        For j = 0 To pLayerExt.ExtensionCount - 1

          If TypeOf pLayerExt.Extension(j) Is IRouteLayerExtension Then

            Set pRtLayerExt = pLayerExt.Extension(j)

            Set pName = pRtLayerExt.RouteLocatorName(pLayer)

            Set pRtLocator = pName.Open

            Set pEnum = pRtLocator.Identify(pEnvelope, "")

            pEnum.Reset

            If pEnum.Count > 0 Then

              pEnum.Next pRtLoc, pFeat

              While Not pFeat Is Nothing

                If TypeOf pRtLoc Is IRouteMeasurePointLocation Then

                  Set pRMPointLoc = pRtLoc

                  pRID = CStr(pRtLoc.RouteID) 'makes specific reachcode a variable

                  pPtMeasLoc = CStr(Round(pRMPointLoc.Measure, 3)) 'makes it possible to have measure as variable

                  For k = 0 To pMap.LayerCount - 1

                  Debug.Print pMap.Layer(k).Name

                  'Debug.Print "pa_stream_" & Left(pRID, 😎 & "gh_l"

                    'If pMap.Layer(k).Name = "pa_stream_" & Left(pRID, 😎 & "gh_l" Then 'This is the old code 7/25/05

                     If pMap.Layer(k).Name = "pa_stream_en" Then

                        Set pEventLayer = pMap.Layer(k)

                        Set pEventFeatureLayer = pEventLayer

                        Set pFeatureClass = pEventFeatureLayer.FeatureClass

                        Exit For

                    End If

                  Next

                  Set pQueryFilter = New QueryFilter

                  pQueryString = "RCH_CODE = '" & pRID & "'"

                  pQueryString = pQueryString & " and F_MEAS <= " & pPtMeasLoc

                  pQueryString = pQueryString & " and T_MEAS >= " & pPtMeasLoc

                  pQueryFilter.WhereClause = pQueryString

                  Set pFeatureCursor = pFeatureClass.Search(pQueryFilter, False)

                  Set pFeature = pFeatureCursor.NextFeature

                  pCounter = 0

                  'PFBC edits - sets value for stream names

                  pNameField = pFeature.Fields.FindField("GNIS_NAME")

                  pName2 = pFeature.Value(pNameField)

                  Do While Not pFeature Is Nothing

                    pFMeasField = pFeature.Fields.FindField("F_MEAS")

                    pFMeas = Round(pFeature.Value(pFMeasField), 3)

                    Debug.Print "The value of pFMeas is " & pFMeas

                    pTMeasField = pFeature.Fields.FindField("T_MEAS")

                    pTMeas = Round(pFeature.Value(pTMeasField), 3)

                    Debug.Print "The value of pTMeas is " & pTMeas

                    pSegLength = pTMeas - pFMeas

                    Debug.Print "The length of the segment is " & pSegLength

                    pFromDist = Round(pPtMeasLoc - pFMeas, 3)

                    Debug.Print "The distance from the node is " & pFromDist

                    pPercSeg = Round((pFromDist / pSegLength) * 100, 3)

                    Debug.Print "The percentage of the segment is " & pPercSeg

                    pRivFromField = pFeature.Fields.FindField("F_RM")

                    pRivFrom = Round(pFeature.Value(pRivFromField), 3)

                    Debug.Print "The value of pRivFrom is " & pRivFrom

                    pRivToField = pFeature.Fields.FindField("T_RM")

                    pRivTo = Round(pFeature.Value(pRivToField), 3)

                    Debug.Print "The value of pRivTo is " & pRivTo

                    pRivSegDist = Round(pRivTo - pRivFrom, 3)

                    Debug.Print "The river segment is " & pRivSegDist & "miles"

                    pRivMilepoint = Round((pRivSegDist / 100) * pPercSeg, 3)

                    Debug.Print "The value of pRivMilePoint is " & pRivMilepoint

                    pRivMiles = Round(pRivFrom + pRivMilepoint, 3)

                    Debug.Print "River Mile Distance is " & pRivMiles

                    pMiles = pRivMiles

                    pCounter = pCounter + 1

                    Set pFeature = pFeatureCursor.NextFeature

                  Loop

                  str = str + "Stream Name: " + CStr(pName2) + vbCrLf

                                str = str + pRtLocator.RouteIDFieldName + ": " + pRID + vbCrLf

                  'PFBC edits - displays stream name on pop up          

                  str = str + "River Miles: " + CStr(pMiles) + vbCrLf                 

                  str = str + "long. = " & pPoint.X & vbCrLf

                  str = str + "lat. = " & pPoint.Y & vbCrLf

                                str = str + vbCrLf

                End If

                pEnum.Next pRtLoc, pFeat

              Wend

              Exit For

            End If

          End If

        Next j

      End If 'NHDFlowline only

    End If

  Next i

 '+++ Display the found route location(s).

  If pCounter > 0 Then

    MsgBox str, vbInformation, "Identify Route Locations"

  Else

    MsgBox "Segment does not exist in PA dataset.  Try clicking closer to the line." & vbNewLine & vbNewLine & "Also be sure you have the pa_stream_en & NHDFlowline layers loaded in this Map Document." & vbNewLine & vbNewLine & "Pa_stream_en is under K:\PFBC_GIS\Shapefile\Base_Mapping\NHD_Streams_Lakes\" & vbNewLine & vbNewLine & "NHDFlowline is under K:\PFBC_GIS\Geodatabase\NHD_June_05.mdb\Hydrography"

  End If

  Exit Sub

EH:

  MsgBox "An error occurred: " + Err.Description & vbNewLine & vbNewLine & "Is Reachcode set as the Route Identifier for NHDFlowline?" & vbNewLine & vbNewLine & "To check, go the Properties of the NHDFlowline layer --> Routes tab --> choose Reachcode for the Route Identifier" & vbNewLine & vbNewLine & "Now try again - if it doesn't work, call Mike at 717-705-7909!", vbExclamation, "ERROR"

  End Sub

Private Sub rivermiletool_Select()

End Sub

[MaxMax2]

Please format your code snippet. It is quite difficult to work with code without syntax highlighting.