unit U_PECommon; interface uses Windows, Forms, StdCtrls, Classes, ComCtrls, Controls, DrawEngine, PCTypesUtils, SysUtils, Dialogs, Contnrs, DrawObjects, PCDrawBox, PCDrawing, PowerCad, Graphics, U_Cad, U_ESCadClasess, U_SCSLists, U_SCSComponent, U_SCSEngineTest, U_BaseCommon, U_Progress, U_Splash, Math, U_Navigator, Messages, U_Constants, pFIBDatabase, FIBQuery, pFIBQuery, pFIBDataSet, pFIBProps, kbmMemTable, DB, SQLMemMain, cxGridDBTableView, cxMaskEdit, cxImage, cxGridLevel, RzTabs, RzTreeVw, Buttons, RzEdit, DateUtils, ExtCtrls, idGlobal{, IdWinsock}, Winsock, Variants, ActiveX, ShlObj, Menus, exgrid, RapTree, FlytreePro, ShellApi, IniFiles, U_TrunkSCS, U_BaseConstants, U_Common, U_PEAutotraceDialog, {Tolik} U_ChoiceConnectSide, Unit_DM_SCS; type PNodeData = record ID: integer; ImageIndex: integer; IDTopComponent: integer; IdCompRel: integer; end; TNodeData = ^PNodeData; const {Тип автотрасировки} tatNone = -1; tatIndivid = 0; // для каждого приёмника отдельный кабель tatShare = 1; // один кабель для всех приёмников //Const // {Динамические строки} // cPEMes1 = 'Ошибка класификации компонентов по типам.'; // cPEMes2 = 'Ошибка'; // cPEMes3 = 'Ошибка поиска обьекта на Cad''е.'; // cPEMes4 = 'Ошибка определения стороны линии.'; // cPEMes5 = 'Ошибка определения конечного обороудования.'; // cPEMes6 = 'Указанный компонент не имеет свободного многократного интерфейса.'; // cPEMes7 = 'Конечный компонент не удалось подключить.'; // cPEMes8 = 'Невозможно подключить кабель'; // cPEMes9 = 'Невозможно подключить кабель: '; // cPEMes10 = ' к конечному обекту '; // cPEMes11 = ', так как у конечного обекта отсутствуют свободные интерфейсы для подключения.'; // cPEMes12 = ' к подключаемому объекту '; // cPEMes14 = 'Не удалось подключить компонент '; // cPEMes15 = 'Распределительная коробку не указана.'; // cPEMes16 = 'Укажите распределительную коробку.'; // cPEMes18 = 'Выбранный кабель для автотрассировки не имеет многопарных интерфейсов.'; // cPEMes19 = 'Указанный компонент не найден.'; // cPEMes20 = 'Укажите компонент.'; // cPEMes21 = 'Больше не выводить это окно.'; procedure TestOfAllComponent; //запуск мастера автотрасировки электрики procedure StartMasterPETrace; // запуск трасировки от выключателей к светильникам procedure StartTraceFromSwitches(ASwitchesObject, ALampObject: TList); // автотрасировки электрики - главная функция procedure PE_AutoTrace(ATypeAutoTrace: integer; AEndList, AWorkList: TList); // автотрасировка от сокетов до щитов от function AutoTraseToShield(AFigures: TList; AEndObjects: TList; AIndivid: boolean): TList; //Проверка на возможность подключения function CheckElectricNet(ACurrObject: TConnectorObject): boolean; //Проверка на наличие в списке function CheckEndCompon(ACurrObject: TConnectorObject; AEndObjects: TList): boolean; //Проверка на наличие обьекта в списке если обьект не является исключением function CheckComponInListWithExc(ACurrObject: TConnectorObject; AEndObjects: TList; AExcObject: TConnectorObject): boolean; //прокладка кабеля от точки к конечному обекту по лучевому принципу function TraceCableToEndPoint(AEndPoint: TList; ACurrPoint: TConnectorObject; AIdCable: integer; AWorkPoint: TList): boolean; //Удаляет со спуска-подъема кабель, подсоедененный одным интерфейсом procedure DeleteCableFromUpDown(AEndPoint: TList; ACurrPoint: TConnectorObject; AIdCable: integer; AWorkPoint: TList); //Определить последний объект при последовательно построении. Function CheckComponCnt(ASourceWS: TFigure): TConnectorObject; //прокладка кабеля от точки к конечному объекту индивидуальным кабелем function TraceIndividCableToEndPoint(AEndPoint: TList; ACurrPoint: TConnectorObject; AIdCable: integer; IgnoreExistingCable: Boolean = True): boolean; // ПОЛУЧИТЬ ВСЮ ТРАССУ с учётом уложенного кабеля function GetAllTracePEInCAD(AFigureServer: Tlist; AFigureWS: TFigure; AForDistance: boolean = false; TraseAnyWhere: Boolean = false): TList; // ПОЛУЧИТЬ ВСЮ ТРАССУ без учёта кабеля function GetAllTracePEInCADwithoutCable(AFigureServer: Tlist; AFigureWS: TFigure): TList; //получить всю трасу с учётом последнего уложенного ID-ка кабеля function GetAllTracePEInCADforLamp(AFigureServer: TList; AFigureWS: TFigure; AForDistance: boolean = false): Tlist; //Проверить наличие кабеля в трассе function CheckInsideCable(AOrthoLine: TOrthoLine; AAnyWhere: boolean = false; AFigureServer: TList = nil): boolean; //проверка наличия нового кабеля function CheckInsideNewCable(AOrthoLine: TOrthoLine{; AAnyWhere: boolean = false}): boolean; //Проверка на наличие у компонента многоразовых спареных функционалов function CheckMultiPairInterfases(ACompon: TSCSComponent; ATermBox: TSCSComponent = nil): boolean; //Проверка на отсутствие подключения к интерфейсам обьекта function CheckConnectToMultiplyInterfaces(ASCSID: integer): boolean; // True если есть неподключенный интерфейс //Подключения кабеля по проложенным трассам //procedure ConnectPEObjects(AFigure: TFigure; AIDCable: integer); //Подключение //Tolik { function ConnectPEObjectCompons(AObject1, AObject2: TSCSCatalog; ASideObject1, ASideObject2: Integer; AOnlyNewLineCompon: Boolean; AFirstComponent : Boolean = false; ALastComponent: Boolean = false; ForSwitch: boolean = false): Boolean; } function ConnectPEObjectCompons(AObject1, AObject2: TSCSCatalog; ASideObject1, ASideObject2: Integer; AOnlyNewLineCompon: Boolean; AFirstComponent : Boolean = false; ALastComponent: Boolean = false; ForSwitch: boolean = false; MaxInterfPosCountToConnect: Integer = 0): Boolean; // //подключение объектов по трассе одним кабелем function ConnectPEObjectsByWay(AWay: TList; APosList: TIntList = nil; AWorkList: TList = Nil; AServList: TList = Nil; AOnlyForNewCable: boolean = False; AForSwitch: boolean = False): Boolean; //подключение объектов по трассе одним кабелем с подключением попутно рабочих обьектов //function ConnectPEObjectsByWay(AWay: TList; APosList: TIntList = nil; {AWorkList: TList = Nil;} AServList: TList = Nil): Boolean; //подключение объектов по трассе индивидуальным кабелем function ConnectIndividPEObjectsByWay(AWay: TList; APosList: TIntList = nil): Boolean; //добавить скрутку и вернуть каталог обекта со скруткой Function AddCabling(APrevObj, ACurrObj: TSCSCatalog; AIdResultConnector: integer = -1; ADoCabling: boolean = true; AOnlyForNewCable: boolean = False): TConnectorObject; //функции для построения дерева function CreateData(AID, AImageIndex: integer; AIDTopComponent: integer = 0; AIdCompRel: integer = 0): TNodeData; function AddChild(ATree: TFlyTreeViewPro; AParentNode:TFlyNode; AChildComplects: TSCSComponents): TFlyNode; function AddNode (ATree: TFlyTreeViewPro; ACurrNode: TFlyNode; ACompon: TSCSComponent; AString: string = ''): TFlyNode; //процедура преобразования всех многократных интерфейсов на однократные последней компоненты каталога procedure ClearMultiplyInterfaces(ASCSID: integer); //вывод формы сообщения с флажком "Больше не выводить" function MessageDlgWithCheck(const AMsg, ACaption: string): boolean; //скрутка всех новопроложенных кабелей function MakeCablingForNewCable(AIDObjectList: Tlist): Boolean; //вычисляем общую длину function TotalLength (AWayList: TList): double; function GetAllTraceInCadToEndPoint(aServer, aWS: TConnectorObject): TList; // Tolik 08/02/2021 -- var GLastIdComponent: integer = -1; GNotShowDialog1: boolean = false; //Tolik AllPassedTraces, ConnectedComponList: TList; // implementation uses U_main, U_PEDialogEqChoice, {U_ChoiceConnectSide,} U_SCSClasses; //вычисляем общую длину function TotalLength (AWayList: TList): double; var distance: double; j: integer; begin result := -1; if Assigned(AWayList) then begin distance := 0; For j := 0 to AWayList.Count - 1 do begin if CheckFigureByClassName(Tfigure(AWayList[j]), cTOrthoLine) then begin distance := distance + abs(TOrthoLine(AWayList[j]).LineLength); end; end; result := distance; end; end; // Tolik 08/02/2021 -- function GetAllTraceInCadToEndPoint(aServer, aWS: TConnectorObject): TList; var RaiserThisList: TConnectorObject; RaiserOtherList: TConnectorObject; CurrentWS: TConnectorObject; CurrentServer: TConnectorObject; AllTrace: TList; i, j, k: integer; CurGCadForm: TF_CAD; isTrace: boolean; RaiseType: TConnRaiseType; ListOfLists: TIntList; ListOfRaises: TList; CurrentCAD: TF_CAD; ConnFrom: TConnectorObject; ConnTo: TConnectorObject; PrevConn: TConnectorObject; PrevCAD: TF_CAD; ListOfAllTraces: TList; EndPoint: TConnectorObject; TracesLength: Double; begin ListOfRaises := Nil; ListOfLists := nil; Result := TList.Create; try CurrentServer := aServer; CurrentWS := aWS; //BeginProgress('', 1, true); BeginProgress('', -1, false); F_Progress.BringToFront; AllTrace := nil; ListOfAllTraces := nil; TracesLength := 0; GCadForm.FDeselectUpDown := True; // в пределах одного листа if GListWithEndPoint = GCadForm then begin if ((GetKeyState(VK_SHIFT) and 128) = 128) then ListOfAllTraces := GetAllTraceInCADByMarked_New1(CurrentServer, CurrentWS) else ListOfAllTraces := GetAllTraceInCADByMarked(CurrentServer, CurrentWS); //Tolik 21/01/2025 -- тут вполне может вернуться нулевой результат (типа, nil) //if ListOfAllTraces.Count > 0 then if ((ListOfAllTraces <> nil) and (ListOfAllTraces.Count > 0)) then // begin //if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then GCadForm.FTracingListIndex := 0; //Tolik 09/10/2017 -- // AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex]; //AllTrace := TList.Create; // проверочка -- на всякий -- //if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and // (TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then // AllTrace.Assign(TList(ListOfAllTraces[GCadForm.FTracingListIndex]), laCopy); // //FreeAndNil(AllTrace); Result.Assign(ListOfAllTraces[0], laCopy); end else // Tolik -- 08/02/2017 -- // GCadForm.FTracingList := TList.Create; begin if GCadForm.FTracingList = nil then GCadForm.FTracingList := TList.Create else GCadForm.FTracingList.Clear; end; // end else if GListWithEndPoint <> nil then begin RaiseType := crt_OnFloor; //#From Oleg# //14.09.2010 // другой лист с КО if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GCadForm.FCADListID then RaiseType := crt_BetweenFloorDown; if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GListWithEndPoint.FCADListID then RaiseType := crt_BetweenFloorUp; ListOfLists := GetSortedListIDsByBounds(GCadForm.FCADListID, GListWithEndPoint.FCADListID); if ListOfLists.Count >= 2 then begin ListOfRaises := GetSortedListOfRaisesFromCurr(ListOfLists, RaiseType, CurrentWS, CurrentServer); if CheckCanTracingBetweenFloor(ListOfLists, ListOfRaises) then begin PrevCAD := nil; PrevConn := nil; for i := 0 to ListOfLists.Count - 1 do begin CurrentCAD := GetListByID(ListOfLists[i]); // взять найденный м-э с-п if i < ListOfLists.Count - 1 then begin ConnTo := TConnectorObject(ListOfRaises[i]); end else begin ConnTo := CurrentServer; end; CurGCadForm := GCadForm; GCadForm := CurrentCAD; if i = 0 then begin ConnFrom := CurrentWS; end else begin ConnFrom := TConnectorObject(GetFigureByID(GCadForm, PrevConn.FID_ConnToPassage)); end; //ListOfAllTraces := GetAllTraceInCADByMarked(ConnTo, ConnFrom{ConnFrom, ConnTo}); ListOfAllTraces := GetAllTraceInCADByMarked(ConnFrom, ConnTo); // Tolik 21/01/2025 -- //if ListOfAllTraces.Count > 0 then if ((ListOfAllTraces <> nil) and (ListOfAllTraces.Count > 0)) then // begin //if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then // GCadForm.FTracingListIndex := 0; AllTrace := TList.Create; // проверочка -- на всякий -- //if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and // (TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then AllTrace.Assign(TList(ListOfAllTraces[0]), laCopy); if AllTrace.Count > 0 then begin GCadForm := CurGCadForm; PrevCAD := CurrentCAD; PrevConn := ConnTo; for j := 0 to AllTrace.Count - 1 do Result.Add(AllTrace[j]); end; FreeAndNil(AllTrace); //Result.Assign(TList(ListOfAllTraces[0]), laCopy); end else begin if GCadForm.FTracingList = nil then GCadForm.FTracingList := TList.Create else GCadForm.FTracingList.Clear; end; end; end; end; if ListOfLists <> nil then FreeAndNil(ListOfLists); if ListOfRaises <> nil then FreeAndNil(ListOfRaises); end; if ListOfAllTraces <> nil then begin for i := 0 to ListOfAllTraces.Count - 1 do begin if TList(ListOfAllTraces[i]) <> nil then TList(ListOfAllTraces[i]).Free; end; FreeAndNil(ListOfAllTraces); end; EndProgress; RefreshCAD(GCadForm.PCad); GCadForm.FDeselectUpDown := false; except on E: Exception do addExceptionToLogEx('U_PECommon.aSelectTracetoServerExecute', E.Message); end; end; // //запуск мастера автотрасировки электрики procedure StartMasterPETrace; var CADList: TF_CAd; TypeAutoTrace: integer; ListFolder: TStringList; CurrList, ListObject: TList; ListIndexOfEndObject: TIntList; IndexFolder: integer; SCSObject: TSCSCatalog; i, j : integer; Compon: TScsComponent; Catalog: TSCSCatalog; SysName: String; ListAllComponent: TSCSComponents; currNode: TFlyNode; EndOjects, WorkObjects: TList; OperFigure: TObject; //лампочки и выключатели IndLamp, IndSwitches: integer; LampObjects, SwitchesObjects: TList; Node: TFlyNode; //Tolik GEndPointAdded: Boolean; ParentCatalog: TSCSCatalog; EndPointComponList: TSCSComponents; //список компонент ЕндПоинта SCScompon: TSCSComponent; Figure: TFigure; tvEndEvent, tvWorkEvent: TStateChangedEvent; FFigure: TFigure; FirstObj, LastObj: TConnectorObject; isLastShield: Boolean; ShieldCount: integer; LastPoint: TConnectorObject; // 16/09/2021 -- // procedure InitTree(var Atree: TFlyTreeViewPro); begin Atree.Images.Clear; Atree.Images.AddImages(F_NormBase.DM.ImageList_Dir); Atree.ButtonCheckedIndex := 1; Atree.ButtonGrayedIndex := 2; Atree.ButtonUnCheckedIndex := 0; Atree.ClickableColumns := false; Atree.DefaultRowHeight := 17; Atree.FixedColAsButton := true; Atree.Indent := 17; Atree.Options := Atree.Options + [goColSizing] - [goHorzLine, goVertLine]; Atree.RightClickSelect := true; Atree.SelectedBackgroundColor := clSilver; Atree.SelectedTextColor := clBlack; Atree.ShowHint := true; Atree.ShowImages := true; Atree.ShowLogic := true; Atree.ToolTips := true; end; procedure ClearList; var i: integer; begin if ListFolder <> nil then ListFolder.Clear; if ListObject <> nil then begin for i := 0 to ListObject.count - 1 do begin if (ListObject[i]) <> nil then TList(ListObject[i]).Free; end; ListObject.Clear; end; end; function CheckFirstType(ACompon: TSCSComponent): integer; var i: integer; begin Result := -1; For i := 0 to ListFolder.Count - 1 do begin if ACompon.ComponentType.NamePlural = ListFolder[i] then Result := i; end; end; procedure SortListObject; var i, NewIndex,OldIndex : integer; step: integer; NewList, OldList: Tlist; OldString, NewString: String; begin step := -1; // Tolik 19/03/2018 -- OldIndex := -1; // из-за того, что не была проинициализирована эта переменная, происходил "Вылет" всего мастера автотрассировки // //сначала положим в конец конечные обьекты For i := ListIndexOfEndObject.Count - 1 downto 0 do begin step := step + 1; // Tolik 19/03/2018 -- if ListIndexOfEndObject[i] <> ListObject.Count - 1 - Step then begin OldIndex := ListIndexOfEndObject[i]; NewIndex := ListObject.Count - 1 - Step; OldList := tList(ListObject[OldIndex]); OldString := ListFolder[OldIndex]; NewList := tList(ListObject[NewIndex]); NewString := ListFolder[NewIndex]; ListObject[NewIndex] := OldList; ListFolder[NewIndex] := OldString; ListObject[OldIndex] := NewList; ListFolder[OldIndex] := NewString; ListIndexOfEndObject[i] := NewIndex; If NewIndex = IndLamp then IndLamp := OldIndex; If NewIndex = IndSwitches then IndSwitches := OldIndex; end; end; //затем в перед конечными светильники if IndLamp > -1 then begin step := step + 1; if IndLamp <> ListObject.Count - 1 - Step then begin NewIndex := ListObject.Count - 1 - step; OldList := tList(ListObject[IndLamp]); OldString := ListFolder[IndLamp]; NewList := tList(ListObject[NewIndex]); NewString := ListFolder[NewIndex]; ListObject[NewIndex] := OldList; ListFolder[NewIndex] := OldString; ListObject[IndLamp] := NewList; ListFolder[IndLamp] := NewString; IndLamp := NewIndex; If NewIndex = IndSwitches then IndSwitches := OldIndex; end; end; if IndSwitches > -1 then //а затем уже перед светильники положим выключатели begin step := step + 1; if IndSwitches <> ListObject.Count - 1 - Step then begin NewIndex := ListObject.Count - 1 - step; OldList := tList(ListObject[IndSwitches]); OldString := ListFolder[IndSwitches]; NewList := tList(ListObject[NewIndex]); NewString := ListFolder[NewIndex]; ListObject[NewIndex] := OldList; ListFolder[NewIndex] := OldString; ListObject[IndSwitches] := NewList; ListFolder[IndSwitches] := NewString; IndSwitches := NewIndex; end; end; end; //Tolik // 18/01/2017 -- procedure ExpandNode(ANode: TFlyNode); var i: Integer; CurrNode: TFlyNode; begin CurrNode := ANode; if CurrNode <> nil then begin while CurrNode <> nil do begin if CurrNode.StateIndex >= 1 then begin CurrNode.Expand(False); end; for i := 0 to CurrNode.Count - 1 do begin if TFlyNode(CurrNode.Item[i]).StateIndex >= 1 then ExpandNode(TFlyNode(CurrNode.Item[i])); end; CurrNode := CurrNode.GetNextSibling; end; end; end; {procedure ExpandNode(ANode: TFlyNode); var i: Integer; begin if ANode.StateIndex >= 1 then begin ANode.Expand(False); end; for i := 0 to ANode.Count - 1 do begin if TFlyNode(ANode.Item[i]).StateIndex > 1 then ExpandNode(TFlyNode(ANode.Item[i])); end; end;} //Tolik 10/11/2015 -- проверить компоненты и вкинуть в списки только те, которые подходят по настройкам листа // (если включено "Свойства листа"--> "Менеджер проектов" --> "Контроль компоновки/подключения компонентов" --> // "Подключение по типу сети") и могут подключиться к выбранному кабелю, чтобы потом не делать дурную работу // (те, которые не могут подключиться вне зависимости от настроек 1х не берем) Procedure AddComponToList(var AList: TSCSComponents; SCSCompon, ACompon: TSCSComponent); var i: Integer; ChildCompon: TSCSComponent; CanAddCompon: Boolean; begin CanAddCompon := True; if ACompon <> nil then begin // если включена проверка подключения по типу сети if F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.ControlJoinByNetType then begin // верхний компонент if (ACompon.GUIDNetType = SCSCompon.GUIDNetType) and (SCSCompon.CheckJoinTo(ACompon,1,0,true).CanConnect) then begin AList.Add(ACompon); CanAddCompon := False; end; // если не подходит, смотрим, подходит ли кто-нибудь из чилдов if CanAddCompon then begin for i := 0 to ACompon.ChildReferences.Count - 1 do begin ChildCompon := TSCSComponent(ACompon.ChildReferences[i]); if (ChildCompon.GUIDNetType = SCSCompon.GUIDNetType) and (SCSCompon.CheckJoinTo(ChildCompon,1,0,true).CanConnect) then begin AList.Add(ACompon); Break; //// BREAK ////; end end; end; end else begin // Tolik 11/11/2016-- если нет контроля по типу сети - отобрать только электрику и ОПС, а // остальные - нах, обо -- НЕХ, (!!!!! это мастер автотрассировки электрики и ОПС ) -- {if SCSCompon.CheckJoinTo(ACompon,1,0,true).CanConnect then begin AList.Add(ACompon); CanAddCompon := False; end; if CanAddCompon then begin for i := 0 to ACompon.ChildReferences.Count - 1 do begin ChildCompon := TSCSComponent(ACompon.ChildReferences[i]); if SCSCompon.CheckJoinTo(ChildCompon,1,0,true).CanConnect then begin AList.Add(ACompon); Break; //// BREAK ////; end end; end;} // верхний компонент if (ACompon.IDNetType in [3,5,7]) and (SCSCompon.CheckJoinTo(ACompon,1,0,true).CanConnect) then begin AList.Add(ACompon); CanAddCompon := False; end; // если не подходит, смотрим, подходит ли кто-нибудь из чилдов if CanAddCompon then begin for i := 0 to ACompon.ChildReferences.Count - 1 do begin ChildCompon := TSCSComponent(ACompon.ChildReferences[i]); if (ChildCompon.IDNetType in [3,5,7]) and (SCSCompon.CheckJoinTo(ChildCompon,1,0,true).CanConnect) then begin AList.Add(ACompon); Break; //// BREAK ////; end end; end; end; end; end; function GetFirstComponFromConnector(aConn: TConnectorObject): TSCSComponent; Var i: integer; SCSCatalog: TSCSCatalog; begin Result := nil; if not AConn.Deleted then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(aConn.Id); if SCSCatalog <> nil then Result := SCSCatalog.GetFirstComponent; end; end; function CheckNotLastObject: Boolean; var i: integer; LastPointCatalog: TSCSCatalog; begin Result := True; LastPointCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(LastPoint.Id); if LastPointCatalog <> nil then begin for i := 0 to LastPointCatalog.ComponentReferences.Count - 1 do begin if (LastPointCatalog.ComponentReferences[i].ComponentType.SysName = ctsnShield) {or (LastPointCatalog.ComponentReferences[i].ComponentType.SysName = ctsnCupboard) or (LastPointCatalog.ComponentReferences[i].ComponentType.SysName = ctsnDistributionCabinet) or (LastPointCatalog.ComponentReferences[i].ComponentType.SysName = ctsnCase) or (LastPointCatalog.ComponentReferences[i].ComponentType.SysName = ctsnBox) or (LastPointCatalog.ComponentReferences[i].ComponentType.SysName = ctsnInstallBox) or (LastPointCatalog.ComponentReferences[i].ComponentType.SysName = ctsnTerminalBox)} then begin Result := False; exit; end; end; end; end; begin // TestOfAllComponent; //Tolik GEndPointAdded := False; ParentCatalog := nil; GDragOnCAD := True; EndPointComponList := nil; ListIndexOfEndObject := nil; ListFolder := nil; ListObject := nil; isLastShield := False; ListAllComponent := nil; // Tolik 21/01/2025 -- LastPoint := nil; // Tolik -- 16/09/2021 -- ShieldCount := 0; For i := GCadForm.PCad.Selection.Count - 1 downto 0 do begin if TFigure(GCadForm.PCad.Selection[i]) is TConnectorObject then begin Compon := GetFirstComponFromConnector(TConnectorObject(GCadForm.PCad.Selection[i])); if Compon <> nil then if Compon.ComponentType.SysName = ctsnShield then inc(ShieldCount); end; end; if ShieldCount = 2 then begin GConnectEndPoints := False; if GCadForm.PCad.TraceFigure <> nil then if GCadForm.PCad.TraceFigure is TOrthoLine then GConnectEndPoints := True; end; // Tolik 11/11/2016-- выкинуть нах из выбранных все кроме точечных объектов // чтобы мастер автотрассировки отобразился по-любому if not GConnectEndPoints then begin For i := GCadForm.PCad.Selection.Count - 1 downto 0 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).ConnectorType = ct_Nb) then begin Continue //// CONTINUE //// end else begin FFigure.Deselect; GCadForm.PCad.Selection.Delete(i); end; end; for i := GSnapFiguresList.Count - 1 downto 0 do begin if GSnapFiguresList[i] <> nil then begin if CheckFigureByClassName(TFigure(GSnapFiguresList[i]), cTConnectorObject) then begin if TConnectorObject(GSnapFiguresList[i]).ConnectorType = ct_NB then begin Compon := GetFirstComponFromConnector(TConnectorObject(GSnapFiguresList[i])); if Compon <> nil then if Compon.ComponentType.SysName = ctsnShield then isLastShield := true; if isLastShield then break; end; end; end; end; end else begin // // если идет соединение крайних черем менюшку на каде GCadForm.PCad.DeselectAll(2); if GSnapFiguresList.Count > 0 then firstObj := TConnectorObject(GSnapFiguresList[0]); LastObj := nil; for i := GSnapFiguresList.Count - 1 downto 1 do begin if TFigure(GSnapFiguresList[i]) is TconnectorObject then begin LastObj := TConnectorObject(GSnapFiguresList[i]); break; end; end; if (FirstObj = nil) or (LastObj = nil) then exit; if FirstObj.ID = LastObj.ID then exit; FirstObj.Select; LastObj.Select; Compon := GetFirstComponFromConnector(LastObj); if Compon <> nil then if Compon.ComponentType.SysName = ctsnShield then isLastShield := true; end; // if GSnapFiguresList.Count > 0 then begin if GSnapFiguresList[GSnapFiguresList.Count - 1] <> nil then begin if CheckFigureByClassName(TFigure(GSnapFiguresList[GSnapFiguresList.Count - 1]), cTConnectorObject) then LastPoint := TConnectorObject(GSnapFiguresList[GSnapFiguresList.Count - 1]); if LastPoint.ConnectorType = ct_Clear then LastPoint := nil; end else begin if GCadForm.FAutoCadMouse then begin if GSnapFiguresList.Count > 2 then begin if GSnapFiguresList[GSnapFiguresList.Count - 2] <> nil then begin if CheckFigureByClassName(TFigure(GSnapFiguresList[GSnapFiguresList.Count - 2]), cTConnectorObject) then LastPoint := TConnectorObject(GSnapFiguresList[GSnapFiguresList.Count - 2]); if LastPoint.ConnectorType = ct_Clear then LastPoint := nil; end; end end; end; end; if LastPoint <> nil then begin if CheckNotLastObject then LastPoint := nil; end; SCSCompon := F_NormBase.GSCSBase.SCSComponent; // -- кабель в НБ для автотрассировки // EndOjects := Nil; WorkObjects := Nil; LampObjects := Nil; SwitchesObjects := Nil; // Tolik -- 18/05/2018 -- //ListAllComponent := TSCSComponents.Create(False); //ListIndexOfEndObject := TIntList.Create; //ListFolder := TStringList.Create; //ListObject := TList.Create; // IndLamp := -1; IndSwitches := -1; F_PEAutoTraceDialog.ShowBadCableConnect := False; //Tolik --18/01/2017 -- //GCanRefreshCad := False; // Tolik 03/03/2021 F_PEAutoTraceDialog.tvEndObject.Items.Clear; F_PEAutoTraceDialog.tvWorkObject.Items.Clear; // Tolik -- хинтик юзеру, что попадает в дерево конечных объектов трассировки if F_PEAutoTraceDialog.tvEndObject.Hint = '' then F_PEAutoTraceDialog.tvEndObject.Hint := PEAutotraceTvEndObjsHint; if F_PEAutoTraceDialog.Label1.Hint = '' then begin //F_PEAutoTraceDialog.Label1.Hint := PE_LableHint; // F_PEAutoTraceDialog.Label1.ShowHint := True; end; // try if GDropComponent = nil then begin if F_NormBase.Tree_Catalog.Selected.Data <> Nil then begin if PObjectData(F_NormBase.Tree_Catalog.Selected.Data).ItemType = itComponLine then begin if F_NormBase.GSCSBase.SCSComponent.ComponentType.SysName <> ctsnCable then begin MessageModal(cPEMes22, cPEMes2, MB_ICONINFORMATION); exit; end end else begin MessageModal(cPEMes22, cPEMes2, MB_ICONINFORMATION); exit; end; end else begin MessageModal(cPEMes22, cPEMes2, MB_ICONINFORMATION); exit; end; end; // Tolik -- 18/05/2018 -- ListAllComponent := TSCSComponents.Create(False); ListIndexOfEndObject := TIntList.Create; ListFolder := TStringList.Create; ListObject := TList.Create; if LastPoint = nil then begin // if not GConnectEndPoints then begin // Tolik // если на КАДе нет выбранных фигур, то делаем по старому алгоритму - шуруем по всем каталогам // листа if GCadForm.PCad.Selection.Count = 0 then begin // если есть конечный объект, то изначально не включаем его в список, чтобы не попал в дерево рабочих компонент // правое дерево мастера автотрассировки if GEndPoint <> nil then begin for i := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.ChildCatalogReferences.Count - 1 do begin SCSObject := F_ProjMan.GSCSBase.CurrProject.CurrList.ChildCatalogReferences[i]; if (SCSObject.ItemType = itSCSConnector) and (SCSObject.SCSID <> GEndPoint.ID) then begin for j := 0 to SCSObject.SCSComponents.Count -1 do //Tolik 10/11/2015 // ListAllComponent.Add(SCSObject.SCSComponents[j]); // -- здесь добавится в список, только если пройдет проверку по типу сети и возможности подключения // если контроль подключения по типу сети отключен, а выбранным кабелем все равно подключиться нельзя, // то компонента в список однозначно не попадет AddComponToList(ListAllComponent, SCSCompon, TSCSComponent(SCSObject.SCSComponents[j])); // end; end; end else begin for i := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.ChildCatalogReferences.Count - 1 do begin SCSObject := F_ProjMan.GSCSBase.CurrProject.CurrList.ChildCatalogReferences[i]; if SCSObject.ItemType = itSCSConnector then begin for j := 0 to SCSObject.SCSComponents.Count - 1 do //Tolik // ListAllComponent.Add(SCSObject.SCSComponents[j]); AddComponToList(ListAllComponent, SCSCompon, TSCSComponent(SCSObject.SCSComponents[j])); // end; end; end; end else // если есть выбранные фигуры на КАДе -- делаем по ним begin for i := 0 to GCadForm.PCad.Selection.Count - 1 do begin Figure := TFigure(GCadForm.PCad.Selection[i]); // если конечный объект - здесь его пропускаем if ((GEndPoint <> nil) and (Figure.ID = GEndPoint.ID)) then Continue //// CONTINUE //// else begin // не удаленный точечный объект if (not Figure.Deleted) and CheckFigureByClassName(Figure, cTConnectorObject) then begin SCSObject := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure.ID); if SCSObject <> nil then begin for j := 0 to SCSObject.SCSComponents.Count - 1 do AddComponToList(ListAllComponent, SCSCompon, TSCSComponent(SCSObject.SCSComponents[j])); end; end; end; end; end; for i := 0 to ListAllComponent.Count - 1 do begin Compon := ListAllComponent[i]; SysName := Compon.ComponentType.SysName; if (SysName = ctsnHouse)or (SysName = ctsnApproach) then begin Continue; end; IndexFolder := CheckFirstType(Compon); if IndexFolder = -1 then begin IndexFolder := ListFolder.Add(Compon.ComponentType.NamePlural); if (SysName = ctsnPlugSwitch) then // смотрим индекс для выключателя begin IndSwitches := IndexFolder; end; if (SysName = ctsnLamp) then // смотрим индекс для лампочек begin IndLamp := IndexFolder; end; if (SysName = ctsnShield) or (SysName = ctsnCupboard) or //отбираем конечные обьекты (SysName = ctsnDistributionCabinet) or (SysName = ctsnCase) or (SysName = ctsnBox) or (SysName = ctsnInstallBox) or (SysName = ctsnTerminalBox) then ListIndexOfEndObject.Add(IndexFolder); end; if IndexFolder > ListObject.Count - 1 then begin CurrList := TList.Create; ListObject.Add(CurrList); end; if IndexFolder > ListObject.Count - 1 then MessageModal(cPEMes1, cPEMes2, MB_ICONWARNING) else TList(ListObject[IndexFolder]).add(Compon); if SCSObject.ItemType = itSCSConnector then begin //SCSObject.SCSComponents[0].chi end; end; //сортировка: ставим конечные объекты в конец списка а список выключателей и ламп в предпоследний SortListObject; // Tolik // сохраняем и сбрасываем обработчик изменения статуса узлов для дерева конечных объектов tvEndEvent := F_PEAutoTraceDialog.tvEndObject.OnStateChanged; F_PEAutoTraceDialog.tvEndObject.OnStateChanged := nil; tvWorkEvent := F_PEAutoTraceDialog.tvWorkObject.OnStateChanged; F_PEAutoTraceDialog.tvWorkObject.OnStateChanged := nil; // //построим дерево потребителей InitTree(F_PEAutoTraceDialog.tvEndObject); InitTree(F_PEAutoTraceDialog.tvWorkObject); F_PEAutoTraceDialog.BuildTree(F_PEAutoTraceDialog.tvWorkObject, ListFolder, ListObject, IndLamp, IndSwitches); //оставляем только щиты, стойки, шкафы, трансформаторы, счётчики, коробки(конечные объекты) if ListIndexOfEndObject.Count > 0 then begin for i := 0 to ListIndexOfEndObject[0] - 1 do begin ListFolder.Delete(0); ListObject.Delete(0); end; end // Tolik // если трассировка только к конечному объекту - очистить списки else ClearList; //Tolik // Если есть конечный объект, то вставляем его в список конечных объектов (все его компоненты) if GEndPoint <> nil then begin // Tolik 06/02/2021 -- делаем допуск на трассировку по всем листам, независимо, где сидит конечная точка трассировки //ParentCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(GEndPoint.ID); ParentCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(GEndPoint.ID); // if ParentCatalog <> nil then begin EndPointComponList := TSCSComponents.Create(False); for i := 0 to ParentCatalog.ComponentReferences.Count - 1 do begin Compon := ParentCatalog.ComponentReferences[i]; // Tolik 09/06/2021 -- выкинуть Узо из Щитка, чтобы к нему не подключился кабель //if Compon.componentType.SysName <> ctsnUZO then // Commented by Tolik 23/07/2021 -- begin if Compon <> nil then if Compon.IsTop then // 10/11/2015 // EndPointComponList.Add(Compon); AddComponToList(EndPointComponList, SCSCompon, Compon); end; end; for i := 0 to EndPointComponList.Count - 1 do begin Compon := TSCSComponent(EndPointComponList[i]); SysName := Compon.ComponentType.SysName; // Tolik 09/06/2021 -- if (SysName = ctsnHouse)or (SysName = ctsnApproach) then //if ((SysName = ctsnHouse) or (SysName = ctsnApproach) or (SysName = ctsnUZO)) then // begin Continue; end; IndexFolder := CheckFirstType(Compon); if IndexFolder = -1 then begin IndexFolder := ListFolder.Add(Compon.ComponentType.NamePlural); end; ListIndexOfEndObject.Add(IndexFolder); if IndexFolder > ListObject.Count - 1 then begin CurrList := TList.Create; ListObject.Add(CurrList); end; if IndexFolder > ListObject.Count - 1 then MessageModal(cPEMes1, cPEMes2, MB_ICONWARNING) else TList(ListObject[IndexFolder]).add(Compon); if SCSObject.ItemType = itSCSConnector then begin end; end; end; end; // //И строим дерево конечных объектов F_PEAutoTraceDialog.BuildTree(F_PEAutoTraceDialog.tvEndObject, ListFolder, ListObject); end else // begin tvEndEvent := F_PEAutoTraceDialog.tvEndObject.OnStateChanged; F_PEAutoTraceDialog.tvEndObject.OnStateChanged := nil; tvWorkEvent := F_PEAutoTraceDialog.tvWorkObject.OnStateChanged; F_PEAutoTraceDialog.tvWorkObject.OnStateChanged := nil; // right tree EndPointComponList := TSCSComponents.Create(False); ParentCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(FirstObj.ID); if ParentCatalog <> nil then begin compon := ParentCatalog.GetFirstComponent; if Compon <> nil then begin ListFolder.Add(Compon.ComponentType.NamePlural); CurrList := TList.Create; for i := 0 to ParentCatalog.ComponentReferences.Count - 1 do begin Compon := ParentCatalog.ComponentReferences[i]; if Compon <> nil then if Compon.IsTop then // 10/11/2015 // EndPointComponList.Add(Compon); AddComponToList(EndPointComponList, SCSCompon, Compon); end; for i := 0 to EndPointComponList.Count - 1 do begin Compon := TSCSComponent(EndPointComponList[i]); SysName := Compon.ComponentType.SysName; if (SysName = ctsnHouse)or (SysName = ctsnApproach) then begin Continue; end; IndexFolder := CheckFirstType(Compon); if IndexFolder = -1 then begin IndexFolder := ListFolder.Add(Compon.ComponentType.NamePlural); end; ListIndexOfEndObject.Add(IndexFolder); if IndexFolder > ListObject.Count - 1 then begin CurrList := TList.Create; ListObject.Add(CurrList); end; if IndexFolder > ListObject.Count - 1 then MessageModal(cPEMes1, cPEMes2, MB_ICONWARNING) else TList(ListObject[IndexFolder]).add(Compon); end; end; InitTree(F_PEAutoTraceDialog.tvWorkObject); F_PEAutoTraceDialog.BuildTree(F_PEAutoTraceDialog.tvWorkObject, ListFolder, ListObject, -1, -1); end; //left tree EndPointComponList.Clear; ListFolder.Clear; FreeList(ListObject); ListObject := TList.Create; ParentCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(LastObj.ID); if ParentCatalog <> nil then begin compon := ParentCatalog.GetFirstComponent; if Compon <> nil then begin ListFolder.Add(Compon.ComponentType.NamePlural); CurrList := TList.Create; for i := 0 to ParentCatalog.ComponentReferences.Count - 1 do begin Compon := ParentCatalog.ComponentReferences[i]; if Compon <> nil then if Compon.IsTop then // 10/11/2015 // EndPointComponList.Add(Compon); AddComponToList(EndPointComponList, SCSCompon, Compon); end; for i := 0 to EndPointComponList.Count - 1 do begin Compon := TSCSComponent(EndPointComponList[i]); SysName := Compon.ComponentType.SysName; if (SysName = ctsnHouse)or (SysName = ctsnApproach) then begin Continue; end; IndexFolder := CheckFirstType(Compon); if IndexFolder = -1 then begin IndexFolder := ListFolder.Add(Compon.ComponentType.NamePlural); end; ListIndexOfEndObject.Add(IndexFolder); if IndexFolder > ListObject.Count - 1 then begin CurrList := TList.Create; ListObject.Add(CurrList); end; if IndexFolder > ListObject.Count - 1 then MessageModal(cPEMes1, cPEMes2, MB_ICONWARNING) else TList(ListObject[IndexFolder]).add(Compon); end; end; InitTree(F_PEAutoTraceDialog.tvEndObject); F_PEAutoTraceDialog.BuildTree(F_PEAutoTraceDialog.tvEndObject, ListFolder, ListObject); end; end; end else begin tvEndEvent := F_PEAutoTraceDialog.tvEndObject.OnStateChanged; F_PEAutoTraceDialog.tvEndObject.OnStateChanged := nil; tvWorkEvent := F_PEAutoTraceDialog.tvWorkObject.OnStateChanged; F_PEAutoTraceDialog.tvWorkObject.OnStateChanged := nil; ListFolder.Clear; FreeList(ListObject); ListObject := TList.Create; // right tree EndPointComponList := TSCSComponents.Create(False); for j := 0 to GSnapFiguresList.Count - 1 do begin if GSnapFiguresList[j] <> nil then begin if CheckFigureByClassName(TFigure(GSnapFiguresList[j]), cTConnectorObject) then begin FirstObj := TConnectorObject(GSnapFiguresList[j]); if FirstObj.Id <> LastPoint.Id then begin ParentCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(FirstObj.ID); if ParentCatalog <> nil then begin compon := ParentCatalog.GetFirstComponent; if Compon <> nil then begin if ListFolder.IndexOf(Compon.ComponentType.NamePlural) = -1 then ListFolder.Add(Compon.ComponentType.NamePlural); CurrList := TList.Create; for i := 0 to ParentCatalog.ComponentReferences.Count - 1 do begin Compon := ParentCatalog.ComponentReferences[i]; if Compon <> nil then if Compon.IsTop then // 10/11/2015 // EndPointComponList.Add(Compon); AddComponToList(EndPointComponList, SCSCompon, Compon); end; end; end; end; end; end; end; for i := 0 to EndPointComponList.Count - 1 do begin Compon := TSCSComponent(EndPointComponList[i]); SysName := Compon.ComponentType.SysName; if (SysName = ctsnHouse)or (SysName = ctsnApproach) then begin Continue; end; IndexFolder := CheckFirstType(Compon); if IndexFolder = -1 then begin IndexFolder := ListFolder.Add(Compon.ComponentType.NamePlural); end; ListIndexOfEndObject.Add(IndexFolder); if IndexFolder > ListObject.Count - 1 then begin CurrList := TList.Create; ListObject.Add(CurrList); end; if IndexFolder > ListObject.Count - 1 then MessageModal(cPEMes1, cPEMes2, MB_ICONWARNING) else TList(ListObject[IndexFolder]).add(Compon); end; InitTree(F_PEAutoTraceDialog.tvWorkObject); F_PEAutoTraceDialog.BuildTree(F_PEAutoTraceDialog.tvWorkObject, ListFolder, ListObject, -1, -1); //left tree EndPointComponList.Clear; ListFolder.Clear; FreeList(ListObject); ListObject := TList.Create; ParentCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(LastPoint.ID); if ParentCatalog <> nil then begin compon := ParentCatalog.GetFirstComponent; if Compon <> nil then begin if ListFolder.IndexOf(Compon.ComponentType.NamePlural) = -1 then ListFolder.Add(Compon.ComponentType.NamePlural); CurrList := TList.Create; for i := 0 to ParentCatalog.ComponentReferences.Count - 1 do begin Compon := ParentCatalog.ComponentReferences[i]; if Compon <> nil then if Compon.IsTop then // 10/11/2015 // EndPointComponList.Add(Compon); AddComponToList(EndPointComponList, SCSCompon, Compon); end; for i := 0 to EndPointComponList.Count - 1 do begin Compon := TSCSComponent(EndPointComponList[i]); SysName := Compon.ComponentType.SysName; if (SysName = ctsnHouse)or (SysName = ctsnApproach) then begin Continue; end; IndexFolder := CheckFirstType(Compon); if IndexFolder = -1 then begin IndexFolder := ListFolder.Add(Compon.ComponentType.NamePlural); end; ListIndexOfEndObject.Add(IndexFolder); if IndexFolder > ListObject.Count - 1 then begin CurrList := TList.Create; ListObject.Add(CurrList); end; if IndexFolder > ListObject.Count - 1 then MessageModal(cPEMes1, cPEMes2, MB_ICONWARNING) else TList(ListObject[IndexFolder]).add(Compon); end; end; InitTree(F_PEAutoTraceDialog.tvEndObject); F_PEAutoTraceDialog.BuildTree(F_PEAutoTraceDialog.tvEndObject, ListFolder, ListObject); end; end; F_PEAutotraceDialog.DeleteDoublesfromWorkTree; // Tolik 26/03/2021 -- удалить дубли из дереваа объектов //!!!!!!!!!!Здесь нужно поснимать флажки в дереве приёмников for i := 0 to ListIndexOfEndObject.Count - 1 do begin currNode := F_PEAutoTraceDialog.tvWorkObject.Items[ListIndexOfEndObject[i]]; //Tolik 11/11/2015 // currNode.StateIndex := 1; if currNode <> nil then begin // Tolik 11/03/2021 -- if GCallAutoTraceElectricMaster then currNode.StateIndex := 2 else // currNode.StateIndex := 1; F_PEAutoTraceDialog.tvWorkObject.NodeStateRefreshChildren(currNode, false); end; end; TypeAutoTrace := tatNone; // Tolik // Дерево конечных объектов раскрываем if F_PEAutoTraceDialog.tvEndObject.Items.Count > 0 then begin CurrNode := F_PEAutoTraceDialog.tvEndObject.GetFirstVisibleNode; while CurrNode <> Nil do begin ExpandNode(CurrNode); CurrNode := CurrNode.GetNextSibling; end; end; //ДЕрево потребителей тоже раскрываем if F_PEAutoTraceDialog.tvWorkObject.Items.Count > 0 then begin CurrNode := F_PEAutoTraceDialog.tvWorkObject.GetFirstVisibleNode; while CurrNode <> Nil do begin ExpandNode(CurrNode); CurrNode := CurrNode.GetNextSibling; end; end; // возвращаем обработчик события изменения статуса узлов дерева конечных объектов F_PEAutoTraceDialog.tvEndObject.OnStateChanged := tvEndEvent; // возвращаем обработчик события изменения статуса узлов дерева начальных объектов F_PEAutoTraceDialog.tvWorkObject.OnStateChanged := tvWorkEvent; //F_ProjMan.Tree_Catalog.Items.EndUpdate; // //показать мастер F_ProjMan.LockTreeAndGrid(true); // Tolik 12/03/2021 -- если вызываем мастер автотрассировки из процедуры создания трасс, выставляем по умолчанию настройки if GCallAutoTraceElectricMaster then begin F_PEAutoTraceDialog.AutotraceKind.ItemIndex := 1; F_PEAutoTraceDialog.TypeConnection.ItemIndex := 0; F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex := 1; F_PEAutoTraceDialog.IgnoreExistingCable.Visible := True; end; F_PEAutotraceDialog.DeselectConnected; // Tolik -- 31/03/2021 -- выключить уже подключенные кабелем // Tolik 30/09/2021 -- если автосоздавались трассы от каждого объекта к конечному - выставить подключение каждого компонента своим кабелем if GAutoTraceCreationOrder = 2 then begin F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex := 0; F_PEAutoTraceDialog.PutBox_Check.Checked := False; end; GAutoTraceCreationOrder := -1; // if F_PEAutoTraceDialog.ShowModal = mrOk then begin F_ProjMan.LockTreeAndGrid(False); if F_ProjMan.GSCSBase.CurrProject <> nil then if F_ProjMan.GSCSBase.CurrProject.Active then if F_ProjMan.GSCSBase.CurrProject.CurrList <> nil then // Tolik 06/02/2021 -- //SaveListToUndoStack(F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID); begin if GEndPoint = nil then SaveListToUndoStack(F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID) // если нет конечной точки трассировки - ундо текущего листа else begin // если есть конечная точка трассировки if TF_Cad(TPowerCad(GEndPoint.Owner).Owner).FCADListID = F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID then begin if GCadForm.FCanSaveForUndo then SaveListToUndoStack(F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID) // конечная точка трассировки - на текущем листе - ундо текущего листа end else SaveCurrProjectToUndoStack; // если конечная точка трассировки не на текущем листе - сделать ундо всего проекта end; end; TypeAutoTrace := F_PEAutotraceDialog.TypeAutoTrace_RadioGroup.ItemIndex; //Вкинем результаты диалога в соотв. листы // Поставим листы для рабочих и конечных обектов if EndOjects <> Nil then EndOjects.Clear else EndOjects := TList.Create; if WorkObjects <> Nil then WorkObjects.Clear else WorkObjects := TList.Create; if LampObjects <> Nil then LampObjects.Clear else LampObjects := TList.Create; if SwitchesObjects <> Nil then SwitchesObjects.Clear else SwitchesObjects := TList.Create; For i := 0 to F_PEAutoTraceDialog.ListEndCompon.Count - 1 do begin if F_PEAutoTraceDialog.ListEndCompon[i] <> -1 then begin Compon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(F_PEAutoTraceDialog.ListEndCompon[i]); if Compon <> nil then begin Catalog := Compon.GetFirstParentCatalog; CADList := GetListByID(Catalog.ListID); if CADList <> nil then OperFigure := GetFigureByID(CADList, Catalog.SCSID) else MessageModal(cPEMes3, cPEMes2, MB_ICONWARNING); if OperFigure <> Nil then EndOjects.Add(OperFigure) else MessageModal(cPEMes3, cPEMes2, MB_ICONWARNING); end; end; end; For i := 0 to F_PEAutoTraceDialog.ListWorkCompon.Count - 1 do begin if F_PEAutoTraceDialog.ListWorkCompon[i] <> -1 then begin Compon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(F_PEAutoTraceDialog.ListWorkCompon[i]); if Compon <> nil then begin Catalog := Compon.GetFirstParentCatalog; CADList := GetListByID(Catalog.ListID); if CADList <> nil then OperFigure := GetFigureByID(CADList, Catalog.SCSID) else MessageModal(cPEMes3, cPEMes2, MB_ICONWARNING); if OperFigure <> Nil then WorkObjects.Add(OperFigure) else MessageModal(cPEMes3, cPEMes2, MB_ICONWARNING); end; end; end; //лампочки For i := 0 to F_PEAutoTraceDialog.ListLampCompon.Count - 1 do begin if F_PEAutoTraceDialog.ListLampCompon[i] <> -1 then begin Compon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(F_PEAutoTraceDialog.ListLampCompon[i]); if Compon <> nil then begin Catalog := Compon.GetFirstParentCatalog; CADList := GetListByID(Catalog.ListID); if CADList <> nil then OperFigure := GetFigureByID(CADList, Catalog.SCSID) else MessageModal(cPEMes3, cPEMes2, MB_ICONWARNING); if OperFigure <> Nil then LampObjects.Add(OperFigure) else MessageModal(cPEMes3, cPEMes2, MB_ICONWARNING); end; end; end; //выключатели For i := 0 to F_PEAutoTraceDialog.ListSwitchesCompon.Count - 1 do begin if F_PEAutoTraceDialog.ListSwitchesCompon[i] <> -1 then begin Compon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(F_PEAutoTraceDialog.ListSwitchesCompon[i]); if Compon <> nil then begin Catalog := Compon.GetFirstParentCatalog; CADList := GetListByID(Catalog.ListID); if CADList <> nil then OperFigure := GetFigureByID(CADList, Catalog.SCSID) else MessageModal(cPEMes3, cPEMes2, MB_ICONWARNING); if OperFigure <> Nil then SwitchesObjects.Add(OperFigure) else MessageModal(cPEMes3, cPEMes2, MB_ICONWARNING); end; end; end; //добавим выключатели в список рабочих обьектов For i := 0 to SwitchesObjects.Count - 1 do begin WorkObjects.Add(SwitchesObjects[i]); end; // если не стоит ФЛАГ, то добавим лампочки ко всем рабочимс объектам if not F_PEAutoTraceDialog.TraceFromSwitch_CheckBox.Checked then begin For i := 0 to LampObjects.Count - 1 do begin WorkObjects.Add(LampObjects[i]); end; end; //!!!!!!!!! запуск автотрассировки !!!!!!!!!!!!!!!!!! // BeginAutoTrace; //if F_ProjMan.GSCSBase.CurrProject <> nil then // if F_ProjMan.GSCSBase.CurrProject.Active then // if F_ProjMan.GSCSBase.CurrProject.CurrList <> nil then // SaveListToUndoStack(F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID); BeginProgress; try if (EndOjects.Count > 0) and (WorkObjects.Count > 0) then begin PE_AutoTrace(TypeAutoTrace, EndOjects, WorkObjects); end; if (F_PEAutoTraceDialog.TraceFromSwitch_CheckBox.Checked) and (SwitchesObjects.Count > 0) then begin StartTraceFromSwitches(SwitchesObjects, LampObjects); end else if (EndOjects.Count > 0) then begin F_PEAutotraceDialog.CopyEndListToSwitchesList; StartTraceFromSwitches(SwitchesObjects, LampObjects); end; // EndAutoTrace; finally F_PEAutoTraceDialog.FromAutoTraceDialog := false; EndProgress; // TestOfAllComponent; end; //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!11 end else begin F_ProjMan.LockTreeAndGrid(False); GCallAutoTraceElectricMaster := False; end; finally //Tolik if F_PEAutoTraceDialog.ShowBadCableConnect then begin if F_PEAutoTraceDialog.CheckCanConnectCable.Checked then ShowMessage(cPeMes23) else ShowMessage(cPeMes24); // Tolik 10/11/2015 - сообщение показали, флаг сбросить (ибо нех) F_PEAutoTraceDialog.ShowBadCableConnect := False; // end; // Tolik FreeAndNil(F_PEAutoTraceDialog.LastAddedCableIDList); FreeAndNil(F_PEAutoTraceDialog.RaspredBoxConnectorList); GDragOnCAD := False; // if EndOjects <> Nil then EndOjects.Free; if WorkObjects <> Nil then WorkObjects.Free; if LampObjects <> Nil then LampObjects.Free; if SwitchesObjects <> Nil then SwitchesObjects.Free; if ListIndexOfEndObject <> nil then ListIndexOfEndObject.Free; ClearList; if ListFolder <> nil then begin ListFolder.Free; end; if ListObject <> nil then ListObject.Free; //Tolik if EndPointComponList <> nil then FreeAndNil(EndPointComponList); // if ListAllComponent <> nil then FreeAndNil(ListAllComponent); //Tolik 21/01/2025 -- end; //GCanRefreshCad := True; GCadForm.PCad.Refresh; end; procedure PE_AutoTrace(ATypeAutoTrace: integer; AEndList, AWorkList: TList); var ListShield: tList; //vLists: TList; begin if F_NormBase.GSCSBase.SCSComponent.ComponentType.SysName = ctsnCable then begin GLastIdComponent := -1; F_NormBase.GSCSBase.SCSComponent.LoadInterfaces; if ATypeAutoTrace > tatNone then begin // BeginAutoTrace; // vLists := TList.Create; // vLists.Add(F_ProjMan.GSCSBase.CurrProject.CurrList); // SaveForProjectUndo(vLists, True, False); if (U_Common.GCadForm <> Nil) and (U_Common.GCadForm.PCad <> Nil) then begin case ATypeAutoTrace of tatShare: ListShield := AutoTraseToShield(AWorkList, AEndList, False); tatIndivid: LIstShield := AutoTraseToShield(AWorkList, AEndList, True); end; FreeAndNil(ListShield); //Tolik 20/1/2025 -- end; // EndAutoTrace; end; //if ATypeAutoTrace > tatNone then // begin // if (U_Common.GCadForm <> Nil) and (U_Common.GCadForm.PCad <> Nil) then // begin // if ATypeAutoTrace = tatShare then // ListShield := AutoTraseToShield(AWorkList, AEndList); // end; // end; end; end; Function GetComponIDFromNB:Integer; var CurrDat: PObjectData; begin Result := 0; CurrDat := F_NormBase.Tree_Catalog.selected.data; Result := CurrDat.ObjectID; end; procedure CheckInterfConnectionsOnEnds; var i, j, k, l, m: Integer; FirstPointInterfCount, LastPointInterfCount, CableInterfCount: Integer; SCSComponent, LineComponent, PartLineComponent, PointComponent: TSCSComponent; SCSCatalog, PointCatalog: TSCSCatalog; currPath, FirstPointComponList, LastPointComponList, PassedCatalogList: TList; CanBreak: Boolean; Figure: TFigure; FirstInterfSide, SecondInterfSide: Integer; PassedCableList: TIntList; Interf: TSCSInterface; currInterfPos: TSCSInterfPosition; currCableList, ServerFigures, ServerObjects: TList; isServerFigure: Boolean; SCSList: TSCSList; // Tolik 08/02/2021 -- //Tolik 18/05/2018 -- procedure clearLists; begin if PassedCableList <> nil then PassedCableList.Free; if PassedCatalogList <> nil then PassedCableList.free; if ServerFigures <> nil then ServerFigures.Free; end; // begin // Tolik 18/05/2018 -- PassedCableList := nil; PassedCatalogList := nil; ServerFigures := nil; // // если прошли хоть одну трассу, попытаемся пересоединить по фень-хую if AllPassedTraces.Count > 0 then begin currPath := nil; PassedCableList := TIntList.Create; PassedCatalogList := TList.Create; CableInterfCount := 0; SCSComponent := F_NormBase.GSCSBase.SCSComponent; // кабель из НБ для автотрассировки if ((SCSComponent <> nil) and (SCSComponent.IsLine = biTrue)) then begin // Количество свободных для подключения интерфейсов на кабеле for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interf := TSCSInterface(SCSComponent.Interfaces[i]); if ((Interf.TypeI = itFunctional) and (Interf.Side = 1)) then begin if Interf.Kolvo = 0 then Inc(CableInterfCount) else CableInterfCount := CableInterfCount + Interf.Kolvo; end; end; // посмотрим, сколько получилось контуров ServerFigures := TList.Create; for i := 0 to AllPassedTraces.Count - 1 do begin currPath := TList(AllPassedTraces[i]); for j := 0 to currPath.Count - 1 do begin Figure := TFigure(currPath[j]); if ServerFigures.IndexOf(Figure) = -1 then begin if CheckFigureByClassName(Figure, cTConnectorObject) then begin if ServerFigures.IndexOf(Figure) = -1 then begin SCSCatalog := nil; // Tolik 08/02/2021 -- //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure.ID); SCSList := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(Figure.Owner).Owner).FCADListID); if SCSList <> nil then SCSCatalog := SCSList.GetCatalogFromReferencesBySCSID(Figure.ID); // if SCSCatalog <> nil then begin isServerFigure := False; for k := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[k]); if SCSComponent <> nil then begin if F_PEAutoTraceDialog.ListEndCompon.IndexOf(SCSComponent.ID) > -1 then begin isServerFigure := True; clearLists; // Tolik 18/05/2018 -- Break; end; end; end; if isServerFigure then ServerFigures.Add(Figure); end; end; end; end; end; end; for i := 0 to ServerFigures.Count - 1 do begin end; end // если в НБ не кабель или не судьба определить компонент - выход (на всякий) else begin clearLists; // Tolik 18/05/2018 -- Exit; end; end; clearLists; // Tolik 18/05/2018 -- end; Procedure CheckAndDeleteCableFromUpDown(AEndObjects, AFigures:TList; IdCable: Integer); var i: integer; CurrObject: TConnectorObject; CurrFigure: TFigure; begin for i := 0 to AFigures.Count - 1 do begin CurrFigure := TFigure(aFigures[i]); if CheckFigureByClassName(CurrFigure, TConnectorObject.ClassName) then if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then CurrObject := TConnectorObject(CurrFigure); if CurrObject <> nil then begin if (IdCable > 0) and (AEndObjects <> Nil) then begin DeleteCableFromUpDown(AEndObjects, CurrObject, IdCable, AFigures); end; end; end; end; (* function AutoTraseToShield(AFigures: TList; AEndObjects: TList; AIndivid: boolean): TList; var i,j: integer; CurrObject: TConnectorObject; CurrFigure: TFigure; IdNbLineCompon: integer; EndConnectorObject,CurrentServer: TConnectorObject; IdCable: integer; FlagOFEnd: boolean; WayList: TList; TracesLength: Double; Figure: TFigure; BackToServer: Boolean; procedure SortObjectsAboutDistance(AWorkFigures, AEndObjects : TList; AStartIndex: integer); var i,j,k: integer; mindist, distance: double; IndexMinDist: integer; Pdist: ^double; DistanceList: TList; OperFigure: TFigure; begin try DistanceList := TList.Create; For i := 0 to AStartIndex - 1 do DistanceList.Add(Nil); try IndexMinDist := -1; For i := 0 + AStartIndex to AWorkFigures.Count - 1 do begin WayList := Nil; OperFigure := TFigure(AWorkFigures[i]); WayList := GetAllTracepeInCAD(AEndObjects, Operfigure, true); distance := 0; if Assigned(WayList) then begin For j := 0 to WayList.Count - 1 do begin if CheckFigureByClassName(Tfigure(WayList[j]), cTOrthoLine) then begin distance := distance + abs(TOrthoLine(WayList[j]).LineLength); end; end end else begin distance := -1; end; if i = 0 + AStartIndex then begin mindist := distance; IndexMinDist := i; end; if mindist > distance then begin mindist := distance; IndexMinDist := i; end; new(Pdist); Pdist^ := distance; DistanceList.Add(Pdist); end; if IndexMinDist > -1 then begin if IndexMinDist <> 0 + AStartIndex then begin Pdist := DistanceList[IndexMinDist]; OperFigure := AWorkFigures[IndexMinDist]; DistanceList[IndexMinDist]:= DistanceList[0 + AStartIndex]; AWorkFigures[IndexMinDist] := AWorkFigures[0 + AStartIndex]; DistanceList[0 + AStartIndex] := Pdist; AWorkFigures[0 + AStartIndex] := OperFigure; end; For k := 1 + AStartIndex to AWorkFigures.Count - 1 do For i := 1 + AStartIndex to AWorkFigures.Count - 1 do begin if double(DistanceList[i-1]^) > double(DistanceList[i]^) then begin Pdist := DistanceList[i]; OperFigure := AWorkFigures[i]; DistanceList[i]:= DistanceList[i - 1]; AWorkFigures[i] := AWorkFigures[i - 1]; DistanceList[i - 1] := Pdist; AWorkFigures[i - 1] := OperFigure; end; end; end; finally For i := 1 to DistanceList.Count - 1 do begin if Assigned(DistanceList[i]) then Dispose(DistanceList[i]); end; DistanceList.Free; end; except on E: Exception do AddExceptionToLogEx('U_PECommon.AutoTraseToShield.SortObjectsAboutDistance ', E.Message); end; end; begin CurrObject := Nil; WayList := nil; Result := TList.Create; try try if F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 0 then F_PEAutoTraceDialog.TypeConnection.ItemIndex := 0; except end; IdCable := 0; F_NormBase.GSCSBase.SCSComponent.LoadInterfaces(-1, false); if F_NormBase.GSCSBase.SCSComponent.ComponentType.SysName = ctsnCable then begin if AIndivid then begin IdCable := F_NormBase.GSCSBase.SCSComponent.ID; end else begin if F_PEAutoTraceDialog.TypeConnection.ItemIndex <> 1 then begin if CheckMultiPairInterfases(F_NormBase.GSCSBase.SCSComponent, F_PEAutoTraceDialog.RaspredBox) then IdCable := F_NormBase.GSCSBase.SCSComponent.ID else begin PauseProgress(True); if F_PEAutoTraceDialog.PutBox_Check.Checked then ShowMessage(cPEMes18) else begin if MessageModal('Кабель не имеет многократных интерфейсов. Установить клемную коробку?', '', mb_YesNo) = 6 then begin F_PEAutoTraceDialog.PutBox_Check.Checked := true; if F_PEAutoTraceDialog.ShowModal = mrOK then if CheckMultiPairInterfases(F_NormBase.GSCSBase.SCSComponent, F_PEAutoTraceDialog.RaspredBox) then IdCable := F_NormBase.GSCSBase.SCSComponent.ID else ShowMessage(cPEMes18); end; end; PauseProgress(False); end; end else IdCable := F_NormBase.GSCSBase.SCSComponent.ID; end; end; if (AFigures <> nil) and (((IdCable > 0)) {or Not ADoAutoTrace}) then begin if not AIndivid then // просортируем все рабочие обьекты по их отдалённости от конечных begin SortObjectsAboutDistance(AFigures, AEndObjects, 0); end; if F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0 then begin for i := 0 to AFigures.Count - 1 do begin CurrFigure := TFigure(aFigures[i]); if CheckFigureByClassName(CurrFigure, TConnectorObject.ClassName) then if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then CurrObject := TConnectorObject(CurrFigure); if CurrObject <> nil then // if CheckElectricNet(CurrObject) then ////Проверка на возможность подключения к кабелю begin //if ADoAutoTrace then begin if (IdCable > 0) and (AEndObjects <> Nil) then begin if AIndivid then begin // индивидуальный кабель для каждого приёмника TraceIndividCableToEndPoint(AEndObjects, CurrObject, IdCable) end else//один кабель для всех begin TraceCableToEndPoint(AEndObjects, CurrObject, IdCable, AFigures); SortObjectsAboutDistance(AFigures, AEndObjects, i); // TestOfAllComponent; end; end; end; end; end; CheckAndDeleteCableFromUpDown(AEndObjects, AFigures, IdCable); end; if F_PEAutoTraceDialog.TypeConnection.ItemIndex = 1 then begin for i := 0 to AFigures.Count - 1 do begin CurrFigure := TFigure(aFigures[i]); if CheckFigureByClassName(CurrFigure, TConnectorObject.ClassName) then if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then CurrObject := TConnectorObject(CurrFigure); if CurrObject <> nil then begin EndConnectorObject := CheckComponCnt(CurrObject); if EndConnectorObject <> nil then begin CurrentServer := TConnectorObject(AEndObjects[0]); if WayList <> nil then WayList.Clear; WayList := GetAllTraceInCADByMarked(TConnectorObject(CurrentServer), EndConnectorObject); WayList := WayList[0]; if WayList <> nil then begin GCadForm.FTracingList := TList.Create; for j := 0 to WayList.Count - 1 do begin Figure := TFigure(WayList[j]); GCadForm.FTracingList.Add(Figure); Figure.Select; if CheckFigureByClassName(Figure, TOrthoLine.ClassName) then TracesLength := TracesLength + TOrtholine(Figure).LineLength; end; end; GListWithEndPoint := GCadForm; TracingToEndPoint(EndConnectorObject, TConnectorObject(CurrentServer), GetComponIDFromNB); GListWithEndPoint := nil; end; end; end; CheckAndDeleteCableFromUpDown(AEndObjects, AFigures, IdCable); end; end; finally if Result.Count = 0 then FreeAndNil(Result); end; end; *) function AutoTraseToShield(AFigures: TList; AEndObjects: TList; AIndivid: boolean): TList; var i, j, k, l: integer; CurrObject: TConnectorObject; CurrFigure: TFigure; IdNbLineCompon: integer; EndConnectorObject,CurrentServer: TConnectorObject; IdCable: integer; FlagOFEnd: boolean; WayList: TList; TracesLength: Double; Figure: TFigure; BackToServer: Boolean; // Tolik PassedFiguresList, CurrFiguresList, CurrPathList, currPath, currServerTraces: TList; TraceList: array of double; //CrossServer: Boolean; CurrentServerFiguresCount: Integer; ServerSideCompons, WSSideCompons: TIntList; currNode, ChildNode: TFlyNode; BreakTracing: Boolean; AllCompons: TSCSComponents; aComponent: TSCSComponent; ShowBadConnectMessage: Boolean; PassedTrace: TList; procedure SortObjectsAboutDistance(AWorkFigures, AEndObjects : TList; AStartIndex: integer); var i,j,k: integer; mindist, distance: double; IndexMinDist: integer; Pdist: ^double; DistanceList: TList; OperFigure: TFigure; begin try //Tolik WayList := Nil; DistanceList := TList.Create; For i := 0 to AStartIndex - 1 do DistanceList.Add(Nil); try IndexMinDist := -1; For i := 0 + AStartIndex to AWorkFigures.Count - 1 do begin OperFigure := TFigure(AWorkFigures[i]); WayList := GetAllTracepeInCAD(AEndObjects, Operfigure, true); distance := 0; if Assigned(WayList) then begin For j := 0 to WayList.Count - 1 do begin if CheckFigureByClassName(Tfigure(WayList[j]), cTOrthoLine) then begin distance := distance + abs(TOrthoLine(WayList[j]).LineLength); end; end; //Tolik FreeAndNil(WayList); // end else begin distance := -1; end; if i = 0 + AStartIndex then begin mindist := distance; IndexMinDist := i; end; if mindist > distance then begin mindist := distance; IndexMinDist := i; end; new(Pdist); Pdist^ := distance; DistanceList.Add(Pdist); end; if IndexMinDist > -1 then begin if IndexMinDist <> 0 + AStartIndex then begin Pdist := DistanceList[IndexMinDist]; OperFigure := AWorkFigures[IndexMinDist]; DistanceList[IndexMinDist]:= DistanceList[0 + AStartIndex]; AWorkFigures[IndexMinDist] := AWorkFigures[0 + AStartIndex]; DistanceList[0 + AStartIndex] := Pdist; AWorkFigures[0 + AStartIndex] := OperFigure; end; For k := 1 + AStartIndex to AWorkFigures.Count - 1 do For i := 1 + AStartIndex to AWorkFigures.Count - 1 do begin if double(DistanceList[i-1]^) > double(DistanceList[i]^) then begin Pdist := DistanceList[i]; OperFigure := AWorkFigures[i]; DistanceList[i]:= DistanceList[i - 1]; AWorkFigures[i] := AWorkFigures[i - 1]; DistanceList[i - 1] := Pdist; AWorkFigures[i - 1] := OperFigure; end; end; end; finally For i := 1 to DistanceList.Count - 1 do begin if Assigned(DistanceList[i]) then Dispose(DistanceList[i]); end; DistanceList.Free; end; except on E: Exception do AddExceptionToLogEx('U_PECommon.AutoTraseToShield.SortObjectsAboutDistance ', E.Message); end; end; Function ConnectFigures(ACurrentWS, AEndPoint: TConnectorObject; AllTrace: TList; AID_Cable: Integer): Boolean; var i, j, k: integer; ComponID: Integer; isConnected: Boolean; IDLine: Integer; IDPos: Integer; SetLinesList: TIntList; SetLinesPos: TIntList; Counts: Integer; JoinedConn: TConnectorObject; CadCrossObject: TCadCrossObject; AutoTraceStatus: Boolean; PointComponent, ACable: TSCSComponent; aCatalog: TSCSCatalog; currTrace: TSCSCatalog; TraceCounter: Integer; JoinedComponent, CableForConnect, ComponentForConnect: TSCSComponent; InterfSide: Integer; CanDisJoin, CanJoin: Boolean; ConnectedInterFaces: TInterfLists; currInterFace, CurrSelfInterFace: TSCSInterface; DisJoinedCompons: TSCSComponents; currCatalog: TSCSCatalog; DisJoinSides, ResultList: TIntList; procedure ReconnectOnEnds; var i, j, k: Integer; isAnyBodyConnected: Boolean; CablePointObjCount: Integer; CablePointObjConnected: Integer; begin BaseBeginUpdate; try CanDisJoin := True; InterfSide := 0; isAnyBodyConnected := False; isConnected := False; CablePointObjCount := 0; CablePointObjConnected := 0; for i := 0 to CableForConnect.JoinedComponents.Count - 1 do begin JoinedComponent := CableForConnect.JoinedComponents[i]; if JoinedComponent.IsLine = biFalse then Inc(CablePointObjCount); end; while CanDisJoin do begin CanDisJoin := False; for i := 0 to CableForConnect.JoinedComponents.Count - 1 do begin JoinedComponent := CableForConnect.JoinedComponents[i]; if JoinedComponent.IsLine = biFalse then begin // определяем сторону кабеля, к которой подключен неподходящий компонент for j := 0 to CableForConnect.Interfaces.Count - 1 do begin // Tolik 12/04/2021 - - CurrSelfInterFace := CableForConnect.Interfaces[j]; if ((CurrSelfInterFace.TypeI = itFunctional) and ((CurrSelfInterFace.IsBusy = biTrue) or (CurrSelfInterFace.BusyPositions.Count > 0)) ) then begin for k := 0 to CurrSelfInterFace.ConnectedInterfaces.Count - 1 do begin currInterFace := CurrSelfInterFace.ConnectedInterfaces[k]; if CurrInterface.ComponentOwner <> nil then begin if CurrInterface.ComponentOwner.IsLine = biFalse then begin CanDisJoin := True; InterfSide := CurrSelfInterFace.Side; //DisJoinedCompons.Add(JoinedComponent); // 19/07/2021 -- Tolik DisJoinedCompons.Add(CurrInterface.ComponentOwner); DisJoinSides.Add(currSelfInterFace.Side); CableForConnect.DisJoinFrom(CurrInterface.ComponentOwner); //break; // Tolik 19/07/2021 -- end; end; end; end; { CurrSelfInterFace := CableForConnect.Interfaces[j]; if ((CurrSelfInterFace.TypeI = itFunctional) and ((CurrSelfInterFace.IsBusy = biTrue) or (CurrSelfInterFace.BusyPositions.Count > 0)) ) then begin currInterFace := CableForConnect.GetInterfaceConnectedWithCompon(CurrSelfInterFace, JoinedComponent); if currInterFace <> nil then begin CanDisJoin := True; DisJoinedCompons.Add(JoinedComponent); DisJoinSides.Add(currSelfInterFace.Side); for k := 0 to currInterFace.ConnectedInterfaces.Count - 1 do begin if currInterFace.ConnectedInterfaces[k].ComponentOwner = CableForConnect then begin InterfSide := CurrSelfInterFace.Side; if currInterFace.ComponentOwner.DisJoinFrom(currInterFace.ConnectedInterfaces[k].ComponentOwner) then begin CableForConnect.DisJoinFrom(JoinedComponent); //CanDisJoin := False; break; end; end; end; end; end; } end; if CanDisJoin then Break; end; end; end; except on E: Exception do AddExceptionToLogEx('U_PECommon.ConnectFigures / ReconnectOnEnds ', E.Message); end; BaseEndUpdate; for i := 0 to DisJoinedCompons.Count - 1 do begin JoinedComponent := DisJoinedCompons[i]; InterfSide := DisJoinSides[i]; currCatalog := JoinedComponent.GetFirstParentCatalog; if InterfSide <> 0 then begin isConnected := False; for j := 0 to AllCompons.Count - 1 do begin ComponentForConnect := AllCompons[j]; if currCatalog.ComponentReferences.IndexOf(ComponentForConnect) <> -1 then begin if ComponentForConnect.IsLine = biFalse then begin CanJoin := CableForConnect.CheckJoinTo(ComponentForConnect, InterfSide, 0).CanConnect; if CanJoin then CableForConnect.JoinTo(ComponentForConnect, InterfSide, 0); if CableForConnect.JoinedComponents.IndexOf(ComponentForConnect) <> -1 then begin isConnected := True; //Break; // Tolik 19/07/2021 -- end; end; end; end; ResultList.Add(BoolToInt(isConnected)); end; end; for i := 0 to CableForConnect.JoinedComponents.Count - 1 do begin JoinedComponent := CableForConnect.JoinedComponents[i]; if JoinedComponent.IsLine = biFalse then Inc(CablePointObjConnected); end; if ((CablePointObjCount = 0) or (CablePointObjCount <> CablePointObjConnected) ) then ResultList.Add(0); DisJoinedCompons.Clear; DisJoinSides.Clear; end; function CheckInversedPath: Boolean; var FirstLine: TOrthoLine; var i: integer; begin Result := False; if AllTrace.Count > 0 then begin FirstLine := nil; for i := 0 to AllTrace.Count - 1 do begin if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin FirstLine := TOrthoLine(AllTrace[i]); break; end; end; if FirstLine <> nil then begin if TConnectorObject(ACurrentWS).ConnectorType = ct_Clear then begin {if TOrthoLine(AllTrace[0]).JoinConnector1.ID <> ACurrentWS.ID then if TOrthoLine(AllTrace[0]).JoinConnector2.ID <> ACurrentWS.ID then Result := True; } if FirstLine.JoinConnector1.ID <> ACurrentWS.ID then if FirstLine.JoinConnector2.ID <> ACurrentWS.ID then Result := True; end else begin Result := True; { if TConnectorObject(TOrthoLine(AllTrace[0]).JoinConnector1).JoinedConnectorsList.Count > 0 then if TConnectorObject(TConnectorObject(TOrthoLine(AllTrace[0]).JoinConnector1).JoinedConnectorsList[0]).Id = ACurrentWS.ID then Result := False; if Result then begin if TConnectorObject(TOrthoLine(AllTrace[0]).JoinConnector2).JoinedConnectorsList.Count > 0 then if TConnectorObject(TConnectorObject(TOrthoLine(AllTrace[0]).JoinConnector2).JoinedConnectorsList[0]).Id = ACurrentWS.ID then Result := False; end; } if TConnectorObject(FirstLine.JoinConnector1).JoinedConnectorsList.Count > 0 then if TConnectorObject(TConnectorObject(FirstLine.JoinConnector1).JoinedConnectorsList[0]).Id = ACurrentWS.ID then Result := False; if Result then begin if TConnectorObject(FirstLine.JoinConnector2).JoinedConnectorsList.Count > 0 then if TConnectorObject(TConnectorObject(FirstLine.JoinConnector2).JoinedConnectorsList[0]).Id = ACurrentWS.ID then Result := False; end; end; end; end; end; begin try Result := True; ResultList := TIntList.Create; if ACurrentWS.ConnectorType <> ct_Clear then begin // выделить трассу if AllTrace <> nil then begin for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; DisableMarking; //15.01.2011 - Отключаем генерацию маркировки для кабеля try // скопировать кабель туда for i := 0 to AllTrace.Count - 1 do begin if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin AutoTraceStatus := F_PEAutoTraceDialog.FromAutoTraceDialog; F_PEAutoTraceDialog.FromAutoTraceDialog := False; ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AID_Cable, True); F_PEAutoTraceDialog.FromAutoTraceDialog := AutoTraceStatus; end; end; finally EnableMarking; end; // убрать выделение трассы for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).DeSelect; // SetLinesList := TIntList.Create; SetLinesPos := TIntList.Create; //SetLinesList.Add(ACurrentWS.Id); // Tolik 10/04/2021 -- for i := 0 to AllTrace.Count - 1 do begin IDLine := TFigure(AllTrace[i]).ID; SetLinesList.Add(IDLine); if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin IDPos := TOrthoLine(AllTrace[i]).FConnectingPos; end else IDPos := -1; SetLinesPos.Add(IDPos); end; //SetLinesList.Add(AEndPoint.Id); // Tolik 10/04/2021 -- if CheckInversedPath then begin //SetLinesList.Insert(0, AEndPoint.Id); //SetLinesList.Add(ACurrentWS.Id); if (SetLinesList[0] = ACurrentWS.Id) and (SetLinesList[SetLinesList.Count - 1] = AEndPoint.Id) then begin SetLinesList[0] := AEndPoint.Id; SetLinesList[SetLinesList.Count - 1] := ACurrentWS.Id end; end else begin //SetLinesList.Insert(0, ACurrentWS.Id); //SetLinesList.Add(AEndPoint.Id); end; // // соединяем isConnected := ConnectObjectsInPMByWay(SetLinesList, nil, nil, nil); if SetLinesList <> nil then FreeAndNil(SetLinesList); if SetLinesPos <> nil then FreeAndNil(SetLinesPos); end; end else begin ACurrentWS.FDisableTracing := True; for Counts := 0 to ACurrentWS.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(ACurrentWS.JoinedConnectorsList[Counts]); // выделить трассу if AllTrace <> nil then begin for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; DisableMarking; //15.01.2011 - Отключаем генерацию маркировки для кабеля try // скопировать кабель туда for i := 0 to AllTrace.Count - 1 do if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin AutoTraceStatus := F_PEAutoTraceDialog.FromAutoTraceDialog; F_PEAutoTraceDialog.FromAutoTraceDialog := False; ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AID_Cable, true); F_PEAutoTraceDialog.FromAutoTraceDialog := AutoTraceStatus; end; finally EnableMarking; end; // убрать выделение трассы for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).DeSelect; // SetLinesList := TIntList.Create; SetLinesPos := TIntList.Create; for i := 0 to AllTrace.Count - 1 do begin IDLine := TFigure(AllTrace[i]).ID; SetLinesList.Add(IDLine); if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin IDPos := TOrthoLine(AllTrace[i]).FConnectingPos; end else IDPos := -1; SetLinesPos.Add(IDPos); end; if CheckInversedPath then begin SetLinesList.Insert(0, AEndPoint.Id); SetLinesList.Add(ACurrentWS.Id); end else begin SetLinesList.Insert(0, ACurrentWS.Id); SetLinesList.Add(AEndPoint.Id); end; isConnected := ConnectObjectsInPMByWay(SetLinesList, nil, nil, nil); if SetLinesList <> nil then FreeAndNil(SetLinesList); if SetLinesPos <> nil then FreeAndNil(SetLinesPos); end; end; ACurrentWS.FDisableTracing := False; end; TraceCounter := 0; for i := 0 to AllTrace.Count - 1 do begin if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then Inc(TraceCounter); end; // ПРОВЕРЯЕМ КОНЕЧНЫЕ СОЕДИНЕНИЯ DisJoinedCompons := TSCSComponents.Create(False); DisJoinSides := TIntList.Create; // первая трасса // Tolik 12/04/2021 -- //currTrace := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[1]).ID); currTrace := nil; for i := 0 to AllTrace.Count - 1 do begin if TFigure(AllTrace[i]) is TOrthoLine then begin currTrace := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); break; end; end; // if currTrace <> nil then begin CableForConnect := currTrace.LastAddedComponent; ReconnectOnEnds; // Tolik 12/04/2021 -- { if TraceCounter > 1 then begin currTrace := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[AllTrace.Count - 2]).ID); if currTrace <> nil then begin CableForConnect := currTrace.LastAddedComponent; ReconnectOnEnds; end else begin //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(TFigure(AllTrace[AllTrace.Count - 2]).ClassName + ' ,ID = ' + inttostr(TFigure(AllTrace[AllTrace.Count - 2]).ID) + ' (' + TFigure(AllTrace[AllTrace.Count - 2]).name + ') - ' + cNoFound); ShowMessageByType(0, smtProtocol, '!!!!!! ' + TFigure(AllTrace[AllTrace.Count - 2]).ClassName + ', ID = ' + inttostr(TFigure(AllTrace[AllTrace.Count - 2]).ID) + ' (' + TFigure(AllTrace[AllTrace.Count - 2]).name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('AutoTraseToShield - ConnectFigures', '!!!!!! ' + TFigure(AllTrace[AllTrace.Count - 2]).ClassName + ', ID = ' + inttostr(TFigure(AllTrace[AllTrace.Count - 2]).ID) + ' (' + TFigure(AllTrace[AllTrace.Count - 2]).name + ') - ' + cNoFound ); end; end; } if TraceCounter > 1 then begin currTrace := nil; for i := Alltrace.count - 1 downto 0 do begin if TFigure(AllTrace[i]) is TOrthoLine then begin if i <> 0 then begin currTrace := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); break; end; end; end; if currTrace <> nil then begin CableForConnect := currTrace.LastAddedComponent; ReconnectOnEnds; end else begin //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(TFigure(AllTrace[AllTrace.Count - 2]).ClassName + ' ,ID = ' + inttostr(TFigure(AllTrace[AllTrace.Count - 2]).ID) + ' (' + TFigure(AllTrace[AllTrace.Count - 2]).name + ') - ' + cNoFound); ShowMessageByType(0, smtProtocol, '!!!!!! ' + TFigure(AllTrace[AllTrace.Count - 2]).ClassName + ', ID = ' + inttostr(TFigure(AllTrace[AllTrace.Count - 2]).ID) + ' (' + TFigure(AllTrace[AllTrace.Count - 2]).name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('AutoTraseToShield - ConnectFigures', '!!!!!! ' + TFigure(AllTrace[AllTrace.Count - 2]).ClassName + ', ID = ' + inttostr(TFigure(AllTrace[AllTrace.Count - 2]).ID) + ' (' + TFigure(AllTrace[AllTrace.Count - 2]).name + ') - ' + cNoFound ); end; end; // end else begin //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(TFigure(AllTrace[1]).ClassName + ' ,ID = ' + inttostr(TFigure(AllTrace[1]).ID) + ' (' + TFigure(AllTrace[1]).name + ') - ' + cNoFound); ShowMessageByType(0, smtProtocol, '!!!!!! ' + TFigure(AllTrace[1]).ClassName + ', ID = ' + inttostr(TFigure(AllTrace[1]).ID) + ' (' + TFigure(AllTrace[1]).name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('AutoTraseToShield - ConnectFigures', '!!!!!! ' + TFigure(AllTrace[1]).ClassName + ', ID = ' + inttostr(TFigure(AllTrace[1]).ID) + ' (' + TFigure(AllTrace[1]).name + ') - ' + cNoFound ); end; for i := 0 to ResultList.Count - 1 do begin Result := Result and IntToBool(ResultList[i]); end; // если какой конец не подключился - удаляем кабель if Not Result then begin ShowBadConnectMessage := True; if (F_PEAutoTraceDialog.CheckCanConnectCable.Visible) and (F_PEAutoTraceDialog.CheckCanConnectCable.Checked) then begin for i := 0 to AllTrace.Count - 1 do begin if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin currTrace := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); if currTrace <> nil then begin CableForConnect := currTrace.LastAddedComponent; F_ProjMan.DM.DelComponent(CableForConnect.ID, CableForConnect, dmTrace); break; end; end; end; end; end; FreeAndNil(ResultList); FreeAndNil(DisJoinSides); FreeAndNil(DisJoinedCompons); except on E: Exception do AddExceptionToLogEx('U_PECommon.ConnectFigures', E.Message); end; end; Procedure DefineCurrServerTraces(aServer: TConnectorObject); Var i, j, k, l: Integer; Figure: TFigure; currLine, JoinedLine: TOrthoLine; JoinConnector, RaizeConnector, JoinToRaizeConnector: TConnectorObject; Begin currServerTraces := TList.Create; for i := 0 to aServer.JoinedConnectorsList.Count - 1 do begin JoinConnector := TConnectorObject(aServer.JoinedConnectorsList[i]); for j := 0 to JoinConnector.JoinedOrtholinesList.Count - 1 do begin currLine := TOrthoLine(JoinConnector.JoinedOrtholinesList[j]); if currLine.FIsRaiseUpDown then begin RaizeConnector := TConnectorObject(currLine.JoinConnector1); for k := 0 to RaizeConnector.JoinedConnectorsList.Count - 1 do begin JoinToRaizeConnector := TConnectorObject(RaizeConnector.JoinedConnectorsList[k]); for l := 0 to JoinToRaizeConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinToRaizeConnector.JoinedOrtholinesList[l]); if not JoinedLine.FIsRaiseUpDown then currServerTraces.Add(TFigure(JoinedLine)); end; end; for k := 0 to RaizeConnector.JoinedOrtholinesList.Count - 1 do currServerTraces.Add(TFigure(RaizeConnector.JoinedOrtholinesList)); RaizeConnector := TConnectorObject(currLine.JoinConnector2); for k := 0 to RaizeConnector.JoinedConnectorsList.Count - 1 do begin JoinToRaizeConnector := TConnectorObject(RaizeConnector.JoinedConnectorsList[k]); for l := 0 to JoinToRaizeConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinToRaizeConnector.JoinedOrtholinesList[l]); if not JoinedLine.FIsRaiseUpDown then currServerTraces.Add(TFigure(JoinedLine)); end; end; for k := 0 to RaizeConnector.JoinedOrtholinesList.Count - 1 do currServerTraces.Add(TFigure(RaizeConnector.JoinedOrtholinesList)); end; currServerTraces.Add(TFigure(currLine)); end; end; End; Function SortPathListByLength(var aList: TList): Boolean; Var i, j, k : integer; currList: TList; Distance: double; DistList: Array of Double; Figure: TFigure; SortAgain: Boolean; WayFound: Boolean; IsCheckedPath: Boolean; aLine: TOrthoLine; Begin Result := True; if aList.Count > 1 then begin IsCheckedPath := False; currList := aList[0]; for i := 0 to currList.Count - 1 do begin Figure := TFigure(currList[i]); if CheckFigureByClassName(Figure, cTOrthoLine) then begin aLine := TOrthoLine(Figure); if aLine.FMarkTracing then begin IsCheckedPath := True; Result := False; break; end; end; end; if not IsCheckedPath then begin SetLength(DistList, 0); k := 0; // Build PathsLegthList for i := 0 to aList.Count - 1 do begin currList := aList[i]; Distance := 0; for j := 0 to currList.Count - 1 do begin Figure := TFigure(currList[j]); if CheckFigureByClassName(Figure, cTOrthoLine) then Distance := Distance + TOrthoLine(Figure).LineLength; end; Inc(k); SetLength(DistList, k); DistList[k - 1] := Distance; end; // Sorting by Length SortAgain := true; while SortAgain do begin SortAgain := False; for i := 0 to aList.Count - 2 do begin if DistList[i] > DistList[i + 1] then begin SortAgain := True; Distance := DistList[i]; DistList[i] := DistList[i + 1]; DistList[i + 1] := Distance; currList := aList[i]; aList[i] := aList[i + 1]; aList[i + 1] := currList; end; end; end; end; end; End; Function TraceFiguresToServer(aServer: TConnectorObject) : TList; var i, j, k: Integer; CanSortPath: Boolean; begin Result := TList.Create; k := 0; for i := 0 to AFigures.Count - 1 do begin CurrFigure := TFigure(aFigures[i]); if PassedFiguresList.IndexOf(CurrFigure) = -1 then begin // Tolik 08/02/2021 -- //currPathList := GetAllTraceInCADByMarked(TFigure(aServer), currFigure, False); if (GEndPoint = nil) or ((GEndPoint <> nil) and (TF_Cad(TpowerCad(GEndPoint.Owner).Owner).FCadListId = F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID)) then currPathList := GetAllTraceInCADByMarked(TFigure(aServer), currFigure, False) else begin currPathList := TList.Create; currPathList.Add(GetAllTraceInCadToEndPoint(TConnectorObject(GEndPoint), TConnectorObject(CurrFigure))); end; // if currPathList <> nil then begin if currPathList.Count > 0 then begin CanSortPath := SortPathListByLength(currPathList); Result.Add(currFigure); PassedFiguresList.Add(currFigure); currPath := currPathList[0]; TracesLength := 0; for j := 0 to currPath.Count - 1 do begin currFigure := TFigure(currPath[j]); if CheckFigureByClassName(CurrFigure, cTOrthoLine) then TracesLength := TracesLength + TOrthoLine(CurrFigure).LengthCalc; end; inc(k); SetLength(TraceList, k); TraceList[k - 1] := TracesLength; //Tolik 21/01/2025 -+ //FreeAndNil(CurrPathList); //FreeAndNil(currPath); // end; //Tolik 21/01/2025 for j := 0 to CurrPathList.Count - 1 do TList(CurrPathList[j]).Free; FreeAndNil(CurrPathList); currPath := nil; // end end; end; end; Procedure ConnectFiguresByCable(AServer: TConnectorObject; AFigList: TList; LengthsList: array of Double); Var i, j, k: Integer; PassList: TList; Figure, NextFigure: TFigure; CableID: Integer; ComponList, ComponList1, currPathsToFigure: TList; TraceLen: Double; LenList: array of Double; CanConnect: Boolean; Catalog, Catalog1 : TSCSCatalog; Procedure SortFigList(var aFigList: TList; LengthList: array of Double); Var i: Integer; SortAgain: Boolean; l : Double; Figure: TFigure; AComponent: TSCSComponent; Begin if ((AFigList.Count > 1) and (AFigList.Count = Length(LengthList))) then begin SortAgain := True; while SortAgain do begin SortAgain := false; for i := 0 to AFigList.Count - 2 do begin if LengthList[i] > LengthList[i + 1] then begin SortAgain := true; // Distances l := LengthList[i]; LengthList[i] := LengthList[i + 1]; LengthList[i + 1] := l; // Figures Figure := TFigure(AFigList[i]); AFigList[i] := AFigList[i + 1]; AFigList[i + 1] := Figure; end; end; end; end; End; Function GetPathByMode(aCurrPathList: TList): TList; Var i, j: Integer; PathList: TList; currFigure: TFigure; WayIsPassed, WayFound: Boolean; CanCheckPath: Boolean; Begin Result := nil; CanCheckPath := False; if ((aCurrPathList <> nil) and (aCurrPathList.Count > 0)) then begin CanCheckPath := SortPathListByLength(aCurrPathList); if not CanCheckPath then Result := aCurrPathList[0] else begin if ((aCurrPathList.Count = 1) or (not F_PEAutoTraceDialog.CheckPassedTraces.Checked)) then begin Result := aCurrPathList[0]; end else begin WayFound := False; for i := 0 to aCurrPathList.Count - 1 do begin PathList := aCurrPathList[i]; WayIsPassed := False; for j := 0 to PathList.Count - 1 do begin currFigure := TFigure(PathList[j]); if CheckFigureByClassName(currFigure, cTOrthoLine) then begin if not TOrthoLine(currFigure).FIsRaiseUpDown then begin if PassedFiguresList.IndexOf(currFigure) <> -1 then begin WayIsPassed := True; Break; end; end; end; end; if not WayIsPassed then begin WayFound := True; Result := PathList; Break; end; end; if not WayFound then Result := aCurrPathList[0]; end; end; end; End; procedure CheckPassedPath(aCurrPath: TList); var I: Integer; Figure: TFigure; begin if aCurrPath <> nil then begin if aCurrPath.Count > 0 then begin for i := 0 to aCurrPath.Count - 1 do begin Figure := TFigure(aCurrPath[i]); if CheckFigureByClassName(Figure, cTOrthoLine) then begin if not TOrthoLine(Figure).FIsRaiseUpDown then begin if PassedFiguresList.IndexOf(Figure) = -1 then PassedFiguresList.Add(Figure); end; end; end; end; end; end; Begin //ComponList := TList.Create; // Tolik 21/01/2025 --эти 2 списка вроде как не юзаются здесь //ComponList1 := TList.Create; currPath:= nil; //Tolik 21/01/2025 -- IdCable := F_NormBase.GSCSBase.SCSComponent.ID; if AFigList.Count > 0 then begin SortFigList(AFigList, LengthsList); end; //PassList := TList.Create; // Tolik 21/01/2025 -- не юзается здесь SetLength(LenList, 0); //connect First Figure To Server Figure := TFigure(AFigList[0]); if not F_PEAutoTraceDialog.CheckPassedTraces.Checked then // Tolik 20/02/2021 -- { currPathList := GetAllTraceInCADByMarked(Figure, TFigure(CurrentServer)) else currPathList := GetAllTraceInCADByMarked(Figure, TFigure(CurrentServer), False); } begin if (GEndPoint = nil) or ((GEndPoint <> nil) and (TF_Cad(TpowerCad(GEndPoint.Owner).Owner).FCadListId = F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID)) then currPathList := GetAllTraceInCADByMarked(Figure, TFigure(CurrentServer)) else currPathList := GetAllTraceInCadToEndPoint(TConnectorObject(GEndPoint), TConnectorObject(Figure)); end else begin if (GEndPoint = nil) or ((GEndPoint <> nil) and (TF_Cad(TpowerCad(GEndPoint.Owner).Owner).FCadListId = F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID)) then currPathList := GetAllTraceInCADByMarked(Figure, TFigure(CurrentServer), False) else currPathList := GetAllTraceInCadToEndPoint(TConnectorObject(GEndPoint), TConnectorObject(Figure)); end; // if currPathList <> nil then begin if currPathList.Count > 0 then begin currPath := GetPathByMode(currPathList); CanConnect := ConnectFigures(CurrentServer, TConnectorObject(Figure), CurrPath, IDCable); if F_PEAutoTraceDialog.CheckPassedTraces.Checked then CheckPassedPath(currPath); FreeAndNil(currPathList); // Tolik 14/11/2019 -- end; end; // Connect All other Figures Between them currPathsToFigure := TList.Create; // Here we Have First Figure to Move From while AFigList.Count > 1 do begin AFigList.Delete(0); SetLength(LenList, 0); // get paths to current Figure for i := 0 to AFigList.Count - 1 do begin currPathList := GetAllTraceInCADByMarked(Figure, TFigure(aFigList[i])); //Tolik 21/01/2025 -- //if currPathList.Count > 0 then if ((currPathList <> nil) and (currPathList.Count > 0)) then // begin SortPathListByLength(CurrPathList); currPathsToFigure.Add(currPathList[0]); end; FreeAndNil(currPathList); // Tolik 14/11/2019 -- end; // buidl LenList k := 0; for i := 0 to currPathsToFigure.Count - 1 do begin TraceLen := 0; currPath := currPathsToFigure[i]; for j := 0 to currPath.Count - 1 do begin if CheckFigureByClassName(TFigure(currPath[j]),cTOrthoLine) then TraceLen := TraceLen + TOrthoLine(currPath[j]).LineLength; end; Inc(k); SetLength(LenList, k); LenList[k - 1] := TraceLen; end; // Sort List to get the Nearest Figure SortFigList(AFigList, LenList); // Get the Next Figure NextFigure := TFigure(AFigList[0]); // Gat Path Between Figures if not F_PEAutoTraceDialog.CheckPassedTraces.Checked then currPathList := GetAllTraceInCADByMarked(Figure, NextFigure) else currPathList := GetAllTraceInCADByMarked(Figure, NextFigure, False); if CurrPathList <> nil then begin if CurrPathList.Count > 0 then begin currPath := GetPathByMode(CurrPathList); CanConnect := ConnectFigures(TConnectorObject(Figure), TConnectorObject(NextFigure), currPath, IDCable); if F_PEAutoTraceDialog.CheckPassedTraces.Checked then CheckPassedPath(currPath); end; end; Figure := NextFigure; if currPathList <> nil then FreeAndNil(currPathList); currPath:= nil; currPathsToFigure.Clear; end; FreeAndNil(currPathsToFigure); // Tolik 21/01/2025 -- if not F_PEAutoTraceDialog.CheckPassedTraces.Checked then // Tolik 20/02/2021 -- { currPathList := GetAllTraceInCADByMarked(Figure, TFigure(CurrentServer)) else currPathList := GetAllTraceInCADByMarked(Figure, TFigure(CurrentServer), False); } begin if (GEndPoint = nil) or ((GEndPoint <> nil) and (TF_Cad(TpowerCad(GEndPoint.Owner).Owner).FCadListId = F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID)) then currPathList := GetAllTraceInCADByMarked(Figure, TFigure(CurrentServer)) else currPathList := GetAllTraceInCadToEndPoint(TConnectorObject(GEndPoint), TConnectorObject(Figure)); end else begin if (GEndPoint = nil) or ((GEndPoint <> nil) and (TF_Cad(TpowerCad(GEndPoint.Owner).Owner).FCadListId = F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID)) then currPathList := GetAllTraceInCADByMarked(Figure, TFigure(CurrentServer), False) else currPathList := GetAllTraceInCadToEndPoint(TConnectorObject(GEndPoint), TConnectorObject(Figure)); end; // currPath := GetPathByMode(CurrPathList); //currPathList[0]; // возврат к начальной точке подключения //Tolik 21/05/2025 -- { if F_PEAutoTraceDialog.TypeConnection.ItemIndex = 1 then CanConnect := ConnectFigures(TConnectorObject(Figure), CurrentServer, currPath, IDCable); } if F_NormBase.GSCSBase.SCSComponent.IDNetType <> 3 then //здесь для электрики обратный кабель не ложим (но лазейку для трассировки оставляем) begin if F_PEAutoTraceDialog.TypeConnection.ItemIndex = 1 then CanConnect := ConnectFigures(TConnectorObject(Figure), CurrentServer, currPath, IDCable); end; // if F_PEAutoTraceDialog.CheckPassedTraces.Checked then CheckPassedPath(currPath); if currPathList <> nil then FreeAndNil(currPathList); if currPath <> nil then FreeAndNil(currPath); SetLength(LenList, 0); // Tolik 21/01/2025 -- End; { procedure GetServerCompons(aNode : TFlyNode); var i, j :Integer; aChildNode: TFlyNode; begin if TNodeData(aNode.Data).ID <> -1 then ServerSideCompons.Add(TNodeData(aNode.Data).ID); for i := 0 to aNode.Count - 1 do begin aChildNode := aNode.Item[i]; if aChildNode.AbsoluteIndex <> 0 then begin if aChildNode.StateIndex = 2 then begin GetServerCompons(aChildNode); end; end; end; end; } Function CheckCableForMultiInterFace(Compon: TSCSComponent): Boolean; var i:Integer; Interf: TSCSInterface; begin Result := False; for i := 0 to Compon.InterFaces.Count - 1 do begin Interf := TSCSInterface(Compon.InterFaces[i]); if ((Interf.TypeI = itFunctional) and (Interf.Multiple = biTrue)) then begin result := True; Break; //// BREAK ////; end; end; end; { procedure ClearEmptyCableInterFaces; var i, j: Integer; currPath: TList; SCSComponent: TSCSComponent; begin if AllPassedTraces <> nil then begin for i := 0 to AllPassedTraces.Count - 1 do begin end; end; end;} begin GDragOnCAD := TRUE; CurrObject := Nil; // Tolik WayList := Nil; PassedFiguresList := Nil; CurrFiguresList := Nil; CurrPathList := nil; CurrPath := nil; CurrServerTraces := nil; AllPassedTraces := TList.Create; // все куски трассировки ConnectedComponList := Nil; // Result := TList.Create; ShowBadConnectMessage := False; try try if F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 0 then F_PEAutoTraceDialog.TypeConnection.ItemIndex := 0; except end; IdCable := 0; F_NormBase.GSCSBase.SCSComponent.LoadInterfaces(-1, false); if F_NormBase.GSCSBase.SCSComponent.ComponentType.SysName = ctsnCable then begin if AIndivid then begin IdCable := F_NormBase.GSCSBase.SCSComponent.ID; end else begin if F_PEAutoTraceDialog.TypeConnection.ItemIndex <> 1 then begin if CheckMultiPairInterfases(F_NormBase.GSCSBase.SCSComponent, F_PEAutoTraceDialog.RaspredBox) then IdCable := F_NormBase.GSCSBase.SCSComponent.ID else begin PauseProgress(True); //Tolik // if (F_PEAutoTraceDialog.PutBox_Check.Checked then if (F_PEAutoTraceDialog.PutBox_Check.Checked and (F_PEAutoTraceDialog.PutBox_Check.Enabled) and ((F_PEAutoTraceDialog.IgnoreExistingCable.Visible = False) or ((F_PEAutoTraceDialog.IgnoreExistingCable.Visible = True) and (F_PEAutoTraceDialog.IgnoreExistingCable.Checked = False)))) then // ShowMessage(cPEMes18) else begin //Tolik // Здесь, на проверке, кабель без многократных интерфейсов, если не устанавливать клемные коробки, // пропускаем только для того спучая, когда производится автотрассировка ОПС параллельная общим кабелем if ((F_PEAutoTraceDialog.AutotraceKind.itemIndex <> 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex <> 0) and (F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex <> 1)) then begin // if MessageModal(cPeMes26, '', mb_YesNo) = 6 then begin F_PEAutoTraceDialog.PutBox_Check.Checked := true; if F_PEAutoTraceDialog.ShowModal = mrOK then if CheckMultiPairInterfases(F_NormBase.GSCSBase.SCSComponent, F_PEAutoTraceDialog.RaspredBox) then IdCable := F_NormBase.GSCSBase.SCSComponent.ID else ShowMessage(cPEMes18); end; end else IdCable := F_NormBase.GSCSBase.SCSComponent.ID; end; PauseProgress(False); end; end else IdCable := F_NormBase.GSCSBase.SCSComponent.ID; end; end; if (AFigures <> nil) and (((IdCable > 0)) {or Not ADoAutoTrace}) then begin //Tolik F_PEAutoTraceDialog.Cypher := F_NormBase.GSCSBase.SCSComponent.Cypher; //if F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0 then // Здесь будет электрика и ОПС последовательная(если для каждого свой кабель или общий кабель, но с распредкоробками) if (((F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.AutotraceKind.itemIndex = 0)) or ((F_PEAutoTraceDialog.AutotraceKind.itemIndex = 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex = 1) and (F_PEAutoTraceDialog.PutBox_Check.Checked = True)) or ((F_PEAutoTraceDialog.AutotraceKind.itemIndex = 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex = 0))) then begin // if AIndivid then ConnectedComponList := TList.Create; if not AIndivid then // просортируем все рабочие обьекты по их отдалённости от конечных begin SortObjectsAboutDistance(AFigures, AEndObjects, 0); end; { if GIsProgress then PauseProgress(true); BeginProgress('',AFigures.Count); if Assigned(F_Progress) then begin F_Progress.Visible := True; F_Progress.PauseProgress(true); F_Progress.StartProgress('',AFigures.Count); end; } for i := 0 to AFigures.Count - 1 do begin // F_Progress.StepProgress; CurrFigure := TFigure(aFigures[i]); if CheckFigureByClassName(CurrFigure, TConnectorObject.ClassName) then if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then CurrObject := TConnectorObject(CurrFigure); if CurrObject <> nil then // if CheckElectricNet(CurrObject) then ////Проверка на возможность подключения к кабелю begin //if ADoAutoTrace then begin if (IdCable > 0) and (AEndObjects <> Nil) then begin if AIndivid then begin // индивидуальный кабель для каждого приёмника // TraceIndividCableToEndPoint(AEndObjects, CurrObject, IdCable, F_PEAutoTraceDialog.IgnoreExistingCable.Checked); TraceIndividCableToEndPoint(AEndObjects, CurrObject, IdCable); end else//один кабель для всех begin TraceCableToEndPoint(AEndObjects, CurrObject, IdCable, AFigures); // SortObjectsAboutDistance(AFigures, AEndObjects, i); // TestOfAllComponent; end; end; end; end; end; { if GIsProgress then PauseProgress(false); F_Progress.StopProgress; F_Progress.PauseProgress(False); EndProgress; } if not AIndivid then begin // CheckAndDeleteCableFromUpDown(AEndObjects, AFigures, IdCable); end; //Tolik // проверяем на соответствие количество подключенных интерфейсов кабеля // если не сходится на разных концах кабеля - отключаем лишние, чтобы было все ровно // if AllPassedTraces.Count > 0 then // ClearEmptyCableInterFaces; // end; // if F_PEAutoTraceDialog.TypeConnection.ItemIndex = 1 then if ((F_PEAutoTraceDialog.TypeConnection.ItemIndex = 1) or ((F_PEAutoTraceDialog.AutotraceKind.itemIndex = 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex = 1) and (F_PEAutoTraceDialog.PutBox_Check.Checked = False))) then begin IdCable := F_NormBase.GSCSBase.SCSComponent.ID; ServerSideCompons := TIntList.Create; { for i := 0 to F_PEAutoTraceDialog.tvEndObject.Items.Count - 1 do begin currNode := F_PEAutoTraceDialog.tvEndObject.Items[i]; if currNode.Selected then begin GetServerCompons(currNode); end; end;} if CurrFiguresList = Nil then CurrFiguresList := TList.Create else CurrFiguresList.Clear; if currPathList = nil then currPathList := TList.Create else currPathList.Clear; if CurrPath = nil then CurrPath := TList.Create else CurrPath.Clear; // All figures must Fall to Passed if PassedFiguresList = Nil then PassedfiguresList := TList.Create else PassedFiguresList.Clear; // collect all Left side of Connection List Together WSSideCompons := TIntList.Create; for i := 0 to F_PEAutoTraceDialog.ListWorkCompon.Count - 1 do begin WSSideCompons.Add(F_PEAutoTraceDialog.ListWorkCompon[i]); end; for i := 0 to F_PEAutoTraceDialog.ListLampCompon.Count - 1 do begin WSSideCompons.Add(F_PEAutoTraceDialog.ListLampCompon[i]); end; for i := 0 to F_PEAutoTraceDialog.ListSwitchesCompon.Count - 1 do begin WSSideCompons.Add(F_PEAutoTraceDialog.ListSwitchesCompon[i]); end; AllCompons := TSCSComponents.Create(False); for i := 0 to WSSideCompons.Count - 1 do begin aComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(WSSideCompons[i]); if aComponent <> nil then begin if Allcompons.IndexOF(aComponent) = -1 then AllCompons.Add(aComponent); for j := 0 to aComponent.ChildReferences.Count - 1 do begin if AllCompons.IndexOF(aComponent.ChildReferences[j]) = -1 then AllCompons.Add(aComponent.ChildReferences[j]); end; end; end; for i := 0 to F_PEAutoTraceDialog.ListEndCompon.Count - 1 do begin aComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(F_PEAutoTraceDialog.ListEndCompon[i]); if aComponent <> nil then begin if AllCompons.IndexOf(aComponent) = -1 then AllCompons.Add(aComponent); for j := 0 to aComponent.ChildReferences.Count - 1 do begin if AllCompons.IndexOf(aComponent.ChildReferences[j]) = -1 then AllCompons.Add(aComponent.ChildReferences[j]); end; end; end; if GIsProgress then PauseProgress(true); BeginProgress('',AFigures.Count); if Assigned(F_Progress) then begin F_Progress.Visible := True; F_Progress.PauseProgress(true); F_Progress.StartProgress('',AEndObjects.Count); end; for i := 0 to AEndObjects.Count - 1 do begin CurrentServerFiguresCount := 0; SetLength(TraceList, 0); if CurrFiguresList <> nil then FreeAndNil(CurrFiguresList); CurrentServer := TConnectorObject(AEndObjects[i]); if CurrServerTraces <> nil then FreeAndNil(currServerTraces); // DefineCurrServerTraces(CurrentServer); //Tolik (24.09.2015) проверка на наличие конечного объекта и списке рабочих компонент, такое может быть если конечных однотипных несколько // и требуется провести автотрассировку в несколько этапов, соединяя и объекты типа сервера или шкафа последовательно с остальными компонентами // если пользователь проебал, что и в левом и в правом дереве диалога есть один и тот же компонент, то такой компонент не автотрассируем, // ибо нех { if WSSideCompons.IndexOf(CurrentServer.ID) = -1 then begin} CurrFiguresList := TraceFiguresToServer(CurrentServer); if ((CurrFiguresList <> nil) and (CurrFiguresList.Count > 0)) then begin BreakTracing := False; ConnectFiguresByCable(CurrentServer, CurrFiguresList, TraceList); end; { end;} end; if GIsProgress then PauseProgress(false); F_Progress.StopProgress; F_Progress.PauseProgress(False); EndProgress; if ShowBadConnectMessage then F_PEAutoTraceDialog.ShowBadCableConnect := True else F_PEAutoTraceDialog.ShowBadCableConnect := False; end; end; finally if Result.Count = 0 then FreeAndNil(Result); // Tolik // освобождаем список пройденных трасс for i := (AllPassedTraces.Count - 1) downto 0 do TList(AllPassedTraces[i]).Free; //10/11/2015 // Если после удаления неподключенных кабелей остались бесхозные(никуда не подключенные) распредкоробки // то надо бы их удалить for i := 0 to F_PEAutoTraceDialog.RaspredBoxList.Count - 1 do begin if TSCSComponent(F_PEAutoTraceDialog.RaspredBoxList[i]).JoinedComponents.Count = 0 then F_ProjMan.DelCompon(TSCSComponent(F_PEAutoTraceDialog.RaspredBoxList[i]), TSCSComponent(F_PEAutoTraceDialog.RaspredBoxList[i]).TreeViewNode, True, True, True, True); end; F_PEAutoTraceDialog.RaspredBoxList.Clear; // Tolik 29/10/2019 -- // FreeAndNil(AllPassedTraces); if ConnectedComponList <> nil then FreeAndNil(ConnectedComponList); // GDragOnCAD := false; //Tolik 20/01/2025 -- FreeAndNil(CurrFiguresList); FreeAndNil(currPathList); FreeAndNil(CurrPath); // end; end; // function CheckElectricNet(ACurrObject: TConnectorObject): boolean; // пока было решено не привязываться к электрике, соответственно и фунция это пока и не проверяет // зато запихнул проверку на подключение с кабелем(если стоит контроль по типу сети) var CurrSCSCompon: TSCSCatalog; SCSLineCompon, SCSCompon: TSCSComponent; i: integer; ConnectInterfRes: TConnectInterfRes; begin Result := false; CurrSCSCompon := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ACurrObject.ID); if CurrSCSCompon <> Nil then begin if CurrSCSCompon.ItemType = itSCSConnector then begin For i := 0 to CurrSCSCompon.ComponentReferences.Count - 1 do begin SCSCompon := CurrSCSCompon.ComponentReferences[i]; if F_NormBase.GSCSBase.SCSComponent.ComponentType.SysName = ctsnCable then begin SCSLineCompon := F_NormBase.GSCSBase.SCSComponent; ConnectInterfRes := SCSCompon.CheckJoinToComponOrChilds(SCSLineCompon, -1, -1); if ConnectInterfRes.CanConnect then begin Result := true; end; end; end; end; end; end; // проверка на наличие обьекта function CheckEndCompon(ACurrObject: TConnectorObject; AEndObjects: TList): boolean; var CurrSCSCompon: TSCSCatalog; i: integer; begin Result := false; //CurrSCSCompon := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ACurrObject.ID); // if CurrSCSCompon <> Nil then begin Result := false; for i := 0 to AEndObjects.Count - 1 do begin if (ACurrObject = AEndObjects[i]) then begin Result := True; break; end; end; end; end; //Проверка на отсутствие подключения к функциональному интерфейсу обьекта function CheckConnectToMultiplyInterfaces(ASCSID: integer): boolean; // True если есть неподключенный фунциональный интерфейс var Catalog: TSCSCatalog; Compon: TSCSComponent; Interf: TSCSInterface; i, j : integer; FlagOfFunctionalInterf: boolean; begin FlagOfFunctionalInterf := false; // Tolik 08/02/2021 -- //Catalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ASCSID); Result := False; Catalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ASCSID); // if Assigned(Catalog) then begin Result := False; for i := 0 to Catalog.ComponentReferences.Count - 1 do begin Compon := Catalog.ComponentReferences[i]; if Assigned(Compon.Interfaces) then begin for j := 0 to Compon.Interfaces.Count - 1 do begin Interf := Compon.Interfaces[j]; if (Interf.TypeI = itFunctional)and (Interf.IsPort = biFalse) {and (Interf.Multiple = biTrue)} then begin FlagOfFunctionalInterf := true; //Tolik //if (Interf.ConnectedInterfaces.Count = 0) and (Interf.IOfIRelOut.Count = 0) then if (((Interf.ConnectedInterfaces.Count = 0) and (Interf.IOfIRelOut.Count = 0)) or (Interf.Multiple = biTrue)) then // begin Result := True; break; end; end; end; end; if Result then break; end; end; if not FlagOfFunctionalInterf then // если вообще нет фунциональных интерфейсов то Result = Тrue; Result := true; end; Function CheckComponCnt(ASourceWS: TFigure): TConnectorObject; var CatalogList: TSCSCatalog; i,j,n: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; SCSList: TSCSList; begin try Result := Nil; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then begin // OBJECT if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin for i := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.fIsRaiseUpDown then begin // Tolik 08/02/2021 -- //CatalogList := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); SCSList := nil; CatalogList := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(JoinedLine.Owner).Owner).FCADListID); if SCSList <> nil then CatalogList := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); // if CatalogList <> nil then begin if CatalogList.SCSComponents.Count <= 1 then begin Result := TConnectorObject(ASourceWS); Break; end; end else begin //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(JoinedLine.ClassName + ' ,ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound); ShowMessageByType(0, smtProtocol, '!!!!!! ' + JoinedLine.ClassName + ', ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('CheckComponCnt', '!!!!!! ' + JoinedLine.ClassName + ', ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound ); end; end; end; if Result <> nil then break; end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); if JoinedLine.fIsRaiseUpDown then begin // Tolik 08/02/2021 -- //CatalogList := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); SCSList := nil; CatalogList := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(JoinedLine.Owner).Owner).FCADListID); if SCSList <> nil then CatalogList := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); // if CatalogList <> nil then begin if CatalogList.SCSComponents.Count <= 1 then begin Result := TConnectorObject(ASourceWS); Break; end; end else begin //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(JoinedLine.ClassName + ' ,ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound); ShowMessageByType(0, smtProtocol, '!!!!!! ' + JoinedLine.ClassName + ', ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('CheckComponCnt', '!!!!!! ' + JoinedLine.ClassName + ', ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound ); end; end; end; end // Connector else if TConnectorObject(ASourceWS).ConnectorType = ct_Clear then begin for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); if JoinedLine.fIsRaiseUpDown then begin // Tolik 08/02/2021 -- //CatalogList := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); SCSList := nil; CatalogList := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(JoinedLine.Owner).Owner).FCADListID); if SCSList <> nil then CatalogList := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); // if CatalogList <> nil then begin if CatalogList.SCSComponents.Count <= 1 then begin Result := TConnectorObject(ASourceWS); Break; end; end else begin //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(JoinedLine.ClassName + ' ,ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound); ShowMessageByType(0, smtProtocol, '!!!!!! ' + JoinedLine.ClassName + ', ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('CheckComponCnt', '!!!!!! ' + JoinedLine.ClassName + ', ID = ' + inttostr(JoinedLine.ID) + ' (' + JoinedLine.name + ') - ' + cNoFound ); end; end; end; end; end; except on E: Exception do AddExceptionToLogEx('U_PECommon.CheckComponCnt ', E.Message); end; end; procedure DeleteCableFromUpDown(AEndPoint: TList; ACurrPoint: TConnectorObject; AIdCable: integer; AWorkPoint: TList); var CatalogList: TSCSCatalog; SCSCompon: TSCSComponent; i, j, n: integer; WasDel: Boolean; AllTrace: TList; Counts: Integer; JoinedConn: TConnectorObject; SortList: Tlist; MinValue: double; Figure: TFigure; // Tolik EndComponList: TList; currInterFace, JoinedInterFace: TSCSInterface; CableIsConnected: Boolean; InterFacePosition, ConnectedPosition: TSCSInterfPosition; SCSList: TSCSList; // Tolik 08/02/2021 -- begin try AllTrace := Nil; begin ACurrPoint.FDisableTracing := True; //Нужно проверить на предмет подключения начального обекта //Проверка на отсутствие подключения к многопарному интерфейсу обьекта // if CheckConnectToMultiplyInterfaces(ACurrPoint.ID) then begin SortList := TList.Create; for Counts := 0 to ACurrPoint.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(ACurrPoint.JoinedConnectorsList[Counts]); AllTrace := GetAllTracePEInCAD(AEndPoint, JoinedConn, False, True); if Assigned(AllTrace)then SortList.Add(AllTrace); end; if SortList.Count > 1 then begin MinValue := TotalLength(AllTrace); for i := SortList.Count-1 downto 0 do begin if TotalLength(TList(SortList[i])) < MinValue then begin AllTrace :=TList(SortList[i]); end end; end //нужно присвоить первую трассу else begin if SortList.Count = 1 then AllTrace := TList(SortList[0]); end; // выделить трассу if Assigned(AllTrace) then begin // Tolik EndComponList := TList.Create; // // докинуть сам объект-источник if Tfigure(AllTrace[0]).ID <> ACurrPoint.ID then AllTrace.Insert(0, ACurrPoint); // Tolik // Список точечных компонентов на пути кабеля for i := 0 to AllTrace.Count - 1 do begin Figure := TFigure(AllTrace[i]); if CheckFigureByClassName(Figure, CTConnectorObject) then begin // Tolik 08/02/2021 -- //CatalogList := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrtholine(Figure).ID); SCSList := nil; CatalogList := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(Figure.Owner).Owner).FCADListID); if SCSList <> nil then CatalogList := SCSList.GetCatalogFromReferencesBySCSID(Figure.ID); // if CatalogList <> nil then begin for j := 0 to CatalogList.ComponentReferences.Count - 1 do EndComponList.Add(CatalogList.ComponentReferences[j]); end; end; end; // Смотрим подключение точечных на с/п к кабелю и удаляем кабель только в том случае, // если кабель никак не подключен for i := 0 to AllTrace.Count - 1 do begin Figure := TFigure(AllTrace[i]); IF (CheckFigureByClassName(Figure, 'TOrthoLine'))and(TOrtholine(Figure).FIsRaiseUpDown) then begin // спуск / подъем // Tolik 08/02/2021 -- //CatalogList := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrtholine(Figure).ID); SCSList := nil; CatalogList := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(TPowerCad(Figure.Owner).Owner).FCADListID); if SCSList <> nil then CatalogList := SCSList.GetCatalogFromReferencesBySCSID(Figure.ID); // if CatalogList <> nil then begin // последний кабель SCSCompon := CatalogList.LastAddedComponent; if SCSCompon <> nil then begin CableIsConnected := False; for j := 0 to SCSCompon.InterFaces.Count - 1 do begin if SCSCompon.InterFaces[j].TypeI = itFunctional then begin currInterFace := TSCSInterface(SCSCompon.InterFaces[j]); for n := 0 to currInterFace.BusyPositions.Count - 1 do begin InterFacePosition := TSCSInterFPosition(currInterFace.BusyPositions[n]); ConnectedPosition := InterFacePosition.GetConnectedPos; if ConnectedPosition <> nil then begin if EndComponList.IndexOf(ConnectedPosition.InterfOwner.ComponentOwner) <> - 1 then begin CableIsConnected := True; Break; end; end; end; end; if CableIsConnected then Break; end; end; end else begin //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(TOrtholine(Figure).ClassName + ' ,ID = ' + inttostr(TOrtholine(Figure).ID) + ' (' + TOrtholine(Figure).name + ') - ' + cNoFound); ShowMessageByType(0, smtProtocol, '!!!!!! ' + TOrtholine(Figure).ClassName + ', ID = ' + inttostr(TOrtholine(Figure).ID) + ' (' + TOrtholine(Figure).name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('DeleteCableFromUpDown', '!!!!!! ' + TOrtholine(Figure).ClassName + ', ID = ' + inttostr(TOrtholine(Figure).ID) + ' (' + TOrtholine(Figure).name + ') - ' + cNoFound ); end; if not CableIsConnected then begin if SCSCompon <> nil then F_ProjMan.DeleteCableFromList(SCSCompon, SCSCompon.TreeViewNode); end; end; end; FreeAndNil(EndComponList); // //Commented by Tolik // так было ... до .... (* for i := 0 to AllTrace.Count - 1 do begin Figure := TFigure(AllTrace[i]); IF (CheckFigureByClassName(Figure, 'TOrthoLine'))and(TOrtholine(Figure).FIsRaiseUpDown) then begin n := 0; CatalogList := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrtholine(Figure).ID); While n < CatalogList.SCSComponents.Count do begin WasDel := false; SCSCompon := CatalogList.SCSComponents[n]; for j := 0 to SCSCOmpon.Interfaces.count - 1 do if SCSCOmpon.Interfaces[j].TypeI = itFunctional then if SCSCOmpon.Interfaces[j].IsBusy = 0 then begin F_ProjMan.DeleteCableFromList(SCSCompon, SCSCompon.TreeViewNode); WasDel := true; break; end; if not WasDel then inc(n); end; end; end; *) for i := 0 to SortList.Count -1 do TList(SortList[i]).Free; SortList.Free; end; end; ACurrPoint.FDisableTracing := False; end; except on E: Exception do AddExceptionToLogEx('U_PECommon.DeleteCableFromUpDown ', E.Message); end; end; ///проложить кабель до конечной точки или первого кабеля, щита function TraceCableToEndPoint(AEndPoint: TList; ACurrPoint: TConnectorObject; AIdCable: integer; AWorkPoint: TList): boolean; var i, j: integer; ComponID: Integer; isConnected: Boolean; IDLine: Integer; IDPos: Integer; AllTrace: TList; SetLinesList: TIntList; SetLinesPos: TIntList; Counts: Integer; JoinedConn: TConnectorObject; CadCrossObject: TCadCrossObject; SortList: Tlist; MinValue: double; // Tolik currTraceCatalog: TSCSCatalog; currCompon, currCompon1 : TSCSComponent; CanTraceCable: Boolean; CableConnectedBySide: Boolean; currInterface: TSCSInterface; BusyInterfCount, BusyInterfCount1: Integer; currInterfPos: TSCSInterfPosition; InterfRel: TSCSIOfIRel; currTraceList: TList; // begin try Result := False; AllTrace := Nil; //CurrTraceList := Nil; //20/01/2025 CurrTraceList := TList.Create; //if ACurrPoint.ConnectorType = ct_Clear then // begin // AllTrace := GetAllTracePEInCAD(AEndPoint, ACurrPoint); // // выделить трассу // if AllTrace <> nil then // begin // for i := 0 to AllTrace.Count - 1 do // TFigure(AllTrace[i]).Select; // // скопировать кабель туда // for i := 0 to AllTrace.Count - 2 do // ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AIdCable); // // убрать выделение трассы // for i := 0 to AllTrace.Count - 1 do // TFigure(AllTrace[i]).DeSelect; // if AllTrace <> nil then // FreeAndNil(AllTrace); // Result := True; // end; // end // else begin ACurrPoint.FDisableTracing := True; //Нужно проверить на предмет подключения начального обекта //Проверка на отсутствие подключения к многопарному интерфейсу обьекта if CheckConnectToMultiplyInterfaces(ACurrPoint.ID) then begin SortList := TList.Create; for Counts := 0 to ACurrPoint.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(ACurrPoint.JoinedConnectorsList[Counts]); AllTrace := GetAllTracePEInCAD(AEndPoint, JoinedConn); if Assigned(AllTrace)then SortList.Add(AllTrace); end; if SortList.Count > 1 then begin MinValue := TotalLength(AllTrace); for i := SortList.Count-1 downto 0 do begin if TotalLength(TList(SortList[i])) < MinValue then begin AllTrace :=TList(SortList[i]); end end; end //нужно присвоить первую трассу else begin if SortList.Count = 1 then AllTrace := TList(SortList[0]); end; if currTraceList.Count > 0 then CurrTraceList.Clear; // Tolik // До того как ложить кабель, если выбрано "не учитывать уже существующий кабель..." // сбросим указатели на последние добавленные объекты (на всякий) в каталогах трасс (ПМ) { if ((F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible)) then begin for i := 0 to AllTrace.Count - 1 do begin if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); if currTraceCatalog <> nil then currTraceCatalog.LastAddedComponent := nil; currTraceCatalog.IDLastAddedComponent := 0; end; end; end;} // выделить трассу if Assigned(AllTrace) then begin // // докинуть сам объект-источник if Tfigure(AllTrace[0]).ID <> ACurrPoint.ID then AllTrace.Insert(0, ACurrPoint); for i := 0 to AllTrace.Count - 1 do currTraceList.Add(AllTrace[i]); AllPassedTraces.Add(TList(currTraceList)); for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; // скопировать кабель туда // Tolik // for i := 1 to AllTrace.Count - 2 do for i := 0 to AllTrace.Count - 1 do // begin // Tolik ComponID := -1; CanTraceCable := True; if ((F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible)) then begin currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); if ((currTraceCatalog <> nil) and (currTraceCatalog.isLine = biTrue)) then begin for j := 0 to currTraceCatalog.ComponentReferences.Count - 1 do begin currCompon := currTraceCatalog.ComponentReferences[j]; if F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(currCompon.ID) <> -1 then begin CanTraceCable := False; Break; end; end; end; end else if ((not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible)) then begin currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); if (currTraceCatalog <> nil) and (currTraceCatalog.isLine = biTrue) then begin for j := 0 to currTraceCatalog.ComponentReferences.Count - 1 do begin currCompon := currTraceCatalog.ComponentReferences[j]; if currCompon.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher then begin CanTraceCable := False; Break; end; end; end; end else //пожарка параллельная begin currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); if ((currTraceCatalog <> nil) and (currTraceCatalog.isLine = biTrue)) then begin for j := 0 to currTraceCatalog.ComponentReferences.Count - 1 do begin currCompon := currTraceCatalog.ComponentReferences[j]; if F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(currCompon.ID) <> -1 then begin CanTraceCable := False; Break; end; end; end; end; if (CanTraceCable and (currTraceCatalog.IsLine = biTrue)) then begin ////Tolik F_PEAutoTraceDialog.FromAutoTraceDialog := False; ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AIDCable); currTraceCatalog.LastAddedComponent.DisJoinFromAll(True, True).Free; currTraceCatalog.LastAddedComponent.DefineInterfCountToConnect; F_PEAutoTraceDialog.FromAutoTraceDialog := True; end; if ComponID > 0 then F_PEAutoTraceDialog.LastAddedCableIDList.Add(ComponID); // if (GLastIdComponent = -1) and (ComponID > 0)then // begin // GLastIdComponent := ComponId -1; // end; end; //будем сюда засовывать соединение кабеля + вызов вопроса нащёт коробки //AllTrace.Remove(TFigure(AEndPoint[0])); // Tolik 08/02/2021 -- // Tolik ConnectPEObjectsByWay(AllTrace, nil, AWorkPoint, AEndPoint); //ConnectPEObjectsByWay(AllTrace, nil, AWorkPoint, AEndPoint, F_PEAutoTraceDialog.IgnoreExistingCable.Checked); // убрать выделение трассы CanTraceCable := True; for i := 0 to AllTrace.Count - 1 do begin // Tolik // Просле прохождения всей трассы нужно удостовериться, что каждый кабель обеими сторонами подключен к чему-либо // Если нет - выставить флаг, чтобы выдать сообщение пользователю, что не все подключилось if not F_PEAutoTraceDialog.ShowBadCableConnect then begin if CanTraceCable then begin if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin // трасса currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); if currTraceCatalog <> nil then begin if currTraceCatalog.LastAddedComponent <> nil then begin currCompon := currTraceCatalog.LastAddedComponent; // поищем занятые интерфейсы // первая сторона CableConnectedBySide := False; for j := 0 to currCompon.Interfaces.Count - 1 do begin if ((TSCSInterface(currCompon.Interfaces[j]).TypeI = itFunctional) and ((TSCSInterface(currCompon.Interfaces[j]).IsBusy = biTrue) or (TSCSInterface(currCompon.Interfaces[j]).BusyPositions.Count > 0 )) and (TSCSInterface(currCompon.Interfaces[j]).Side = 1)) then begin CableConnectedBySide := True; Break; end; end; if not CableConnectedBySide then begin CanTraceCable := False; Break; end else // вторая сторона (если на первой - есть контакт) begin CableConnectedBySide := False; for j := 0 to currCompon.Interfaces.Count - 1 do begin if ((TSCSInterface(currCompon.Interfaces[j]).TypeI = itFunctional) and ((TSCSInterface(currCompon.Interfaces[j]).IsBusy = biTrue) or (TSCSInterface(currCompon.Interfaces[j]).BusyPositions.Count > 0 )) and (TSCSInterface(currCompon.Interfaces[j]).Side = 2)) then begin CableConnectedBySide := True; Break; end; end; end; if not CableConnectedBySide then begin CanTraceCable := False; Break; end; end; end; if not CanTraceCable then Break; end; end else F_PEAutoTraceDialog.ShowBadCableConnect := True; end; TFigure(AllTrace[i]).DeSelect; end; // Флажок для сообщения об ошибке подключения if not CanTraceCable then F_PEAutoTraceDialog.ShowBadCableConnect := True; Result := True; // !!! количество подключенных интерфейсов на концах кабеля уравниваем currCompon := nil; currCompon1 := nil; // первый кусок кабеля (их, по идее, два, но может быть и один, так что ищем...) if CheckFigureByClassName(TFigure(AllTrace[0]), cTOrthoLine) then begin // трасса 1 currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[0]).ID); if currTraceCatalog <> nil then begin if currTraceCatalog.LastAddedComponent <> nil then begin // первый кусок кабеля currCompon := currTraceCatalog.LastAddedComponent; end; end; end else begin if AllTrace.Count > 1 then begin if CheckFigureByClassName(TFigure(AllTrace[1]), cTOrthoLine) then begin // трасса 1 currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[1]).ID); if currTraceCatalog <> nil then begin if currTraceCatalog.LastAddedComponent <> nil then begin // первый кусок кабеля currCompon := currTraceCatalog.LastAddedComponent; end; end; end; end; end; // смотрим, будет ли второй кусок кабеля if (AllTrace.Count > 1) then begin if CheckFigureByClassName(TFigure(AllTrace[AllTrace.Count - 1]), cTOrthoLine) then begin // трасса 2 currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[AllTrace.Count - 1]).ID); if currTraceCatalog <> nil then begin if currTraceCatalog.LastAddedComponent <> nil then begin // второй кусок кабеля currCompon1 := currTraceCatalog.LastAddedComponent; end; end; end else begin if AllTrace.Count > 2 then begin if CheckFigureByClassName(TFigure(AllTrace[AllTrace.Count - 2]), cTOrthoLine) then begin // трасса 2 currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[AllTrace.Count - 2]).ID); if currTraceCatalog <> nil then begin if currTraceCatalog.LastAddedComponent <> nil then begin // второй кусок кабеля currCompon1 := currTraceCatalog.LastAddedComponent; end; end; end; end; end; end; BusyInterfCount := 0; BusyInterfCount1 := 0; //если трасса от объекта к объекту состоит из неск участков if ((currCompon <> nil) and (currCompon1 <> nil)) then begin // количество занятых интерфейсов на первом кабеле // СЧИТАЕМ ПО КОЛИЧЕСТВУ ПОДКЛЮЧЕННЫХ ПОЗИЦИЙ ИНТЕРФЕЙСОВ К ТОЧЕЧНОМУ ОБЪЕКТУ for i := 0 to currCompon.Interfaces.Count - 1 do begin if TSCSInterface(currCompon.Interfaces[i]).TypeI = itFunctional then begin for j := 0 to TSCSInterface(currCompon.Interfaces[i]).BusyPositions.Count - 1 do begin currInterfPos := TSCSInterfPosition(TSCSInterface(currCompon.Interfaces[i]).BusyPositions[j]); currInterfPos := currInterfPos.GetConnectedPos; if TSCSComponent(TSCSInterface(currInterfPos.InterfOwner).ComponentOwner).IsLine = biFalse then Inc(BusyInterfCount); end; end; end; // количество занятых интерфейсов на втором кабеле for i := 0 to currCompon1.Interfaces.Count - 1 do begin if TSCSInterface(currCompon1.Interfaces[i]).TypeI = itFunctional then begin for j := 0 to TSCSInterface(currCompon1.Interfaces[i]).BusyPositions.Count - 1 do begin currInterfPos := TSCSInterfPosition(TSCSInterface(currCompon1.Interfaces[i]).BusyPositions[j]); currInterfPos := currInterfPos.GetConnectedPos; if TSCSComponent(TSCSInterface(currInterfPos.InterfOwner).ComponentOwner).IsLine = biFalse then Inc(BusyInterfCount1); end; end; end; // если количество занятых позиций не равно, то нужно уравнять if BusyInterfCount <> BusyInterfCount1 then begin { if BusyInterfCount > BusyInterfCount1 then begin for i := 0 to currCompon.Interfaces.Count - 1 do begin if TSCSInterface(currCompon.Interfaces[i]).TypeI = itFunctional then begin for j := 0 to TSCSInterface(currCompon.Interfaces[i]).BusyPositions.Count - 1 do begin currInterfPos := TSCSInterfPosition(TSCSInterface(currCompon.Interfaces[i]).BusyPositions[j]); end; end; end; end else if BusyInterfCount < BusyInterfCount1 then begin end; } end; end // если трасса одна ... else begin // ... и на нее лег кабель if currCompon <> nil then begin end; end; for i := 0 to SortList.Count -1 do TList(SortList[i]).Free; SortList.Free; end; end; ACurrPoint.FDisableTracing := False; end; except on E: Exception do AddExceptionToLogEx('U_PECommon.TraceCableToEndPoint ', E.Message); end; end; // ПОЛУЧИТЬ ВСЮ ТРАССУ function GetAllTracePEInCAD(AFigureServer: TList; AFigureWS: TFigure; AForDistance: boolean = false; TraseAnyWhere: Boolean = false): TList; var CurrLength: Double; LastLength: Double; IDAutoTracingPropertyStr: String; CurrFigure: TFigure; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; IDCompon: ^Integer; Res: Boolean; ptrIDCompon: ^Integer; i: Integer; CurrIDPathList: TList; LastIDPathList: TList; ResultList: TList; EndObject: TFigure; ////////////////////////////////////////////////////////////////////////////// Procedure GetStepInCAD(ASourceWS: TFigure; AInOrder: TList; ATraveledIndex: Integer); var i, j: Integer; //IDConn: ^Integer; ComponLength: Double; ConnectedIDList: TList; InOrder: TList; //New FlagEndOfStep: boolean; OperFlag: Boolean; begin ConnectedIDList := nil; // Tolik 18/05/2018 -- FlagEndOfStep := False; ComponLength := 0; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin FlagEndOfStep := CheckEndCompon(TconnectorObject(ASourceWS), AFigureServer); end; if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin if not TraseAnyWhere then FlagEndOfStep := CheckInsideCable(TOrthoLine(ASourceWS), false, AFigureServer{, AIDCable}) else FlagEndOfStep := false; if not FlagEndOfStep then begin ComponLength := abs(TOrthoLine(ASourceWS).LineLength); if (CurrLength + ComponLength -1 >= LastLength) and (LastLength > -1) then Exit; end; end; CurrLength := CurrLength + ComponLength; if Not FlagEndOfStep then CurrIDPathList.Add(ASourceWS); if FlagEndOfStep and ((CurrLength <= LastLength) or (LastLength = -1)) then begin //***Переприсвоить кратчайшый путь LastIDPathList.Clear; for i := 0 to CurrIDPathList.Count - 1 do begin CurrFigure := TFigure(CurrIDPathList[i]); LastIDPathList.Add(CurrFigure); end; //*** Переприсвоить кратчайшую длину LastLength := CurrLength; // ***Переприсвоить конечный обект EndObject := ASourceWS; end else {************************************************************************} begin ConnectedIDList := TList.Create; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then begin // OBJECT if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin for i := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if not JoinedLine.Deleted then // Tolik 01/04/2021 -- ConnectedIDList.Add(JoinedLine); end; end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); if not JoinedLine.Deleted then // Tolik 01/04/2021 -- ConnectedIDList.Add(JoinedLine); end; end // Connector else if TConnectorObject(ASourceWS).ConnectorType = ct_Clear then begin for j := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[j]); if not JoinedConn.Deleted then // Tolik 01/04/2021 -- ConnectedIDList.Add(JoinedConn); end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); if not JoinedLine.Deleted then // Tolik 01/04/2021 -- ConnectedIDList.Add(JoinedLine); end; end; end; if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector1); if not JoinedConn.Deleted then // Tolik 01/04/2021 -- ConnectedIDList.Add(JoinedConn); JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector2); if not JoinedConn.Deleted then // Tolik 01/04/2021 -- ConnectedIDList.Add(JoinedConn); end; InOrder := TList.Create; if AInOrder <> nil then InOrder.Assign(AInOrder); InOrder.Assign(ConnectedIDList, laOr); for i := 0 to ConnectedIDList.Count - 1 do begin CurrFigure := TFigure(ConnectedIDList[i]); if not CurrFigure.deleted then // Tolik 01/04/2021 -- begin //if CheckNoFigureinList(CurrFigure, AInOrder) and CheckNoFigureinList(CurrFigure, CurrIDPathList) then //GetStepInCAD(CurrFigure, ConnectedIDList, ATraveledIndex + 1); //Old if ((AInOrder = nil) or ((AInOrder <> nil) and (AInOrder.IndexOf(CurrFigure) = -1))) and (CurrIDPathList.IndexOf(CurrFigure) = -1) then GetStepInCAD(CurrFigure, InOrder, ATraveledIndex + 1); end; end; FreeAndNil(InOrder); if ConnectedIDList <> nil then FreeAndNil(ConnectedIDList); end; CurrLength := Roundx(CurrLength - ComponLength, 10); if CurrIDPathList.Count - 1 = ATraveledIndex then CurrIDPathList.Delete(ATraveledIndex); end; ////////////////////////////////////////////////////////////////////////////// begin try //Tolik ResultList := Nil; // Result := nil; EndObject := nil; CurrIDPathList := Tlist.Create; CurrLength := 0; LastIDPathList := Tlist.Create; LastLength := -1; // Tolik 06/02/2021 -- if (GEndPoint = nil) or ((GEndPoint <> nil) and (TF_Cad(TpowerCad(GEndPoint.Owner).Owner).FCadListId = F_ProjMan.GSCSBase.CurrProject.CurrList.CurrID)) then begin GetStepInCAD(AFigureWS, nil, 0); //добавим конечный обект в конец пути if Assigned(EndObject) and(Not AForDistance) then // if CheckFigureByClassName(EndObject, cTConnectorObject) then LastIDPathList.Add(EndObject); end else begin LastIDPathList.Free; LastIDPathList := GetAllTraceInCadToEndPoint(TConnectorObject(GEndPoint), TConnectorObject(AFigureWS)); end; { GetStepInCAD(AFigureWS, nil, 0); //добавим конечный обект в конец пути if Assigned(EndObject) and(Not AForDistance) then // if CheckFigureByClassName(EndObject, cTConnectorObject) then LastIDPathList.Add(EndObject); } ResultList := TList.Create; for i := 0 to LastIDPathList.Count - 1 do begin CurrFigure := TFigure(LastIDPathList[i]); if CheckFigureByClassName(CurrFigure, cTOrthoLine) then ResultList.Add(CurrFigure); if CheckFigureByClassName(CurrFigure, cTConnectorObject) then if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then ResultList.Add(CurrFigure); end; if ResultList.Count = 0 then FreeAndNil(ResultList) else Result := ResultList; if CurrIDPathList <> nil then FreeAndNil(CurrIDPathList); if LastIDPathList <> nil then FreeAndNil(LastIDPathList); except on E: Exception do addExceptionToLogEx('U_PECommon.GetAllTracePEInCAD ', E.Message); end; end; //Проверить наличие кабеля в трассе function CheckInsideCable(AOrthoLine: TOrthoLine; AAnyWhere: boolean = false; AFigureServer: TList = nil): boolean; var NBGuid: string; i,j: integer; LineCatalog: TSCSCatalog; LineComponent: TSCSComponent; ConnConn: TConnectorObject; //CableComponent: TSCSComponent; begin Result := False; if aOrthoLine.Deleted then // Tolik 01/04/2021 -- тут ОЧЕНЬ актуально exit; // CableComponent := F_NormBase.GSCSBase.SCSComponent; //NBGuid := F_NormBase.DM.GetStringFromTableByID(tnComponent, fnGuid, AIDCable, qmPhisical); if F_PEAutoTraceDialog.TypeConnection.ItemIndex <> 1 then begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(AOrthoLine.ID); if LineCatalog <> nil then begin If LineCatalog.ItemType = itSCSLine then begin // Tolik // если не учитывать проложенное ранее if ((F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible)) then begin for i := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineComponent := LineCatalog.ComponentReferences[i]; if F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(LineComponent.ID) <> -1 then begin Result := True; Break; end; end; end else begin for i := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineComponent := LineCatalog.ComponentReferences[i]; // if (GLastIdComponent > -1) and (LineComponent.ID > GLastIdComponent) then begin //Проверка на наличие многоразовых спареных интерфейсов if AAnyWhere then begin //if LineComponent.ComponentType.SysName = ctsnCable then if isCableComponent(LineComponent) then begin //Tolik //if ( (LineComponent.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher) and ( (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and // (F_PEAutoTraceDialog.IgnoreExistingCable.Visible) )) then if ( (LineComponent.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher) and ( ((not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible)) or ((F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.PutBox_Check.Checked = true) and (F_PEAutoTraceDialog.PutBox_Check.Enabled)) )) then begin // Result := true; break; end; end end else begin if LineComponent.ComponentType.SysName = ctsnCable then if CheckMultiPairInterfases(LineComponent,F_PEAutoTraceDialog.RaspredBox) then begin if CheckComponentsForSideSection(LineComponent) then begin //Tolik //if ( (LineComponent.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher) and ( (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and // (F_PEAutoTraceDialog.IgnoreExistingCable.Visible) )) then if ( (LineComponent.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher) and ( ((not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible)) or ((F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.PutBox_Check.Checked = true) and (F_PEAutoTraceDialog.PutBox_Check.Enabled = True)) )) then begin // Result := true; break; end; end; end; end; end; end; end; end; end else begin ShowMessageByType(0, smtProtocol, '!!!!!! ' + AOrthoLine.ClassName + ', ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('CheckInsideCable', '!!!!!! ' + AOrthoLine.ClassName + ', ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound ); //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(AOrthoLine.ClassName + ' ,ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound); end; end else begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(AOrthoLine.ID); if LineCatalog <> nil then begin for i := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineComponent := LineCatalog.ComponentReferences[i]; begin //Проверка на наличие многоразовых спареных интерфейсов if not Assigned(AFigureServer)then begin if LineComponent.ComponentType.SysName = ctsnCable then begin Result := true; break; end end else begin for j := 0 to TConnectorObject(AOrthoLine.JoinConnector1).JoinedConnectorsList.Count - 1 do begin ConnConn := TConnectorObject(TConnectorObject(AOrthoLine.JoinConnector1).JoinedConnectorsList[j]); if (not CheckEndCompon(ConnConn, AFigureServer))then begin Result := true; break; end; end; if not Result then begin for j := 0 to TConnectorObject(AOrthoLine.JoinConnector2).JoinedConnectorsList.Count - 1 do begin ConnConn := TConnectorObject(TConnectorObject(AOrthoLine.JoinConnector2).JoinedConnectorsList[j]); if (not CheckEndCompon(ConnConn, AFigureServer))then begin Result := true; break; end; end; end; end; end; end; end else begin ShowMessageByType(0, smtProtocol, '!!!!!! ' + AOrthoLine.ClassName + ', ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('CheckInsideCable', '!!!!!! ' + AOrthoLine.ClassName + ', ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound ); //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(AOrthoLine.ClassName + ' ,ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound); end; end; end; function FindConnObjSides(AIDObj1, AIDObj2: Integer; ObjSidesList: TList): PConnectedObjectsSides; var i: Integer; ptrResConnObjSides: PConnectedObjectsSides; OperSide: integer; begin Result := nil; for i := 0 to ObjSidesList.Count - 1 do begin ptrResConnObjSides := ObjSidesList[i]; if ((ptrResConnObjSides.IDObj1 = AIDObj1) and (ptrResConnObjSides.IDObj2 = AIDObj2)) then begin Result := ptrResConnObjSides; Break; end else if (ptrResConnObjSides.IDObj1 = AIDObj2) and (ptrResConnObjSides.IDObj2 = AIDObj1) then begin OperSide := ptrResConnObjSides.Side1; ptrResConnObjSides.Side1 := ptrResConnObjSides.Side2; ptrResConnObjSides.Side2 := OperSide; Result := ptrResConnObjSides; Break; end; end; end; //Tolik оригинал закомменчен см. ниже, переписано, потому что не учли интерфейсы, заданные количественно function GetInterfCountBySide(ACompon: TSCSComponent; ASide: Integer): Integer; var i: Integer; Interfac: TSCSInterface; ResCount: Integer; begin Result := 0; ResCount := 0; for i := 0 to ACompon.Interfaces.Count - 1 do begin Interfac := ACompon.Interfaces[i]; if ((Interfac.Side = ASide) and (Interfac.TypeI = itFunctional)) then begin if Interfac.Kolvo = 1 then begin if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then ResCount := ResCount + 1; end else if Interfac.Kolvo > 1 then begin if Interfac.Multiple = biTrue then ResCount := ResCount + Interfac.Kolvo else ResCount := ResCount + (Interfac.Kolvo - Interfac.KolvoBusy); end; end; end; Result := ResCount; end; {function GetInterfCountBySide(ACompon: TSCSComponent; ASide: Integer): Integer; var i: Integer; Interfac: TSCSInterface; ResCount: Integer; begin Result := 0; ResCount := 0; for i := 0 to ACompon.Interfaces.Count - 1 do begin Interfac := ACompon.Interfaces[i]; if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then if Interfac.Side = ASide then ResCount := ResCount + 1; end; Result := ResCount; end;} function ConnectPEObjectCompons(AObject1, AObject2: TSCSCatalog; ASideObject1, ASideObject2: Integer; AOnlyNewLineCompon: Boolean; AFirstComponent : Boolean = false; ALastComponent: Boolean = false; ForSwitch: boolean = false; MaxInterfPosCountToConnect: Integer = 0): Boolean; var i, j, k, l, m, n: Integer; ConnectInterfRes: TConnectInterfRes; InterfCount1, InterfCount2: Integer; InterfCountToConnect: Integer; MaxConnectInterfaces: Integer; WasChange: boolean; SCSComponent1, SCSComponent2, ConnCompon1, ConnCompon2, PartComponent, PointCompon: TSCSComponent; WasBreak: Boolean; Catalog1, Catalog2: TSCSCatalog; BeginCableInterfSide: Integer; SCSList: TSCSList; Side1, Side2: integer; //Tolik // выбросил наверх { function GetInterfCountBySide(ACompon: TSCSComponent; ASide: Integer): Integer; var i: Integer; Interfac: TSCSInterface; ResCount: Integer; begin Result := 0; ResCount := 0; for i := 0 to ACompon.Interfaces.Count - 1 do begin Interfac := ACompon.Interfaces[i]; if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then if Interfac.Side = ASide then ResCount := ResCount + 1; end; Result := ResCount; end; } function ConnectComponents(ACompon1, ACompon2: TSCSComponent; AObjSide1, AObjSide2: Integer; MaxInterfCount: Integer): TConnectInterfRes;// Boolean; var ConnectInterfRes: TConnectInterfRes; // Tolik CanJoin: Boolean; begin if (ACompon1 <> nil) and (ACompon2 <> nil) then begin // Tolik CanJoin := True; if ((F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible)) then begin if ( (ACompon1.IsLine = biTrue) and (ACompon2.IsLine = biTrue) ) then begin if ( (F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(ACompon1.ID) = -1) or (F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(ACompon2.ID) = -1) ) then CanJoin := False; end; end else begin if ACompon1.isLine = biTrue then begin if ACompon1.Cypher <> F_NormBase.GSCSBase.SCSComponent.Cypher then CanJoin := False; end; if ACompon2.isLine = biTrue then begin if ACompon2.Cypher <> F_NormBase.GSCSBase.SCSComponent.Cypher then CanJoin := False; end; end; if CanJoin then begin // Tolik //ConnectInterfRes := ACompon1.JoinTo(ACompon2, AObjSide1, AObjSide2, False, nil, nil, MaxInterfCount); Result{ConnectInterfRes} := ACompon1.JoinTo(ACompon2, AObjSide1, AObjSide2, True, nil, nil, MaxInterfCount); // commented by Tolik (удобнее видеть результат соединения) {if ConnectInterfRes.CanConnect then begin Result := true; end;} end //Tolik else begin Result.CanConnect := False; end; end; end; function CheckJoinToJoinedObjectIfMultiple(AComponToJoin: TSCSComponent; AObjectToJoin: TSCSCatalog): Boolean; var i: Integer; JoinedCompon: TSCSComponent; begin Result := false; if AComponToJoin.HaveMultipleInterface then for i := 0 to AComponToJoin.JoinedComponents.Count - 1 do begin JoinedCompon := AComponToJoin.JoinedComponents[i]; if JoinedCompon.GetFirstParentCatalog = AObjectToJoin then begin Result := true; Break; ///// BREAK ///// end; end; end; function CheckComponForCanConnect(AComponent: TSCSComponent; AComponObject: TSCSCatalog): Boolean; begin try Result := false; //Tolik // нех что попало соединять if ((AComponent.IsLine = biTrue) and (AComponent.Cypher <> F_NormBase.GSCSBase.SCSComponent.Cypher)) then Exit; // if AComponent.ServCanConnect then case AComponent.IsLine of biTrue: if (Not AOnlyNewLineCompon) or (AComponObject.LastAddedComponent = AComponent)or(AComponObject.NewComponList.IndexOf(AComponent) <> -1) then Result := true; biFalse: begin if Not WasChange and AFirstComponent then //проверка стартового обьекта begin if Assigned(F_PEAutoTraceDialog.ListWorkCompon) then if F_PEAutoTraceDialog.ListWorkCompon.IndexOf(AComponent.ID) > -1 then // if AWorkList.IndexOf(AComponent) > -1 then Result := true else if AComponent.Parent is TSCSComponent then Result := CheckComponForCanConnect(TSCSComponent(AComponent.Parent),AComponObject); end; if ((Assigned(F_PEAutoTraceDialog.ListEndCompon)) and (Not ForSwitch)) or (Assigned(F_PEAutoTraceDialog.ListSwitchesCompon) and ForSwitch) then if WasChange and ALastComponent then //проверка конечного объекта begin if (AComponent.JoinedComponents.Count = 0) then begin if ForSwitch then begin if F_PEAutoTraceDialog.ListSwitchesCompon.IndexOf(AComponent.ID) > -1 then begin Result := true end else begin if AComponent.Parent is TSCSComponent then Result := CheckComponForCanConnect(TSCSComponent(AComponent.Parent),AComponObject); end; end else begin if F_PEAutoTraceDialog.ListEndCompon.IndexOf(AComponent.ID) > -1 then begin Result := true end else begin if AComponent.Parent is TSCSComponent then Result := CheckComponForCanConnect(TSCSComponent(AComponent.Parent),AComponObject); end; end; end //Tolik else begin if ((F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex = 0) and (F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 0)) then Result := True; end; // end else Result := true; end; end Except on E: Exception do addExceptionToLogEx('U_PECommon.CheckComponForCanConnect', E.Message); end; // else // if IsTrunkComponent(AComponent) then // Result := true; end; begin Result := false; Catalog1 := AObject1; //TSCSCatalog.Create(GForm); Catalog2 := AObject2; //TSCSCatalog.Create(GForm); Side1 := ASideObject1; Side2 := ASideObject2; WasChange := false; try if (Catalog1.ItemType = itSCSConnector) and (Catalog2.ItemType = itSCSLine) then begin //ExchangeObjects(Catalog1, Catalog2); Catalog2 := AObject1; //TSCSCatalog.Create(GForm); Catalog1 := AObject2; //TSCSCatalog.Create(GForm); //ExchangeIntegers(ASideObject1, ASideObject2); Side2 := ASideObject1; Side1 := ASideObject2; end else begin WasChange := true; end; ConnCompon1 := nil; ConnCompon2 := nil; MaxConnectInterfaces := MaxInterfPosCountToConnect; //Tolik // Электрика (или ОПС параллельное, если отдельный кабель для каждого или ОПС параллельное, если индивидуально, но с распредкоробками //if F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 0 then if ((F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 0) or ((F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex = 0)) or ((F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex = 1) and (F_PEAutoTraceDialog.PutBox_Check.Checked)) ) then begin // всегда линия SCSComponent1 := Catalog1.LastAddedComponent; if SCSComponent1 <> nil then begin ConnCompon1 := nil; ConnCompon2 := nil; //MaxConnectInterfaces := 0; MaxConnectInterfaces := MaxInterfPosCountToConnect; WasBreak := false; if CheckComponForCanConnect(SCSComponent1, Catalog1) then begin // если индивидуальный кабель для каждого потребителя if F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex = 0 then begin //*** Если у компоненты есть многократные инетрфейсы (не дать кабелю 220в подключится два раза к одному и томуже компоненту/объекту) if CheckJoinToJoinedObjectIfMultiple(SCSComponent1, Catalog2) then SCSComponent1.ServCanConnect := false else begin if Catalog2.IsLine = biFalse then begin for j := 0 to Catalog2.ComponentReferences.Count - 1 do begin SCSComponent2 := Catalog2.ComponentReferences[j]; if ((F_PEAutoTraceDialog.ListEndCompon.IndexOf(SCSComponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListWorkCompon.IndexOf(SCSComponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListLampCompon.IndexOf(SCSComponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListSwitchesCompon.IndexOf(SCSComponent2.ID) <> -1)) then begin // если сторона потребителя, то подключаем не подключенный ранее if F_PEAutoTraceDialog.ListEndCompon.IndexOf(SCSComponent2.ID) = -1 then begin if ConnectedComponList.IndexOf(SCSComponent2) = -1 then begin if CheckComponForCanConnect(SCSComponent2, Catalog2) then begin begin ConnectedComponList.Add(SCSComponent2); //*** Определить количество интерфейсов для соединения //Tolik 11/03/2021 -- //InterfCount1 := GetInterfCountBySide(SCSComponent1, SideObject1); //InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); InterfCount1 := GetInterfCountBySide(SCSComponent1, Side1); InterfCount2 := GetInterfCountBySide(SCSComponent2, Side2); // if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount2 else InterfCountToConnect := InterfCount1; // Tolik 11/03/2021 -- //ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2, true); ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, Side1, Side2, true); // if ConnectInterfRes.CanConnect then begin { //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin} //Tolik 11/03/2021 -- //ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2, InterfCountToConnect); ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, Side1, Side2, InterfCountToConnect); // if ConnectInterfRes.CanConnect then if Result = false then Result := true; { end;} Break; end; end; end; end; end else // если со стороны щитка begin if (CheckComponForCanConnect(SCSComponent2, Catalog2) or ((F_PEAutoTraceDialog.TypeConnection.ItemIndex = 0) and (F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 1) and (GetInterfCountBySide(SCSComponent2, ASideObject2) > 0))) then begin begin BeginCableInterfSide := 0; SCSComponent2.DefineInterfCountToConnect; //*** Определить количество интерфейсов для соединения // Tolik 11/03/2021 -- //InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); //InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); InterfCount1 := GetInterfCountBySide(SCSComponent1, Side1); InterfCount2 := GetInterfCountBySide(SCSComponent2, Side2); // if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount2 else InterfCountToConnect := InterfCount1; // кабель с конечным компонентом // теперь посмотрим, сколько подключено вначале ( а вдруг меньше) SCSComponent1.LoadWholeComponent(True); InterfCount1 := -1; for k := 0 to SCSComponent1.WholeComponent.Count - 1 do begin // Tolik 08/02/2021 -- PartComponent := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SCSComponent1.WholeComponent[k]); if PartComponent = nil then // если не на текущем листе - ищем по проекту begin for l := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin SCSList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[l]; if SCSList <> F_ProjMan.GSCSBase.CurrProject.CurrList then if SCSList.Setting.ListType = lt_Normal then PartComponent := SCSList.GetComponentFromReferences(SCSComponent1.WholeComponent[k]); if PartComponent <> nil then break; end; end; // if PartComponent <> nil then begin for l := 0 to PartComponent.JoinedComponents.Count - 1 do begin if TSCSComponent(PartComponent.JoinedComponents[l]).IsLine = biFalse then begin InterfCount1 := 0; PointCompon := TSCSComponent(PartComponent.JoinedComponents[l]); for m := 0 to PointCompon.Interfaces.Count - 1 do begin if TSCSInterface(PointCompon.Interfaces[m]).TypeI = itFunctional then begin for n := 0 to TSCSInterface(PointCompon.Interfaces[m]).ConnectedInterfaces.Count - 1 do begin if TSCSInterFace(TSCSInterface(PointCompon.Interfaces[m]).ConnectedInterfaces[n]).ComponentOwner = PartComponent then begin Inc(InterfCount1); if BeginCableInterfSide = 0 then BeginCableInterfSide := TSCSInterFace(TSCSInterface(PointCompon.Interfaces[m]).ConnectedInterfaces[n]).Side; end; end; end; end; Break; end; if InterfCount1 > -1 then break; end; end; if InterfCount1 > -1 then break; end; if InterfCount1 > -1 then if InterfCountToConnect > InterfCount1 then InterfCountToConnect := InterfCount1; //Tolik 11/03/2021 -- //ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2, true); ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, Side1, Side2, true); // if ConnectInterfRes.CanConnect then begin { //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin} // Tolik 11/03/2021 -- //ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2, InterfCountToConnect); ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, Side1, Side2, InterfCountToConnect); // if ConnectInterfRes.CanConnect then if Result = false then Result := true; // вот здесь уравняем подключенные интерфейсы на концах кабеля if ConnectInterfRes.CanConnect then begin InterfCountToConnect := ConnectInterfRes.ConnectInterfCount; if InterfCountToConnect < InterfCount1 then begin PartComponent.DisJoinFrom(PointCompon); PartComponent.DefineInterfCountToConnect; ConnectComponents(PartComponent, PointCompon, BeginCableInterfSide, 0, InterfCountToConnect); end; end; { end;} Break; end; end; end; end; end; end; end else // если второй компонент - тоже кабель, смотрим, нет ли подключения на кабелях к точечным объектам begin WasBreak := False; SCSComponent2 := Catalog2.LastAddedComponent; if SCSComponent1.Cypher = SCSComponent2.Cypher then begin for j := 0 to SCSComponent1.Interfaces.Count - 1 do begin // Tolik 11/03/2021 -- //if (TSCSInterface(SCSComponent1.Interfaces[j]).Side = ASideObject1) then if (TSCSInterface(SCSComponent1.Interfaces[j]).Side = Side1) then // begin for k := 0 to TSCSInterface(SCSComponent1.Interfaces[j]).ConnectedInterfaces.Count - 1 do begin if TSCSInterface(TSCSInterface(SCSComponent1.Interfaces[j]).ConnectedInterfaces[k]).ComponentOwner.IsLine = biFalse then begin WasBreak := True; Break; end; end; end; if WasBreak then Break; end; if not WasBreak then begin for j := 0 to SCSComponent2.Interfaces.Count - 1 do begin if (TSCSInterface(SCSComponent2.Interfaces[j]).Side = ASideObject2) then begin for k := 0 to TSCSInterface(SCSComponent2.Interfaces[j]).ConnectedInterfaces.Count - 1 do begin if TSCSInterface(TSCSInterface(SCSComponent2.Interfaces[j]).ConnectedInterfaces[k]).ComponentOwner.IsLine = biFalse then begin WasBreak := True; Break; end; end; end; if WasBreak then Break; end; end; // если в точке подклчения нет подключения кабеля к точечному, то можем подключить кабели между собой if not WasBreak then begin if CheckComponForCanConnect(SCSComponent2, Catalog2) then begin begin //*** Определить количество интерфейсов для соединения // Tolik 11/03/2021 -- //InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); //InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); InterfCount1 := GetInterfCountBySide(SCSComponent1, Side1); InterfCount2 := GetInterfCountBySide(SCSComponent2, Side2); // if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount2 else InterfCountToConnect := InterfCount1; if InterfCount1 = InterfCount2 then begin // Tolik 11/03/2021 -- //ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2, true); ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, Side1, Side2, true); // if ConnectInterfRes.CanConnect then begin //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin // Tolik 11/03/2021 -- //ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2, InterfCountToConnect); ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, Side1, Side2, InterfCountToConnect); // if ConnectInterfRes.CanConnect then if Result = false then Result := true; end; end; end; end; end; end; end; end; end; end else if F_PEAutoTraceDialog.TypeAutotrace_RadioGroup.ItemIndex = 1 then begin //*** Если у компоненты есть многократные инетрфейсы (не дать кабелю 220в подключится два раза к одному и томуже компоненту/объекту) if CheckJoinToJoinedObjectIfMultiple(SCSComponent1, Catalog2) then SCSComponent1.ServCanConnect := false else begin if Catalog2.IsLine = biFalse then begin for j := 0 to Catalog2.ComponentReferences.Count - 1 do begin SCSComponent2 := Catalog2.ComponentReferences[j]; if ((F_PEAutoTraceDialog.ListEndCompon.IndexOf(SCSComponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListWorkCompon.IndexOf(SCSComponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListLampCompon.IndexOf(SCSComponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListSwitchesCompon.IndexOf(SCSComponent2.ID) <> -1)) then begin if CheckComponForCanConnect(SCSComponent2, Catalog2) then begin begin //*** Определить количество интерфейсов для соединения // Tolik 11/03/2021 -- //InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); //InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); // Tolik 06/04/2021 -- //InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); //InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); InterfCount1 := GetInterfCountBySide(SCSComponent1, Side1); InterfCount2 := GetInterfCountBySide(SCSComponent2, Side2); // // if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount2 else InterfCountToConnect := InterfCount1; //Tolik 11/03/2021 -- //ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2, true); ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, Side1, Side2, true); // if ConnectInterfRes.CanConnect then begin { //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin} // Tolik 11/03/2021 -- //ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2, InterfCountToConnect); ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, Side1, Side2, InterfCountToConnect); if ConnectInterfRes.CanConnect then if Result = false then Result := true; { end;} end; end; end; end; end; end else // если второй компонент - тоже кабель, смотрим, нет ли подключения на кабелях к точечным объектам begin WasBreak := False; SCSComponent2 := Catalog2.LastAddedComponent; if SCSComponent1.Cypher = SCSComponent2.Cypher then begin for j := 0 to SCSComponent1.Interfaces.Count - 1 do begin // Tolik 11/03/2021 -- //if (TSCSInterface(SCSComponent1.Interfaces[j]).Side = ASideObject1) then if (TSCSInterface(SCSComponent1.Interfaces[j]).Side = Side1) then // begin for k := 0 to TSCSInterface(SCSComponent1.Interfaces[j]).ConnectedInterfaces.Count - 1 do begin if TSCSInterface(TSCSInterface(SCSComponent1.Interfaces[j]).ConnectedInterfaces[k]).ComponentOwner.IsLine = biFalse then begin WasBreak := True; Break; end; end; end; if WasBreak then Break; end; if not WasBreak then begin for j := 0 to SCSComponent2.Interfaces.Count - 1 do begin if (TSCSInterface(SCSComponent2.Interfaces[j]).Side = ASideObject2) then begin for k := 0 to TSCSInterface(SCSComponent2.Interfaces[j]).ConnectedInterfaces.Count - 1 do begin if TSCSInterface(TSCSInterface(SCSComponent2.Interfaces[j]).ConnectedInterfaces[k]).ComponentOwner.IsLine = biFalse then begin WasBreak := True; Break; end; end; end; if WasBreak then Break; end; end; // если в точке подклчения нет подключения кабеля к точечному, то можем подключить кабели между собой if not WasBreak then begin if CheckComponForCanConnect(SCSComponent2, Catalog2) then begin begin //*** Определить количество интерфейсов для соединения //Tolik 11/03/2021 -- //InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); //InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); InterfCount1 := GetInterfCountBySide(SCSComponent1, Side1); InterfCount2 := GetInterfCountBySide(SCSComponent2, Side2); // if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount2 else InterfCountToConnect := InterfCount1; if InterfCount1 = InterfCount2 then begin //Tolik 11/03/2021 -- //ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2, true); ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, Side1, Side2, true); // if ConnectInterfRes.CanConnect then begin //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin // Tolik 11/03/2021 -- //ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2, InterfCountToConnect); ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, Side1, Side2, InterfCountToConnect); // if ConnectInterfRes.CanConnect then if Result = false then Result := true; end; end; end; end; end; end; end; end; end; end; SCSComponent1.ServCanConnect := true; if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) then begin // Tolik 11/03/2021 -- //ConnectInterfRes := ConnectComponents(ConnCompon1, ConnCompon2, ASideObject1, ASideObject2, InterfCountToConnect); ConnectInterfRes := ConnectComponents(ConnCompon1, ConnCompon2, Side1, Side2, InterfCountToConnect); // if ConnectInterfRes.CanConnect then if Result = false then Result := true; ConnCompon1 := nil; ConnCompon2 := nil; end; end; end; end else // ОПС //if F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 1 then //if ((F_PEAutoTraceDialog.AutotraceKind.ItemIndex = 1) and (F_PEAutoTraceDialog.TypeConnection.ItemIndex <> 0)) then begin // первый компонент - все равно трасса SCSComponent1 := Catalog1.LastAddedComponent; // кабель (если положили) if SCSComponent1 <> nil then begin ConnCompon1 := nil; ConnCompon2 := nil; //MaxConnectInterfaces := 0; MaxConnectInterfaces := MaxInterfPosCountToConnect; WasBreak := false; if Catalog2.IsLine = biFalse then begin if CheckComponForCanConnect(SCSComponent1, Catalog1) then begin //*** Если у компоненты есть многократные инетрфейсы (не дать кабелю 220в подключится два раза к одному и томуже компоненту/объекту) if CheckJoinToJoinedObjectIfMultiple(SCSComponent1, Catalog2) then SCSComponent1.ServCanConnect := false else for j := 0 to Catalog2.ComponentReferences.Count - 1 do if Assigned(Catalog2.ComponentReferences[j]) then begin SCSComponent2 := Catalog2.ComponentReferences.Items[j]; if (F_PEAutoTraceDialog.ListEndCompon.IndexOf(SCScomponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListWorkCompon.IndexOf(SCScomponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListLampCompon.IndexOf(SCScomponent2.ID) <> -1) or (F_PEAutoTraceDialog.ListSwitchesCompon.IndexOf(SCScomponent2.ID) <> -1) then begin if CheckComponForCanConnect(SCSComponent2, Catalog2) then begin begin //*** Определить количество интерфейсов для соединения // Tolik 11/03/2021 -- //InterfCount1 := GetInterfCountBySide(SCSComponent1, ASideObject1); //InterfCount2 := GetInterfCountBySide(SCSComponent2, ASideObject2); InterfCount1 := GetInterfCountBySide(SCSComponent1, Side1); InterfCount2 := GetInterfCountBySide(SCSComponent2, Side2); // //Tolik {if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount1 else InterfCountToConnect := InterfCount2;} if InterfCount1 > InterfCount2 then InterfCountToConnect := InterfCount2 else InterfCountToConnect := InterfCount1; // // Tolik 11/03/2021 -- //ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, ASideObject1, ASideObject2, true); ConnectInterfRes := SCSComponent1.CheckJoinTo(SCSComponent2, Side1, Side2, true); // if ConnectInterfRes.CanConnect then begin //*** Ели соединение может происходить всемя интерфейсами, то соединять if (ConnectInterfRes.ConnectInterfCount = InterfCountToConnect) then begin //Tolik 11/03/2021 -- //ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, ASideObject1, ASideObject2, InterfCountToConnect); ConnectInterfRes := ConnectComponents(SCSComponent1, SCSComponent2, Side1, Side2, InterfCountToConnect); // if ConnectInterfRes.CanConnect then if Result = false then Result := true; WasBreak := true; Break; ///// BREAK ///// end; end; end; end; if WasBreak then Break; ///// BREAK ///// end; end; //if WasBreak then // Break; ///// BREAK ///// SCSComponent1.ServCanConnect := true; if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) then begin // Tolik 11/03/2021 -- //ConnectInterfRes := ConnectComponents(ConnCompon1, ConnCompon2, ASideObject1, ASideObject2, InterfCountToConnect); ConnectInterfRes := ConnectComponents(ConnCompon1, ConnCompon2, Side1, Side2, InterfCountToConnect); // if ConnectInterfRes.CanConnect then if Result = false then Result := true; ConnCompon1 := nil; ConnCompon2 := nil; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_PECommon.ConnectPEObjectCompons', E.Message); end; //if (ConnCompon1 <> nil) and (ConnCompon2 <> nil) then //begin // Result := ConnectComponents(ConnCompon1, ConnCompon2, ASideObject1, ASideObject2); //end; end; //Подключения кабеля по проложенным трассам function ConnectPEObjectsByWay(AWay: TList; APosList: TIntList = nil; AWorkList: TList = Nil; AServList: TList = Nil; AOnlyForNewCable: boolean = False; AForSwitch: boolean = False): Boolean; var WayObjects: TSCSCatalogs; SCSObject: TSCSCatalog; CurrObj: TSCSCatalog; PrevObj: TSCSCatalog; PrevPrevObj: TSCSCatalog; CopyObj: TSCSCatalog; CopyCompon, LastCompon: TSCSComponent; ConnectInterfRes: TConnectInterfRes; SCSCompon: TSCSComponent; //SCSCompon1: TSCSComponent; //SCSCompon2: TSCSComponent; ConnectKind: TConnectKind; WasConnect: Boolean; i, j: Integer; ptrConnObjSides: PConnectedObjectsSides; ptrPrevConnObjSides: PConnectedObjectsSides; ObjectSidesList: TList; ListEndComponsForTree: TSCSComponents; // SCSList: TSCSList; FirstPointObject: TSCSCatalog; LastPointObject: TSCSCatalog; FirstPointPort: TSCSInterface; LastPointPort: TSCSInterface; FirstPointPortInterfCount: Integer; LastPointPortInterfCount: Integer; MaxInterfCountToConnect: Integer; //Tolik FirstPointInterfCount, LastPointInterfCount: Integer; SCSComponent: TSCSComponent; // SCSLineComponents: TSCSComponents; FirstLineComponent: TSCSComponent; LastLineComponent: TSCSComponent; FirstLineComponentPos: Integer; LastLineComponentPos: Integer; FirstLineComponentSide: Integer; LastLineComponentSide: Integer; WasJoinedToEndPoints: Boolean; FirstLineComponentInterfaces: TSCSInterfaces; LastLineComponentInterfaces: TSCSInterfaces; FirstPointInterface: TSCSInterface; LastPointInterface: TSCSInterface; EndConnector: TConnectorObject; FlagConnect: TConnectInterfRes; FlagCabling: boolean; CADList: TF_CAD; function CheckConectComponToMultiInterf(ACompon: TSCSComponent): boolean; /////проверка компонента на хоть один многократный интерфейс занятый многократным интерфесом var i,j : integer; Interf: TSCSInterface; IOfIRel: TSCSIOfIRel; begin Result := false; for i := 0 to ACompon.Interfaces.Count - 1 do begin Interf := ACompon.Interfaces[i]; if (Interf.Multiple = biTrue) and (Interf.TypeI = itFunctional) then begin if Assigned(Interf.IOfIRelOut) then for j := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.IOfIRelOut[j]); if IOfIRel.InterfaceTo.Multiple = biTrue then begin Result := true; break; end; end; if Assigned(Interf.ConnectedInterfaces) then For j := 0 to Interf.ConnectedInterfaces.Count - 1 do begin If Interf.ConnectedInterfaces[j].Multiple = biTrue then begin Result := true; break; end; end; if Result then break; end; end; end; function GetLineComponInterfacesForJoinToPoint(ALineComponent: TSCSComponent; APointObject: TSCSCatalog; var AlineComponSide: Integer): TSCSInterfaces; var LineComponObject: TSCSCatalog; ptrConnectedObjSides: PConnectedObjectsSides; LineComponSide: Integer; begin Result := nil; ptrConnectedObjSides := nil; LineComponSide := -1; LineComponObject := ALineComponent.GetFirstParentCatalog; if LineComponObject <> nil then ptrConnectedObjSides := FindConnObjSides(APointObject.ID, LineComponObject.ID, ObjectSidesList); if ptrConnectedObjSides <> nil then begin if ptrConnectedObjSides.IDObj1 = LineComponObject.ID then LineComponSide := ptrConnectedObjSides.Side1 else if ptrConnectedObjSides.IDObj2 = LineComponObject.ID then LineComponSide := ptrConnectedObjSides.Side2; if LineComponSide <> -1 then begin Result := GetComponInterfacesBySide(ALineComponent, LineComponSide, biFalse); AlineComponSide := LineComponSide; end; end; end; //Tolik -- 18/09/2019 -- Procedure CheckWayList; var i: Integer; Figure: TFigure; delFigure: Boolean; begin if AWay.Count > 0 then begin if ((AWorkList <> Nil) and (AServList <> Nil)) then begin for i := AWay.Count - 1 downto 0 do begin if ((i <> 0) and (i <> aWay.Count - 1)) then begin Figure := TFigure(aWay[i]); if CheckFigureByClassNAme(Figure, cTConnectorObject) then begin if ((AWorkList.IndexOf(Figure) = -1) or (aServList.IndexOf(Figure) = -1)) then aWay.Remove(Figure); end; end; end; end; end; end; // begin Result := true; try WayObjects := TSCSCatalogs.Create(false); ObjectSidesList := Tlist.Create; SCSLineComponents := TSCSComponents.Create(false); //ConnectInterfRes := Nil; try //SCSList := nil; SCSObject := nil; PrevObj := nil; FirstPointObject := nil; LastPointObject := nil; FirstLineComponent := nil; LastLineComponent := nil; FirstLineComponentPos := -1; LastLineComponentPos := -1; FirstPointInterface := nil; LastPointInterface := nil; if F_PEAutotraceDialog.TypeAutoTrace_RadioGroup.ItemIndex = 1 then CheckWayList; // Tolik 18/09/2019 -- сбросить точечные объекты, которые не входят в автотрассировку, чтобы мог соединиться кабель for i := 0 to AWay.Count - 1 do begin WasConnect := false; PrevObj := SCSObject; SCSObject := nil; SCSObject := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AWay[i]).ID); if Assigned(SCSObject) then begin // if SCSList = nil then // SCSList := SCSObject.GetListOwner; if SCSObject.ItemType = itSCSConnector then begin if i = 0 then FirstPointObject := SCSObject; if i = AWay.Count - 1 then LastPointObject := SCSObject; SCSObject.ReloadComponentReferences; end else if SCSObject.ItemType = itSCSLine then if SCSObject.LastAddedComponent <> nil then begin SCSLineComponents.Add(SCSObject.LastAddedComponent); if APosList <> nil then begin if i = 1 then FirstLineComponentPos := APosList[i]; if i = AWay.Count - 2 then LastLineComponentPos := APosList[i]; end; end; WayObjects.Add(SCSObject); if Prevobj <> nil then begin //New(ptrConnObjSides); GetMem(ptrConnObjSides, SizeOf(TConnectedObjectsSides)); ptrConnObjSides.IDObj1 := PrevObj.ID; ptrConnObjSides.IDObj2 := SCSObject.ID; GetSidesByConnectedFigures(PrevObj.ListID, SCSObject.ListID, PrevObj.SCSID, SCSObject.SCSID, ptrConnObjSides^.Side1, ptrConnObjSides^.Side2); ObjectSidesList.Add(ptrConnObjSides); end; //*** Разрешить соединение компонентам for j := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSCompon := SCSObject.ComponentReferences[j]; SCSCompon.DefineInterfCountToConnect; end; end; end; //Соединение первого и последнего обьектов CurrObj := nil; PrevObj := nil; PrevPrevObj := nil; //Tolik // определяем количество интерфейсов для подключения (по кабелю от начального до конечного объекта) MaxInterfCountToConnect := 0; FirstPointInterfCount :=0; LastPointInterfCount := 0; // начальная точка if CheckFigureByClassName(TFigure(AWay[0]), cTConnectorObject) then begin SCSObject := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AWay[0]).ID); if SCSObject <> nil then begin for i := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(SCSObject.ComponentReferences[i]); end; end; end; // конечная точка if CheckFigureByClassName(TFigure(AWay[AWay.Count - 1 ]), cTConnectorObject) then begin end; // for i := 0 to WayObjects.Count - 1 do begin PrevPrevObj := Nil; PrevPrevObj := PrevObj; PrevObj := nil; PrevObj := CurrObj; CurrObj := nil; CurrObj := WayObjects[i]; if PrevObj <> nil then begin if ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSLine)) or // только две линии ((PrevObj.ItemType = itSCSConnector) and (CurrObj.ItemType = itSCSLine) and (i=1)) or // первый точечный и линия ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSConnector) and (i=WayObjects.Count-1)) or // Последний точечный и линия //Tolik ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSConnector) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible) and (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked)) // then begin ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID, ObjectSidesList); // Tolik 09/02/2021 -- //if (i = WayObjects.Count-1) and ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSLine)) then //если последний компонент и соединять линию с линией if (PrevObj.ListID = CurrObj.ListID) and {(i = WayObjects.Count-1) and} ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSLine)) then //если последний компонент и соединять линию с линией // begin //добавим в точку соединения скрутку EndConnector := AddCabling(PrevObj, CurrObj, -1, true, AOnlyForNewCable); end else if ptrConnObjSides <> nil then begin //WasConnect := ConnectWayObjects(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2); //Tolik //WasConnect := ConnectPEObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, true, i = 1, i=WayObjects.Count-1, AForSwitch); WasConnect := ConnectPEObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, False, i = 1, i=WayObjects.Count-1, AForSwitch); // if (Result = true) and Not(WasConnect) then Result := false; end; end; if (PrevPrevObj <> Nil) then if (PrevPrevObj.ItemType = itSCSLine) and (PrevObj.ItemType = itSCSConnector) and (CurrObj.ItemType = itSCSLine) then begin FlagCabling := true; CADList := GetListByID(PrevObj.ListID); if CADList <> nil then if CheckEndCompon(TConnectorObject(GetFigureByID(CADList, PrevObj.SCSID)), AWorkList) then begin if PrevObj.ComponentReferences.Count > 0 then begin For j := 0 to PrevObj.ComponentReferences.Count - 1 do begin if CurrObj.LastAddedComponent.CheckJoinTo(PrevObj.ComponentReferences[j],-1, -1, true).CanConnect then begin ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID, ObjectSidesList); if ptrConnObjSides <> nil then begin //Tolik //ConnectPEObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, true, i = 1, i=WayObjects.Count-1, AForSwitch); ConnectPEObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, False, i = 1, i=WayObjects.Count-1, AForSwitch); // end; ptrConnObjSides := FindConnObjSides(PrevObj.ID, PrevPrevObj.ID, ObjectSidesList); if ptrConnObjSides <> nil then begin //Toilk // ConnectPEObjectCompons(PrevObj, PrevPrevObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, true, i = 1, i=WayObjects.Count-1, AForSwitch); ConnectPEObjectCompons(PrevObj, PrevPrevObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, False, i = 1, i=WayObjects.Count-1, AForSwitch); // end; //CurrObj.LastAddedComponent.JoinTo(PrevObj.ComponentReferences[j], -1, -1, true); // PrevPrevObj.LastAddedComponent.JoinTo(PrevObj.ComponentReferences[j], -1, -1, true); // FlagCabling := false; break; end; end; end; end else begin // FlagCabling := false; end; if FlagCabling then begin AddCabling(CurrObj, PrevPrevObj, PrevObj.SCSID, true, AOnlyForNewCable); end; end; //для конечного и первого обьектов, которые не подключаются к кабелю делаем скрутку всех кабелей if (Not WasConnect) and ((i = WayObjects.Count - 1)or (i = 1) ) and (PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSConnector) then begin FlagCabling := true; CopyCompon := TSCSComponent.Create(F_ProjMan); LastCompon := TSCSComponent.Create(F_ProjMan); Try if PrevObj.LastAddedComponent <> Nil then begin LastCompon.Assign(PrevObj.LastAddedComponent, false, false); if LastCompon.JoinedComponents.Count > 0 then begin LastCompon.DisJoinFromAll(false).free; end; end; For j := 0 to CurrObj.ComponentReferences.Count - 1 do begin CopyCompon.Assign(CurrObj.ComponentReferences[j], false, false); if CopyCompon.JoinedComponents.Count > 0 then begin CopyCompon.DisJoinFromAll(false).Free; end; if PrevObj.LastAddedComponent <> Nil then begin // LastCompon.Assign(PrevObj.LastAddedComponent, false, false); // if LastCompon.JoinsCount > 0 then // begin // LastCompon.DisJoinFromAll(false); // end; if LastCompon.CheckJoinTo(CopyCompon,-1, -1, true).CanConnect then begin FlagCabling := false; break; end; end; end; if FlagCabling then begin AddCabling(PrevObj, nil, CurrObj.SCSID, true, AOnlyForNewCable); end else //если есть конечный объект, к которому можно подключится, но не "подключилося" - выдаём окно с вопросом куда подключить begin if (i = WayObjects.Count - 1) and (CurrObj.ItemType = itSCSConnector) then begin //подготовка листа с компонентами для отображения в дереве ListEndComponsForTree := TSCSComponents.Create(False); try For j := 0 to CurrObj.ComponentReferences.Count - 1 do begin if F_PEAutoTraceDialog.ListEndCompon.IndexOf(CurrObj.ComponentReferences[j].ID) > -1 then begin if CheckConectComponToMultiInterf (CurrObj.ComponentReferences[j]) then ListEndComponsForTree.Add(CurrObj.ComponentReferences[j]); end; end; if ListEndComponsForTree.Count > 0 then begin // F_PEDialogEqChoice.LineComponForConnect := LastCompon; if ListEndComponsForTree.Count = 1 then begin F_PEDialogEqChoice.ComponForConnect := ListEndComponsForTree[0]; F_PEDialogEqChoice.bOkClick(F_PEDialogEqChoice); if not PrevObj.LastAddedComponent.JoinTo(F_PEDialogEqChoice.ComponForConnect, -1, -1, true, nil, F_PEDialogEqChoice.ComponInterfaces).CanConnect then begin AddExceptionToLog(cPEMes7); //MessageModal(cPEMes7, cPEMes2, MB_ICONWARNING); end; // F_PEDialogEqChoice.ComponInterfaces := ListEndComponsForTree[0].Interfaces; end else begin F_PEDialogEqChoice.BuildTreeEndCompon(ListEndComponsForTree, CurrObj); EndProgress; if F_PEDialogEqChoice.ShowModal = mrOk then begin if (F_PEDialogEqChoice.ComponForConnect <> nil) and (F_PEDialogEqChoice.ComponInterfaces <> Nil) then begin if not PrevObj.LastAddedComponent.JoinTo(F_PEDialogEqChoice.ComponForConnect, -1, -1, true, nil, F_PEDialogEqChoice.ComponInterfaces).CanConnect then begin AddExceptionToLog(cPEMes7);//MessageModal(cPEMes7, cPEMes2, MB_ICONWARNING); end; end; end; BeginProgress; end; end //else // MessageModal(cPEMes5, cPEMes2, MB_ICONWARNING); finally ListEndComponsForTree.Free; end; end; //BuildTree(); end; finally CopyCompon.Free; LastCompon.Free; end; end; end; end; finally //if ConnectInterfRes <> nil then // FreeMemory(ConnectInterfRes); WayObjects.Free; // Tolik 03/10/2017 -- //ObjectSidesList.Free; freeList(ObjectSidesList); // SCSLineComponents.Free; // if SCSList <> nil then // SCSList.Free; end; except on E: Exception do AddExceptionToLog('ConnectPEObjectsByWay '+E.Message); end; end; //добавить скрутку и вернуть каталог обекта со скруткой Function AddCabling(APrevObj, ACurrObj: TSCSCatalog; AIdResultConnector: integer = -1; ADoCabling: boolean = true; AOnlyForNewCable: boolean = False): TConnectorObject; var Line1, Line2: TOrthoLine; ParamsList: TList; i,j,k,l : integer; CADList: TF_CAD; ListConnector, UsedConnectorList: TList; ListLine: TList; Connector, OperConnector: TConnectorObject; FlagConsist: boolean; ThereisConCompon: boolean; IsDownUP: boolean; CountLineWithCable: integer; IDCurrRaspredBox: integer; RaspredBoxCurr: TSCSComponent; CatalogOwner: TSCSCatalog; // Tolik CanPutRaspredBox: boolean; PointLineList: TList; PassedList, SavedComponList, SavedInterfList, SavedConnComponsList, CurrentCableList: TList; currBox : TSCSComponent; currRaspredBox: TSCSComponent; currObject, currLine, NextLine: TSCSCatalog; TOperConnectorComponent: TSCSComponent; ptrConnObjSides: PConnectedObjectsSides; ConnectorJoinedLinesList: TList; currCable, JoinedComponent, PointCompon, NextCable: TSCSComponent; CanConnect: Boolean; currCableInterFace: TSCSInterface; LineConnSide, BoxConnSide: Integer; LineCompon1, LineCompon2: TSCSComponent; procedure GetParamsFromLine(ALine: TOrthoLine); var ptrInterfRecord: PConnectObjectParam; begin New(ptrInterfRecord); ptrInterfRecord.IDObject := ALine.ID; ptrInterfRecord.Side := 0; if Connector = ALine.JoinConnector1 then begin ptrInterfRecord.Side := 1; end; if Connector = ALine.JoinConnector2 then begin ptrInterfRecord.Side := 2; end; if ptrInterfRecord.Side > 0 then ParamsList.Add(ptrInterfRecord) else begin MessageModal(cPEMes2, cPEMes4, MB_ICONWARNING); Dispose(ptrInterfRecord); end; end; function FindConnector (var Aconnector: TConnectorObject): boolean; var i,j,c : integer; OperConnector: TConnectorObject; CanFind, FlagAdded: boolean; UpDownConnector: TConnectorObject; begin ConnectorJoinedLinesList.Clear; Result := false; FlagAdded := false; UsedConnectorList.Add(Aconnector); if aConnector.ConnectorType <> ct_Clear then ThereisConCompon := true; if aConnector.ConnectorType = ct_Clear then begin ListConnector.Add(Aconnector); end; for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin //запуск проверки линий на полкдюченный СП, на конечную линию на наличие кабеля if not TOrthoLine(Aconnector.JoinedOrtholinesList[i]).deleted then // Tolik 01/04/2021 -- begin if TOrthoLine(Aconnector.JoinedOrtholinesList[i]).FIsRaiseUpDown then //на полкдюченный СП begin UpDownConnector := TConnectorObject(TOrthoLine(Aconnector.JoinedOrtholinesList[i]).JoinConnector1); if UpDownConnector.JoinedConnectorsList.Count > 0 then IsDownUP := true else begin UpDownConnector := TConnectorObject(TOrthoLine(Aconnector.JoinedOrtholinesList[i]).JoinConnector2); if UpDownConnector.JoinedConnectorsList.Count > 0 then IsDownUP := true end; end; if TOrthoLine(Aconnector.JoinedOrtholinesList[i]) = Line1 then //на конечную линию begin FlagAdded := true; end; If CheckInsideCable (TOrthoLine(Aconnector.JoinedOrtholinesList[i]), true) then //на наличие кабеля begin if (F_PEAutotraceDialog.DoNotUseUpDown.Checked) and ((TOrthoLine(Aconnector.JoinedOrtholinesList[i]).FisRaiseUpDown)) then else begin CountLineWithCable := CountLineWithCable + 1; end; end; end; end; Result := FlagAdded; if not FlagAdded then begin for i := 0 to AConnector.JoinedConnectorsList.Count - 1 do begin OperConnector := TConnectorObject(Aconnector.JoinedConnectorsList[i]); if UsedConnectorList.IndexOf(OperConnector) = -1 then FlagAdded := FindConnector(OperConnector); if FlagAdded then begin Result := True; end; end; end; end; // Tolik 18/05/2018 -- Procedure ClearLists; begin if ConnectorJoinedLinesList <> nil then ConnectorJoinedLinesList.Free; if ListConnector <> nil then ListConnector.Free; if UsedConnectorList <> nil then UsedConnectorList.free; end; // begin // Tolik 1805/2018 -- ConnectorJoinedLinesList := nil; ListConnector := nil; UsedConnectorList := nil; ptrConnObjSides := nil; // Try // Tolik // скрутку кабелей можно производить, только, если у них нет общего подключенного компонента, // а то х кака-то выходит: к одному, например, светильнику подключено по кабелю, так мало того, // при наличии мультиинтерфейсов, они еще и друг к дружке присоединятся... ТАК вот, ВО ИЗБЕЖАНИЕ: CanConnect := False; if (APrevObj <> nil) and (ACurrObj <> nil) then begin CanConnect := True; // если два линейных if ((APrevObj.IsLine = biTrue) and (ACurrObj.IsLine = biTrue )) then begin LineCompon1 := APrevObj.LastAddedComponent; LineCompon2 := ACurrObj.LastAddedComponent; if (((LineCompon1 <> nil) and (LineCompon2 <> nil)) and (LineCompon1.Cypher = LineCompon2.Cypher)) then begin if ((LineCompon1.JoinedComponents.Count > 0) and (LineCompon2.JoinedComponents.Count > 0)) then begin for i := 0 to LineCompon1.JoinedComponents.Count - 1 do begin for j := 0 to LineCompon2.JoinedComponents.Count - 1 do begin if TSCSComponent(LineCompon1.JoinedComponents[i]) = TSCSComponent(LineCompon2.JoinedComponents[j]) then begin // есть общий компонент - нельзя соединять кабель CanConnect := False; Break; end; if not CanConnect then break; end; end; end; end; end; end; if CanConnect then begin // Result := Nil; ParamsList := Nil; ListLine := Nil; CountLineWithCable := 0; CADList := Nil; ThereisConCompon := False; IsDownUP := false; //Tolik CanPutRaspredBox := True; ConnectorJoinedLinesList := TList.Create; // if Assigned(APrevObj) then CADList := GetListByID(APrevObj.ListID); ListConnector := TList.Create; UsedConnectorList := TList.Create; OperConnector := Nil; try if (APrevObj.ItemType = itSCSLine)then if Assigned(ACurrObj) then if (ACurrObj.ItemType <> itSCSLine) then begin ClearLists; // Tolik 18/05/2018 -- exit; end; Line1 := Nil; Line2 := Nil; // CADList := GetListByID(ACurrObj.ListID); if (CADList <> nil) and Assigned(APrevObj) then Line1 := TOrthoLine(GetFigureByID(CADList, APrevObj.SCSID)); // CADList := GetListByID(ACurrObj.ListID); if (CADList <> nil) and Assigned(ACurrObj) then Line2 := TOrthoLine(GetFigureByID(CADList, ACurrObj.SCSID)); if AidResultConnector = -1 then begin if (Line1 = Nil) or (Line2 = Nil) then begin ClearLists; // Tolik 18/05/2018 -- exit; end; OperConnector := TConnectorObject(LINE2.JoinConnector1); if not FindConnector(OperConnector) then begin ListConnector.Clear; ThereisConCompon := false; IsDownUP := false; CountLineWithCable := 0; OperConnector := TConnectorObject(LINE2.JoinConnector2); if not FindConnector(OperConnector) then begin ListConnector.Clear; end; end; end else begin if (Line1 = Nil) then begin ClearLists; // Tolik 18/05/2018 -- exit; end; if CADList <> nil then OperConnector := TConnectorObject(GetFigureByID(CADList, AidResultConnector)) else begin CADList := GetListByID(APrevObj.ListID); if CADList <> nil then OperConnector := TConnectorObject(GetFigureByID(CADList, AidResultConnector)); end; if Assigned(OperConnector)then begin FindConnector(OperConnector); end; end; // в листе ListConnector у находятся все коннекторы подключенные к линиям // значит вытягиваем линии и определяем их параметры для скрутки if ListConnector.Count > 0 then begin ListLine := TList.Create; //if ParamsList = nil then ParamsList := TList.Create; for i := 0 to ListConnector.Count - 1 do begin Connector := TConnectorObject(ListConnector[i]); For j := 0 to Connector.JoinedOrtholinesList.Count - 1 do begin FlagConsist := False; for k := 0 to ListLine.Count - 1 do begin // Если Следующая трасса равняется предыдущей if TOrthoLine(Connector.JoinedOrtholinesList[j]) = TOrthoLine(ListLine[k]) then begin FlagConsist := true; break; end; end; if not FlagConsist then begin { if (F_PEAutotraceDialog.DoNotUseUpDown.Checked) and ((TOrthoLine(Connector.JoinedOrtholinesList[j]).FisRaiseUpDown)) then else } begin ListLine.Add(Connector.JoinedOrtholinesList[j]); //добавим в список заюзаных линий GetParamsFromLine(TOrthoLine(Connector.JoinedOrtholinesList[j])); end; end; end; end; end; if ParamsList <> nil then begin if ADoCabling and (ParamsList.Count > 0) then begin if AOnlyForNewCable then MakeCablingForNewCable(ParamsList) else MakeCablingInPM(ParamsList); end; if ( ((not ThereisConCompon) and (CountLineWithCable >= F_PEAutoTraceDialog.KolTrace)) or // если игнорировать существующий кабель (ThereisConCompon and (CountLineWithCable >= F_PEAutoTraceDialog.KolTrace) and ((F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible))) ) then //вкидываем разветвительную коробку begin if F_PEAutoTraceDialog.PutBox_Check.Checked then begin if Assigned(F_PEAutoTraceDialog.RaspredBox) then begin if F_PEAutoTraceDialog.RaspredBoxConnectorList.IndexOf(OperConnector) = -1 then begin // Tolik if (F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible) and ThereisConCompon then F_PEAutoTraceDialog.NewRaspredBox := True; //SaveLineConnectionsAtPoint (OperConnector); // { cu/rObject := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(OperConnector.ID); if currObject <> nil then currRaspredBox := TSCSComponent(CreateComponInPMByType(TObject(currObject), F_PEAutoTraceDialog.RaspredBox.ComponentType.SysName, biFalse )); if currRaspredBox <> nil then begin currRaspredBox.AssignProperties(F_PEAutoTraceDialog.RaspredBox.Properties); currRaspredBox.IDSymbol := 0; currRaspredBox.GUIDSymbol := ''; currRaspredBox.IDObjectIcon := 0; currRaspredBox.GUIDObjectIcon := ''; CatalogOwner := currRaspredBox.GetFirstParentCatalog; if CatalogOwner <> nil then F_ProjMan.F_ChoiceConnectSide.DefineObjectParamsByServFldsInFuture(CatalogOwner, [dopIcon]); end; } try //IDCurrRaspredBox := CopyComponentToSCSObject(OperConnector.ID, F_PEAutoTraceDialog.RaspredBox.ID); // Tolik 02/02/2021 -- if OperConnector.ConnectorType = Ct_Clear then begin if OperConnector.JoinedconnectorsList.Count > 0 then begin isDownUp := True; OperConnector := TConnectorObject(OperConnector.JoinedConnectorsList[0]); end; end; IDCurrRaspredBox := CopyComponentToSCSObject(OperConnector.ID, F_PEAutoTraceDialog.RaspredBox.ID, true); {// Tolik 06/04/2021 -- try GDropComponent := F_PEAutoTraceDialog.RaspredBox; GFigureSnap := operConnector; GCadForm.DoDragDrop(operConnector.ap1.x, operConnector.ap1.y); except on E: Exception do addExceptionToLogEx('U_PECommon.addCabling', E.Message); end; } //Tolik 01/10/2021 -- { GDropComponent := nil; GFigureSnap := nil; } // except on E: Exception do begin end; end; F_PEAutoTraceDialog.NewRaspredBox := False; //IDCurrRaspredBox := CopyComponentToSCSObject(OperConnector.ID, F_PEAutoTraceDialog.RaspredBox.ID, True); // RaspredBoxCurr := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(IDCurrRaspredBox); if IsDownUP and (IDCurrRaspredBox > 0) then begin // RaspredBoxCurr := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(IDCurrRaspredBox); //PaspredBoxCurr. // Tolik 06/04/2021 -- это не нужно, а то сбросится фигура отрисовки для распредкоробки на райзе { RaspredBoxCurr.IDSymbol := 0; RaspredBoxCurr.GUIDSymbol := ''; RaspredBoxCurr.IDObjectIcon := 0; RaspredBoxCurr.GUIDObjectIcon := ''; // Tolik commetnted this 29/10/2019 -- // 09/11/2015 //if F_PEAutoTraceDialog.RaspredBoxList.IndexOf(RaspredBoxCurr) = -1 then // F_PEAutoTraceDialog.RaspredBoxList.Add(RaspredBoxCurr); // CatalogOwner := RaspredBoxCurr.GetFirstParentCatalog; CatalogOwner.LastAddedComponent := RaspredBoxCurr; if CatalogOwner <> nil then F_ProjMan.F_ChoiceConnectSide.DefineObjectParamsByServFldsInFuture(CatalogOwner, [dopIcon]); } end; if IDCurrRaspredBox <> -1 then F_PEAutoTraceDialog.RaspredBoxConnectorList.Add(OperConnector); // Tolik 29/10/2019 -- if F_PEAutoTraceDialog.RaspredBoxList.IndexOf(RaspredBoxCurr) = -1 then F_PEAutoTraceDialog.RaspredBoxList.Add(RaspredBoxCurr); end; // // Tolik if OperConnector.ConnectorType = ct_Nb then begin currObject := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TConnectorObject(OperConnector).ID); if currObject <> nil then begin // Tolik 02/02/2021 if currObject.SCSComponents.Count > 0 then begin PointCompon := currObject.SCSComponents[0]; for i := 0 to currObject.SCSComponents.Count - 1 do begin if PointCompon.ID < currObject.SCSComponents[i].ID then PointCompon := currObject.SCSComponents[i]; end; if PointCompon <> nil then begin CanConnect := True; ConnectorJoinedLinesList.Clear; for i := 0 to OperConnector.JoinedOrtholinesList.Count - 1 do begin ConnectorJoinedLinesList.Add(TOrthoLine(OperConnector.JoinedOrtholinesList[i])); end; for i := 0 to OperConnector.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(OperConnector.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin ConnectorJoinedLinesList.Add(TOrthoLine(TConnectorObject(OperConnector.JoinedConnectorsList[i]).JoinedOrtholinesList[j])); end; end; // Здесь имеем трассы, пересекающиеся на коробке // но кабель, там где смог, уже соединился, а перекресток сюда попал уже потом, // поэтому кабель сначала нужно рассоединить, потом подключить к коробке, // а то фигня какая-то выходит ... if ConnectorJoinedLinesList.Count > 0 then begin for i := 0 to ConnectorJoinedLinesList.Count - 1 do begin currLine := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TOrthoLine(ConnectorJoinedLinesList[i]).ID); if currLine <> nil then begin //if (currObject.ID = APrevObj.ID) or (currObject.ID = ACurrObj.ID) then begin currCable := nil; if F_PEAutoTraceDialog.IgnoreExistingCable.Visible and F_PEAutoTraceDialog.IgnoreExistingCable.Checked then currCable := currLine.LastAddedComponent else begin if F_PEAutoTraceDialog.IgnoreExistingCable.Visible and (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) then begin for j := 0 to currLine.ComponentReferences.Count - 1 do begin // Tolik 11/04/2021 -- //if F_PEAutoTraceDialog.LastAddedCableIDList.IndexOf(currLine.ComponentReferences[j].ID) <> - 1 then // begin currCable := currLine.ComponentReferences[j]; // Tolik 11/04/2021 -- //Break; if currCable.JoinedComponents.IndexOf(PointCompon) = -1 then begin for l := 0 to ConnectorJoinedLinesList.Count - 1 do begin if CurrLine.SCSID <> TOrthoLine(ConnectorJoinedLinesList[l]).ID then begin NextLine := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TOrthoLine(ConnectorJoinedLinesList[l]).ID); if NextLine <> nil then begin for k := 0 to NextLine.ComponentReferences.Count - 1 do begin NextCable := NextLine.ComponentReferences[k]; if isCableComponent(NextCable) then begin //if currCable.JoinedComponents.IndexOf(currLine.ComponentReferences[k]) <> - 1 then if currCable.JoinedComponents.IndexOf(NextCable) <> - 1 then begin currCable.DisJoinFrom(NextCable); NextCable.DefineInterfCountToConnect; PointCompon.DefineInterfCountToConnect; LineConnSide := -1; BoxConnSide := -1; GetMem(ptrConnObjSides, SizeOf(TConnectedObjectsSides)); ptrConnObjSides.IDObj1 := NextCable.ID; ptrConnObjSides.IDObj2 := PointCompon.ID; GetSidesByConnectedFigures(NextCable.ListID, PointCompon.ListID, TSCSCatalog(NextCable.GetFirstParentCatalog).SCSID, TSCSCatalog(Pointcompon.GetFirstParentCatalog).SCSID, ptrConnObjSides^.Side1, ptrConnObjSides^.Side2); if ptrConnObjSides <> nil then begin LineConnSide := ptrConnObjSides.Side1; BoxConnSide := ptrConnObjSides.Side2; NextCable.JoinTo(PointCompon, LineConnSide, BoxConnSide, true); FreeMem(ptrConnObjSides); ptrConnObjSides := nil; end; end; end; end; end; end; end; end; end; end; end; end; if currCable <> nil then begin if currCable.Joinedcomponents.IndexOf(PointCompon) = -1 then begin // вот тут рассоединяем кабель ... //for j := (i+1) to ConnectorJoinedLinesList.Count - 1 do for j := i to ConnectorJoinedLinesList.Count - 1 do begin //currLine := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TOrthoLine(ConnectorJoinedLinesList[j]).ID); NextLine := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TOrthoLine(ConnectorJoinedLinesList[j]).ID); //if currLine <> nil then if ((NextLine <> nil) and (NextLine.SCSID <> currLine.SCSID)) then begin if F_PEAutoTraceDialog.IgnoreExistingCable.Visible and F_PEAutoTraceDialog.IgnoreExistingCable.Checked then begin {for k := 0 to currLine.ComponentReferences.Count - 1 do begin if currCable.JoinedComponents.IndexOf(currLine.ComponentReferences[k]) <> - 1 then begin if currLine.LastAddedComponent <> nil then currCable.DisJoinFrom(currLine.ComponentReferences[k]); end; end;} //if currLine.LastAddedComponent <> nil then if NextLine.LastAddedComponent <> nil then begin {if currCable.JoinedComponents.IndexOf(currLine.LastAddedComponent) <> -1 then currCable.DisJoinFrom(currLine.LastAddedComponent);} if currCable.JoinedComponents.IndexOf(NextLine.LastAddedComponent) <> -1 then currCable.DisJoinFrom(NextLine.LastAddedComponent); end; end else begin // Tolik 11/04/2021 -- здесь рассоединить ВЕСЬ кабель, подходящий по шифру и подключить его к клеммной коробке { if F_PEAutoTraceDialog.IgnoreExistingCable.Visible and (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) then begin //for k := 0 to currLine.ComponentReferences.Count - 1 do for k := 0 to NextLine.ComponentReferences.Count - 1 do begin //if currCable.JoinedComponents.IndexOf(currLine.ComponentReferences[k]) <> - 1 then if currCable.JoinedComponents.IndexOf(NextLine.ComponentReferences[k]) <> - 1 then begin currCable.DisJoinFrom(currLine.ComponentReferences[k]); end; end; end; } if F_PEAutoTraceDialog.IgnoreExistingCable.Visible and (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) then begin //for k := 0 to currLine.ComponentReferences.Count - 1 do for k := 0 to NextLine.ComponentReferences.Count - 1 do begin NextCable := NextLine.ComponentReferences[k]; if isCableComponent(NextCable) then begin //if currCable.JoinedComponents.IndexOf(currLine.ComponentReferences[k]) <> - 1 then if currCable.JoinedComponents.IndexOf(NextCable) <> - 1 then begin currCable.DisJoinFrom(NextCable); end; end; end; end; end; end; end; end; // а теперь только подключим к коробке if PointCompon.JoinedComponents.IndexOf(currCable) = -1 then begin // кабель, упамши на трассу автоматом подключится, сволочь, к первой же попавшейся коробке, // поэтому, чтобы исправить данное непотребство, сначала отключим нах с этой стороны кабеля // точечные объекты for j := 0 to currObject.SCSComponents.Count - 1 do begin if currObject.SCSComponents[j].ID <> PointCompon.ID then begin if F_PEAutoTraceDialog.IgnoreExistingCable.Visible and F_PEAutoTraceDialog.IgnoreExistingCable.Checked then begin if currCable.JoinedComponents.IndexOf(currObject.SCSComponents[j]) <> - 1 then currCable.DisJoinFrom(currObject.SCSComponents[j]); end else begin if F_PEAutoTraceDialog.IgnoreExistingCable.Visible and (not F_PEAutoTraceDialog.IgnoreExistingCable.Checked) then if currCable.JoinedComponents.IndexOf(currObject.SCSComponents[j]) <> - 1 then currCable.DisJoinFrom(currObject.SCSComponents[j]); end; end; end; currCable.DefineInterfCountToConnect; PointCompon.DefineInterfCountToConnect; LineConnSide := -1; BoxConnSide := -1; GetMem(ptrConnObjSides, SizeOf(TConnectedObjectsSides)); ptrConnObjSides.IDObj1 := currCable.ID; ptrConnObjSides.IDObj2 := PointCompon.ID; GetSidesByConnectedFigures(CurrCable.ListID, PointCompon.ListID, TSCSCatalog(currCable.GetFirstParentCatalog).SCSID, TSCSCatalog(Pointcompon.GetFirstParentCatalog).SCSID, ptrConnObjSides^.Side1, ptrConnObjSides^.Side2); if ptrConnObjSides <> nil then begin LineConnSide := ptrConnObjSides.Side1; BoxConnSide := ptrConnObjSides.Side2; currCable.JoinTo(PointCompon, LineConnSide, BoxConnSide, true); FreeMem(ptrConnObjSides); ptrConnObjSides := nil; end; { if currCable.CheckJoinTo(PointCompon, 1, 0, True).CanConnect then begin // currCable.DefineInterfCountToConnect; //currCable.JoinTo(PointCompon, 1, 0, True); if currCable.JoinTo(PointCompon, 1, 0).CanConnect then; end else begin // то же самое с другой стороны if currCable.CheckJoinTo(PointCompon, 2, 0, True).CanConnect then begin // currCable.DefineInterfCountToConnect; // currCable.JoinTo(PointCompon, 2, 0, True); if currCable.JoinTo(PointCompon, 2, 0, true).CanConnect then; end; end; } end; end; end; end; end; end; end; end; end; end; // // end; end; end; end // Tolik // Если приходим к перекрестку, на котором есть коробочка, не мешало бы попробовать к ней подключиться // для тех случаев, когда она - не конечный объект в пути else begin { if F_PEAutoTraceDialog.IgnoreExistingCable.Visible and F_PEAutoTraceDialog.IgnoreExistingCable.Checked then begin} // если только две трассы - не разрываем кабель if CountLineWithCable > 2 then begin // Tolik 28/10/2019 -- if OperConnector.JoinedConnectorsList.Count > 0 then if TConnectorObject(OperConnector.JoinedConnectorsList[0]).ConnectorType = ct_NB then OperConnector := TConnectorObject(OperConnector.JoinedConnectorsList[0]); // if OperConnector.ConnectorType = ct_Nb then begin currObject := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TConnectorObject(OperConnector).ID); if currObject <> nil then begin if currObject.SCSComponents.Count > 0 then begin PointCompon := currObject.SCSComponents[0]; for i := 0 to currObject.SCSComponents.Count - 1 do begin if PointCompon.ID < currObject.SCSComponents[i].ID then PointCompon := currObject.SCSComponents[i]; end; if PointCompon <> nil then begin CanConnect := True; ConnectorJoinedLinesList.Clear; for i := 0 to OperConnector.JoinedOrtholinesList.Count - 1 do begin ConnectorJoinedLinesList.Add(TOrthoLine(OperConnector.JoinedOrtholinesList[i])); end; for i := 0 to OperConnector.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(OperConnector.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin ConnectorJoinedLinesList.Add(TOrthoLine(TConnectorObject(OperConnector.JoinedConnectorsList[i]).JoinedOrtholinesList[j])); end; end; // Здесь имеем трассы, пересекающиеся на коробке // но кабель, там где смог, уже соединился, а перекресток сюда попал уже потом, // поэтому кабель сначала нужно рассоединить, потом подключить к коробке, // а то фигня какая-то выходит ... if ConnectorJoinedLinesList.Count > 0 then begin for i := 0 to ConnectorJoinedLinesList.Count - 1 do begin currLine := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TOrthoLine(ConnectorJoinedLinesList[i]).ID); if currLine <> nil then begin //if (currObject.ID = APrevObj.ID) or (currObject.ID = ACurrObj.ID) then begin currCable := currLine.LastAddedComponent; if currCable <> nil then begin // вот тут рассоединяем кабель ... for j := i to ConnectorJoinedLinesList.Count - 1 do begin currLine := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TOrthoLine(ConnectorJoinedLinesList[j]).ID); if currLine <> nil then begin for k := 0 to currLine.ComponentReferences.Count - 1 do begin if currCable.JoinedComponents.IndexOf(currLine.ComponentReferences[k]) <> - 1 then begin currCable.DisJoinFrom(currLine.ComponentReferences[k]); end; end; end; end; // а теперь только подключим к коробке if PointCompon.JoinedComponents.IndexOf(currCable) = -1 then begin // кабель, упамши на трассу автоматом подключится, сволочь, к первой же попавшейся коробке, // поэтому, чтобы исправить данное непотребство, сначала отключим нах с этой стороны кабеля // точечные объекты for j := 0 to currObject.SCSComponents.Count - 1 do begin if currObject.SCSComponents[j].ID <> PointCompon.ID then begin if currCable.JoinedComponents.IndexOf(currObject.SCSComponents[j]) <> - 1 then currCable.DisJoinFrom(currObject.SCSComponents[j]); end; end; currCable.DefineInterfCountToConnect; PointCompon.DefineInterfCountToConnect; { if currCable.CheckJoinTo(PointCompon, 1, 0, True).CanConnect then begin // currCable.DefineInterfCountToConnect; // currCable.JoinTo(PointCompon, 1, 0, True); if currCable.JoinTo(PointCompon, 1, 0).CanConnect then; end else begin // то же самое с другой стороны if currCable.CheckJoinTo(PointCompon, 2, 0, True).CanConnect then begin //currCable.DefineInterfCountToConnect; // currCable.JoinTo(PointCompon, 2, 0, True); if currCable.JoinTo(PointCompon, 2, 0, True).CanConnect then; end; end; } LineConnSide := -1; BoxConnSide := -1; GetMem(ptrConnObjSides, SizeOf(TConnectedObjectsSides)); ptrConnObjSides.IDObj1 := currCable.ID; ptrConnObjSides.IDObj2 := PointCompon.ID; GetSidesByConnectedFigures(CurrCable.ListID, PointCompon.ListID, TSCSCatalog(currCable.GetFirstParentCatalog).SCSID, TSCSCatalog(Pointcompon.GetFirstParentCatalog).SCSID, ptrConnObjSides^.Side1, ptrConnObjSides^.Side2); if ptrConnObjSides <> nil then begin LineConnSide := ptrConnObjSides.Side1; BoxConnSide := ptrConnObjSides.Side2; currCable.JoinTo(PointCompon, LineConnSide, BoxConnSide, true); FreeMem(ptrConnObjSides); end; end; end; end; end; end; end; end; end; end; end; end; end; // // Tolik 11/03/2021 -- {if ParamsList <> nil then begin for i := 0 to ParamsList.Count - 1 do Dispose(PConnectObjectParam(ParamsList[i])); FreeAndNil(ParamsList); end;} //FreeList(ParamsList); // FreeAndNil(ParamsList); end; finally ListConnector.Free; UsedConnectorList.Free; if Assigned(ListLine) then ListLine.Free; end; end; except on E: Exception do addExceptionToLogEx('AddCabling ', E.Message); end; end; //Проверка на наличие у компонента многоразовых спареных функционалов function CheckMultiPairInterfases(ACompon: TSCSComponent; ATermBox: TSCSComponent = nil): boolean; var Interf: TSCSInterface; i: integer; TraceMultiple,TermMultiple: boolean; begin TraceMultiple := false; TermMultiple := false; Result := False; for i := 0 to ACompon.Interfaces.Count-1 do begin Interf := ACompon.Interfaces[i]; if (interf.TypeI = itFunctional) and (Interf.IDAdverse > 0) then begin if (ATermBox = nil)or(not F_PEAutoTraceDialog.PutBox_Check.Checked) then begin if (Interf.Multiple = biTrue) then begin Result := True; break; end; end else if (Interf.Multiple = biTrue) then begin TraceMultiple := true; break; end; end; end; if (ATermBox <> nil)and(F_PEAutoTraceDialog.PutBox_Check.Checked) then begin for i:= 0 to ATermBox.Interfaces.Count - 1 do begin if (ATermBox.Interfaces[i].TypeI = itFunctional)and(ATermBox.Interfaces[i].Multiple = biTrue) then begin TermMultiple := true; break; end; end; if ((TraceMultiple) and (TermMultiple))or((not TraceMultiple)and(TermMultiple))or((not TraceMultiple)and(not TermMultiple)) then Result := true else Result := false; end; end; //функции для построения дерева Function CreateData(AID, AImageIndex: integer; AIDTopComponent: integer = 0; AIdCompRel: integer = 0): TNodeData; begin Result := GetMemory(SizeOf(PNodeData)); Result.ID := AID; Result.ImageIndex := AImageIndex; Result.IDTopComponent := AIDTopComponent; Result.IdCompRel := AIdCompRel; end; function AddChild(ATree: TFlyTreeViewPro; AParentNode:TFlyNode; AChildComplects: TSCSComponents): TFlyNode; var i: integer; ParentState: integer; // Tolik 23/07/2021 -- CurrCompon: TSCSComponent; //Tolik 10/11/2015 - чтобы отсеять то, что не сможем подключить изначально Function CanAddComponToTree(ACompon, SCSCompon: TSCSComponent): Boolean; var i: Integer; ChildCompon: TSCSComponent; begin Result := False; if ACompon <> nil then begin //Tolik 09/06/2021 -- исключить УЗО //if ACompon.ComponentType.SysName = ctsnUZO then // exit; // // если включена проверка подключения по типу сети if F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.ControlJoinByNetType then begin // верхний компонент if (ACompon.GUIDNetType = SCSCompon.GUIDNetType) and (SCSCompon.CheckJoinTo(ACompon,1,0,true).CanConnect) then Result := True; if not Result then begin for i := 0 to ACompon.ChildReferences.Count - 1 do begin ChildCompon := ACompon.ChildReferences[i]; if (ChildCompon.GUIDNetType = SCSCompon.GUIDNetType) and (SCSCompon.CheckJoinTo(ChildCompon,1,0,true).CanConnect) then begin Result := True; Break; //// BREAK ////; end; end; end; end else begin // Tolik -- 11/11/2016-- { if SCSCompon.CheckJoinTo(ACompon,1,0,true).CanConnect then Result := True; if not Result then begin for i := 0 to ACompon.ChildReferences.Count - 1 do begin ChildCompon := ACompon.ChildReferences[i]; if (SCSCompon.CheckJoinTo(ChildCompon,1,0,true).CanConnect) then begin Result := True; Break; //// BREAK ////; end; end; end; } // верхний компонент if (ACompon.IDNetType in [3,5,7]) and (SCSCompon.CheckJoinTo(ACompon,1,0,true).CanConnect) then Result := True; if not Result then begin for i := 0 to ACompon.ChildReferences.Count - 1 do begin ChildCompon := ACompon.ChildReferences[i]; //if (ChildCompon.IDNetType in [3,4]) and (SCSCompon.CheckJoinTo(ChildCompon,1,0,true).CanConnect) then if (ChildCompon.IDNetType in [3,5,7]) and (SCSCompon.CheckJoinTo(ChildCompon,1,0,true).CanConnect) then begin Result := True; Break; //// BREAK ////; end; end; end; // end; end; end; begin ParentState := aParentNode.StateIndex; if AChildComplects <> nil then begin For i := 0 to AChildComplects.Count -1 do begin CurrCompon := AChildComplects[i]; // Tolik 10/11/2015 if CanAddcomponToTree(CurrCompon, F_NormBase.GSCSBase.SCSComponent) then begin // Result := Atree.Items.AddChild(AParentNode,CurrCompon.GetNameForVisible(true)); Result.ImageIndex := 5; // Tolik 09/06/2021 -- if CurrCompon.ComponentType.SysName = ctsnElCounter then begin Result.StateIndex := 1; //AParentNode.StateIndex; AParentNode.StateIndex := 3; end else if CurrCompon.ComponentType.SysName = ctsnUZO then begin Result.StateIndex := 1; //AParentNode.StateIndex; AParentNode.StateIndex := 3; end else //Result.StateIndex := AParentNode.StateIndex; Result.StateIndex := ParentState; Result.SelectedIndex := Result.ImageIndex; Result.Data := CreateData(CurrCompon.ID, 5, CurrCompon.IDTopComponent, CurrCompon.IDCompRel); if CurrCompon.ChildComplects.Count > 0 then AddChild(ATree, Result, CurrCompon.ChildComplects); end; end; end; end; Function AddNode (ATree: TFlyTreeViewPro; ACurrNode: TFlyNode; ACompon: TSCSComponent; AString: string = ''): TFlyNode; var vList: TF_Cad; begin if ACompon = Nil then begin Result := ATree.Items.Add(ACurrNode, AString); Result.Data := CreateData(-1, 33); Result.ImageIndex := 33; Result.SelectedIndex := Result.ImageIndex; Result.StateIndex := 2; end else begin vList := GetListByID(ACompon.ListID); if TNodeData(ACurrNode.Data).ID > -1 then Result := Atree.Items.Add(ACurrNode, ACompon.GetNameForVisible(true)) else Result := Atree.Items.AddChild(ACurrNode, ACompon.GetNameForVisible(true)); if GCadForm.PCad.SelectedCount > 0 then begin if GCadForm.PCad.Selection.IndexOf(GetFigureByID(vList, ACompon.GetFirstParentCatalog.SCSID)) <> -1 then Result.StateIndex := 2 else Result.StateIndex := 1; end else Result.StateIndex := 2; Result.ImageIndex := 5; Result.SelectedIndex := Result.ImageIndex; Result.Data := CreateData(ACompon.ID, 5); if ACompon.ChildComplects.Count > 0 then AddChild(ATree, Result, ACompon.ChildComplects); Atree.NodeStateRefreshParent(result, false); end; end; //прокладка кабеля от точки к конечному объекту индивидуальным кабелем function TraceIndividCableToEndPoint(AEndPoint: TList; ACurrPoint: TConnectorObject; AIdCable: integer; IgnoreExistingCable: Boolean = True): boolean; var AllTrace: TList; Counts,i, j, k: integer; ComponID: integer; JoinedConn: TConnectorObject; SortList: TList; MinValue: double; //Tolik currTraceCatalog: TSCSCatalog; SCSList: TSCSList; // Tolik 08/02/2021 -- // procedure CheckAndDelNotConnectedCable(ATraceList: TList); var i,j, ConnectCount: Integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; FInterf: TSCSInterface; CanDelCable: Boolean; begin if ATraceList <> nil then begin for i := 0 to ATraceList.Count - 1 do begin CanDelCable := False; // Tolik 08/02/2021 -- //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(ATraceList[i]).ID); SCSCatalog := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(TPowerCad(TFigure(ATraceList[i]).Owner).Owner).FCADListID); if SCSList <> nil then SCSCatalog := SCSList.GetCatalogFromReferencesBySCSID(TFigure(ATraceList[i]).ID); // if (SCSCatalog <> nil) and (SCSCatalog.IsLine = biTrue) then begin SCSComponent := SCSCatalog.LastAddedComponent; if SCSComponent <> nil then begin ConnectCount := 0; // проверяем подключение на стороне 1 for j := 0 to SCSComponent.Interfaces.Count - 1 do begin FInterf := TSCSInterface(SCSComponent.Interfaces[j]); if (FInterf.TypeI = itFunctional) and (FInterf.Side = 1) and ((FInterf.IsBusy = biTrue) or (FInterf.BusyPositions.Count > 0)) then begin Inc(ConnectCount); Break; //// BREAK ////; end; end; // проверяем подключение на стороне 2 for j := 0 to SCSComponent.Interfaces.Count - 1 do begin FInterf := TSCSInterface(SCSComponent.Interfaces[j]); if (FInterf.TypeI = itFunctional) and (FInterf.Side = 2) and ((FInterf.IsBusy = biTrue) or (FInterf.BusyPositions.Count > 0)) then begin Inc(ConnectCount); Break; //// BREAK ////; end; end; // если подключен не с обеих сторон, то семафорим, что можно удалить if ConnectCount < 2 then begin CanDelCable := true; Break; //// BREAK ////; end; end; end; end; // Если кабель где-то не подключился - удалить нах по всей трассе if CanDelCable then begin for i := 0 to ATraceList.Count - 1 do begin // Tolik 08/02/2021 -- SCSCatalog := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(TPowerCad(TFigure(ATraceList[i]).Owner).Owner).FCADListID); if SCSList <> nil then SCSCatalog := SCSList.GetCatalogFromReferencesBySCSID(TFigure(ATraceList[i]).ID); //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(ATraceList[i]).ID); // if (SCSCatalog <> nil) and (SCSCatalog.IsLine = biTrue) then begin SCSComponent := SCSCatalog.LastAddedComponent; if SCSComponent <> nil then begin //20/11/2015 -- Tolik if SCSComponent.Cypher = F_NormBase.GSCSBase.SCSComponent.Cypher then // на всякий...мало ли begin // SCSCatalog.LastAddedComponent := nil; SCSCatalog.IDLastAddedComponent := 0; F_ProjMan.DelCompon(SCSComponent, SCSComponent.TreeViewNode, True, True, True, true); end; end; end; end; F_PEAutoTraceDialog.ShowBadCableConnect := True; end; end; end; // begin try Result := False; AllTrace := Nil; if ACurrPoint.ConnectorType = ct_Clear then begin //Tolik if IgnoreExistingCable then AllTrace := GetAllTracePEInCAD(AEndPoint, JoinedConn) else // AllTrace := GetAllTracePEInCADwithoutCable(AEndPoint, ACurrPoint); // выделить трассу if AllTrace <> nil then begin for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; // скопировать кабель туда for i := 0 to AllTrace.Count - 1 do //убираем на кабеле многопарный интерфейс //Tolik //ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AIdCable); begin if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin // Tolik 08/02/2021 -- //currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(TPowerCad(TFigure(AllTrace[i]).Owner).Owner).FCADListID); currTraceCatalog := nil; if SCSList <> nil then currTraceCatalog := SCSList.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); // if currTraceCatalog <> nil then begin F_PEAutoTraceDialog.FromAutoTraceDialog := False; ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AIDCable); currTraceCatalog.LastAddedComponent.DisJoinFromAll(True, True).Free; currTraceCatalog.LastAddedComponent.DefineInterfCountToConnect; F_PEAutoTraceDialog.FromAutoTraceDialog := True; end; end; end; // // убрать выделение трассы for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).DeSelect; if AllTrace <> nil then FreeAndNil(AllTrace); Result := True; end; end else begin ACurrPoint.FDisableTracing := True; //Нужно проверить на предмет подключения начального обекта //Проверка на отсутствие подключения к многопарному интерфейсу обьекта if CheckConnectToMultiplyInterfaces(ACurrPoint.ID) then begin for Counts := 0 to ACurrPoint.JoinedConnectorsList.Count - 1 do begin SortList := TList.Create; JoinedConn := TConnectorObject(ACurrPoint.JoinedConnectorsList[Counts]); //Tolik if IgnoreExistingCable then AllTrace := GetAllTracePEInCAD(AEndPoint, JoinedConn) else AllTrace := GetAllTracePEInCADwithoutCable(AEndPoint, JoinedConn);//GetAllTracePEInCADforLamp(AEndPoint, JoinedConn); if Assigned(AllTrace)then SortList.Add(AllTrace); end; // выделить трассу if AllTrace <> nil then begin // докинуть сам объект-источник AllTrace.Insert(0, ACurrPoint); for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; // скопировать кабель туда //Tolik {for i := 1 to AllTrace.Count - 2 do begin ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AIDCable); if ComponID > 0 then begin ClearMultiplyInterfaces(TFigure(AllTrace[i]).ID); //убираем многократность из линейного интерфейса end; if (GLastIdComponent = -1) and (ComponID > 0)then begin GLastIdComponent := ComponId -1; end; end;} for i := 0 to AllTrace.Count - 1 do begin if CheckFigureByClassName(TFigure(AllTrace[i]), cTOrthoLine) then begin // Tolik 08/02/2021 -- SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(TPowerCad(TFigure(AllTrace[i]).Owner).Owner).FCADListID); currTraceCatalog := nil; if SCSList <> nil then currTraceCatalog := SCSList.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); //currTraceCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(AllTrace[i]).ID); // if currTraceCatalog <> nil then begin F_PEAutoTraceDialog.FromAutoTraceDialog := False; ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AIDCable); if ComponID > 0 then begin ClearMultiplyInterfaces(TFigure(AllTrace[i]).ID); currTraceCatalog.LastAddedComponent.DisJoinFromAll(True, True).Free; currTraceCatalog.LastAddedComponent.DefineInterfCountToConnect; F_PEAutoTraceDialog.FromAutoTraceDialog := True; if GLastIDComponent = -1 then GLastIDComponent := ComponID - 1; end; end; end; end; //будем сюда засовывать соединение кабеля + вызов вопроса нащёт коробки ConnectIndividPEObjectsByWay(AllTrace, nil{, AWorkPoint, AEndPoint}); // Tolik 10/11/2015 CheckAndDelNotConnectedCable(AllTrace); // удаляем неподключенный кабель // // убрать выделение трассы for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).DeSelect; Result := True; for i := 0 to SortList.Count -1 do TList(SortList[i]).Free; SortList.Free; end; end; ACurrPoint.FDisableTracing := False; end; except on E: Exception do AddExceptionToLogEx('U_PECommon.TraceIndividCableToEndPoint ', E.Message); end; end; // ПОЛУЧИТЬ ВСЮ ТРАССУ без учёта кабеля function GetAllTracePEInCADwithoutCable(AFigureServer: Tlist; AFigureWS: TFigure): TList; var CurrLength: Double; LastLength: Double; IDAutoTracingPropertyStr: String; CurrFigure: TFigure; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; IDCompon: ^Integer; Res: Boolean; ptrIDCompon: ^Integer; i: Integer; CurrIDPathList: TList; LastIDPathList: TList; ResultList: TList; EndObject: TFigure; ////////////////////////////////////////////////////////////////////////////// Procedure GetStepInCAD(ASourceWS: TFigure; AInOrder: TList; ATraveledIndex: Integer); var i, j: Integer; //IDConn: ^Integer; ComponLength: Double; ConnectedIDList: TList; InOrder: TList; //New FlagEndOfStep: boolean; OperFlag: Boolean; begin FlagEndOfStep := False; ComponLength := 0; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin FlagEndOfStep := CheckEndCompon(TconnectorObject(ASourceWS), AFigureServer); end; if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin // if not FlagEndOfStep then begin ComponLength := abs(TOrthoLine(ASourceWS).LineLength); if (CurrLength + ComponLength >= LastLength) and (LastLength > 0) then Exit; end; end; CurrLength := CurrLength + ComponLength; if Not FlagEndOfStep then CurrIDPathList.Add(ASourceWS); if FlagEndOfStep and ((CurrLength <= LastLength) or (LastLength = 0)) then begin //***Переприсвоить кратчайшый путь LastIDPathList.Clear; for i := 0 to CurrIDPathList.Count - 1 do begin CurrFigure := TFigure(CurrIDPathList[i]); LastIDPathList.Add(CurrFigure); end; //*** Переприсвоить кратчайшую длину LastLength := CurrLength; // ***Переприсвоить конечный обект EndObject := ASourceWS; end else {************************************************************************} begin ConnectedIDList := TList.Create; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then begin // OBJECT if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin for i := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end // Connector else if TConnectorObject(ASourceWS).ConnectorType = ct_Clear then begin for j := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[j]); ConnectedIDList.Add(JoinedConn); end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end; end; if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector1); ConnectedIDList.Add(JoinedConn); JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector2); ConnectedIDList.Add(JoinedConn); end; InOrder := TList.Create; if AInOrder <> nil then InOrder.Assign(AInOrder); InOrder.Assign(ConnectedIDList, laOr); for i := 0 to ConnectedIDList.Count - 1 do begin CurrFigure := TFigure(ConnectedIDList[i]); //if CheckNoFigureinList(CurrFigure, AInOrder) and CheckNoFigureinList(CurrFigure, CurrIDPathList) then //GetStepInCAD(CurrFigure, ConnectedIDList, ATraveledIndex + 1); //Old if ((AInOrder = nil) or ((AInOrder <> nil) and (AInOrder.IndexOf(CurrFigure) = -1))) and (CurrIDPathList.IndexOf(CurrFigure) = -1) then GetStepInCAD(CurrFigure, InOrder, ATraveledIndex + 1); end; FreeAndNil(InOrder); if ConnectedIDList <> nil then FreeAndNil(ConnectedIDList); end; CurrLength := CurrLength - ComponLength; if CurrIDPathList.Count - 1 = ATraveledIndex then CurrIDPathList.Delete(ATraveledIndex); end; ////////////////////////////////////////////////////////////////////////////// begin try Result := nil; CurrIDPathList := Tlist.Create; CurrLength := 0; LastIDPathList := Tlist.Create; LastLength := 0; GetStepInCAD(AFigureWS, nil, 0); //добавим конечный обект в конец пути LastIDPathList.Add(EndObject); ResultList := TList.Create; for i := 0 to LastIDPathList.Count - 1 do begin CurrFigure := TFigure(LastIDPathList[i]); if CheckFigureByClassName(CurrFigure, cTOrthoLine) then ResultList.Add(CurrFigure); if CheckFigureByClassName(CurrFigure, cTConnectorObject) then if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then ResultList.Add(CurrFigure); end; if ResultList.Count = 0 then FreeAndNil(ResultList) else Result := ResultList; if CurrIDPathList <> nil then FreeAndNil(CurrIDPathList); if LastIDPathList <> nil then FreeAndNil(LastIDPathList); except on E: Exception do addExceptionToLogEx('U_PECommon.GetAllTracePEInCAD', E.Message); end; end; //подключение объектов по трассе индивидуальным кабелем function ConnectIndividPEObjectsByWay(AWay: TList; APosList: TIntList = nil): Boolean; var WayObjects: TSCSCatalogs; SCSObject: TSCSCatalog; CurrObj: TSCSCatalog; PrevObj: TSCSCatalog; PrevPrevObj: TSCSCatalog; CopyObj: TSCSCatalog; CopyCompon, LastCompon: TSCSComponent; ConnectInterfRes: TConnectInterfRes; SCSCompon: TSCSComponent; //SCSCompon1: TSCSComponent; //SCSCompon2: TSCSComponent; ConnectKind: TConnectKind; WasConnect: Boolean; i, j: Integer; ptrConnObjSides: PConnectedObjectsSides; ptrPrevConnObjSides: PConnectedObjectsSides; ObjectSidesList: TList; ListEndComponsForTree: TSCSComponents; // SCSList: TSCSList; FirstPointObject: TSCSCatalog; LastPointObject: TSCSCatalog; FirstPointPort: TSCSInterface; LastPointPort: TSCSInterface; FirstPointPortInterfCount: Integer; LastPointPortInterfCount: Integer; MaxInterfCountToConnect: Integer; SCSLineComponents: TSCSComponents; FirstLineComponent: TSCSComponent; LastLineComponent: TSCSComponent; FirstLineComponentPos: Integer; LastLineComponentPos: Integer; FirstLineComponentSide: Integer; LastLineComponentSide: Integer; WasJoinedToEndPoints: Boolean; FirstLineComponentInterfaces: TSCSInterfaces; LastLineComponentInterfaces: TSCSInterfaces; FirstPointInterface: TSCSInterface; LastPointInterface: TSCSInterface; EndConnector: TConnectorObject; FlagConnect: TConnectInterfRes; FlagCabling: boolean; NameOfFirstCompon,NameOfCompon, NameOfCable: string; IDFirstCompon: integer; OperComponForGetName: TSCSComponent; function FindConnObjSides(AIDObj1, AIDObj2: Integer): PConnectedObjectsSides; var i: Integer; ptrResConnObjSides: PConnectedObjectsSides; begin Result := nil; for i := 0 to ObjectSidesList.Count - 1 do begin ptrResConnObjSides := ObjectSidesList[i]; if ((ptrResConnObjSides.IDObj1 = AIDObj1) and (ptrResConnObjSides.IDObj2 = AIDObj2)) or ((ptrResConnObjSides.IDObj1 = AIDObj2) and (ptrResConnObjSides.IDObj2 = AIDObj1)) then begin Result := ptrResConnObjSides; Break; //// BREAK //// end; end; end; function GetLineComponInterfacesForJoinToPoint(ALineComponent: TSCSComponent; APointObject: TSCSCatalog; var AlineComponSide: Integer): TSCSInterfaces; var LineComponObject: TSCSCatalog; ptrConnectedObjSides: PConnectedObjectsSides; LineComponSide: Integer; begin Result := nil; ptrConnectedObjSides := nil; LineComponSide := -1; LineComponObject := ALineComponent.GetFirstParentCatalog; if LineComponObject <> nil then ptrConnectedObjSides := FindConnObjSides(APointObject.ID, LineComponObject.ID); if ptrConnectedObjSides <> nil then begin if ptrConnectedObjSides.IDObj1 = LineComponObject.ID then LineComponSide := ptrConnectedObjSides.Side1 else if ptrConnectedObjSides.IDObj2 = LineComponObject.ID then LineComponSide := ptrConnectedObjSides.Side2; if LineComponSide <> -1 then begin Result := GetComponInterfacesBySide(ALineComponent, LineComponSide, biFalse); AlineComponSide := LineComponSide; end; end; end; begin Result := true; try //Tolik MaxInterfCountToConnect := 0; ptrConnObjSides := nil; // WayObjects := TSCSCatalogs.Create(false); ObjectSidesList := Tlist.Create; SCSLineComponents := TSCSComponents.Create(false); //ConnectInterfRes := Nil; try //SCSList := nil; SCSObject := nil; PrevObj := nil; FirstPointObject := nil; LastPointObject := nil; FirstLineComponent := nil; LastLineComponent := nil; FirstLineComponentPos := -1; LastLineComponentPos := -1; FirstPointInterface := nil; LastPointInterface := nil; for i := 0 to AWay.Count - 1 do begin WasConnect := false; PrevObj := SCSObject; SCSObject := nil; SCSObject := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(AWay[i]).ID); if Assigned(SCSObject) then begin // if SCSList = nil then // SCSList := SCSObject.GetListOwner; if SCSObject.ItemType = itSCSConnector then begin if i = 0 then FirstPointObject := SCSObject; if i = AWay.Count - 1 then LastPointObject := SCSObject; SCSObject.ReloadComponentReferences; end else if SCSObject.ItemType = itSCSLine then if SCSObject.LastAddedComponent <> nil then begin SCSLineComponents.Add(SCSObject.LastAddedComponent); if APosList <> nil then begin if i = 1 then FirstLineComponentPos := APosList[i]; if i = AWay.Count - 2 then LastLineComponentPos := APosList[i]; end; end; WayObjects.Add(SCSObject); if Prevobj <> nil then begin //New(ptrConnObjSides); GetMem(ptrConnObjSides, SizeOf(TConnectedObjectsSides)); ptrConnObjSides.IDObj1 := PrevObj.ID; ptrConnObjSides.IDObj2 := SCSObject.ID; GetSidesByConnectedFigures(PrevObj.ListID, SCSObject.ListID, PrevObj.SCSID, SCSObject.SCSID, ptrConnObjSides^.Side1, ptrConnObjSides^.Side2); ObjectSidesList.Add(ptrConnObjSides); end; //*** Разрешить соединение компонентам for j := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSCompon := SCSObject.ComponentReferences[j]; SCSCompon.DefineInterfCountToConnect; end; end; end; //Соединение первого и последнего обьектов CurrObj := nil; PrevObj := nil; PrevPrevObj := nil; for i := 0 to WayObjects.Count - 1 do begin PrevPrevObj := Nil; PrevPrevObj := PrevObj; PrevObj := nil; PrevObj := CurrObj; CurrObj := nil; CurrObj := WayObjects[i]; if PrevObj <> nil then begin if ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSLine)) or // только две линии ((PrevObj.ItemType = itSCSConnector) and (CurrObj.ItemType = itSCSLine) and (i=1)) or // первый точечный и линия ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSConnector) and (i=WayObjects.Count-1)) // Последний точечный и линия then begin ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID); // if ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSLine)) then //если последний компонент и соединять линию с линией // begin // ptrConnObjSides := FindConnObjSides(PrevObj.ID, CurrObj.ID); // if ptrConnObjSides <> nil then // ConnectPEObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, true, i = 1, i=WayObjects.Count-1); // end // else if ptrConnObjSides <> nil then begin if ((PrevObj.ItemType = itSCSLine) and (CurrObj.ItemType = itSCSLine)) then AddCabling(PrevObj, CurrObj, -1, false); ////WasConnect := ConnectWayObjects(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2); //WasConnect := true; WasConnect := ConnectPEObjectCompons(PrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, true, i = 1, i=WayObjects.Count-1); if (Result = true) and Not(WasConnect) then Result := false; end; end; if (PrevPrevObj <> Nil) then if (PrevPrevObj.ItemType = itSCSLine) and (PrevObj.ItemType = itSCSConnector) and (CurrObj.ItemType = itSCSLine) then begin ///************************************************** GetMem(ptrConnObjSides, SizeOf(TConnectedObjectsSides)); ptrConnObjSides.IDObj1 := PrevPrevObj.SCSID; ptrConnObjSides.IDObj2 := CurrObj.SCSID; GetSidesByConnectedFigures(PrevPrevObj.ListID, CurrObj.ListID, PrevPrevObj.SCSID, CurrObj.SCSID, ptrConnObjSides^.Side1, ptrConnObjSides^.Side2); ObjectSidesList.Add(ptrConnObjSides); // AddCabling(PrevPrevObj, CurrObj, -1, false); if ptrConnObjSides <> nil then WasConnect := ConnectPEObjectCompons(PrevPrevObj, CurrObj, ptrConnObjSides.Side1, ptrConnObjSides.Side2, true, false, false); end; end; { if (Not WasConnect) then //если не удалось подключить к кабелю объект, то выдаём соответствующее соообщение begin EndProgress; if (i = 1) then begin If CurrObj.ItemType = itSCSLine then begin NameOfCable := CurrObj.GetNameForVisible +'\'+ CurrObj.LastAddedComponent.GetNameForVisible(false); NameOfCompon := PrevObj.GetNameForVisible(false); MessageModal(cPEMes9 + NameOfCable + cPEMes12 + NameOfCompon, cPEMes8, MB_ICONINFORMATION); end end else if (i=WayObjects.Count-1) and (CurrObj.ItemType = itSCSConnector) then begin if PrevObj.LastAddedComponent.IsLine = biTrue then PrevObj.LastAddedComponent.LoadWholeComponent(true); if (PrevObj.LastAddedComponent.FirstIDConnectedConnCompon > 0) or (PrevObj.LastAddedComponent.LastIDConnectedConnCompon > 0) then begin if PrevObj.LastAddedComponent.FirstIDConnectedConnCompon > 0 then IDFirstCompon := PrevObj.LastAddedComponent.FirstIDConnectedConnCompon else if PrevObj.LastAddedComponent.LastIDCompon > 0 then IDFirstCompon := PrevObj.LastAddedComponent.LastIDConnectedConnCompon; for j := 0 to F_ProjMan.GSCSBase.CurrProject.ComponentReferences.Count - 1 do begin OperComponForGetName := F_ProjMan.GSCSBase.CurrProject.ComponentReferences[j]; if OperComponForGetName.ID = IDFirstCompon then begin NameOfFirstCompon := OperComponForGetName.GetNameForVisible; break; end; end; NameOfCompon := CurrObj.GetNameForVisible(false); // p //MessageModal(cPEMes14 + NameOfFirstCompon + cPEMes10 + NameOfCompon, cPEMes8, MB_ICONINFORMATION); if not GNotShowDialog1 then GNotShowDialog1 := MessageDlgWithCheck(cPEMes14 + NameOfFirstCompon + cPEMes10 + NameOfCompon, cPEMes8); end else begin NameOfCable := PrevObj.GetNameForVisible(False)+'\'+ PrevObj.LastAddedComponent.GetNameForVisible(false); NameOfCompon := CurrObj.GetNameForVisible(false); if not GNotShowDialog1 then GNotShowDialog1 := MessageDlgWithCheck(cPEMes9 + NameOfCable + cPEMes10 + NameOfCompon, cPEMes8); // MessageModal(cPEMes9 + NameOfCable + cPEMes10 + NameOfCompon, cPEMes8, MB_ICONINFORMATION); end; end; BeginProgress; end;} end; finally //if ConnectInterfRes <> nil then // FreeMemory(ConnectInterfRes); // Tolik 04/01/2020 -- { if ptrConnObjSides <> nil then Dispose(ptrConnObjSides);} if ptrConnObjSides <> nil then // иногда попадает в список, получаем двойное освобождение одной и той же памяти // с соответствующими последствиями .... begin if ObjectSidesList = nil then FreeMem(ptrConnObjSides) else if ObjectSidesList.IndexOf(ptrConnObjSides) = -1 then FreeMem(ptrConnObjSides); end; // WayObjects.Free; // Tolik -- 03/10/2017 -- //ObjectSidesList.Free; if ObjectSidesList <> nil then FreeList(ObjectSidesList); // SCSLineComponents.Free; // if SCSList <> nil then // SCSList.Free; end; except on E: Exception do AddExceptionToLog('ConnectIndividPEObjectsByWay '+E.Message); end; end; //процедура преобразования всех многократных интерфейсов на однократные последней компоненты каталога procedure ClearMultiplyInterfaces(ASCSID: integer); var Catalog: TSCSCatalog; Compon: TSCSComponent; Interf: TSCSInterface; i: integer; begin try Catalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ASCSID); if Assigned(Catalog) then begin if Assigned(Catalog.LastAddedComponent) then begin if Catalog.ItemType = itSCSLine then begin Compon := Catalog.LastAddedComponent; if Compon.IsLine = biTrue then begin if Assigned(Compon.Interfaces) then For i := 0 to Compon.Interfaces.Count - 1 do begin Interf := Compon.Interfaces[i]; if (Interf.TypeI = itFunctional) and (Interf.Multiple = biTrue)then Interf.Multiple := biFalse; end; end; end; end; end; except on E: Exception do AddExceptionToLog('ClearMultiplyInterfaces '+E.Message); end; end; function MessageDlgWithCheck(const AMsg, ACaption: string): boolean; const AddHeigth: integer = 20; var FormDlg: TForm; CurrComponent: TComponent; CurrComponName: String; i, j: Integer; ButtonOrder: TIntList; CurrButtonIndex: Integer; ButtonFromOrder: TButton; ButtonInOrderIndex: TButton; TempInt: Integer; CheckBox: TCheckBox; DELTA: INTEGER; begin Result := false; FormDlg := CreateMessageDialog(AMsg, mtInformation, [mbOK]); try try FormDlg.Caption := ACaption; FormDlg.Height := FormDlg.Height + AddHeigth; if FormDlg.Width < 260 then begin DELTA := 260 - FormDlg.Width; FormDlg.Width := 260; end else delta := 0; CheckBox := TCheckBox.Create(FormDlg); CheckBox.Parent := FormDlg; CheckBox.Height := 17;//AddHeigth; CheckBox.Width := 200; CheckBox.Left := 55;//trunc(FormDlg.Width / 2 - 100); CheckBox.Top := FormDlg.ClientHeight - AddHeigth - 45; CheckBox.Caption := cPeMes21; //CheckBox.Visible := true; CheckBox.Checked := False; // CheckBox.Alignment := taLeftJustify; for i := 0 to FormDlg.ComponentCount - 1 do begin CurrComponent := FormDlg.Components[i]; CurrComponName := AnsiUpperCase(CurrComponent.Name); if CurrComponent is TButton then begin TButton(CurrComponent).Top := TButton(CurrComponent).Top + AddHeigth; TButton(CurrComponent).Left := TButton(CurrComponent).Left + DELTA; if CurrComponName = 'OK' then TButton(CurrComponent).Caption := cBaseCommon13; end; end; except end; FormDlg.ShowModal; Result := CheckBox.Checked; finally //FreeAndNil(FormComponents); FreeAndNil(FormDlg); end; end; // запуск трасировки от выключателей к светильникам procedure StartTraceFromSwitches(ASwitchesObject, ALampObject: TList); var ListOfLamps, ListOfSwitches: TList; CurrLamp: TConnectorObject; IdCable: integer; IndLamp,i, j: integer; ComponID: Integer; isConnected: Boolean; LastCompon: TConnectorObject; WayList: TList; IDLine: Integer; IDPos: Integer; AllTrace: TList; SetLinesList: TIntList; SetLinesPos: TIntList; Counts: Integer; JoinedConn: TConnectorObject; CadCrossObject: TCadCrossObject; SortList: Tlist; MinValue: double; procedure SortObjectsAboutDistance(AWorkFigures, AEndObjects : TList; AStartIndex: integer); var count, i,j,k: integer; mindist, distance, operdist: double; IndexMinDist: integer; Pdist: ^double; DistanceList: TList; OperFigure: TConnectorObject; begin try if WayList <> nil then FreeAndNil(WayList);//Tolik 20/01/2025 -- DistanceList := TList.Create; For i := 0 to AStartIndex - 1 do DistanceList.Add(Nil); try IndexMinDist := -1; For i := 0 + AStartIndex to AWorkFigures.Count - 1 do begin distance := -1; operdist := 0; OperFigure := TConnectorObject(AWorkFigures[i]); for Count := 0 to OperFigure.JoinedConnectorsList.Count - 1 do begin //Tolik 20/01/2025 -- { WayList := Nil; } WayList := GetAllTracePEInCADforLamp(AEndObjects, Operfigure, true); if WayList <> nil then begin // operdist := TotalLength(WayList); if ((operdist <> -1) and(operdist < distance)) or (distance = -1) then distance := operdist; FreeAndNil(WayList); // Tolik 20/01/2025 -- end; end; if i = 0 + AStartIndex then begin mindist := distance; IndexMinDist := i; end; if mindist > distance then begin mindist := distance; IndexMinDist := i; end; new(Pdist); Pdist^ := distance; DistanceList.Add(Pdist); end; if IndexMinDist > -1 then begin if IndexMinDist <> 0 + AStartIndex then begin Pdist := DistanceList[IndexMinDist]; OperFigure := AWorkFigures[IndexMinDist]; DistanceList[IndexMinDist]:= DistanceList[0]; AWorkFigures[IndexMinDist] := AWorkFigures[0]; DistanceList[0 + AStartIndex] := Pdist; AWorkFigures[0 + AStartIndex] := OperFigure; end; For k := 1 + AStartIndex to AWorkFigures.Count - 1 do For i := 1 + AStartIndex to AWorkFigures.Count - 1 do begin if double(DistanceList[i-1]^) > double(DistanceList[i]^) then begin Pdist := DistanceList[i]; OperFigure := AWorkFigures[i]; DistanceList[i]:= DistanceList[i - 1]; AWorkFigures[i] := AWorkFigures[i - 1]; DistanceList[i - 1] := Pdist; AWorkFigures[i - 1] := OperFigure; end; end; end; finally For i := 1 to DistanceList.Count - 1 do begin if Assigned(DistanceList[i]) then Dispose(DistanceList[i]); end; DistanceList.Free; end; except on E: Exception do AddExceptionToLogEx('U_PECommon.StartTraceFromSwitches.SortObjectsAboutDistance ', E.Message); end; end; begin try if ASwitchesObject.Count < 1 then exit; if F_NormBase.GSCSBase.SCSComponent.ComponentType.SysName = ctsnCable then begin IdCable := F_NormBase.GSCSBase.SCSComponent.ID; end else begin exit; end; GLastIdComponent := -1; SortObjectsAboutDistance(ALampObject,ASwitchesObject, 0); for IndLamp := 0 to ALampObject.Count - 1 do begin AllTrace := Nil; CurrLamp := TConnectorObject(ALampObject[IndLamp]); if CurrLamp.ConnectorType <> ct_Clear then begin CurrLamp.FDisableTracing := True; //Нужно проверить на предмет подключения начального обекта //Проверка на отсутствие подключения к функциональному интерфейсу обьекта if CheckConnectToMultiplyInterfaces(CurrLamp.ID) then begin SortList := TList.Create; for Counts := 0 to CurrLamp.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(CurrLamp.JoinedConnectorsList[Counts]); AllTrace := GetAllTracePEInCADforLamp(ASwitchesObject, JoinedConn); if Assigned(AllTrace)then SortList.Add(AllTrace); end; if SortList.Count > 1 then begin MinValue := TotalLength(AllTrace); for i := SortList.Count-2 downto 0 do begin if TotalLength(TList(SortList[i])) < MinValue then begin AllTrace :=TList(SortList[i]); end end; end else begin if SortList.Count = 1 then AllTrace := TList(SortList[0]); end; // выделить трассу if Assigned(AllTrace)then begin // докинуть сам объект-источник if Tfigure(AllTrace[0]).ID <> CurrLamp.ID then AllTrace.Insert(0, CurrLamp); for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; // скопировать кабель туда for i := 1 to AllTrace.Count - 2 do begin ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, IdCable); if (GLastIdComponent = -1) and (ComponID > 0)then begin GLastIdComponent := ComponId -1; end; end; //будем сюда засовывать соединение кабеля + вызов вопроса нащёт коробки ConnectPEObjectsByWay(AllTrace, nil, ALampObject, ASwitchesObject, true, true); // убрать выделение трассы for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).DeSelect; for i := 0 to SortList.Count -1 do TList(SortList[i]).Free; SortList.Free; // FreeAndNil(AllTrace); end; end; CurrLamp.FDisableTracing := False; end; SortObjectsAboutDistance(ALampObject,ASwitchesObject, IndLamp); end; except on E: Exception do AddExceptionToLogEx('U_PECommon.StartTraceFromSwitches ', E.Message); end; end; //получить всю трасу с учётом последнего уложенного ID-ка кабеля function GetAllTracePEInCADforLamp(AFigureServer: TList; AFigureWS: TFigure; AForDistance: boolean = false): Tlist; var CurrLength: Double; LastLength: Double; IDAutoTracingPropertyStr: String; CurrFigure: TFigure; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; IDCompon: ^Integer; Res: Boolean; ptrIDCompon: ^Integer; i: Integer; CurrIDPathList: TList; LastIDPathList: TList; ResultList: TList; EndObject: TFigure; ////////////////////////////////////////////////////////////////////////////// Procedure GetStepInCAD(ASourceWS: TFigure; AInOrder: TList; ATraveledIndex: Integer); var i, j: Integer; //IDConn: ^Integer; ComponLength: Double; ConnectedIDList: TList; InOrder: TList; //New FlagEndOfStep: boolean; OperFlag: Boolean; begin FlagEndOfStep := False; ComponLength := 0; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin FlagEndOfStep := CheckEndCompon(TconnectorObject(ASourceWS), AFigureServer); // if not FlagEndOfStep then // FlagEndOfStep := CheckComponInListWithExc(TconnectorObject(ASourceWS), AFigureWS, TconnectorObject(AFigureWS) ); end; if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin FlagEndOfStep := CheckInsideNewCable(TOrthoLine(ASourceWS){, AIDCable}); if not FlagEndOfStep then begin ComponLength := abs(TOrthoLine(ASourceWS).LineLength); if (CurrLength + ComponLength - 1 >= LastLength) and (LastLength > -1) then Exit; end; end; CurrLength := CurrLength + ComponLength; if Not FlagEndOfStep then CurrIDPathList.Add(ASourceWS); if FlagEndOfStep and ((CurrLength <= LastLength) or (LastLength = -1)) then begin //***Переприсвоить кратчайшый путь LastIDPathList.Clear; for i := 0 to CurrIDPathList.Count - 1 do begin CurrFigure := TFigure(CurrIDPathList[i]); LastIDPathList.Add(CurrFigure); end; //*** Переприсвоить кратчайшую длину LastLength := CurrLength; // ***Переприсвоить конечный обект // if CheckFigureByClassName(ASourceWS, cTConnectorObject) then EndObject := ASourceWS; end else {************************************************************************} begin ConnectedIDList := TList.Create; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then begin // OBJECT if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin for i := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end // Connector else if TConnectorObject(ASourceWS).ConnectorType = ct_Clear then begin for j := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[j]); ConnectedIDList.Add(JoinedConn); end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end; end; if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector1); ConnectedIDList.Add(JoinedConn); JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector2); ConnectedIDList.Add(JoinedConn); end; InOrder := TList.Create; if AInOrder <> nil then InOrder.Assign(AInOrder); InOrder.Assign(ConnectedIDList, laOr); for i := 0 to ConnectedIDList.Count - 1 do begin CurrFigure := TFigure(ConnectedIDList[i]); //if CheckNoFigureinList(CurrFigure, AInOrder) and CheckNoFigureinList(CurrFigure, CurrIDPathList) then //GetStepInCAD(CurrFigure, ConnectedIDList, ATraveledIndex + 1); //Old if ((AInOrder = nil) or ((AInOrder <> nil) and (AInOrder.IndexOf(CurrFigure) = -1))) and (CurrIDPathList.IndexOf(CurrFigure) = -1) then GetStepInCAD(CurrFigure, InOrder, ATraveledIndex + 1); end; FreeAndNil(InOrder); if ConnectedIDList <> nil then FreeAndNil(ConnectedIDList); end; CurrLength := CurrLength - ComponLength; if CurrIDPathList.Count - 1 = ATraveledIndex then CurrIDPathList.Delete(ATraveledIndex); end; ////////////////////////////////////////////////////////////////////////////// begin try Result := nil; CurrIDPathList := Tlist.Create; CurrLength := 0; LastIDPathList := Tlist.Create; LastLength := -1; EndObject := Nil; GetStepInCAD(AFigureWS, nil, 0); //добавим конечный обект в конец пути if Assigned(EndObject) and (Not AForDistance) then // if CheckFigureByClassName(EndObject, cTConnectorObject) then LastIDPathList.Add(EndObject); ResultList := TList.Create; for i := 0 to LastIDPathList.Count - 1 do begin CurrFigure := TFigure(LastIDPathList[i]); if CheckFigureByClassName(CurrFigure, cTOrthoLine) then ResultList.Add(CurrFigure); if CheckFigureByClassName(CurrFigure, cTConnectorObject) then if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then ResultList.Add(CurrFigure); end; if ResultList.Count = 0 then FreeAndNil(ResultList) else Result := ResultList; if CurrIDPathList <> nil then FreeAndNil(CurrIDPathList); if LastIDPathList <> nil then FreeAndNil(LastIDPathList); except on E: Exception do addExceptionToLogEx('U_PECommon.GetAllTracePEInCADforLamp ', E.Message); end; end; //проверка наличия нового кабеля function CheckInsideNewCable(AOrthoLine: TOrthoLine{; AAnyWhere: boolean = false}): boolean; var NBGuid: string; i: integer; LineCatalog: TSCSCatalog; LineComponent: TSCSComponent; begin Result := False; LineCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(AOrthoLine.ID); if LineCatalog <> nil then begin If LineCatalog.ItemType = itSCSLine then for i := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineComponent := LineCatalog.ComponentReferences[i]; if (GLastIdComponent > -1) and (LineComponent.ID > GLastIdComponent) then begin //Проверка на наличие многоразовых спареных интерфейсов инif // if AAnyWhere then begin if LineComponent.ComponentType.SysName = ctsnCable then begin Result := true; break; end end //else // begin // if CheckMultiPairInterfases(LineComponent) then // begin // Result := true; // break; // end; // end; end; end; end else begin //if GCadForm <> nil then // GCadForm.mProtocol.Lines.Add(AOrthoLine.ClassName + ' ,ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound); ShowMessageByType(0, smtProtocol, '!!!!!! ' + AOrthoLine.ClassName + ', ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound, '', MB_ICONINFORMATION or MB_OK); addExceptionToLogEx('CheckInsideNewCable', '!!!!!! ' + AOrthoLine.ClassName + ', ID = ' + inttostr(AOrthoLine.ID) + ' (' + AOrthoLine.name + ') - ' + cNoFound ); end; end; //Проверка на наличие обьекта в списке если обьект не является обьектом исключения function CheckComponInListWithExc(ACurrObject: TConnectorObject; AEndObjects: TList; AExcObject: TConnectorObject): boolean; var CurrSCSCompon: TSCSCatalog; i: integer; begin Result := false; if ACurrObject <> AExcObject then begin CurrSCSCompon := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ACurrObject.ID); if CurrSCSCompon <> Nil then begin Result := false; for i := 0 to AEndObjects.Count - 1 do begin if (ACurrObject = AEndObjects[i]) then begin Result := True; break; end; end; end; end; end; //скрутка всех новопроложенных кабелей function MakeCablingForNewCable(AIDObjectList: Tlist): Boolean; var CatalogList: TSCSCatalogs; ComponCount: Integer; Catalog1: TSCSCatalog; Catalog2: TSCSCatalog; SCSComponent1: TSCSComponent; SCSComponent2: TSCSComponent; i, j, k, l: Integer; Side1, Side2: Integer; WasUnion: Boolean; SavedForUndo: Boolean; ListOwner: TSCSList; function GetCatalogList(AConnectObjectParams: Tlist; var AComponCount: Integer): TSCSCatalogs; var ResList: TSCSCatalogs; i: Integer; ptrConnectObjectParam: PConnectObjectParam; SCSCatalog: TSCSCatalog; function LoadCatalogInterfaces(var ACatalog: TSCSCatalog; ASide: Integer): Boolean; var SCSComponent: TSCSComponent; i, j: Integer; CurrInterCanConn: Integer; TotalInterCanConn: Integer; begin Result := false; TotalInterCanConn := 0; for i := 0 to ACatalog.ComponentReferences.Count - 1 do begin CurrInterCanConn := 0; SCSComponent := ACatalog.ComponentReferences.Items[i]; if Assigned(SCSComponent) then begin CurrInterCanConn := SCSComponent.GetInterfaceCountToConnect(ASide); if CurrInterCanConn > 0 then begin SCSComponent.ServCanConnect := true; Inc(AComponCount); SCSComponent.ServInterfCntToConnect := CurrInterCanConn; end else SCSComponent.ServCanConnect := false; TotalInterCanConn := TotalInterCanConn + CurrInterCanConn; end; end; if TotalInterCanConn > 0 then begin ACatalog.ServCanConnect := true; Result := true; end else ACatalog.ServCanConnect := false; end; begin Result := nil; ResList := TSCSCatalogs.Create(False); AComponCount := 0; for i := 0 to AConnectObjectParams.Count - 1 do begin ptrConnectObjectParam := AConnectObjectParams.Items[i]; SCSCatalog := nil; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ptrConnectObjectParam.IDObject); if Assigned(SCSCatalog) then begin if LoadCatalogInterfaces(SCSCatalog, ptrConnectObjectParam.Side) then ResList.Add(SCSCatalog); end; end; if ResList.Count = 0 then ResList.Free else Result := ResList; end; function UnionInterfaces(AInterfaces1, AInterfaces2: TSCSInterfaces): Boolean; var i, j: Integer; ptrInterface1: TSCSInterface; ptrInterface2: TSCSInterface; InterfCount: Integer; WasUnionInterf: Boolean; begin Result := false; WasUnionInterf := false; if AInterfaces1.Count < AInterfaces2.Count then InterfCount := AInterfaces1.Count else InterfCount := AInterfaces2.Count; for i := 0 to AInterfaces1.Count - 1 do begin ptrInterface1 := AInterfaces1[i]; for j := 0 to AInterfaces1.Count - 1 do begin ptrInterface2 := AInterfaces2[j]; //if CanConnectInterfaces(ptrInterface1, ptrInterface2, cnkVarious or cnkMaleMale) = chrSuccess then if (ptrInterface1.ID <> ptrInterface2.ID) and (ptrInterface1.ID_Component <> ptrInterface2.ID_Component) and (ptrInterface1.TypeI = itFunctional) and (ptrInterface2.TypeI = itFunctional) and (ptrInterface1.Side = Side1) and (ptrInterface2.Side = Side2) then begin //*** Проверить, соединен ди интерфейс с интерфейсом соединяемой компоненты if Not(ptrInterface1.CheckJoinToComponent(ptrInterface2.ComponentOwner)) and Not(ptrInterface2.CheckJoinToComponent(ptrInterface1.ComponentOwner)) then WasUnionInterf := F_ProjMan.UnionInterfaces(ptrInterface1, ptrInterface2, cnkVarious or cnkMaleMale); end; end; end; Result := WasUnionInterf; end; begin Result := false; try SavedForUndo := false; WasUnion := false; GDragPrevTickCount := GetTickCount; CatalogList := GetCatalogList(AIDObjectList, ComponCount); if CatalogList = nil then Exit; ///// EXIT ///// Screen.Cursor := crHourGlass; try //*** Если компоненты SCSComponent1 и SCSComponent2 как цельный, то разъединить for i := 0 to CatalogList.Count - 1 do begin Catalog1 := CatalogList.Items[i]; for j := 0 to Catalog1.SCSComponents.Count - 1 do begin SCSComponent1 := Catalog1.SCSComponents.Items[j]; if (SCSComponent1.ID > GLastIdComponent) and (GLastIdComponent > -1) then begin for k := 0 to CatalogList.Count - 1 do begin Catalog2 := CatalogList.Items[k]; if Catalog2.ID <> Catalog1.ID then for l := 0 to Catalog2.SCSComponents.Count - 1 do begin SCSComponent2 := Catalog2.SCSComponents.Items[l]; if SCSComponent1.ID <> SCSComponent2.ID then //*** Если компоненты SCSComponent1 и SCSComponent2 как цельный, то разъединить if SCSComponent1.Whole_ID = SCSComponent2.Whole_ID then if SCSComponent1.JoinedComponents.IndexOf(SCSComponent2) <> -1 then begin SCSComponent1.DisJoinFrom(SCSComponent2); end; end; end; end; end; end; for i := 0 to CatalogList.Count - 1 do begin Catalog1 := CatalogList.Items[i]; for j := 0 to Catalog1.SCSComponents.Count - 1 do begin SCSComponent1 := Catalog1.SCSComponents.Items[j]; if (SCSComponent1.ID > GLastIdComponent) and (GLastIdComponent > -1) then begin for k := 0 to CatalogList.Count - 1 do begin Catalog2 := CatalogList.Items[k]; if Catalog2.ID <> Catalog1.ID then for l := 0 to Catalog2.SCSComponents.Count - 1 do begin SCSComponent2 := Catalog2.SCSComponents.Items[l]; if (SCSComponent2.ID > GLastIdComponent) then begin if SCSComponent1.ID <> SCSComponent2.ID then if F_ProjMan.CanConnCompon(SCSComponent1, SCSComponent2, cntUnion, smtNone) then begin GetSidesByConnectedFigures(SCSComponent1.ListID, SCSComponent2.ListID, Catalog1.SCSID, Catalog2.SCSID, Side1, Side2); if (Side1 <> -1) and (Side2 <> -1) then begin WasUnion := UnionInterfaces(SCSComponent1.Interfaces, SCSComponent2.Interfaces); end; end; end; end; end; end; end; end; Result := WasUnion; if WasUnion then F_ProjMan.RefreshNode; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; finally Screen.Cursor := crDefault; CatalogList.Free; //FreeCatalogList(CatalogList); end; except on E: Exception do AddExceptionToLog('U_PECommon.MakeCablingForNewCable '+E.Message); end; end; procedure TestOfAllComponent; var i,j,k: integer; AllComponents: TSCSComponents; Compon: TSCSComponent; Interf: TSCSInterface; Count: integer; begin if F_ProjMan.GSCSBase.CurrProject <> nil then if F_ProjMan.GSCSBase.CurrProject.Active then if F_ProjMan.GSCSBase.CurrProject.CurrList <> nil then AllComponents := F_ProjMan.GSCSBase.CurrProject.ComponentReferences; try for i := 0 to AllComponents.Count -1 do begin Compon := AllComponents[i]; for j := 0 to Compon.Interfaces.Count -1 do begin Interf := Compon.Interfaces[j]; For k := 0 to Interf.IOfIRelOut.Count - 1 do begin if Assigned(TSCSIOfIRel(Interf.IOfIRelOut[k]).InterfaceTo) then begin try if TSCSIOfIRel(Interf.IOfIRelOut[k]).InterfaceTo.ID > 0 then EmptyProcedure; except EmptyProcedure; end; end; end; end; end; except ShowMessage('ОШИБКА_ААА!'); end; end; end.