,
9 декабря 2019
Анализ топологии сети. Путь и дерево путей (VBScript)
Решаем задачу поиска ошибок, связанных с нарушением правил ввода объектов в сетях с сотнями тысяч элементов.
Ищем среди миллиона объектов неправильно подключенный узел.
Рассмотрены варианты анализа сети с построением пути и построением дерева путей.
' ActiveX enumeration values definitions start (do not change!)
Const eIncidentAll = 3
Const eNetworkAll = 3
' ActiveX enumeration values definitions end
'***********************************************************************
'Построение пути между двумя узлами
'***********************************************************************
Sub GetWay
'Объект для вывода в окно сообщений
Set Out = Zulu.OpenOutputChannel("Сообщения")
'Очищаем окно сообщений
Out.Clear
'Получаем активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Active
'Очищаем группу слоя
L.Selection.Clear
'Строим путь от конкретного узла до мигающего в данный момент объекта
Set Way = L.ShortWay (959910, L.CurrentID)
'По всем объектам пути
For i = 1 To Way.Count
ID = Way.Item(i)
'Выводим ID объектам пути
Out.Put "id=" + Cstr(ID) + Chr(10)
'Добавляем объект пути в гпуппу
L.Selection.AddElem ID
Next
End Sub
'***********************************************************************
'Анализ пути между двумя узлами
'***********************************************************************
Sub WayAnalyze
'Объект для вывода в окно сообщений
Set Out = Zulu.OpenOutputChannel("Сообщения")
'Очищаем окно сообщений
Out.Clear
'Получаем активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Active
'Очищаем группу слоя
L.Selection.Clear
'Строим путь от конкретного узла до мигающего в данный момент объекта
Set Way = L.ShortWay (L.CurrentID, 959910)
'По всем объектам пути
For i = 1 To Way.Count
'Получаем ID i-го объекта пути
ID = Way.Item(i)
If i Mod 2 = 0 Then
'Четный элемент пути (участок) добавляем в группу
L.Selection.AddElem ID
Else
'Нечетный элемент пути (узел)
Set El = L.Elements.GetElement(ID)
'Получаем тип узла
TypeID = El.TypeID
'Получаем количество связанных с узлом участков
InzNum = L.GetIncidentElements (ID, eIncidentAll).Count
'Выводим в окно сообщений ID узла, его тип и количество связей
Out.Put "id=" + Cstr(ID) + " TypeID:" + CStr(TypeID) + " InzNum:" + CStr(InzNum) + Chr(10)
'Добавляем в группу
L.Selection.AddElem ID
End If
Next
End Sub
'***********************************************************************
'Проверяем конкретный потребитель на правильное присоединение к сети
'(должна быть задвижка до разветвления)
'***********************************************************************
Sub FindError
'Объект для вывода в окно сообщений
Set Out = Zulu.OpenOutputChannel("Сообщения")
'Очищаем окно сообщений
Out.Clear
'Получаем активный слой текущей карты
Set L = Zulu.ActiveMapDoc.Layers.Active
'Строим путь от мигающего в данный момент объекта до конкретного узла (корнеыой источник)
Set Way = L.ShortWay (L.CurrentID, 959910)
'По всем объектам пути
For i = 1 To Way.Count
ID = Way.Item(i)
'Анализируем только нечетные (только узлы, пропуская участки)
If i Mod 2 = 1 Then
'Текущих элемент пути
Set El = L.Elements.GetElement(ID)
'Тип узла
TypeID = El.TypeID
'Если первым встретилась задвижка (TypeID = 7),
'то ошибки нет и выходим из цикла
If TypeID = 7 Then
Out.Put "id=" + Cstr(L.CurrentID) + " Ok!"
Exit For
End If
'Количество связей узла
InzNum = L.GetIncidentElements (ID, eIncidentAll).Count
'Если количество связей больше 2 (разветвление),
'то обнаружили ошибку и выходим из цикла
If InzNum > 2 Then
Out.Put "id=" + Cstr(L.CurrentID) + " Error!"
Exit For
End If
End If
Next
End Sub
'***********************************************************************
'Проверяем все потребители на правильное присоединение к сети
'(должна быть задвижка до разветвления)
'Методом построения путей от каждого потребителя до головного источника
'***********************************************************************
Sub FindErrors
Set Out = Zulu.OpenOutputChannel("Сообщения")
Out.Clear
Set L = Zulu.ActiveMapDoc.Layers.Active
'Получаем список ключей всех потребителей (TypeID = 3)
Set Keys = L.SelectByType(3, 0)
'Запомнили количество потребителей
cnt = Keys.Count
Out.put "{\B}Число потребителей: " + CStr(cnt) + Chr(10)
'По всем потребителям сети
For j = 1 To cnt
'Получаем путь от текущего потребителя до головного источника
Set Way = L.ShortWay (Keys.item(j), 959910)
'Выводим процент выполнения
Out.Put "{\B}" + CStr(CLng(CDbl(j*10000/cnt))/100) + "%" + CHR(13)
'По всем объектам пути
For i = 1 To Way.Count
'ID текущего объекта пути
ID = Way.Item(i)
'Анализируем только нечетные (только узлы, пропуская участки)
If i Mod 2 = 1 Then
'Текущих элемент пути
Set El = L.Elements.GetElement(ID)
'Тип узла
TypeID = El.TypeID
'Если первым встретилась задвижка (TypeID = 7),
'то ошибки нет и просто выходим из цикла
If TypeID = 7 Then
Exit For
End If
'Количество связей узла
InzNum = L.GetIncidentElements (ID, eIncidentAll).Count
'Если количество связей больше 2 (разветвление),
'то обнаружили ошибку и выходим из цикла
If InzNum > 2 Then
Out.Put "id=" + Cstr(Keys.item(j)) + " Error!"
Exit For
End If
End If
Next
Next
Out.put Chr(10)+ "{\B}Процесс завершен!" + Chr(10)
End Sub
'***********************************************************************
'Проверяем все потребители на правильное присоединение к сети
'(должна быть задвижка до разветвления)
'Методом построения дерева кратчайших путей от головного источника
'***********************************************************************
Sub FindErrorsTree
Set Out = Zulu.OpenOutputChannel("Сообщения")
Out.Clear
Set L = Zulu.ActiveMapDoc.Layers.Active
'Получаем объект с описанием топологии сети
Set NObjects = L.NetworkObjects (eNetworkAll)
'Получаем дерево путей от головного источника
Set Tree = L.GetShortWayTree(959910)
'Получаем список ключей всех потребителей (TypeID = 3)
Set Keys = L.SelectByType(3, 0)
cnt = Keys.Count
Out.put "{\B}Число потребителей: " + CStr(cnt) + Chr(10)
'По всем потребителям сети
For j = 1 To cnt
'Получаем элемент дерева, содержащий текущий потребитель
Set Item = Tree.ItemById(Keys(j))
'Цикл перебора узлов от потребителя до корня дерева
Do
'Если у текущего узла дерева нет родителя, выходим из цикла
If Item.ParentId = -1 Then Exit Do
'Переходим от текущего узла к его родителю, который становится текущим узлом
Set Item = Tree.ItemById(Item.ParentId)
'Прлучаем объект со свойствами текущего узла
Set Obj = NObjects.GetItemByKey(Item.NodeID)
' Если встретили задвижку (7), просто выходим из цикла для данного потребителя
If Obj.TypeID = 7 Then
Exit Do
End If
'Количество связей узла
InzNum = NOBJECTS.GetIncidentKeys(Item.NodeID, eIncidentAll).Count
'Если количество связей больше 2 (разветвление),
'то выводим в окно сообщение об ошибке ошибку и выходим из цикла для данного потребителя
If InzNum > 2 Then
Out.Put "id=" + Cstr(Keys.item(j)) + " Error!" + CHR(10)
Exit Do
End If
Loop
Next
Out.put Chr(10)+ "{\B}Процесс завершен!" + Chr(10)
End Sub
Последнее обновление — 09.12.2019 15:27:18