admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 09:35:40 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/SRC/SCSNormBase/U_PECommon.pas
Anatoly d7204c6898 First_commit
2025-05-13 16:51:40 +03:00

8552 lines
342 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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.
Reference in New Issue View Git Blame Copy Permalink