unit U_ProjectPlan;

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_Common, FastStrings;


procedure DrawProjectPlan(aList: TF_CAD; aComponTypes: TObjectList; aDivideGroupsByJoinedNetTypes, aShowGroupContents: Boolean);
Function DrawObjectsOnProjectPlan(aList: TF_CAD; aObjCatalog: TSCSCatalog; aCabBounds: TDoubleRect; aObjectX, aObjectY: Double): TPlanObject;
procedure DrawTracesOnProjectPlan(aList: TF_CAD; aPlanProject: PPlanProject; aObjList: TObjectList);
procedure DrawTraceWay(aList: TF_CAD; aPlanProject: PPlanProject; aBegObject, aEndObject: TPlanObject; aLinesNotes: TStringList; aBegObjectType, aEndObjectType: string);

function GetListBound(aList: TF_CAD): TDoubleRect;
function GetScaleNotesToBlock(aBlockBnd, aNoteBnd: TDoubleRect): Double;
function GetBlockScale(aObject: TFigureGrp; aX, aY: double): Double;
function FindPlanObject(aList: TF_CAD; aSCSID: Integer): TPlanObject;
function CheckByPlanTrace(aX, aY: Double; aTracesList: TList): TPlanTrace;
function CheckByPlanConnector(aX, aY: Double; aCurrConn1, aCurrConn2: TPlanConnector): TPlanConnector;
function CheckPlanConnectorAtPos(aSelf: TPlanConnector; aX, aY: Double): Boolean;
function CheckTypesIdentity(aCurrBegType, aCurrEndType, aSnapBegType, aSnapEndType: string): Boolean;
// автопривязки
function CheckPlanConnectorGoesToEndObject(aEndSCSID: Integer; aPlanConnector: TPlanConnector): Boolean;
function CheckPlanTraceGoesToEndObject(aEndSCSID: Integer; aPlanTrace: TPlanTrace): Boolean;
procedure SnapToPlanConnector(aConnector, aSnapConnector: TPlanConnector);
procedure SnapToPlanTrace(aConnector: TPlanConnector; aSnapTrace: TPlanTrace);
function FindSnapOnTraceTraffic(aPlanTrace: TPlanTrace; aEndObject: TPlanObject; aBegObjectType, aEndObjectType: string): Boolean;
// создание подписи к группе трасс
procedure CreatePlanTraceCaption(aPlanTrace: TPlanTrace; aCaption: TStringList);
function GetPlanTraceAngle(aPoints1, aPoints2: TDoublePoint): Double;



implementation
uses USCS_Main, Menus, U_main, U_MasterNewList, U_AutoTraceType, U_Layers, FPlan, U_SCSObjectsProp,
  cxMemo, U_ChooseComponTypes, U_Constants;


procedure DrawProjectPlan(aList: TF_CAD; aComponTypes: TObjectList; aDivideGroupsByJoinedNetTypes, aShowGroupContents: Boolean);
var
  i, j, k: Integer;
  Bnd: TDoubleRect;
  LHandle: Integer;
  Rect: TRectangle;
  Line: TLine;
  Text: TText;
  MaketX, MaketY: Double;
  CurrProject: TSCSProject;
  StructuredLists: TSCSLists;
  ListCatalog: TSCSCatalog;

  FloorDelta: Double;
  CabDelta: Double;
  BegPosX, BegPosY: Double;
  CabBound: TDoubleRect;
  ObjGroup: TPlanObject;
  MaxX, MaxY: double;
  ptrPlanProject: PPlanProject;
  ptrPlanFloor: PPlanFloor;
  ptrPlanCabinet: PPlanCabinet;
  ConnectionsGroup: TCatalogGroupConnection;
  ObjList: TObjectList;

  NbrCircle: TCircle;
  NbrText: TText;
  CabCenter: TDoublePoint;

begin
  try
    BeginProgress;

    GCadForm.Pcad.DefaultPenColor := clNavy;
    GCadForm.PCad.DefaultPenWidth := 2;
    GCadForm.PCad.DefaultPenStyle := psSolid;

    CurrProject := F_ProjMan.GSCSBase.CurrProject;
    StructuredLists := CurrProject.GetListsFilteredByComponentTypes(aComponTypes, aDivideGroupsByJoinedNetTypes, aShowGroupContents);

    aList.CurrentLayer := 1;
    Bnd := GetListBound(aList);
    MaketX := abs(Bnd.Left - Bnd.Right);
    MaketY := abs(Bnd.Bottom - Bnd.Top);
    LHandle := aList.PCad.GetLayerHandle(1);

    Rect := TRectangle.create(Bnd.Left, Bnd.Top, Bnd.Right, Bnd.Bottom, 1, ord(psDash), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, aList.PCad);
    aList.PCad.AddCustomFigure(1, Rect, False);

    FloorDelta := MaketY / StructuredLists.Count;
    BegPosX := Bnd.Left;
    BegPosY := Bnd.Bottom;

    // Calc MaxX, MaxY
    MaxY := FloorDelta;
    MaxX := 0;
    for i := 0 to StructuredLists.Count - 1 do
    begin
      if i = 0 then
      // Tolik 16/11/2020 -- тут тоже деление на НОЛЬ исключаем...
      //  MaxX := MaketX / StructuredLists[i].ChildCatalogs.Count
      begin
        if StructuredLists[i].ChildCatalogs.Count > 0 then
          MaxX := MaketX / StructuredLists[i].ChildCatalogs.Count
        else
          MaxX := MaketX;
      end
      //
      else
      // Tolik 14/11/2020 -- тут нужно исключить деление на НОЛЬ!!!
      //if MaketX / StructuredLists[i].ChildCatalogs.Count < MaxX then
      //  MaxX := MaketX / StructuredLists[i].ChildCatalogs.Count;
      begin
      if StructuredLists[i].ChildCatalogs.Count > 0 then
        if MaketX / StructuredLists[i].ChildCatalogs.Count < MaxX then
          MaxX := MaketX / StructuredLists[i].ChildCatalogs.Count;
      end;
    end;
    // !
    New(ptrPlanProject);
    ptrPlanProject.FSizeX := MaketX;
    ptrPlanProject.FSizeY := MaketY;
    ptrPlanProject.FBounds.Left := Bnd.Left;
    ptrPlanProject.FBounds.Right := Bnd.Right;
    ptrPlanProject.FBounds.Top := Bnd.Top;
    ptrPlanProject.FBounds.Bottom := Bnd.Bottom;
    ptrPlanProject.FFloors := TList.Create;
    // !

    // ЭТАЖИ
    for i := 0 to StructuredLists.Count - 1 do
    begin
      BegPosX := Bnd.Left;
      BegPosY := BegPosY - FloorDelta;
      // !
      New(ptrPlanFloor);
      ptrPlanFloor.FSizeX := MaketX;
      ptrPlanFloor.FSizeY := FloorDelta;
      ptrPlanFloor.FBounds.Left := BegPosX;
      ptrPlanFloor.FBounds.Right := BegPosX + ptrPlanFloor.FSizeX;
      ptrPlanFloor.FBounds.Top := BegPosY;
      ptrPlanFloor.FBounds.Bottom := BegPosY + ptrPlanFloor.FSizeY;
      ptrPlanFloor.FCabinets := TList.Create;
      // !
      if i < StructuredLists.Count - 1 then
      begin
        // линию разделительную
        Line := TLine.Create(BegPosX, BegPosY, BegPosX + MaketX, BegPosY, 1, ord(psDash), clBlack, 0, LHandle, mydsNormal, aList.PCad);
        aList.PCad.AddCustomFigure(1, Line, False);
      end;
      // номер этажа
      Text := TText.Create(0, 0, 14, 8, IntToStr(i + 1), aList.FFontName, RUSSIAN_CHARSET, clGray, LHandle, mydsNormal, aList.PCad);
      Text.Move(BegPosX + 5 - Text.CenterPoint.x, BegPosY + FloorDelta / 2 - Text.CenterPoint.y);
      aList.PCad.AddCustomFigure(1, Text, False);
      Text := TText.Create(0, 0, 14, 8, IntToStr(i + 1), aList.FFontName, RUSSIAN_CHARSET, clGray, LHandle, mydsNormal, aList.PCad);
      Text.Move(BegPosX + MaketX - 5 - Text.CenterPoint.x, BegPosY + FloorDelta / 2 - Text.CenterPoint.y);
      aList.PCad.AddCustomFigure(1, Text, False);

      if StructuredLists[i].ChildCatalogs.Count > 0 then // Tolik 14/11/2020 -- исключить деление на НОЛЬ!!!
        CabDelta := MaketX / StructuredLists[i].ChildCatalogs.Count;

      // КАБИНЕТЫ
      for j := 0 to StructuredLists[i].ChildCatalogs.Count - 1 do
      begin
        ListCatalog := StructuredLists[i].ChildCatalogs[j];

        // !
        New(ptrPlanCabinet);
        ptrPlanCabinet.FSizeX := CabDelta;
        ptrPlanCabinet.FSizeY := FloorDelta;
        ptrPlanCabinet.FBounds.Left := BegPosX;
        ptrPlanCabinet.FBounds.Right := BegPosX + ptrPlanCabinet.FSizeX;
        ptrPlanCabinet.FBounds.Top := BegPosY;
        ptrPlanCabinet.FBounds.Bottom := BegPosY + ptrPlanCabinet.FSizeY;
        ptrPlanCabinet.FObjects := TList.Create;
        // !
        BegPosX := BegPosX + CabDelta;
        if j < StructuredLists[i].ChildCatalogs.Count - 1 then
        begin
          // линию разделительную
          Line := TLine.Create(BegPosX, BegPosY, BegPosX, BegPosY + FloorDelta, 1, ord(psDash), clBlack, 0, LHandle, mydsNormal, aList.PCad);
          aList.PCad.AddCustomFigure(1, Line, False);
        end;
        CabBound.Top := BegPosY;
        CabBound.Bottom := BegPosY + FloorDelta;
        CabBound.Left := BegPosX - CabDelta;
        CabBound.Right := BegPosX;
        // нарисовать номер кабинета
        CabCenter.x := (CabBound.Right + CabBound.Left) / 2;
        CabCenter.y := (CabBound.Bottom + CabBound.Top) / 2;
        NbrCircle := TCircle.Create(CabCenter.x, CabCenter.y, 6, 1, ord(psDash), clMaroon, ord(bsClear), clNone, LHandle, mydsNormal, aList.PCad);
        aList.PCad.AddCustomFigure(1, NbrCircle, False);
        NbrText := TText.Create(CabCenter.x - 1.5, CabCenter.y - 3, 6, 3, IntToStr(ListCatalog.MarkID), aList.FFontName, RUSSIAN_CHARSET, clMaroon, LHandle, mydsNormal, aList.PCad);
        aList.PCad.AddCustomFigure(1, NbrText, False);

        // ОБЪЕКТЫ ПО ТИПАМ
        for k := 0 to StructuredLists[i].ChildCatalogs[j].ChildCatalogs.Count - 1 do
        begin
          ObjGroup := DrawObjectsOnProjectPlan(aList, StructuredLists[i].ChildCatalogs[j].ChildCatalogs[k], CabBound, MaxX, MaxY);
          if k = 0 then
            ObjGroup.move(0, 0)
          else
          if k = 1 then
            ObjGroup.move(CabDelta / 2, 0)
          else
          if k = 2 then
            ObjGroup.move(0, FloorDelta / 2)
          else
          if k = 3 then
            ObjGroup.move(CabDelta / 2, FloorDelta / 2)
          else
            ObjGroup.move(CabDelta / 2, FloorDelta / 2);
          ObjGroup.FSCSID := StructuredLists[i].ChildCatalogs[j].ChildCatalogs[k].SCSID;
          ObjGroup.FFloorNumber := i;
          ObjGroup.FCabNumber := j;
          ptrPlanCabinet.FObjects.Add(ObjGroup);
        end;
        ptrPlanFloor.FCabinets.Add(ptrPlanCabinet);
      end;
      ptrPlanProject.FFloors.Add(ptrPlanFloor);
    end;

    ObjList := TObjectList(CurrProject.GetPlanJoining(StructuredLists));
    // ПРОВЕСТИ ТРАССЫ
    DrawTracesOnProjectPlan(aList, ptrPlanProject, ObjList);

    // Tolik -- 09/03/2017 -- утечка памяти -- нужно освободить занятую память !!!
    {for i := 0 to ObjList.Count - 1 do
    begin
      ConnectionsGroup := TCatalogGroupConnection(ObjList[i]);

      ConnectionsGroup.Free;
    end;}

    {
    for i := (ObjList.Count - 1) downto 0 do
    begin
      ConnectionsGroup := TCatalogGroupConnection(ObjList[i]);
      ObjList.Remove(ConnectionsGroup);
      ConnectionsGroup.Free;
    end; }

    ObjList.Clear;
    ObjList.Free; // -- объекты

    // структура проекта
    for i := 0 to ptrPlanProject.FFloors.Count - 1 do
    begin
      ptrPlanFloor := ptrPlanProject.FFloors[i];
      for j := 0 to ptrPlanFloor.FCabinets.Count - 1 do
      begin
        ptrPlanCabinet := ptrPlanFloor.FCabinets[j];
        ptrPlanCabinet.FObjects.Clear;
        FreeAndNil(ptrPlanCabinet.FObjects);
        FreeMem(ptrPlanCabinet);
      end;
      ptrPlanFloor.FCabinets.clear;
      FreeAndNil(ptrPlanFloor.FCabinets);
      FreeMem(ptrPlanFloor);
    end;
    ptrPlanProject.FFloors.Clear;
    FreeAndNil(ptrPlanProject.FFloors);
    FreeMem(ptrPlanProject);
    //
    FreeAndNil(StructuredLists);
    RefreshCAD(aList.PCad);
    aList.CurrentLayer := 1;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.UpdateProjectPlan', E.Message);
  end;
  EndProgress;
end;

function DrawObjectsOnProjectPlan(aList: TF_CAD; aObjCatalog: TSCSCatalog; aCabBounds: TDoubleRect; aObjectX, aObjectY: Double): TPlanObject;
var
  i, j, k: Integer;
  Stream: TMemoryStream;
  NotesList: TStringList;
  GroupName: String;
  GroupCount: Integer;
  LHandle: Integer;
  TotalFigure: TPlanObject;
  Block: TBlock;
  Rect: TRectangle;
  BlockBnd: TDoubleRect;
  BlockX, BlockY: double;
  NoteBnd: TDoubleRect;
  NoteX, NoteY: double;
  ScaleDelta: Double;
  NotesGroup: TRichText;
  TM: TTextMetric;
  xCanvas: TMetafileCanvas;
  h, w: double;
  BlockCP: TDoublePoint;
  NeedCP: TDoublePoint;
begin
  try
    Result := nil;
    LHandle := aList.PCad.GetLayerHandle(1);
    Stream := aObjCatalog.GetObjectIcon(ieBlk);
    GroupName := aObjCatalog.Name;
    NotesList := aObjCatalog.Notes;
    GroupCount := aObjCatalog.ChildCatalogs.Count;
    if Stream <> nil then
    begin
      Block := TBlock(aList.PCad.InsertBlockFromStream(1, Stream, -100, -100));
    end
    else
    begin
      Rect := TRectangle.create(-100, -100, -100 + 18, -100 + 12,  2, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, aList.PCad);
      Block := TBlock.Create(LHandle, aList.PCad);
      Block.AddFigure(Rect);
      aList.PCad.AddCustomFigure(1, Block, False);
    end;

    // масштабирование УО
    BlockBnd := Block.GetBoundRect;
    BlockX := abs(BlockBnd.Left - BlockBnd.Right);
    BlockY := abs(BlockBnd.Top - BlockBnd.Bottom);
    ScaleDelta := GetBlockScale(Block, aObjectX, aObjectY);
    Block.Scale(ScaleDelta, ScaleDelta);
    RefreshCAD(aList.PCad);
    BlockBnd := Block.GetBoundRect;
    BlockX := abs(BlockBnd.Left - BlockBnd.Right);
    BlockY := abs(BlockBnd.Top - BlockBnd.Bottom);

    {==========================================================================}
    for k := 14 downto 1 do
    begin
      NotesGroup := TRichText.create(-100, -100, -100, -100,
                                     1, ord(psSolid), clBlue, ord(bsClear), clBlack, LHandle, mydsNormal, aList.PCad);
      NotesGroup.re.Font.Size := k;
      NotesGroup.RE.Lines.Clear;
      for i := 0 to NotesList.Count - 1 do
      begin
        NotesList[i] := FastReplace(NotesList[i],#13#10,' ');
        NotesGroup.re.Lines.Add(NotesList[i]);
      end;

      aList.PCad.AddCustomFigure(1, NotesGroup, False);
      RefreshCAD(aList.PCad);
      // получить свойства

      // Tolik
      NotesGroup.ttMetaFile:= TMetaFile.Create;
      NotesGroup.ttMetafile.Enhanced := True;

      xCanvas := TMetafileCanvas.Create(NotesGroup.ttMetafile, 0);
      xCanvas.Font.Name := NotesGroup.re.Font.Name;
      xCanvas.Font.Size := NotesGroup.re.Font.Size;
      GetTextMetrics(xCanvas.Handle, TM);
      h := TM.tmHeight / 4 * NotesGroup.re.Lines.Count + 1;
      w := 0;
      for i := 0 to NotesGroup.re.Lines.Count - 1 do
      begin
        if w < xCanvas.TextWidth(NotesGroup.Re.Lines[i]) then
          w := xCanvas.TextWidth(NotesGroup.Re.Lines[i]);
      end;
      w := (w + 3) / 4 ;
      FreeAndNil(xCanvas);
      NotesGroup.ttMetaFile.Free;
      // пересоздать с новыми свойствами
      if NotesGroup <> nil then
      begin
        aList.PCad.Figures.Remove(NotesGroup);
        FreeAndNil(NotesGroup);
      end;
      if (k = 1) or (w < BlockX) and (h < BlockY) then
      begin
        NotesGroup := TRichText.create(-100, -100, -100 + w, -100 + h,
                                       1, ord(psSolid), clBlue, ord(bsClear), clBlack, LHandle, mydsNormal, aList.PCad);
        NotesGroup.re.Font.Size := k;
        NotesGroup.RE.Lines.Clear;
        for i := 0 to NotesList.Count - 1 do
        begin
          NotesList[i] := FastReplace(NotesList[i],#13#10,' ');
          NotesGroup.re.Lines.Add(NotesList[i]);
        end;
        RefreshCAD(aList.PCad);
        Break;
      end;
    end;
    {==========================================================================}

    // подгонка подписи под УО
    BlockBnd := Block.GetBoundRect;
    BlockCP.x := BlockBnd.Left + BlockX / 2;
    BlockCP.y := BlockBnd.Top + BlockY / 2;
    NotesGroup.Move(BlockCP.x - NotesGroup.CenterPoint.x, BlockCP.y - NotesGroup.CenterPoint.y);

    // в общий объект
    TotalFigure := TPlanObject.create(LHandle, aList.PCad);
    TotalFigure.AddFigure(Block);
    TotalFigure.AddFigure(NotesGroup);
    Result := TPlanObject(aList.PCad.AddCustomFigure(1, TotalFigure, False));
    if Block <> nil then
      aList.PCad.Figures.Remove(Block);

    // смещение Result объекта
    BlockBnd := Result.GetBoundRect;
    BlockX := abs(BlockBnd.Left - BlockBnd.Right);
    BlockY := abs(BlockBnd.Top - BlockBnd.Bottom);
    Result.FSizeX := BlockX;
    Result.FSizeY := BlockY;
    Result.Deselect;
    Result.move(aCabBounds.Left - Result.CenterPoint.x + BlockX / 2 + 2, aCabBounds.Top - Result.CenterPoint.y + BlockY / 2 + 2);
    NeedCP := GetCoordsWithSnapToGrid(Result.CenterPoint.x, Result.CenterPoint.y);
    Result.move(NeedCP.x - Result.CenterPoint.x, NeedCP.y - Result.CenterPoint.y);
    RefreshCAD(aList.PCad);
    FreeAndNil(Stream);
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.DrawObjectsOnProjectPlan', E.Message);
  end;
end;

procedure DrawTracesOnProjectPlan(aList: TF_CAD; aPlanProject: PPlanProject; aObjList: TObjectList);
var
  i: integer;
  aConnectionsGroup: TCatalogGroupConnection;
  BegCatalog: TSCSCatalog;
  EndCatalog: TSCSCatalog;
  Lines: TSCSCatalogs;
  BegObject: TPlanObject;
  EndObject: TPlanObject;
  LinesNotes: TStringList;
  BegObjectType, EndObjectType: string;
begin
  try
    for i := 0 to aObjList.Count - 1 do
    begin
      aConnectionsGroup := TCatalogGroupConnection(aObjList[i]);
      BegCatalog := aConnectionsGroup.BeginCatalogGroup;
      EndCatalog := aConnectionsGroup.EndCatalogGroup;
      LinesNotes := aConnectionsGroup.LinesNote;
      BegObject := FindPlanObject(aList, BegCatalog.SCSID);
      EndObject := FindPlanObject(aList, EndCatalog.SCSID);
      BegObjectType := BegCatalog.GUIDComponentType;
      EndObjectType := EndCatalog.GUIDComponentType;
      if (BegObject <> nil) and (EndObject <> nil) then
        DrawTraceWay(aList, aPlanProject, BegObject, EndObject, LinesNotes, BegObjectType, EndObjectType);
    end;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.DrawTracesOnProjectPlan', E.Message);
  end;
end;

procedure DrawTraceWay(aList: TF_CAD; aPlanProject: PPlanProject; aBegObject, aEndObject: TPlanObject; aLinesNotes: TStringList; aBegObjectType, aEndObjectType: string);
var
  i, j, k: Integer;
  x1, x2, y1, y2: Double;
  PlanTrace1, PlanTrace2, PlanTrace3: TPlanTrace;
  Conn1, Conn2, Conn3, Conn4: TPlanConnector;
  LHandle: Integer;
  CabBounds: TDoubleRect;
  CabPosX: Double;
  deltato: Double;

begin
  try
    CabBounds := PPlanCabinet(PPlanFloor(aPlanProject.FFloors[aBegObject.FFloorNumber]).FCabinets[aBegObject.FCabNumber]).FBounds;
    CabPosX := abs(CabBounds.Right - CabBounds.Left) / 2;
    CabPosX := CabPosX + abs(CabBounds.Right - CabBounds.Left) * aBegObject.FCabNumber + aPlanProject.FBounds.Left;
    LHandle := aList.PCad.GetLayerHandle(1);

    // Correct BeginEnd Objects Pos
    if aBegObject.FFloorNumber = aEndObject.FFloorNumber then
      if abs(aBegObject.CenterPoint.y - aEndObject.CenterPoint.y) < 1 then
        aBegObject.move(0, 1);

    // начинать вправо
    if aBegObject.CenterPoint.x < CabPosX then
    begin
      x1 := aBegObject.CenterPoint.x + aBegObject.FSizeX / 2;
      y1 := aBegObject.CenterPoint.y;

      x2 := CabPosX;
      y2 := y1;
      if abs(x1 - x2) < 5 then
      begin
        if x1 < x2 then
          x2 := x1 + 5
        else
          x2 := x1 - 5;
      end;
    end
    else
    // влево
    begin
      x1 := aBegObject.CenterPoint.x - aBegObject.FSizeX / 2;
      y1 := aBegObject.CenterPoint.y;

      x2 := CabPosX;
      y2 := y1;
      if abs(x1 - x2) < 5 then
      begin
        if x1 < x2 then
          x2 := x1 + 5
        else
          x2 := x1 - 5;
      end;
    end;
    x1 := GetCoordXWithSnapToGrid(x1);
    y1 := GetCoordXWithSnapToGrid(y1);
    x2 := GetCoordXWithSnapToGrid(x2);
    y2 := GetCoordXWithSnapToGrid(y2);


    // Connector1
    Conn1 := TPlanConnector.Create(x1, y1, 0, LHandle, mydsNormal, aList.PCad);
    Conn1.FBegSCSID := aBegObject.FSCSID;
    Conn1.FEndSCSID := aEndObject.FSCSID;
    Conn1.FBegType := aBegObjectType;
    Conn1.FEndType := aEndObjectType;
    Conn1.ConnectorType := ct_Clear;
    aList.PCad.AddCustomFigure (1, Conn1, False);
    // DELETE FROM PM
//    if Conn1.Selected then
//      Conn1.Deselect;
//    DeleteObjectFromPM(Conn1.ID, Conn1.Name);

    aBegObject.JoinedConnectors.Add(Conn1);
    Conn1.JoinedPlanObject := aBegObject;
    Conn1.LockSelect := True;
    Conn1.LockModify := True;

    // Trace1
    PlanTrace1 := TPlanTrace.create(x1, y1, x2, y2, 2, ord(psSolid), clNavy, 0, LHandle, mydsNormal, aList.PCad);
    PlanTrace1.FBegSCSID := aBegObject.FSCSID;
    PlanTrace1.FEndSCSID := aEndObject.FSCSID;
    PlanTrace1.FBegType := aBegObjectType;
    PlanTrace1.FEndType := aEndObjectType;
    aList.PCad.AddCustomFigure(1, PlanTrace1, False);
    // Connector2
    Conn2 := TPlanConnector.Create(x2, y2, 0, LHandle, mydsNormal, aList.PCad);
    Conn2.FBegSCSID := aBegObject.FSCSID;
    Conn2.FEndSCSID := aEndObject.FSCSID;
    Conn2.FBegType := aBegObjectType;
    Conn2.FEndType := aEndObjectType;
    Conn2.ConnectorType := ct_Clear;
    aList.PCad.AddCustomFigure (1, Conn2, False);
    // DELETE FROM PM
//    if Conn2.Selected then
//      Conn2.Deselect;
//    DeleteObjectFromPM(Conn2.ID, Conn1.Name);

    PlanTrace1.SetJConnector1(Conn1);
    SetConnBringToFront(Conn1);
    PlanTrace1.SetJConnector2(Conn2);
    CreatePlanTraceCaption(PlanTrace1, aLinesNotes);
    // FindSnapLine
    if aBegObjectType <> aEndObjectType then
    begin
      if FindSnapOnTraceTraffic(PlanTrace1, aEndObject, aBegObjectType, aEndObjectType) then
        Exit;
    end;
    // если в точке начала - спустить на 1
    while CheckPlanConnectorAtPos(Conn1, Conn1.ActualPoints[1].x, Conn1.ActualPoints[1].y) do
    begin
      if Conn1 <> nil then
        Conn1.move(0, 3);
      if Conn2 <> nil then
        Conn2.move(0, 3);
//      PlanTrace1.Move(0, 3);
    end;

    // Trace2
    x1 := Conn2.ActualPoints[1].x;
    y1 := Conn2.ActualPoints[1].y;
    x2 := x1;
    y2 := aEndObject.CenterPoint.y;
    x2 := GetCoordXWithSnapToGrid(x2);
    y2 := GetCoordXWithSnapToGrid(y2);
    if abs(y1 - y2) < 1 then
      y2 := y1 + 1;

    PlanTrace2 := TPlanTrace.create(x1, y1, x2, y2, 2, ord(psSolid), clNavy, 0, LHandle, mydsNormal, aList.PCad);
    PlanTrace2.FBegSCSID := aBegObject.FSCSID;
    PlanTrace2.FEndSCSID := aEndObject.FSCSID;
    PlanTrace2.FBegType := aBegObjectType;
    PlanTrace2.FEndType := aEndObjectType;
    aList.PCad.AddCustomFigure (1, PlanTrace2, False);
    // Connector3
    Conn3 := TPlanConnector.Create(x2, y2, 0, LHandle, mydsNormal, aList.PCad);
    Conn3.FBegSCSID := aBegObject.FSCSID;
    Conn3.FEndSCSID := aEndObject.FSCSID;
    Conn3.FBegType := aBegObjectType;
    Conn3.FEndType := aEndObjectType;
    Conn3.ConnectorType := ct_Clear;
    aList.PCad.AddCustomFigure (1, Conn3, False);
    // DELETE FROM PM
//    if Conn3.Selected then
//      Conn3.Deselect;
//    DeleteObjectFromPM(Conn3.ID, Conn1.Name);

    PlanTrace2.SetJConnector1(Conn2);
    SetConnBringToFront(Conn2);
    PlanTrace2.SetJConnector2(Conn3);
    // LineCorrect
    if (aEndObject.IsPointIn(Conn2.ActualPoints[1].x, Conn2.ActualPoints[1].y)) or (aEndObject.IsPointIn(Conn3.ActualPoints[1].x, Conn3.ActualPoints[1].y)) then
    begin
      if PlanTrace1.ActualPoints[1].x < PlanTrace1.ActualPoints[2].x then
      begin
        deltato := aEndObject.CenterPoint.x + aEndObject.FSizeX / 2 + 5;
        deltato := GetCoordXWithSnapToGrid(deltato);
        PlanTrace2.Move(deltato - Conn3.ActualPoints[1].x, 0);
      end
      else
      begin
        deltato := aEndObject.CenterPoint.x - aEndObject.FSizeX / 2 + 5;
        deltato := GetCoordXWithSnapToGrid(deltato);
        PlanTrace2.Move(deltato - Conn3.ActualPoints[1].x, 0);
      end;
    end;
    // FindSnapLine
    if aBegObjectType <> aEndObjectType then
    begin
      if FindSnapOnTraceTraffic(PlanTrace2, aEndObject, aBegObjectType, aEndObjectType) then
        Exit;
    end;

    // Trace3
    CabPosX := Conn3.ActualPoints[1].x;
    // налево
    if aEndObject.CenterPoint.x < CabPosX then
    begin
      x1 := Conn3.ActualPoints[1].x;
      y1 := Conn3.ActualPoints[1].y;
      x2 := aEndObject.CenterPoint.x + aEndObject.FSizeX / 2;
      y2 := y1;
    end
    else
    // направо
    begin
      x1 := Conn3.ActualPoints[1].x;
      y1 := Conn3.ActualPoints[1].y;
      x2 := aEndObject.CenterPoint.x - aEndObject.FSizeX / 2;
      y2 := y1;
    end;
    PlanTrace3 := TPlanTrace.create(x1, y1, x2, y2, 2, ord(psSolid), clNavy, 0, LHandle, mydsNormal, aList.PCad);
    PlanTrace3.FBegSCSID := aBegObject.FSCSID;
    PlanTrace3.FEndSCSID := aEndObject.FSCSID;
    PlanTrace3.FBegType := aBegObjectType;
    PlanTrace3.FEndType := aEndObjectType;
    aList.PCad.AddCustomFigure (1, PlanTrace3, False);
    // Connector4
    Conn4 := TPlanConnector.Create(x2, y2, 0, LHandle, mydsNormal, aList.PCad);
    Conn4.FBegSCSID := aBegObject.FSCSID;
    Conn4.FEndSCSID := aEndObject.FSCSID;
    Conn4.FBegType := aBegObjectType;
    Conn4.FEndType := aEndObjectType;
    Conn4.ConnectorType := ct_Clear;
    aList.PCad.AddCustomFigure (1, Conn4, False);
    // DELETE FROM PM
//    if Conn4.Selected then
//      Conn4.Deselect;
//    DeleteObjectFromPM(Conn4.ID, Conn4.Name);

    PlanTrace3.SetJConnector1(Conn3);
    SetConnBringToFront(Conn3);
    PlanTrace3.SetJConnector2(Conn4);
    SetConnBringToFront(Conn4);
    // LineCorrect
    if aBegObjectType <> aEndObjectType then
    begin
      if FindSnapOnTraceTraffic(PlanTrace3, aEndObject, aBegObjectType, aEndObjectType) then
        Exit;
    end;
    // если в точке конца трассы - спустить на 1
    while CheckPlanConnectorAtPos(Conn4, Conn4.ActualPoints[1].x, Conn4.ActualPoints[1].y) do
    begin
      if Conn3 <> nil then
        Conn3.move(0, 3);
      if Conn4 <> nil then
        Conn4.move(0, 3);
//      PlanTrace3.Move(0, 3);
    end;

    aEndObject.JoinedConnectors.Add(Conn4);
    Conn4.JoinedPlanObject := aEndObject;
    Conn4.LockSelect := True;
    Conn4.LockModify := True;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.DrawTraceWay', E.Message);
  end;
end;

function FindPlanObject(aList: TF_CAD; aSCSID: Integer): TPlanObject;
var
  i: integer;
begin
  try
    Result := nil;
    for i := 0 to aList.PCad.FigureCount - 1 do
    begin
      if CheckFigureByClassName(TFigure(aList.PCad.Figures[i]), cTPlanObject) then
      begin
        if TPlanObject(aList.PCad.Figures[i]).FSCSID = aSCSID then
          Result := TPlanObject(aList.PCad.Figures[i]);
      end;
    end;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.FindPlanObject', E.Message);
  end;
end;

function GetListBound(aList: TF_CAD): TDoubleRect;
var
  ListWidth, Listheight: double;
  ListBottomParam: double;
  step: double;
  LeftBound, RightBound, TopBound, BottomBound: double;
begin
  try
    Result := DoubleRect(0, 0, 0, 0);
    ListWidth := AList.PCad.WorkWidth;
    ListHeight := AList.PCad.WorkHeight;
    if AList.FCadStampType = stt_simple then
      ListBottomParam := 15
    else
    if AList.FCadStampType = stt_extended then
      ListBottomParam := 40
    else
    if AList.FCadStampType = stt_detailed then
      ListBottomParam := 55;
    step := aList.PCad.GridStep;

    TopBound := 25;
    LeftBound := 30;
    RightBound := aList.PCad.WorkWidth - 15;
    BottomBound := aList.PCad.WorkHeight - 20 - ListBottomParam;

    Result.Top := GetCoordYWithSnapToGrid(TopBound);
    Result.Left := GetCoordXWithSnapToGrid(LeftBound);
    Result.Right := GetCoordYWithSnapToGrid(RightBound);
    Result.Bottom := GetCoordYWithSnapToGrid(BottomBound);

  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.GetListBound', E.Message);
  end;
end;

function GetBlockScale(aObject: TFigureGrp; aX, aY: double): Double;
var
  BlockBnd: TDoubleRect;
  BlockX, BlockY: double;
  CabX, CabY: Double;
  px, py: double;
begin
  try
    Result := 0;
    BlockBnd := aObject.GetBoundRect;
    BlockX := abs(BlockBnd.Left - BlockBnd.Right);
    BlockY := abs(BlockBnd.Top - BlockBnd.Bottom);
    CabX := aX;
    CabY := aY;
    px := (CabX - 6) / BlockX / 2;
    py := (CabY - 6) / BlockY / 2;
    if px < py then
      Result := px
    else
      Result := py;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.GetBlockScale', E.Message);
  end;
end;

function GetScaleNotesToBlock(aBlockBnd, aNoteBnd: TDoubleRect): Double;
var
  BlockX, BlockY: double;
  NoteX, NoteY: double;
  LimitNoteX, LimitNoteY: double;
  KoefScaleX, KoefScaleY: double;
begin
  try
    Result := 0;
    BlockX := abs(aBlockBnd.Left - aBlockBnd.Right);
    BlockY := abs(aBlockBnd.Top - aBlockBnd.Bottom);
    NoteX := abs(aNoteBnd.Left - aNoteBnd.Right);
    NoteY := abs(aNoteBnd.Top - aNoteBnd.Bottom);
    LimitNoteX := BlockX - 2;
    LimitNoteY := BlockY - 2;
    KoefScaleX := LimitNoteX / NoteX;
    KoefScaleY := LimitNoteY / NoteY;
    if KoefScaleX < KoefScaleY then
      Result := KoefScaleX
    else
      Result := KoefScaleY;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.ScaleNotesToBlock', E.Message);
  end;
end;

function CheckByPlanTrace(aX, aY: Double; aTracesList: TList): TPlanTrace;
var
  i: integer;
  CurFigure: TFigure;
begin
  try
    Result := nil;
    for i := 0 to GCadForm.PCad.FigureCount - 1 do
    begin
      CurFigure := TFigure(GCadForm.PCad.Figures[i]);
      if CheckFigureByClassName(CurFigure, cTPlanTrace) then
      begin
        if CheckNoFigureInList(CurFigure, aTracesList) then
          if TPlanTrace(CurFigure).IsPointIn(aX, aY) then
            Result := TPlanTrace(CurFigure);
      end;
    end;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckByPlanTrace', E.Message);
  end;
end;

function CheckByPlanConnector(aX, aY: Double; aCurrConn1, aCurrConn2: TPlanConnector): TPlanConnector;
var
  i: integer;
  CurFigure: TFigure;
begin
  try
    Result := nil;
    for i := 0 to GCadForm.PCad.FigureCount - 1 do
    begin
      CurFigure := TFigure(GCadForm.PCad.Figures[i]);
      if CheckFigureByClassName(CurFigure, cTPlanConnector) then
      begin
        if TPlanConnector(CurFigure).IsPointIn(aX, aY) then
          if (aCurrConn1 <> TPlanConnector(CurFigure)) and (aCurrConn2 <> TPlanConnector(CurFigure)) then
            if TPlanConnector(CurFigure).JoinedPlanObject = nil then
              Result := TPlanConnector(CurFigure);
      end;
    end;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckByPlanConnector', E.Message);
  end;
end;

function CheckPlanConnectorAtPos(aSelf: TPlanConnector; aX, aY: Double): Boolean;
var
  i: Integer;
  CurFigure: TFigure;
begin
  try
    Result := false;
    for i := 0 to GCadForm.PCad.FigureCount - 1 do
    begin
      CurFigure := TFigure(GCadForm.PCad.Figures[i]);
      if CheckFigureByClassName(CurFigure, cTPlanConnector) then
      begin
        if TPlanConnector(CurFigure) <> aSelf then
          if TPlanConnector(CurFigure).IsPointIn(aX, aY) then
            if TPlanConnector(CurFigure).JoinedPlanObject <> nil then
              Result := True;
      end;
    end;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckPlanConnectorAtPos', E.Message);
  end;
end;

function CheckTypesIdentity(aCurrBegType, aCurrEndType, aSnapBegType, aSnapEndType: string): Boolean;
begin
  try
    Result := false;
    if ((aCurrBegType = aSnapBegType) and (aCurrEndType = aSnapEndType)) or
       ((aCurrBegType = aSnapEndType) and (aCurrEndType = aSnapBegType)) then
      Result := True;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckTypesIdentity', E.Message);
  end;
end;

function CheckPlanConnectorGoesToEndObject(aEndSCSID: Integer; aPlanConnector: TPlanConnector): Boolean;
var
  i: integer;
  CurTrace: TPlanTrace;
begin
  try
    Result := false;
    if aEndSCSID = aPlanConnector.FEndSCSID then
      Result := true
    else
      Result := false;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckPlanConnectorGoesToEndObject', E.Message);
  end;
end;

function CheckPlanTraceGoesToEndObject(aEndSCSID: Integer; aPlanTrace: TPlanTrace): Boolean;
begin
  try
    Result := false;
    if aEndSCSID = aPlanTrace.FEndSCSID then
      Result := true
    else
      Result := false;
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CheckPlanTraceGoesToEndObject', E.Message);
  end;
end;

procedure SnapToPlanConnector(aConnector, aSnapConnector: TPlanConnector);
var
  i, j: integer;
  NewDeltaX, NewDeltaY: double;
  OLine: TPlanTrace;

begin
  try
    aConnector.Name := aSnapConnector.Name;
    // вычисление разницы в координатах для соединения обьектов
    NewDeltaX := ASnapConnector.ActualPoints[1].x - AConnector.ActualPoints[1].x;
    NewDeltaY := ASnapConnector.ActualPoints[1].y - AConnector.ActualPoints[1].y;
    AConnector.ActualPoints[1] := DoublePoint(ASnapConnector.ActualPoints[1].x, ASnapConnector.ActualPoints[1].y);

    for i := 0 to AConnector.JoinedTraces.Count - 1 do
    begin
      if AConnector = TPlanTrace(AConnector.JoinedTraces[i]).JoinObject1 then
      begin
        TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1] := DoublePoint(
                   TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1].x + NewDeltaX,
                   TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1].y + NewDeltaY);
      end;
      if AConnector = TPlanTrace(AConnector.JoinedTraces[i]).JoinObject2 then
      begin
        TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2] := DoublePoint(
                   TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2].x + NewDeltaX,
                   TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2].y + NewDeltaY);
      end;
    end;

    for i := 0 to ASnapConnector.JoinedTraces.Count - 1 do
    begin
      OLine := TPlanTrace(ASnapConnector.JoinedTraces[i]);
      if OLine.JoinObject1 = ASnapConnector then
      begin
        OLine.SetJConnector1(AConnector);
      end;
      if OLine.JoinObject2 = ASnapConnector then
      begin
        OLine.SetJConnector2(AConnector);
      end;
    end;
    aSnapConnector.JoinedTraces.Clear;
    aSnapConnector.Delete;
    RefreshCAD(GCadForm.PCad);
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.SnapToPlanConnector', E.Message);
  end;
end;

procedure SnapToPlanTrace(aConnector: TPlanConnector; aSnapTrace: TPlanTrace);
var
  i, j: integer;
  NewDeltaX, NewDeltaY: double;
  AddLine: TPlanTrace;
  NextConnector: TFigure;
  Modx, Mody, NextModx, NextMody: Double;
  DeltaHeight: Double;
  JoinedConn: TPlanConnector;

begin
  try
    NextConnector := aSnapTrace.JoinObject2;
    if aSnapTrace.ActualPoints[1].x = aSnapTrace.ActualPoints[2].x then
    begin
      NewDeltaY := 0;
      NewDeltaX := aSnapTrace.ActualPoints[1].x - AConnector.ActualPoints[1].x;
      AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x + NewDeltaX, AConnector.ActualPoints[1].y);
    end
    else
    if aSnapTrace.ActualPoints[1].y = aSnapTrace.ActualPoints[2].y then
    begin
      NewDeltaX := 0;
      NewDeltaY := aSnapTrace.ActualPoints[1].y - AConnector.ActualPoints[1].y;
      AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x, AConnector.ActualPoints[1].y + NewDeltaY);
    end
    else
    begin
      NewDeltaX := 0;
      NewDeltaY := 0;
      AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x + NewDeltaX, AConnector.ActualPoints[1].y + NewDeltaY);
    end;

    for i := 0 to AConnector.JoinedTraces.Count - 1 do
    begin
      if AConnector = TPlanTrace(AConnector.JoinedTraces[i]).JoinObject1 then
      begin
        TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1] := DoublePoint(
          TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1].x + NewDeltaX,
          TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[1].y + NewDeltaY);
      end;
      if AConnector = TPlanTrace(AConnector.JoinedTraces[i]).JoinObject2 then
      begin
        TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2] := DoublePoint(
          TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2].x + NewDeltaX,
          TPlanTrace(AConnector.JoinedTraces[i]).ActualPoints[2].y + NewDeltaY);
      end;
    end;
    // вычисление точек модификации
    Modx := (AConnector.ActualPoints[1].x + AConnector.ActualPoints[2].x) / 2;
    Mody := (AConnector.ActualPoints[1].y + AConnector.ActualPoints[2].y) / 2;
    NextModx := (NextConnector.ActualPoints[1].x + NextConnector.ActualPoints[2].x) / 2;
    NextMody := (NextConnector.ActualPoints[1].y + NextConnector.ActualPoints[2].y) / 2;
    // При соединении конектора с линией, создается 2 линии
    // переназначение связей линии к которой присоединились новому коннектору
    aSnapTrace.ActualPoints[2] := DoublePoint(Modx, Mody);
    aSnapTrace.SetJConnector2(AConnector);
    TPlanConnector(NextConnector).JoinedTraces.Remove(aSnapTrace);
    AddLine := TPlanTrace.Create(Modx, Mody, NextModx, NextMody,
                                 aSnapTrace.width, ord(aSnapTrace.Style), aSnapTrace.Color, 0, aSnapTrace.LayerHandle, mydsNormal, GCadForm.PCad);
    GCadForm.PCad.AddCustomFigure (GLN(aSnapTrace.LayerHandle), AddLine, false);
    // присвоить связи новой ортолинии
    AddLine.SetJConnector1(AConnector);
    AddLine.SetJConnector2(NextConnector);
    SetConnBringToFront(AConnector);

    AddLine.FBegSCSID := aSnapTrace.FBegSCSID;
    AddLine.FEndSCSID := aSnapTrace.FEndSCSID;
    RefreshCAD(GCadForm.PCad);
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.SnapToPlanTrace', E.Message);
  end;
end;

function FindSnapOnTraceTraffic(aPlanTrace: TPlanTrace; aEndObject: TPlanObject; aBegObjectType, aEndObjectType: string): Boolean;
var
  i: integer;
  CheckConnector: TPlanConnector;
  CheckTrace: TPlanTrace;
  Conn1, Conn2: TPlanConnector;
  CheckedX, CheckedY: double;
  x1, x2, y1, y2: double;
  step: double;
  TracesList: TList;
begin
  try
    Result := false;
    TracesList := TList.create;
    Conn1 := TPlanConnector(aPlanTrace.JoinObject1);
    Conn2 := TPlanConnector(aPlanTrace.JoinObject2);
    for i := 0 to Conn1.JoinedTraces.Count - 1 do
      TracesList.Add(Conn1.JoinedTraces[i]);
    for i := 0 to Conn2.JoinedTraces.Count - 1 do
      TracesList.Add(Conn2.JoinedTraces[i]);

    // CHECK BY SNAP !!!
    step := GCadForm.PCad.GridStep;
    CheckedX := Conn2.ActualPoints[1].x;
    CheckedY := Conn2.ActualPoints[1].y;

    // по X
    if abs(aPlanTrace.ActualPoints[1].y - aPlanTrace.ActualPoints[2].y) < 0.1 then
    begin
      x1 := aPlanTrace.ActualPoints[1].x;
      x2 := aPlanTrace.ActualPoints[2].x;
      // путь идет вправо
      if aPlanTrace.ActualPoints[1].x < aPlanTrace.ActualPoints[2].x then
      begin
        while x1 <= x2 do
        begin
          CheckConnector := CheckByPlanConnector(x1, CheckedY, Conn1, Conn2);
          CheckTrace := CheckByPlanTrace(x1, CheckedY, TracesList);
          if CheckConnector <> nil then
          begin
            if CheckPlanConnectorGoesToEndObject(aEndObject.FSCSID, CheckConnector) then
            begin
              if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckConnector.FBegType, CheckConnector.FEndType) then
              begin
                Conn2.move(x1 - Conn2.ActualPoints[1].x, 0);
                SnapToPlanConnector(Conn2, CheckConnector);
                Result := true;
                // Tolik -- 09/03/2017 -- утечка памяти
                TracesList.Free;
                //
                exit;
              end;
            end;
          end
          else
          if CheckTrace <> nil then
          begin
            if CheckPlanTraceGoesToEndObject(aEndObject.FSCSID, CheckTrace) then
            begin
              if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckTrace.FBegType, CheckTrace.FEndType) then
              begin
                Conn2.move(x1 - Conn2.ActualPoints[1].x, 0);
                SnapToPlanTrace(Conn2, CheckTrace);
                Result := true;
                // Tolik -- 09/03/2017 -- утечка памяти
                TracesList.Free;
                //
                exit;
              end;
            end;
          end;
          x1 := x1 + step;
        end;
      end
      else
      // путь идет влево
      if aPlanTrace.ActualPoints[1].x > aPlanTrace.ActualPoints[2].x then
      begin
        while x1 >= x2 do
        begin
          CheckConnector := CheckByPlanConnector(x1, CheckedY, Conn1, Conn2);
          CheckTrace := CheckByPlanTrace(x1, CheckedY, TracesList);
          if CheckConnector <> nil then
          begin
            if CheckPlanConnectorGoesToEndObject(aEndObject.FSCSID, CheckConnector) then
            begin
              if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckConnector.FBegType, CheckConnector.FEndType) then
              begin
                Conn2.move(x1 - Conn2.ActualPoints[1].x, 0);
                SnapToPlanConnector(Conn2, CheckConnector);
                Result := true;
                // Tolik -- 09/03/2017 -- утечка памяти
                TracesList.Free;
                //
                exit;
              end;
            end;
          end
          else
          if CheckTrace <> nil then
          begin
            if CheckPlanTraceGoesToEndObject(aEndObject.FSCSID, CheckTrace) then
            begin
              if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckTrace.FBegType, CheckTrace.FEndType) then
              begin
                Conn2.move(x1 - Conn2.ActualPoints[1].x, 0);
                SnapToPlanTrace(Conn2, CheckTrace);
                Result := true;
                // Tolik -- 09/03/2017 -- утечка памяти
                TracesList.Free;
                //
                exit;
              end;
            end;
          end;
          x1 := x1 - step;
        end;
      end
    end
    else
    // по Y
    if abs(aPlanTrace.ActualPoints[1].x - aPlanTrace.ActualPoints[2].x) < 0.1 then
    begin
      y1 := aPlanTrace.ActualPoints[1].y;
      y2 := aPlanTrace.ActualPoints[2].y;
      // путь идет вниз
      if aPlanTrace.ActualPoints[1].y < aPlanTrace.ActualPoints[2].y then
      begin
        while y1 <= y2 do
        begin
          CheckConnector := CheckByPlanConnector(CheckedX, y1, Conn1, Conn2);
          CheckTrace := CheckByPlanTrace(CheckedX, y1, TracesList);
          if CheckConnector <> nil then
          begin
            if CheckPlanConnectorGoesToEndObject(aEndObject.FSCSID, CheckConnector) then
            begin
              if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckConnector.FBegType, CheckConnector.FEndType) then
              begin
                Conn2.move(0, y1 - Conn2.ActualPoints[1].y);
                SnapToPlanConnector(Conn2, CheckConnector);
                Result := true;
                // Tolik -- 09/03/2017 -- утечка памяти
                TracesList.Free;
                //
                exit;
              end;
            end;
          end
          else
          if CheckTrace <> nil then
          begin
            if CheckPlanTraceGoesToEndObject(aEndObject.FSCSID, CheckTrace) then
            begin
              if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckTrace.FBegType, CheckTrace.FEndType) then
              begin
                Conn2.move(0, y1 - Conn2.ActualPoints[1].y);
                SnapToPlanTrace(Conn2, CheckTrace);
                Result := true;
                // Tolik -- 09/03/2017 -- утечка памяти
                TracesList.Free;
                //
                exit;
              end;
            end;
          end;
          y1 := y1 + step;
        end;
      end
      else
      // путь идет вверх
      if aPlanTrace.ActualPoints[1].y > aPlanTrace.ActualPoints[2].y then
      begin
        while y1 >= y2 do
        begin
          CheckConnector := CheckByPlanConnector(CheckedX, y1, Conn1, Conn2);
          CheckTrace := CheckByPlanTrace(CheckedX, y1, TracesList);
          if CheckConnector <> nil then
          begin
            if CheckPlanConnectorGoesToEndObject(aEndObject.FSCSID, CheckConnector) then
            begin
              if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckConnector.FBegType, CheckConnector.FEndType) then
              begin
                Conn2.move(0, y1 - Conn2.ActualPoints[1].y);
                SnapToPlanConnector(Conn2, CheckConnector);
                Result := true;
                // Tolik -- 09/03/2017 -- утечка памяти
                TracesList.Free;
                //
                exit;
              end;
            end;
          end
          else
          if CheckTrace <> nil then
          begin
            if CheckPlanTraceGoesToEndObject(aEndObject.FSCSID, CheckTrace) then
            begin
              if CheckTypesIdentity(aBegObjectType, aEndObjectType, CheckTrace.FBegType, CheckTrace.FEndType) then
              begin
                Conn2.move(0, y1 - Conn2.ActualPoints[1].y);
                SnapToPlanTrace(Conn2, CheckTrace);
                Result := true;
                // Tolik -- 09/03/2017 -- утечка памяти
                TracesList.Free;
                //
                exit;
              end;  
            end;
          end;
          y1 := y1 - step;
        end;
      end
    end
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.FindSnapOnTraceTraffic', E.Message);
  end;
end;

procedure CreatePlanTraceCaption(aPlanTrace: TPlanTrace; aCaption: TStringList);
var
  i: Integer;
  LHandle: Integer;
  NoteBnd: TDoubleRect;
  CaptionGroup: TRichText;
  TM: TTextMetric;
  xCanvas: TMetafileCanvas;
  h, w: double;
  TraceCP: TDoublePoint;
  MvAngle: Double;
  Bnd: TDoubleRect;
begin
  try
    LHandle := GCadForm.PCad.GetLayerHandle(1);
    CaptionGroup := TRichText.create(-100, -100, -100, -100,
                                     1, ord(aPlanTrace.Style), aPlanTrace.color, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad);
    CaptionGroup.re.Font.Size := 6;
    CaptionGroup.re.Font.Color := aPlanTrace.color;
    CaptionGroup.re.Lines.Clear;
    for i := 0 to aCaption.Count - 1 do
    begin
      aCaption[i] := FastReplace(aCaption[i],#13#10,' ');
      CaptionGroup.re.Lines.Add(aCaption[i]);
    end;

    GCadForm.PCad.AddCustomFigure(1, CaptionGroup, False);
    RefreshCAD(GCadForm.PCad);
    // получить свойства

    // Tolik
    CaptionGroup.ttMetaFile:= TMetaFile.Create;
    CaptionGroup.ttMetafile.Enhanced := True;

    xCanvas := TMetafileCanvas.Create(CaptionGroup.ttMetafile, 0);
    xCanvas.Font.Name := CaptionGroup.re.Font.Name;
    xCanvas.Font.Size := CaptionGroup.re.Font.Size;
    GetTextMetrics(xCanvas.Handle, TM);
    h := TM.tmHeight / 4 * CaptionGroup.re.Lines.Count + 1;
    w := 0;
    for i := 0 to CaptionGroup.re.Lines.Count - 1 do
    begin
      if w < xCanvas.TextWidth(CaptionGroup.Re.Lines[i]) then
        w := xCanvas.TextWidth(CaptionGroup.Re.Lines[i]);
    end;
    w := (w + 3) / 4 ;
    FreeAndNil(xCanvas);
    CaptionGroup.ttMetaFile.Free;
    // пересоздать с новыми свойствами
    if CaptionGroup <> nil then
    begin
      GCadForm.PCad.Figures.Remove(CaptionGroup);
      FreeAndNil(CaptionGroup);
    end;
    CaptionGroup := TRichText.create(-100, -100, -100 + w, -100 + h,
                                     1, ord(aPlanTrace.Style), aPlanTrace.color, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad);
    CaptionGroup.re.Font.Size := 6;
    CaptionGroup.re.Font.Color := aPlanTrace.color;    
    CaptionGroup.re.Lines.Clear;
    for i := 0 to aCaption.Count - 1 do
    begin
      aCaption[i] := FastReplace(aCaption[i],#13#10,' ');
      CaptionGroup.re.Lines.Add(aCaption[i]);
    end;
    TraceCP.x := (aPlanTrace.ActualPoints[1].x + aPlanTrace.ActualPoints[2].x) / 2;
    TraceCP.y := (aPlanTrace.ActualPoints[1].y + aPlanTrace.ActualPoints[2].y) / 2;
    CaptionGroup.Move(TraceCP.x - CaptionGroup.CenterPoint.x, TraceCP.y - CaptionGroup.CenterPoint.y);
    CaptionGroup.Move(0, - h / 2);

    MvAngle := GetPlanTraceAngle(aPlanTrace.ActualPoints[1], aPlanTrace.ActualPoints[2]);
    MvAngle := MvAngle * pi / 180;
    CaptionGroup.Rotate(MvAngle, CaptionGroup.CenterPoint);
    aPlanTrace.Caption := CaptionGroup;
    GCadForm.PCad.AddCustomFigure(1, aPlanTrace.Caption, False);
    RefreshCAD(GCadForm.PCad);
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.CreatePlanTraceCaption', E.Message);
  end;
end;

function GetPlanTraceAngle(aPoints1, aPoints2: TDoublePoint): Double;
var
  Len_X, Len_Y: Double;
  AngleA: Double;
  Degree: Double;
begin
  try
    Result := 0;
    Degree := 0;
    Len_X := aPoints1.x - aPoints2.x;
    Len_Y := aPoints1.y - aPoints2.y;
    if Len_X = 0 then
      Len_X := 0.001;
    Degree := ArcTan(Len_Y / Len_X) * 180 / pi;     // в градусах
    Degree := round(Degree);
    if Degree = 90 then
      Degree := -90;
    Result :=  Degree / 180 * pi;                   // в радианах
  except
    on E: Exception do AddExceptionToLogEx('U_ProjectPlan.GetPlanTraceAngle', E.Message);
  end;
end;

end.