寻找两线相交的点，并生成到新的图层中去（Engine）

Public Sub CreatePointsFromIntersectingPolylines()
    Dim pEditLayers As IEditLayers
    Dim pEditor As IEditor
    Dim pEnumFeature As IEnumFeature
    Dim pFeature As IFeature
    Dim pFeature2 As IFeature
    Dim pGeomColl As IGeometryCollection
    Dim pID As New UID
    Dim pInvalidArea As IInvalidArea
    Dim pPoint As IPoint
    Dim pTopoOptr As ITopologicalOperator
   
    Dim bInOperation As Boolean
    Dim Count As Integer
   
    On Error GoTo ErrorHandler
   
    'Get a handle to the Editor extension
    pID = "esriEditor.Editor"
    Set pEditor = Application.FindExtensionByCLSID(pID)
    Set pEditLayers = pEditor 'QI
   
    If (Not pEditor.SelectionCount = 2) Or (Not pEditLayers.CurrentLayer.FeatureClass.ShapeType = esriGeometryPoint) Then
        MsgBox "Must have exactly two polylines selected and Target Layer must be a point layer."
        Exit Sub
    End If
   
    'Loop through the selected features to make sure we have polylines only
    Set pEnumFeature = pEditor.EditSelection
    pEnumFeature.Reset
    Set pFeature = pEnumFeature.Next
    Do While Not pFeature Is Nothing
        If Not pFeature.Shape.GeometryType = esriGeometryPolyline Then
            MsgBox "Both seleted features must be a polyline."
            Exit Sub
        End If
        Set pFeature = pEnumFeature.Next
    Loop
   
    'Intersect the two polylines creating a multipoint
    pEnumFeature.Reset
    Set pFeature = pEnumFeature.Next
    Set pFeature2 = pEnumFeature.Next
    Set pTopoOptr = pFeature.Shape
    Set pGeomColl = pTopoOptr.Intersect(pFeature2.Shape, esriGeometry0Dimension)
   
    'If no intersection points, exit
    If pGeomColl.GeometryCount = 0 Then Exit Sub
   
    Set pInvalidArea = New InvalidArea
    Set pInvalidArea.Display = pEditor.Display
   
    'Create a new point features at each intersection
    pEditor.StartOperation
    bInOperation = True
    For Count = 0 To pGeomColl.GeometryCount - 1
        Set pPoint = pGeomColl.Geometry(Count)
        Set pFeature = pEditLayers.CurrentLayer.FeatureClass.CreateFeature
        Set pFeature.Shape = pGeomColl.Geometry(Count)
        pFeature.Store
        pInvalidArea.Add pFeature
    Next Count
    pEditor.StopOperation ("Create Points from Intersections")
    bInOperation = False
   
    'Refresh the display
    pInvalidArea.Invalidate esriAllScreenCaches
   
    Exit Sub 'Exit to avoid error handler
   
ErrorHandler:
    If bInOperation Then
        pEditor.AbortOperation
    End If
   
End Sub

 

http://www.gisall.com/?uid-5607-action-viewspace-itemid-3150

转载于:https://www.cnblogs.com/kaixin110/archive/2010/06/30/1768386.html