RUS  ENG 

Примеры

Дмитрий Емельянов , 9 Декабря 2019

Анализ топологии сети. Путь и дерево путей (VBScript)

Решаем задачу поиска ошибок, связанных с нарушением правил ввода объектов в сетях с сотнями тысяч элементов.

Ищем среди миллиона объектов неправильно подключенный узел.

Рассмотрены варианты анализа сети с построением пути и построением дерева путей.

  • Пример подробно разобран в видеоролике Макросы. Урок 3. Анализ топологии сети. Путь и дерево путей


  • ' 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

    Скачать пример (9.92 КБ)


    Возврат к списку

    Последнее обновление — 09.12.2019 15:27:18