,
13 мая 2019
Определение подсети от заданного узла (VBScript)
Решаем задачу определения подсети от заданного узла. Используем функции анализа топологии Layer.NetworkTools. В цикле для всех ЦТП определяем подсеть. SQL запросом записываем в поле каждого элемента подсети ID ЦТП.
' ActiveX enumeration values definitions start (do not change!)
Const eIncidentIncoming = 1
Const eSwitchOff = 1
Const eSelCreate = 1
' ActiveX enumeration values definitions end
'Присваиваем всем элементам сети ID ЦТП, к которому они относятся
Sub SetCtpID
'Получаем активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Active
'Делаем невидимым на карте группу слоя
L.Selection.Visible = False
'Делаем невидимыми на карте флаги топологических операций
L.NetworkTools.FlagsVisible = False
'Делаем невидимыми на карте результаты топологических операций
L.NetworkTools.ResultsVisible = False
'Получаем коллекцию всех объектов слоя с ID типа 8 (ЦТП)
Set keys = L.SelectByType(8, 0)
'Для всех ЦТП слоя
For i = 1 To keys.Count
'Для i-го ЦТП из коллекции получаем группу объектов с ним связанных
If SelectElements(keys.Item(i)) = True Then
'Всем элементам группы записываем в поле "Ctp_id" ID i-го ЦТП
L.ExecSQL "UPDATE SET [Ctp_id] = " + CStr(keys.Item(i)) + "WHERE Geometry.Selected() = 1"
'Очищаем группу слоя
L.Selection.Clear
End If
Next
'Возвращаем видимость группы и элементов топологического анализа
L.Selection.Visible = True
L.NetworkTools.FlagsVisible = True
L.NetworkTools.ResultsVisible = True
End Sub
'Получаем группу объектов связанных с текущим объектом слоя
Sub SelectByID
'Получаем активный слой текущей карты
Set L = zulu.ActiveMapDoc.Layers.Active
'Если нет активного объекта слоя, выходим из процедуры
If L.CurrentID = -1 Then Exit Sub
'Получаем группу объектов связанных с текущим объектом слоя
If SelectElements(L.CurrentID) = True Then
MsgBox "Группа создана!"
'Очищаем группу слоя
L.Selection.Clear
End If
End Sub
'Получаем группу объектов связанных с объектом слоя с заданным ID
Function SelectElements(ID)
'Изначально функция возвращает False
SelectElements = False
'Получаем активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Active
'Очищаем группу слоя
L.Selection.Clear
'Очищаем флаги топологических операций
L.NetworkTools.ClearFlags
'Очищаем результаты топологических операций
L.NetworkTools.ClearResults
'Очищаем временные состояния объектов сети
L.NetworkTools.ClearOverloadedStates
'Получаем участки, входящие в узел с данным ID
Set Els = L.GetIncidentElements(ID, eIncidentIncoming)
'Если нет единственного входящего участка (не корректное подключение ЦТП) - завершаем функцию
If Els.Count <> 1 Then Exit Function
'Временно отключаем входящий в узел участок
L.NetworkTools.OverloadElemState Els.FirstItem.Key, eSwitchOff
'Определяем ID узлов на концах отключенного участка
Set Els1 = L.GetIncidentElements(Els.FirstItem.Key, eIncidentIncoming)
If Els1.Count = 2 Then
'Ставим флаги на концах перекрытого участка
L.NetworkTools.AddFlag Els1.Item(1).Key
L.NetworkTools.AddFlag Els1.Item(2).Key
'Ищем путь от начала к концу перекрытого участка
If L.NetworkTools.FindWay = True Then
'Если такой путь есть, то ЦТП в кольце. Завершаем функцию
L.NetworkTools.ClearFlags
L.NetworkTools.ClearResults
Exit Function
End If
Else
'Eсли начальный узел отсутствует, завершаем функцию
Exit Function
End If
'Очищаем флаги
L.NetworkTools.ClearFlags
L.NetworkTools.ClearResults
'Ставим флаг на заданный узел
L.NetworkTools.AddFlag ID
'Ищем все связанные с данным узлом элементы
L.NetworkTools.FindConnected
'Добавляем найденные элементы в группу
L.Selection.ModifyByKeys eSelCreate, L.NetworkTools.Results
'Очищаем флаги, временные состояния и результаты топологического анализа
L.NetworkTools.ClearFlags
L.NetworkTools.ClearResults
L.NetworkTools.ClearOverloadedStates
'Функция возвращает True
SelectElements = True
End Function
Последнее обновление — 13.05.2019 07:49:19