Question

Kirk Kuykendall几年前在ESRI论坛http://forums.esri.com/Thread.asp?c=93&f=996&t=88246&mc=4中给出了一个脚本示例，说明如何在点击该点时沿路径找到shapefile中某点的M（度量）值。这非常方便，但是......我有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

识别路线位置工具是否可以满足您的需求？

点击自定义＆gt;自定义模式。
单击“命令”选项卡。
单击“类别”列表中的“线性参照”。
将识别路线位置工具识别路线位置拖动到您选择的工具栏，例如工具工具栏。
单击“关闭”。

Adding the Identify Route Locations tool

如何自动沿路线查找M值

2 个答案: