arcgis - 如何自动沿路线查找 M 值

Question

几年前，Kirk Kuykendall 在 ESRI 论坛http://forums.esri.com/Thread.asp?c=93&f=996&t=88246&mc=4中给出了一个脚本示例，说明如何找到单击该点时沿路线的 shapefile 中的一个点。这非常方便，但是..我有 1500 个点需要 M 值。有没有办法自动化这种类型的事情？我需要点的 M 值来在路线上创建线性事件。

注意：我不是程序员，但有可以帮助我的人。

Answer 1

这是一些旧代码，尚未对其进行太多测试。

Option Explicit
Sub Test()
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument

    Dim pEditor As IEditor
    Set pEditor = Application.FindExtensionByName("ESRI Object Editor")

    Dim pEL As IEditLayers
    Set pEL = pEditor


    ' assume the points are the current edit target
    ' and the polylines are the top layer in the TOC
    Dim pPointLayer As IFeatureLayer
    Set pPointLayer = pEL.CurrentLayer

    Dim pLineLayer As IFeatureLayer
    Set pLineLayer = pMxDoc.FocusMap.Layer(0)

    pEditor.StartOperation
    On Error Resume Next
    CalcMeasures pPointLayer, pLineLayer, "M", pMxDoc.SearchTolerance
    If Err.Number = 0 Then
        pEditor.StopOperation "calc Ms"
    Else
        MsgBox Err.Description
        pEditor.AbortOperation
    End If

End Sub

Sub CalcMeasures(pPointLayer As IFeatureLayer, pLineLayer As IFeatureLayer, fldName As String, searchTol As Double)
    On Error GoTo EH

    Dim idx As Long
    idx = pPointLayer.FeatureClass.Fields.FindField(fldName)
    If idx = -1 Then
        Err.Raise 1, , "field not found: " & fldName
    End If

    Application.StatusBar.ShowProgressBar "calculating measures", 0, pPointLayer.FeatureClass.FeatureCount(Nothing), 1, False
    Dim pFCur As IFeatureCursor
    Set pFCur = pPointLayer.FeatureClass.Update(Nothing, False)
    Dim pFeat As IFeature
    Set pFeat = pFCur.NextFeature
    Do Until pFeat Is Nothing
        Dim pLinefeat As IFeature
        Set pLinefeat = GetClosestFeat(pFeat.Shape, pLineLayer.FeatureClass, searchTol)
        If Not pLinefeat Is Nothing Then
            Dim m As Double
            m = GetMeasure(pFeat.Shape, pLinefeat.Shape)
            pFeat.Value(idx) = m
        Else
            ' what to do if nothing is nearby?
            pFeat.Value(idx) = -1#
        End If
        pFCur.UpdateFeature pFeat
        Set pFeat = pFCur.NextFeature
        Application.StatusBar.StepProgressBar
    Loop
    Exit Sub
EH:
    MsgBox Err.Description
    Err.Raise Err.Number, , Err.Description
End Sub

Function GetClosestFeat(pPoint As IPoint, pLineFC As IFeatureClass, searchTol As Double) As IFeature
    Dim pEnv As IEnvelope
    Set pEnv = pPoint.Envelope
    pEnv.Expand searchTol * 2#, searchTol * 2#, False

    Dim pSF As ISpatialFilter
    Set pSF = New SpatialFilter
    Set pSF.Geometry = pEnv
    pSF.SpatialRel = esriSpatialRelEnvelopeIntersects
    Set pSF.Geometry = pEnv

    Dim pFCur As IFeatureCursor
    Set pFCur = pLineFC.Search(pSF, False)

    Dim pProxOp As IProximityOperator
    Set pProxOp = pPoint

    Dim pFeat As IFeature, pClosestFeat As IFeature
    Dim dDist As Double, dClosestDist As Double
    Set pClosestFeat = Nothing

    Set pFeat = pFCur.NextFeature
    Do Until pFeat Is Nothing
        dDist = pProxOp.ReturnDistance(pFeat.Shape)
        If pClosestFeat Is Nothing Then
            Set pClosestFeat = pFeat
            dClosestDist = dDist
        Else
            If dDist < dClosestDist Then
                Set pClosestFeat = pFeat
                dClosestDist = dDist
            End If
        End If
        Set pFeat = pFCur.NextFeature
    Loop
    Set GetClosestFeat = pClosestFeat
End Function

Function GetMeasure(pPoint As IPoint, pPolyline As IPolyline) As Double

    Dim pOutPoint As IPoint
    Set pOutPoint = New Point
    Dim dAlong As Double, dFrom As Double, bRight As Boolean
    pPolyline.QueryPointAndDistance esriNoExtension, _
                                    pPoint, False, _
                                    pOutPoint, dAlong, _
                                    dFrom, bRight
    Dim pMSeg As IMSegmentation2, vMeasures As Variant
    Set pMSeg = pPolyline
    vMeasures = pMSeg.GetMsAtDistance(dAlong, False)
    GetMeasure = vMeasures(0)
End Function

Answer 2

识别路线位置工具会做您想要的吗？

1. 单击自定义 > 自定义模式。
2. 单击命令选项卡。
3. 单击类别列表中的线性参考。
4. 将识别路径位置工具识别路径位置拖动到您选择的工具栏，例如工具工具栏。
5. 单击关闭。

添加识别路径位置工具