Цитата:
Microsoft Visual Basic 6.0
Тыкнуть мышкой примерно в линию и этим её разрезать на две максимально близко в точке тычка. И получить координаты точки разреза (лежащие на исходной полилинии).
Отдельной функции, которая разбивала бы объект, если где-то рядом тыкнуть, нет. Программно сейчас можно, например, так для автономного приложения (для плагина аналогично):
Private Sub MapCtrl1_OnMouseLeftDblClick(ByVal State As ZuluOcx.eMouseState, ByVal X As Long, ByVal Y As Long, ByVal RealX As Double, ByVal RealY As Double)
Dim ID, i As Long
Dim Pt As ZPoint
Dim El As Element
Dim L As Layer
Dim M As MapDoc
Dim Pl, Pl1 As PolyLine
Dim Ppl As PolyPolyLine
Dim Geom As ZGeometry
Set Geom = New ZGeometry
Set M = MapCtrl1.Map
Set L = M.Layers.Active
Set Pt = New ZPoint
'Получаем ID объектa, ближайшего к тычку мыши в пределах пяти пикселей экрана и точку на нем
ID = L.GetClosestElementByXY(RealX, RealY, 5 * M.Active.MapScale, False, Pt)
If ID <> -1 Then
'Получаем объект
Set El = L.Elements.GetElement(ID)
'Проверяем, что объект линейный
If El.GraphType = eGraphTypePrimPolyline Or El.GraphType = eGraphTypeTypedPolyline Then
Set Ppl = El.PolyPolyLine
'Проверяем, что объект состоит из одной полилинии (не составной)
If Ppl.Count = 1 Then
Dim Idx As Long
Idx = -1
'Получили геометрию объекта в виде полилинии
Set Pl = Ppl.Item(0)
'Проверяем, не совпал ли тычок мыши с вершиной
For i = 1 To Pl.NumTops
If Pt.X = Pl.GetX(i) And Pt.Y = Pl.GetY(i) Then
'Запомнили номер вершины разбиения
Idx = i
Exit For
End If
Next i
'Если вершины не совпали с тычком мыши, ищем отрезок, ближайший к тычку
If Idx = -1 Then
For i = 1 To Pl.NumTops - 1
Dim D, D1, D2 As Double
D = Geom.Distance(Pl.GetX(i), Pl.GetY(i), Pl.GetX(i + 1), Pl.GetY(i + 1))
D1 = Geom.Distance(Pl.GetX(i), Pl.GetY(i), Pt.X, Pt.Y)
D2 = Geom.Distance(Pl.GetX(i + 1), Pl.GetY(i + 1), Pt.X, Pt.Y)
'Сравниваем длину отрезка ломаной с суммой расстояний от точки до его концов
If (D1 + D2 - D) < 2 Then
'Если разницы длин меньше 2 сантиметров (для сантиметровой точности), вставляем в ломаную новую точку
Pl.InsertPoint Pt.X, Pt.Y, i + 1
'Запомнили номер вершины разбиения
Idx = i + 1
Exit For
End If
Next i
End If
'Если вершина разбиения есть и не является концом ломаной
If Idx > 1 And Idx <> Pl.NumTops Then
Dim St As ElemStyle
Set St = El.ElemStyle
Set Pl1 = New PolyLine
'Создаем новую полилинию для разбиваемого объекта
For i = 1 To Idx
Pl1.AddPoint Pl.GetX(i), Pl.GetY(i)
Next i
'Перезаписываем старый объект
El.SetPolyLine Pl1
Pl1.Clear
'Создаем полилинию для нового объекта (вторую часть результата разбиения)
For i = Idx To Pl.NumTops
Pl1.AddPoint Pl.GetX(i), Pl.GetY(i)
Next i
'Добавляем новую полилинию
L.AddPolyLine Pl1, St, El.TypeID, El.ModeId
End If
End If
End If
End If
End Sub
