Start Sub Start() '============== Start of Main Script ============== Set e3 = CreateObject("CT.Application") Set prj = e3.CreateJobObject ' Set net = prj.CreateNetObject ' Set ns = prj.CreateNetSegmentObject ' Set sht = prj.CreateSheetObject Set dev = prj.CreateDeviceObject Set dev1 = prj.CreateDeviceObject Set dev2 = prj.CreateDeviceObject Set wir = prj.CreatePinObject Set pin1 = prj.CreatePinObject Set pin2 = prj.CreatePinObject Dim zwl Dim iswire 'Словарь TWLDict вида "Элемент(ключ)" для подсчета общего значения длин используемых проводов в проекте 'Ключ имеет вид WireGroup_WireType (CrossSection) [ например: ПВ3_1мм2 (1мм2) ] 'Для получения значения элемента по ключу используется следующая конструкция: TWLDict.Item(ключ) - возвращаемое значение - значение элемента словаря с указанным ключом Set TWLDict = CreateObject("Scripting.Dictionary") TWLDict.RemoveAll e3.ClearOutputWindow zwl = 0 iswire = 0 e3.PutMessage "-<< Script Started >>-" e3.PutMessage "" e3.PutMessage "Длины используемых в проекте проводов и кабелей:" e3.PutMessage "" '--- 'считаем число кабелей в проекте 'способ №1 ' cabs = prj.GetCableCount ' e3.PutMessage "GetCableCount = " & prj.GetCableCount 'способ №2 ' cabcount = prj.GetCableIds(cabids) - 1 ' e3.PutMessage "GetCableCount2 = " & cabcount '--- cabs = prj.GetCableIds(cabids) for c = 1 to cabs dev.SetId cabids(c) iswire = dev.IsWireGroup 'isWire = 1 - провод, isWire = 0 - кабель if iswire then e3.PutMessage ".. " & dev.GetName & ":" else e3.PutMessage "" e3.PutMessage "Кабель " & dev.GetName & ":" end if wirs = dev.GetPinCount dev.GetPinIds wirids for w = 1 to wirs wir.SetId wirids(w) pin1.SetId wir.GetEndPinId( 1 ) dev1.SetId Pin1.GetId pin2.SetId wir.GetEndPinId( 2 ) dev2.SetId pin2.GetId wir.GetWireType CompName, WireName if( wir.GetLength > 0) then msg = " Провод " & wir.GetName & ":" else msg = "(!!) Провод " & wir.GetName & ":" 'помечаем провода с нулевой длиной zwl = 1 'ставим флаг наличия проводов с нулевой длиной end if 'e3.PutMessage "zwl = " & zwl 'Разведен ли провод/кабель в E3.Panel ' if( wir.IsRouted ) then ' msg = msg & " routed " ' else ' msg = msg & " unrouted " ' end if msg = msg & " сигнал= " & wir.GetSignalName & ", " msg = msg & " цепь [" & dev1.GetName & ":" & pin1.GetName & " -> " & dev2.GetName & ":" & pin2.GetName & "], " msg = msg & " марка провода= " & CompName & ", тип провода= " & WireName & ", " msg = msg & " длина провода= " & wir.GetLength & " мм, " msg = msg & " сечение провода= " & wir.GetCrossSectionDescription & ", " msg = msg & " цвет провода= " & wir.GetColourDescription & ", " 'Ключ словаря TWLDict для подсчета общего значения длин используемых проводов в проекте 'Ключ имеет вид WireGroup_WireType (CrossSection) [ например: ПВ3_1мм2 (1мм2) ] if Trim(CompName) > "" then if Trim(WireName) > "" then TWLDict_CurKey = CompName & "_" & WireName & " (" & wir.GetCrossSectionDescription &")" end if end if ' В элемент словаря (при наличии такого элемента) с текущим ключом (т.е. текущая "марка_тип (сечение) провода" ) суммируем длину текущего проводника с данной маркой, типом и сечением провода ' Если элемент с таким ключом отсутствует (изменились "марка или тип или сечение провода"), то создается новый элемент с таким ключом TWLDict.Item(TWLDict_CurKey) = TWLDict.Item(TWLDict_CurKey) + wir.GetLength e3.PutMessage msg next next e3.PutMessage "" e3.PutMessage "---//---" e3.PutMessage "" e3.PutMessage "Общая длина используемых марок проводов:" ' Получаем массив ключей словаря TWLDict KeysArr = TWLDict.Keys ' По количеству элементов этого массива выводим в сообщении элементы словаря в виде ' Ключ - Значение элемента с данным ключом, т.е. ' марка_тип (сечение) = длина мм for i = 0 to TWLDict.Count-1 e3.PutMessage KeysArr(i) & " = " & TWLDict.Item(KeysArr(i)) & " мм" next ' по флагу определяем наличие проводов с нулевой длиной в проекте и выводим расшифровку значка данных проводов при их наличии в проекте if (zwl > 0) then e3.PutMessage "" e3.PutMessage "---" e3.PutMessage "Символом (!!) обозначены провода с нулевой длиной" end if e3.PutMessage "" e3.PutMessage "---" e3.PutMessage "-xx Script Finished xx-" e3.PutMessage "" e3.PutMessage "© DXon 2016" '========== End of Main Script ========== '########## Some Tests Part ################### ' e3.PutMessage "Global Net:" ' netcnt = prj.GetNetIds(netids) ' For i = 1 To netcnt ' net.SetId netids(i) ' e3.PutMessage "Name: " & net.GetName, net.GetId ' e3.PutMessage "Parent: " & net.GetParentId, net.GetParentId ' e3.PutMessage "Net Segments:" ' netsegcnt = net.GetNetSegmentIds(netsegids) ' For j = 1 To netsegcnt ' ns.SetId netsegids(j) ' e3.PutMessage "Name: " & ns.GetName, ns.GetId ' Next ' e3.PutMessage "" ' Next ' e3.PutMessage "Sheet-local Net:" ' shtcnt = prj.GetSheetIds(shtids) ' For j = 1 To shtcnt ' sht.SetId (shtids(j)) ' e3.PutMessage "Sheet: " & sht.GetName & "[" & sht.GetId & "]" ' netcnt = sht.GetNetIds(netids) ' For i = 1 To netcnt ' net.SetId netids(i) ' e3.PutMessage "Name: " & net.GetName, net.GetId ' e3.PutMessage "Signal Name: " & net.GetSignalName ' 'e3.PutMessage "Net Length: " & net.GetLength ' e3.PutMessage "Net Segments:" ' netsegcnt = net.GetNetSegmentIds(netsegids) ' For k = 1 To netsegcnt ' ns.SetId netsegids(k) ' e3.PutMessage "Name: " & ns.GetName, ns.GetId ' Next ' If (net.HasAttribute("Номер цепи") = 0) Then ' ret = net.AddAttributeValue("Номер цепи", net.GetId) ' If (ret) Then ' net.DisplayAttributeValueAt "Номер цепи", sht.GetId, 100, 100 + i * 10 ' End If ' End If ' Next ' e3.PutMessage "" ' Next ''***************************** Set Dict = CreateObject("Scripting.Dictionary") 'Dict.Add 1, "One" 'Dict.Add 2, "Two" 'Dict.Key(1) = "Eins" 'MsgBox Dict.Item("Eins") 'MsgBox Dict.Item(2) 'Dict.Add "qw", "qwerty" 'MsgBox Dict.Item("qw") Dict.Item("qw") = "asd" 'MsgBox Dict.Item("qw") '--------------- Dim WiresArray(6) WiresArray(0) = "q" WiresArray(1) = "w" WiresArray(2) = "e" WiresArray(3) = "r" WiresArray(4) = "t" WiresArray(5) = "y" 'e3.PutMessage "WiresArray = " & WiresArray(0) & "; " & WiresArray(1) & "; " & WiresArray(2) & "; " & WiresArray(3) & "; " & WiresArray(4) & "; " & WiresArray(5) & "; " '########## End of Some Tests Part ################### Set e3 = Nothing ' The final part of script - DO NOT DELETE End Sub ' The final part of script - DO NOT DELETE