unit U_ArchClasses;

interface

uses Forms, StdCtrls, SysUtils, Classes, ComCtrls, Windows, Controls, Contnrs, ExtCtrls, Messages, Dialogs, Math, TypInfo,
     U_Common_Classes, U_SCSComponent, U_SCSLists, U_BaseCommon, PCDrawing, DrawObjects, fplan, PCTypesUtils, PowerCad, U_BaseConstants, U_Constants;


type
  TWallDivPath = class;
  TRoomWallRect = class;
  //TBrickWallRect = class;
  TWallPolyPath = class;

  TArchEngine = class;
  TArchExport = class;

  TWallDivPath = class(TWallPath)
    class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override;
  end;

  TRoomWallRect = class(TWallRect)
    class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override;
  end;
  //TBrickWallRect = class(TRoomWallRect)
  //end;

  TWallPolyPath = class(TPolyLine)
    class function CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure;override;
  end;

  TArchEngine = class(TObject)
    private
      FCADToSetTool: TForm;
      FClassSetTool: TFigureClass;
      FToolData: LongInt;

      FInsertingObjectType: Integer;
      FInsertingObjectCount: Integer;
      FInsrtedPointsID: TIntList;
      FInsrtedCorners: TSCSComponents;

      FLookedPointsOnScale: TList;
      FLookedPointNetsOnScale: TList;
      FSavedLookedPointsOnScale: TList;
      FScaleObjectCount: Integer;
      FNetsToDefHeights: TList;

      FLastObjsSizes: TStringsHash;

      FTimerSetTool: TTimer;
      FTimerDefNetHeights: TTimer;
      function CreateTimer(AInterval: Integer; AOnTimer: TNotifyEvent): TTimer;
      procedure FOnTimer(Sender: TObject);
      procedure FOnTimerDefNetHeights(Sender: TObject);
    public
      FDeletingObject: TObject;
      FGroupingMode: Boolean;
      FIsExporting: Boolean;
      FExport: TArchExport;
      FPrevSelCADObj: TObject;

      FLastObjTiltAngle: Double; // Угол наклона объекта для которого подгружали переметры

      procedure BeginExport;
      procedure EndExport;
      procedure AfterLoadProps(AObject: TObject);
      function GetLastDoorObjSize(aDoorObjType: TDoorObjType; aDefVal: Double): Double;
      function GetLastObjSize(const aKey: String; aDefVal: Double): Double;
      // Tolik -- 09/11/2017 --
      function GetLastObjParam(const aKey: String): boolean;
      //
      function OnAddPoint(Sender: TNet; aTrgPath: TNetPath; APoint: PDoublePoint; AID: Integer): Integer;
      procedure OnAfterDivPath(Sender: TObject);
      procedure OnAutoAddPath(Sender: TObject; SrcPath, NewPath: TNetPath);
      procedure OnBeforeDivPath(Sender: TObject);
      procedure OnDblClick(Sender: TObject);
      function OnDefineJoinedNets(Sender: TNet; ANetList, ACheckNetList, AResJoined: TList): Boolean;
      function OnDefineMoveObjects(Sender: TNet; Apt: PDoublePoint; APath: TNetPath; ANetList: TList; AllowNear: Boolean=true): Boolean;
      procedure OnDoorChangePathQuery(Sender: TNetDoor; APath, ANewPath: TNetPath; var CanChange: Boolean);
      procedure OnDeleteObj(Sender: TObject);
      function OnDeletePoint(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer;
      procedure OnDuplicate(SrcObj, NewObj: TObject);
      function OnGetHeight(Sender: TObject): Double;
      function OnGetHeightOfPt(Sender: TObject; pt: PDoublePoint): Double;
      procedure OnGetPathCheckOverlapMargin(Sender: TNet; Path, PathChk: TNetPath; var aMargin: Double);
      procedure OnMovePath(Sender: TObject);
      procedure OnMergeNetPathsQuery(Sender: TNet; var CanMerge: Boolean);
      procedure OnMergeNetsQuery(ANet1, ANet2: TNet; var CanMerge: Boolean);
      procedure OnMergePaths(AMainPath, APath: TNetPath); //13.01.2011
      procedure OnMergePathsQuery(APath1, APath2: TNetPath; var CanMerge: Boolean);
      procedure OnMove(Sender: TObject);
      procedure OnMoveJoinedPoints(Sender: TObject);
      function OnMovePoint(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer;
      procedure OnPathsOverlapQuery(APath, ACheckPath: TNetPath; Apt: PDoublePoint; var ACanOverlap: Boolean);
      procedure OnResize(Sender: TObject);
      procedure OnScaleAfter(Sender: TObject);
      procedure OnScaleBefore(Sender: TObject);
      procedure OnScale(Sender: TObject; PercentX, PercentY: Double; rPoint: PDoublePoint);
      procedure OnSetScale(Sender: TObject; OldScale, NewScale: Double);
      procedure OnSelectObj(Sender: TObject);
      function OnSelectPoint(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer;
      procedure SetLastDoorObjSize(aDoorObjType: TDoorObjType; aVal: Double);
      procedure SetLastObjSize(const aKey: String; aVal: Double);
      //Tolik 09/11/2017 --
      procedure SetLastObjParam(const aKey: String; aVal: string);
      //
      constructor Create;
      destructor Destroy; override;
      procedure AddNetToDefHeights(ANet: TObject); // Добавляет TNet на определение высот внутри других контуров
      // Выполняется перед началом вкидки объекта, нужно например для того,
      // когда добавляется УГОЛ стены нужно знать для какого он типа объекта - просто перестенок, стена комнаты, стена кир.стены
      procedure BeginInsertObject(AObjectType: Integer);
      procedure EndInsertObject(AID: Integer=0);
      procedure SetHandlersToObj(AObject: TObject);
      procedure SetRoomWallRectTool(ACAD: TForm);
  end;

  TArchObjPropExp = class(TMyObject)
    FCaption: String;
    FObjectSN: String;
    FPropsSN: TStringList; // сист.имена свойств, которые будут суммироваться в группе
                           // - первым в списке будет свойство из которого создается этот объект
    FGroupPropsSN: TStringList; // сист.имена свойств, по которым будет идти группировка
    FGroupedObjects: TObjectList; // сгруппированные объекты
    FObjectPropsSN: TStringList; // остальные сист.имена свойств, которые пойдут в объект SC
    FAllObjectPropsSN: TStringList; // весь перечень свойств, которые пойдут в объект SC

    FPropsCorrespond: TStringList; // соответствие систюимене свойств арх.объектов и SC

    procedure AddPropCorrespond(const AArchPropSN, ASCPropSN: String);
    function AddGrpPropObj(const APropSN: string; AValue: string='0'): TStringList;
    procedure AddPropValToGrp(const AGrpPropSN, AGrpVal, APropSN: String; AVal: Double);
    function GetGrpObj(const AGrpPropSN, AGrpVal: String): TStringList; // Вернет групповой объект-StringList по названию и знач. свойства 
    constructor Create;
    destructor Destroy; override;
    procedure DefineAllProps;
  end;

  TArchExport = class
    private
      TmpCompon: TSCSComponent;
    public
      FMaterilaRemainsGrp: TArchObjPropExp;
      FMaterilaRemains: TStringList;
      FScaleKoeff: Double;

      constructor Create;
      destructor Destroy; override;

      // Добавить материал в остатки
      function AddMaterialToRemains(AMatType: Integer; AWidth, AHeight, ARemainsMinUseSize: Double; ACount: Integer): Boolean;
      procedure AddPropToKey(const APropSN, AVal: String; var AKey: String);
      // Проверяет может ли использоваться остаток в зависимости от высоты материала
      function CanUseRemainByPercent(ARemainsH, AMatHeight: Double): Boolean;
      // Вернет процент, по которому определяем что остаток м.б. учтен если он не меньше высоты материала по этому проценту  
      function GetHeightPersentToRemains(AHeight: Double): Double;
      function GetMaterilaRemainsIndex(AMatType: Integer; AWidth: Double; AKey: Pointer=nil): Integer;
      // Вычитать материал из остатков - вернет кол-во вычтенных
      function RemoveMaterialFromRemains(AMatType: Integer; AWidth, AHeight, ARemainsMinUseSize: Double; ACount: Integer): Integer;
      procedure Clear;
  end;


implementation

uses U_ArchCommon, U_Main, U_CAD, U_Common, PCDrawBox;

{ TWallDivPath }

class function TWallDivPath.CreateFromShadow(aOwner: TComponent;
  LHandle: Integer; Shadow: TFigure): TFigure;
var
  CAD: TForm;
  points: TDoublePointArr;
  pt: TDoublePoint;
  NextPt: TDoublePoint;
  NextPtExists: Boolean;
  i, j, k: Integer;

  TrgNet: TNet;
  NetRegionPathsPoints: TDoublePointArr;
  PathsPoints: TDoublePointArr;
  IsRoomOut: Boolean;

  Path: TNetPath;

  DefArchWallInfo: TArchWallInfo;
  ArchWallDivInfo: TArchWallDivInfo;
  TryCount: Integer;
  ip1, ip2, op1, op2: TDoublePoint;
  //27.08.2012 ipt: TPoint;
  //27.08.2012 dx,dy,z: Double;
  PathFullConture: TDoublePointArr;
  DirectionKoef: Integer;
  PollyRegion: Integer;
  PathWidthInt: Integer;
begin
//  Result := inherited CreateFromShadow(aOwner, LHandle, Shadow);
  result := nil;
  try
    // *UNDO*
    //if GCadForm.FCanSaveForUndo then
    //begin
    //  GCadForm.SaveForUndo(uat_None, True, False);
    //  GCadForm.FCanSaveForUndo := False;
    //end;
    CAD := TForm(TPowerCad(aOwner).Owner);
    TF_CAD(CAD).BeginSaveForUndo(uat_None, True, False);

    if TWallPath(Shadow).valid and assigned(ActiveNet) then
    begin
      //10.04.2012 - значение по умолчанию
      DefArchWallInfo := TArchWallInfo(GetArchObjDefaultParams(ctArhWallDivision));
      if DefArchWallInfo = nil then
        DefArchWallInfo := TArchWallInfo(GetArchObjDefaultParams(ctArhWall));
      //ActiveNet.MakePath(points)
      ArchWallDivInfo := TArchWallDivInfo.Create(nil);
      ArchWallDivInfo.Thickness := 0.1;
      if DefArchWallInfo <> nil then
      begin
        ArchWallDivInfo.Height := DefArchWallInfo.Height;
        if DefArchWallInfo is TArchWallDivInfo then
        begin
          ArchWallDivInfo.Thickness := DefArchWallInfo.Thickness;
          ArchWallDivInfo.Coordz := TArchWallDivInfo(DefArchWallInfo).Coordz;
        end;
      end;

      while (Shadow.PointCount > 1) and EQDP(Shadow.FigurePoints[Shadow.PointCount], Shadow.FigurePoints[Shadow.PointCount - 1]) do
      begin
        Shadow.PointCount := Shadow.PointCount - 1;
      end;

      TrgNet := nil;
      IsRoomOut := false;
      SetLength(Points, Shadow.PointCount{-1});
      SetLength(NetRegionPathsPoints, 0);
      For i := 1 to Shadow.PointCount{-1} do
      begin
        pt := Shadow.FigurePoints[i];
        Points[i - 1] := pt;
        NextPtExists := false;
        if i < Shadow.PointCount then
        begin
          NextPt := Shadow.FigurePoints[i+1];
          NextPtExists := true;
        end
        else if i > 1 then
        begin
          NextPt := Shadow.FigurePoints[1];
          NextPtExists := true;
        end;

        if i = 1 then
        begin
          TrgNet := GetRoomNetByPoint(Points[i - 1], GCadForm);
          // Если не нашли кабинет, в котором должен рисоваться перестенок
          if TrgNet = nil then
          begin
            IsRoomOut := true;
            Break; //// BREAK ////
          end
          else
            // набор координат стен, образующих комнату
            GetNetRegionPathPoints(TrgNet, nil, NetRegionPathsPoints);
        end;

        if TrgNet <> nil then
        begin
          {//27.08.2012
          dx := pt.x;
          dy := pt.y;
          z := 0;
          TrgNet.XDrawEngine.ConvertPoint(dx,dy,z);
          ipt := Point(round(dx),round(dy));}

          //10.04.2012 - Если точка входит в сегмент, то сместить на внутренний край сегмента
          TryCount := 0; //10.04.2012 - цыкл два раза, так как точка может быть в углу, тогда нужно по вертикали и горизонтали
          //11.04.2012 for j := 0 to TrgNet.Paths.Count - 1 do
          for j := 0 to TrgNet.Paths.Count - 1 do
          begin
            Path := TrgNet.Paths[j];
            //Path.DefineInOutPoints;
            //if Path.IsPointIn(pt.x, pt.y) then

            // pa1-pa2 определяем как более длинная линия чем pb1-pb2
            {pa1 := Path.a1;
            pa2 := Path.a2;
            pb1 := Path.b1;
            pb2 := Path.b2;
            if GetLineLength(Path.a1, Path.a2) < GetLineLength(Path.b1, Path.b2) then
            begin
              pa1 := Path.b1;
              pa2 := Path.b2;
              pb1 := Path.a1;
              pb2 := Path.a2;
            end;}
            {Path.DefineInOutPoints;
            pa1 := Path.op1^;
            pa2 := Path.op2^;
            pb1 := Path.ip1^;
            pb2 := Path.ip2^;}
            //DirectionKoef := GetParallelPointDirectionKoeff(pa1, pa2, pb1);
            //GetParallelPoints(pa1, pa2, pb1, pb2, DirectionKoef * Path.Width);
            ////GetParallelPoints(Path.p1^, Path.p2^, pa1, pa2, Path.Width/2);
            ////GetParallelPoints(Path.p1^, Path.p2^, pb1, pb2, -1*Path.Width/2);
            //PollyRegion := TPCDrawing(aOwner).Dengine.PolygonRegion(pa1, pa2, pb2, pb1);
            ////if PointInPolyRect(pt, Path.ip1^, Path.ip2^, Path.op2^, Path.op1^) then
            //PollyRegion := TPCDrawing(aOwner).Dengine.PolygonRegion(Path.GetFullConture);
            //if ptInRegion(PollyRegion, ipt.x, ipt.y) then
            //  EmptyProcedure;
            //DeleteObject(PollyRegion);
          end;

          EmptyProcedure;
          for j := TrgNet.Paths.Count - 1 downto 0 do
          begin
            Path := TrgNet.Paths[j];
            PollyRegion := TPCDrawing(aOwner).Dengine.PolygonRegion(Path.GetFullConture);
            //if Path.IsPointIn(pt.x, pt.y) then
            //27.08.2012 if ptInRegion(PollyRegion, ipt.x, ipt.y) then
            if TrgNet.XDrawEngine.IsPointInRegion(PollyRegion, @pt) then
            begin
              Path.DefineInOutPoints;
              ip1 := Path.ip1^;
              ip2 := Path.ip2^;
              op1 := Path.op1^;
              op2 := Path.op2^;
              if Not Path.FIsConture and NextPtExists then
              begin
                // Проверяем какая точка сегмента ближе к второй точке
                if GetLineLenght(Path.ip1^, NextPt) > GetLineLenght(Path.op1^, NextPt) then
                begin
                  ip1 := Path.op1^;
                  ip2 := Path.op2^;
                  op1 := Path.ip1^;
                  op2 := Path.ip2^;
                end;
              end;
              if ArchWallDivInfo.Thickness > 0 then
              begin
                // Опред. направление к внешним точкам (будем его использовать как обратное с * -1)
                //27.08.2012 DirectionKoef := GetParallelPointDirectionKoeff(Path.ip1^, Path.ip2^, Path.op1^);
                //27.08.2012 GetParallelPoints(Path.ip1^, Path.ip2^, ip1, ip2, -1 * DirectionKoef * (ArchWallDivInfo.Thickness*0.5) *(1000/ TPowerCad(TrgNet.Owner).MapScale) );
                DirectionKoef := GetParallelPointDirectionKoeff(ip1, ip2, op1);
                GetParallelPoints(ip1, ip2, ip1, ip2, -1 * DirectionKoef * (ArchWallDivInfo.Thickness*0.5) *(1000/ TPowerCad(TrgNet.Owner).MapScale) );
              end;
              PointToLineByAngle(ip1, ip2, pt);
              Points[i - 1] := pt;

              {//27.08.2012 - Если точка все равно пересекает сегмент, тогда подвигаем ее к второй точке
              if NextPtExists and TrgNet.XDrawEngine.IsPointInRegion(PollyRegion, @pt) then
              begin
                PathWidthInt := Trunc(Path.Width);
                for k := 1 to PathWidthInt do
                begin
                  pt := MPoint(pt, NextPt, 1);
                  if Not TrgNet.XDrawEngine.IsPointInRegion(PollyRegion, @pt) then
                  begin
                    Points[i - 1] := pt;
                    Break; //// BREAK ////
                  end;
                end;
              end;}
            end;
            DeleteObject(PollyRegion);
          end;
          EmptyProcedure;

          // Если точка входит в любую стену (перестенок) комнаты
          // ИЛИ точка выходит за пределы комнаты
          if {//10.04.2012 TrgNet.IsPointIn(pt.x, pt.y) or} Not IsPtInPolygon(pt, NetRegionPathsPoints) then
          begin
            IsRoomOut := true;
            Break; //// BREAK ////
          end;
        end;
      end;

      // Проверяем, не пересикают ли новые сегменты существующие стены/перестенки
      if Not IsRoomOut and (TrgNet <> nil) then
      begin
        GetPathsPoints(TrgNet.Paths, PathsPoints);
        if Length(PathsPoints) > 0 then
          for i := 1 to Length(Points) - 1 do
          begin
            for j := 1 to Length(PathsPoints) - 1 do
            begin
              if j mod 2 <> 0 then
                //if LinesIntersect(Points[i-1], Points[i], PathsPoints[j-1], PathsPoints[j]) then
                //10.04.2012 if LinesCross(Points[i-1], Points[i], PathsPoints[j-1], PathsPoints[j]) then
                if LinesCross(Points[i-1], Points[i], PathsPoints[j-1], PathsPoints[j], false) then
                begin
                  IsRoomOut := true;
                  Break; //// BREAK ////
                end;
            end;
            if IsRoomOut then
              Break; //// BREAK ////
          end;
      end;

      if Not IsRoomOut then
      begin
        TrgNet.FDisableMergePaths := true;
        try
          {//10.04.2012
          DefArchWallInfo := TArchWallInfo(GetArchObjDefaultParams(ctArhWallDivision));
          if DefArchWallInfo = nil then
            DefArchWallInfo := TArchWallInfo(GetArchObjDefaultParams(ctArhWall));

          //ActiveNet.MakePath(points)
          ArchWallDivInfo := TArchWallDivInfo.Create(nil);

          ArchWallDivInfo.Thickness := 0.1;
          if DefArchWallInfo <> nil then
          begin
            ArchWallDivInfo.Height := DefArchWallInfo.Height;
            if DefArchWallInfo is TArchWallDivInfo then
            begin
              ArchWallDivInfo.Thickness := DefArchWallInfo.Thickness;
              ArchWallDivInfo.Coordz := TArchWallDivInfo(DefArchWallInfo).Coordz;
            end;
          end; }

          for i := 1 to Length(Points) - 1 do
          begin
            ArchWallDivInfo.P1 := Points[i-1];
            ArchWallDivInfo.P2 := Points[i];
            CreateArchWallByNet(TrgNet, ctArhWallDivision, ArchWallDivInfo);
          end;
        finally
          TrgNet.FDisableMergePaths := false;
        end;
        //10.04.2012 if DefArchWallInfo <> nil then
        //10.04.2012   DefArchWallInfo.Free;

        FreeAndNil(ArchWallDivInfo);
        RefreshNet(TrgNet);
      end
      else
        MessageInfo('Перегородка должна находится внутри комнаты и не пересекать стены');

      if DefArchWallInfo <> nil then
        DefArchWallInfo.Free;
    end;

    TF_CAD(CAD).EndSaveForUndo;
    // *UNDO*
    //GCadForm.FCanSaveForUndo := True;
  except
    on E: Exception do AddExceptionToLogEx('TWallDivPath.CreateFromShadow', E.Message);
  end;
end;


{ TRoomWallRect }

class function TRoomWallRect.CreateFromShadow(aOwner: TComponent;
  LHandle: Integer; Shadow: TFigure): TFigure;
var
  CAD: TForm;
  //List: TSCSList;
  WalsPoints: TDoublePointArr;
  ObjType: Integer;
begin
  result := nil;
  if TWallRect(Shadow).valid and assigned(ActiveNet) then
  begin
    // *UNDO*
    //if GCadForm.FCanSaveForUndo then
    //begin
    //  GCadForm.SaveForUndo(uat_None, True, False);
    //  GCadForm.FCanSaveForUndo := False;
    //end;
    CAD := TForm(TPowerCad(aOwner).Owner);

    SetLength(WalsPoints, 5);
    WalsPoints[0] := Shadow.ap1;
    WalsPoints[1] := DoublePoint(Shadow.ap2.x, Shadow.ap1.Y);
    WalsPoints[2] := Shadow.ap2;
    WalsPoints[3] := DoublePoint(Shadow.ap1.x, Shadow.ap2.Y);
    WalsPoints[4] := Shadow.ap1;

    ObjType := TF_CAD(CAD).PCad.ToolData;
    if Not CheckContureIntersectNet(ObjType, @WalsPoints, CAD) then
    begin
      TF_CAD(CAD).BeginSaveForUndo(uat_None, True, False);

      //List := GetSCSListByCAD(CAD);
      try
        //15.10.2010 ObjType := ctArhRoom;
        //if Self is TBrickWallRect then
        //15.10.2010 if ClassName = TBrickWallRect.ClassName then
        //15.10.2010   ObjType := ctArhBrickWall;
        CreateArchRoomByWallInfo(nil, nil, CAD, ObjType, nil, WalsPoints, nil, nil, true, true);
      finally
        TF_CAD(CAD).EndSaveForUndo;
      end;

      // *UNDO*
      //GCadForm.FCanSaveForUndo := True;
    end;
  end;
end;

{ TWallPolyPath }

class function TWallPolyPath.CreateFromShadow(aOwner: TComponent;
  LHandle: Integer; Shadow: TFigure): TFigure;
var
  CAD: TForm;
  points: TDoublePointArr;
  pt: TDoublePoint;
  i: Integer;
  ToolData: Integer;
  ObjType: Integer;

  NewArchObj: TSCSComponent;
  NewNet: TNet;
begin
  result := nil;
  try
    while (Shadow.PointCount > 1) and EQDP(Shadow.FigurePoints[Shadow.PointCount], Shadow.FigurePoints[Shadow.PointCount - 1]) do
    begin
      Shadow.PointCount := Shadow.PointCount - 1;
    end;

    if Shadow.PointCount >= 4 then
    begin
      // первая и последняя точки должны совпадать
      if EQDP(Shadow.FigurePoints[1], Shadow.FigurePoints[Shadow.PointCount]) then
      begin
        SetLength(Points, Shadow.PointCount);
        For i := 1 to Shadow.PointCount do
        begin
          pt := Shadow.FigurePoints[i];
          Points[i - 1] := pt;
        end;

        CAD := TForm(TPowerCad(aOwner).Owner);
        ObjType := TF_CAD(CAD).PCad.ToolData; //ctArhRoom;
        if Not IsCrossExistsByPoints(Points) then
        begin
          if Not CheckContureIntersectNet(ObjType, @Points, CAD) then
          begin
            TF_CAD(CAD).BeginSaveForUndo(uat_None, True, False);

            NewArchObj := CreateArchRoomByWallInfo(nil, nil, CAD, ObjType, nil, Points, nil, nil, true, true);

            TF_CAD(CAD).EndSaveForUndo;

            //if Not IsConvexPolygon(@Points) then
            //  Messageinfo('Сегмент должен быть выпуклым');

            if NewArchObj <> nil then
            begin
              NewNet := TNet(GetCADObjByArchObj(NewArchObj));
              CheckNetRoofSegCortex(NewNet, NewArchObj);
            end;
          end;
        end
        else
          MessageInfo('Нельзя чтобы линии пересекались');
      end;
    end;
  except
    on E: Exception do AddExceptionToLogEx('TWallPolyPath.CreateFromShadow', E.Message);
  end;
end;

{ TArchEngine }

procedure TArchEngine.BeginExport;
begin
  FIsExporting := true;
  FExport := TArchExport.Create;
end;

procedure TArchEngine.EndExport;
begin
  FIsExporting := false;
  FExport.Free;
end;

procedure TArchEngine.AfterLoadProps(AObject: TObject);
var
  ArchObj: TSCSComponent;
begin
  if AObject is TNetPath then
  begin
    ArchObj := GetArchObjByCADObj(TNetPath(AObject));
    if ArchObj <> nil then
      SetNetPathColorByObj(TNetPath(AObject), ArchObj);
  end
  else if AObject is TNet then
  begin
    //DefineArchRoomCornersNamesByCadObj(AObject);
  end;
end;

function TArchEngine.GetLastDoorObjSize(aDoorObjType: TDoorObjType; aDefVal: Double): Double;
begin
  Result := GetLastObjSize(aoskPathDoorSize + IntToStr(Ord(aDoorObjType)), aDefVal);
end;

function TArchEngine.GetLastObjSize(const aKey: String; aDefVal: Double): Double;
var
  ResStr: String;
begin
  Result := aDefVal;
  if FLastObjsSizes.GetVal(aKey, ResStr) then
    Result := StrToFloat_My(ResStr);
end;
//Tolik 09/11/2017 --
function TArchEngine.GetLastObjParam(const aKey: String): Boolean;
var
  ResStr: String;
begin
  Result := False;
  if FLastObjsSizes.GetVal(aKey, ResStr) then
    if ResStr = 'TRUE' then
      Result := True;
end;

function TArchEngine.OnAddPoint(Sender: TNet; aTrgPath: TNetPath; APoint: PDoublePoint; AID: Integer): Integer;
var
  AArchContainer: TSCSCatalog;
  RoomObj: TSCSComponent;
  NewObj: TSCSComponent;
  NetPath: TNetPath;
  PathFromPoint: TNetPath;
  WallCompon: TSCSComponent;
  i: Integer;
  //SnapInfo: String;
  TrgPathPointObj: TSCSComponent;

  IsPointInBrickWall: Boolean;
  ObjType: Integer;
  ObjTypeSN: String;
begin
  Result := AID;
  if Sender.FComponID <> 0 then
  begin
    AArchContainer := GetArchContainerByCADObj(Sender);
    RoomObj := GetArchObjByCADObj(Sender, AArchContainer);
    if RoomObj <> nil then
    begin
      ObjType := ctArhWallCorner;
      ObjTypeSN := ctsnArhWallCorner;
      if (RoomObj.IsLine = ctArhRoofSeg) then
      begin
        ObjType := ctArhRoofHipCorner;
        ObjTypeSN := ctsnArhRoofHipCorner;
      end;
      NewObj := TSCSComponent(CreateComponInPMByType(RoomObj, ObjTypeSN, ObjType));
      if NewObj <> nil then
      begin
        Result := NewObj.ID;

        // Определяем точка на стене, или перестенке
        PathFromPoint := nil;
        WallCompon := nil;
        for i := 0 to Sender.Paths.Count - 1 do
        begin
          NetPath := TNetPath(Sender.Paths[i]);
          if (NetPath.p1 = APoint) or (NetPath.p2 = APoint) then
          begin
            PathFromPoint := NetPath;
            WallCompon := GetArchObjByCADObj(PathFromPoint, AArchContainer);
            Break; //// BREAK ////
          end;
          //if 
        end;
        //SnapInfo := TPowerCad(Sender.Owner).SnapInfo;

        IsPointInBrickWall := (RoomObj.Isline = ctArhBrickWall) and
                             ((FInsertingObjectType = ctArhBrickWall) or
                              (FInsertingObjectType = ctArhWall) or (Assigned(WallCompon) and (WallCompon.IsLine = ctArhWall)));

        // Если не кир. стена или точка на перегородке - удаляем лишние свойства
        if Not IsPointInBrickWall then
        //if (RoomObj.Isline = ctArhRoom) or
        //   (Assigned(WallCompon) and (WallCompon.IsLine = ctArhWallDivision)) or
        //   (Not Assigned(WallCompon) and ((SnapInfo = 'TWallDivPath') or (SnapInfo = 'TRoomWallRect') )) then
        begin
          //NewObj.RemovePropertyBySysName(pnPlinthHeight);
          //NewObj.RemovePropertyBySysName(pnBasementDepth);
          //NewObj.RemovePropertyBySysName(pnBasementTotalHeight);
          NewObj.RemovePropertyBySysName(pnTrenchDepth);
        end;

        // Перетягиваем свойства из точки сегмента, на который добавляется точка
        TrgPathPointObj := nil;
        if aTrgPath <> nil then
          TrgPathPointObj := GetArchCornerByPoint(Sender, aTrgPath.p1);
        if TrgPathPointObj <> nil then
          NewObj.AssignProperties(TrgPathPointObj.Properties);

        if FInsertingObjectCount > 0 then
        begin
          FInsrtedPointsID.Add(Result);
          FInsrtedCorners.Add(NewObj);
        end;
      end;
    end;
  end;
end;

procedure TArchEngine.OnAfterDivPath(Sender: TObject);
begin
  if (Sender is TNetPath) then
    if TNetPath(Sender).FComponID <> 0 then
    begin
      Self.EndInsertObject(0);
    end;
end;

procedure TArchEngine.OnAutoAddPath(Sender: TObject; SrcPath, NewPath: TNetPath);
var
  Net: TNet;
  //CAD: TF_CAD;

  SrcObj: TSCSComponent;
  NBObj: TSCSComponent;
  NewObj: TSCSComponent;
  SCSList: TSCSList;
  ArchContainer: TSCSCatalog;
  CompTypeSysName: String;
  CompType: Integer;
begin
  //CAD := TF_CAD(GetCADFormByObj(Sender));

  if SrcPath.FComponID <> 0 then
  //if Sender.FComponID <> 0 then
  begin
    // Добавяляем компоненту к новому сегменту

    ArchContainer := GetArchContainerByCADObj(Sender);
    SrcObj := ArchContainer.GetComponentFromReferences(SrcPath.FComponID);
    if SrcObj <> nil then
    begin
      //TF_CAD(CAD).BeginSaveForUndo(uat_None, True, False);
      try
        NewObj := nil;
        NBObj := GetNBArchObj(SrcObj.IsLine);
        if NBObj <> nil then
          NewObj := CreateArchObj(SrcObj.Parent, NBObj)
        else
        begin
          CompTypeSysName := '';
          CompType := ctArhWall;
          case SrcObj.IsLine of
            ctArhWall:
              begin
                CompTypeSysName := ctsnArhWall;
                CompType := ctArhWall;
              end;
            ctArhWallDivision:
              begin
                CompTypeSysName := ctsnArhWallDivision;
                CompType := ctArhWallDivision;
              end;
            ctArhRoofHip:
              begin
                CompTypeSysName := ctsnArhRoofHip;
                CompType := ctArhRoofHip;
              end;
          end;
          if CompTypeSysName <> '' then
            //26.04.2011 NewObj := TSCSComponent(CreateComponInPMByType(SrcObj.Parent, CompTypeSysName, ctArhWall));
            NewObj := TSCSComponent(CreateComponInPMByType(SrcObj.Parent, CompTypeSysName, CompType));
        end;

        if NewObj <> nil then
        begin
          NewObj.AssignProperties(SrcObj.Properties);

          NewPath.FComponID := NewObj.ID;
          NewPath.FOnSelect := Self.OnSelectObj;
        end;

      finally
        //TF_CAD(CAD).EndSaveForUndo;
      end;
    end;
    GArchEngine.AfterLoadProps(NewPath);
  end;

  if FGroupingMode then
  begin
    NewPath.Opath := SrcPath.Opath;
    NewPath.FDivedFrom := SrcPath;
  end;
end;

procedure TArchEngine.OnBeforeDivPath(Sender: TObject);
var
  ArchObj: TSCSComponent;
  ObjType: Integer;
begin
  if (Sender is TNetPath) then
    if TNetPath(Sender).FComponID <> 0 then
    begin
      ObjType := ctNone;
      ArchObj := GetArchObjByCADObj(Sender);
      if ArchObj <> nil then
        ObjType := ArchObj.IsLine;
      Self.BeginInsertObject(ObjType);
    end;
end;

procedure TArchEngine.OnDblClick(Sender: TObject);
begin
  //ShowMessage(Sender.ClassName);
  EditCADArchObj(Sender);
end;

function TArchEngine.OnDefineJoinedNets(Sender: TNet; ANetList, ACheckNetList, AResJoined: TList): Boolean;
var
  i, j: Integer;
  ArchObjList: TSCSComponents;
  Obj: TSCSComponent;
  CheckNetList: TList;
  ArchCheckObjList: TSCSComponents;
  Net, CheckNet: TNet;

  procedure FindJoined(AObj: TSCSComponent);
  var
    i: Integer;
    Joined, JoinedTopObj: TSCSComponent;
    NetFromList: TNet;
  begin
    for i := 0 to AObj.JoinedComponents.Count - 1 do
    begin
      Joined := AObj.JoinedComponents[i];
      JoinedTopObj := Joined.GetTopComponent;
      if JoinedTopObj <> nil then
        if ArchCheckObjList.GetComponenByID(JoinedTopObj.ID) <> nil then
        begin
          NetFromList := GetNetByComponIDFromList(JoinedTopObj.ID, CheckNetList);
          if (NetFromList <> nil) then
          begin
            if (AResJoined.IndexOf(NetFromList) = -1) then
              AResJoined.Add(NetFromList);
            CheckNetList.Remove(NetFromList);
            ArchCheckObjList.Remove(JoinedTopObj);
          end;
        end;
    end;
  end;

begin
  Result := false;
  AResJoined.Clear;
  if Sender.FComponID <> 0 then
  begin
    CheckNetList := TList.Create;
    CheckNetList.Assign(ACheckNetList);
    ArchObjList := GetArchObjsByCADObjs(ANetList);
    ArchCheckObjList := GetArchObjsByCADObjs(ACheckNetList);
    // Добавляем по подключениям компонентов
    for i := 0 to ArchObjList.Count - 1 do
    begin
      Obj := ArchObjList[i];
      for j := 0 to Obj.ChildReferences.Count - 1 do
        FindJoined(Obj.ChildReferences[j]);
    end;
    // Добавляем по подключению к точкам
    for i := 0 to ANetList.Count - 1 do
    begin
      Net := TNet(ANetList[i]);
      for j := ACheckNetList.Count - 1 downto 0 do
      begin
        CheckNet := TNet(ACheckNetList[j]);
        if AResJoined.IndexOf(CheckNet) = -1 then
          if Net.CheckIntersect(CheckNet) then
          begin
            AResJoined.Add(CheckNet);
            ACheckNetList.Delete(j);
          end;
      end;
      if ACheckNetList.Count = 0 then
        Break; //// BREAK ////
    end;
    // Добавляем по подключению к точкам среди найденных
    if ACheckNetList.Count > 0 then
    begin
      i := 0;
      while i < AResJoined.Count do
      begin
        Net := TNet(AResJoined[i]);
        for j := ACheckNetList.Count - 1 downto 0 do
        begin
          CheckNet := TNet(ACheckNetList[j]);
          if AResJoined.IndexOf(CheckNet) = -1 then
            if Net.CheckIntersect(CheckNet) then
            begin
              AResJoined.Add(CheckNet);
              ACheckNetList.Delete(j);
            end;
        end;
        if ACheckNetList.Count = 0 then
          Break; //// BREAK ////
        inc(i);
      end;
    end;

    ArchObjList.Free;
    ArchCheckObjList.Free;
    CheckNetList.Free;
  end;
end;

// AllowNear: Boolean; // Позволять ли искать на тех же координатах с других TNet
function TArchEngine.OnDefineMoveObjects(Sender: TNet; Apt: PDoublePoint; APath: TNetPath; ANetList: TList; AllowNear: Boolean=true): Boolean;
var
  i, j: integer;
  PointObj: TSCSComponent;
  SegObjList: TSCSComponents;
  SegObjIdx: Integer;
  SegObj: TSCSComponent;
  Joined: TSCSComponent;
  JoinedPt: PDoublePoint;
  JoinedPath: TNetPath;
  TmpPath: TNetPath;
  ptSrc: PDoublePoint;
  JoinedTopObj: TSCSComponent;
  ArchObjList: TSCSComponents;
  Connection: PComplect;
  NetFromList: TNet;
  Net: TNet;
  pt: PDoublePoint;
  ChildObj: TSCSComponent;
  ptObj: TSCSComponent;
  //AllowNear: Boolean; // Позволять ли искать на тех же координатах с других TNet

  function LoadObjectsForJoined(AJoinedObj: TSCSComponent): Boolean;
  begin
    Result := false;
    if Joined <> nil then
    begin
      JoinedTopObj := Joined.GetTopComponent;
      if JoinedTopObj <> nil then
        if ArchObjList.GetComponenByID(JoinedTopObj.ID) <> nil then
        begin
          Connection := AJoinedObj.GetConnectionByConnected(Joined);
          if Connection <> nil then
          begin
            NetFromList := GetNetByComponIDFromList(JoinedTopObj.ID, ANetList);
            if NetFromList <> nil then
              Result := true
          end;
        end;
    end;
  end;

  procedure AddPtToJoined(AJoined: TSCSComponent);
  var
    i, j: integer;
    PointsNear: TList;
  begin
    JoinedPt := NetFromList.GetPointByID(AJoined.ID);
    if (JoinedPt = nil) and (NetFromList.FSrcNet <> nil) then
    begin
      ptSrc := NetFromList.FSrcNet.GetPointByID(AJoined.ID);
      if (ptSrc <> nil) and AllowNear then
        JoinedPt := NetFromList.GetPointByNear(ptSrc^);
    end;
    if JoinedPt <> nil then
    begin
      Result := true;
      if NetFromList.FJoinedMovePoints.IndexOf(JoinedPt) = -1 then
      begin
        NetFromList.FJoinedMovePoints.Add(JoinedPt);
        NetFromList.FJoinedMovePointsDirections.Add(Pointer(Connection^.RelType));
        NetFromList.FJoinedMovePointsFixedState.Add(Pointer(Connection^.Fixed));
      end;
      if AllowNear then
        for i := 0 to ANetList.Count - 1 do
        begin
          Net := TNet(ANetList[i]);
          {PointsNear := Net.GetPointsByNear(JoinedPt^); //23.09.2011} pt := Net.GetPointByNear(JoinedPt^);
          //for j := 0 to PointsNear.Count - 1 do
          begin
            //pt := PDoublePoint(PointsNear[j]);
            if (pt <> nil) and (pt <> JoinedPt) then
              if (APath = nil) or ((pt <> APath.p1) and (pt <> APath.p2)) then
              begin
                if Net.FJoinedMovePoints.IndexOf(pt) = -1 then
                begin
                  PtObj := GetArchCornerByPoint(Net, pt);
                  if (PtObj <> nil) and (PtObj.ID = 115) then
                    EmptyProcedure;
                  Net.FJoinedMovePoints.Add(pt);
                  Net.FJoinedMovePointsDirections.Add(Pointer(Connection^.RelType));
                  Net.FJoinedMovePointsFixedState.Add(Pointer(Connection^.Fixed));
                end;
              end;
          end;
          //PointsNear.Free;
        end;
    end;
  end;

begin
  Result := false;
  //AllowNear := false;
  // Сброс
  //for i := 0 to ANetList.Count - 1 do
  //begin
  //  Net := ANetList[i];
  //  Net.FJoinedMovePoints.Clear;
  //  Net.FJoinedMovePointsDirections.Clear;
  //  Net.FJoinedMovePointsFixedState.Clear;
  //  Net.FJoinedMovePaths.Clear;
  //  Net.FJoinedMovePathsDirections.Clear;
  //end;
  ClearJoinedParamsInNets(ANetList);
  

  if Sender.FComponID <> 0 then
  begin
    // Ищем объект точки, в которого есть подключенные точки
    PointObj := nil;
    if Apt <> nil then
      PointObj := GetArchCornerByPointWithJoined(ANetList, Apt);
    // Ищем объект сегмента, в которого есть подключенныя
    SegObjList := nil;
    if APath <> nil then
      SegObjList := GetArchSegByPtWithJoined(ANetList, APath.p1, APath.p2);
    if (PointObj <> nil) or (SegObjList <> nil) then
    begin
      ArchObjList := GetArchObjsByCADObjs(ANetList);
      if PointObj <> nil then
      begin
        for i := 0 to PointObj.JoinedComponents.Count - 1 do
        begin
          Joined := PointObj.JoinedComponents[i];
          if (Joined.IsLine = PointObj.IsLine) and LoadObjectsForJoined(PointObj) then
          begin
            AddPtToJoined(Joined);
          end;
        end;
      end;
      if SegObjList <> nil then
      begin
        for SegObjIdx := 0 to SegObjList.Count - 1 do
        begin
          SegObj := SegObjList[SegObjIdx];
          for i := 0 to SegObj.JoinedComponents.Count - 1 do
          begin
            Joined := SegObj.JoinedComponents[i];
            if LoadObjectsForJoined(SegObj) then
            begin
              // Если подключена точка
              if IsArchCornerComponByIsLine(Joined.IsLine) then
              begin
                AddPtToJoined(Joined);
              end
              // Если подключено ребро/линия
              else if IsArchSegmentComponByIsLine(Joined.IsLine) then
              begin
                // Определяем подключенный сегмент
                JoinedPath := GetNetPathByComponIDFromNet(Joined.ID, NetFromList);
                if (JoinedPath = nil) and (NetFromList.FSrcNet <> nil) then
                begin
                  for j := 0 to NetFromList.FSrcNet.Paths.Count - 1 do
                  begin
                    TmpPath := TNetPath(NetFromList.FSrcNet.Paths[j]);
                    if Assigned(TmpPath.Opath) and (TmpPath.Opath.FComponID = Joined.ID) then
                    begin
                      JoinedPath := TmpPath.Opath;
                      Break; //// BREAK ////
                    end;
                  end;
                end;
                if JoinedPath <> nil then
                begin
                  Result := true;
                  NetFromList.FJoinedMovePaths.Add(JoinedPath);
                  NetFromList.FJoinedMovePathsDirections.Add(Pointer(Connection^.RelType));
                  if AllowNear then
                    for j := 0 to ANetList.Count - 1 do
                    begin
                      Net := TNet(ANetList[j]);
                      TmpPath := Net.GetPathByNearPoints(JoinedPath.p1, JoinedPath.p2);
                      if (TmpPath <> nil) and (TmpPath <> JoinedPath) then
                      begin
                        if TmpPath <> APath then
                        begin
                          Net.FJoinedMovePaths.Add(TmpPath);
                          Net.FJoinedMovePathsDirections.Add(Pointer(Connection^.RelType));
                        end;
                      end
                      else
                      begin
                        pt := Net.GetPointByNear(JoinedPath.p1^);
                        if (pt <> nil) and (pt <> JoinedPath.p1) then
                          if Net.FJoinedMovePoints.IndexOf(pt) = -1 then
                          begin
                            PtObj := GetArchCornerByPoint(Net, pt);
                            if (PtObj <> nil) and (PtObj.ID = 115) then
                              EmptyProcedure;
                            Net.FJoinedMovePoints.Add(pt);
                            Net.FJoinedMovePointsDirections.Add(Pointer(Connection^.RelType));
                            Net.FJoinedMovePointsFixedState.Add(Pointer(Connection^.Fixed));
                          end;
                        pt := Net.GetPointByNear(JoinedPath.p2^);
                        if (pt <> nil) and (pt <> JoinedPath.p2) then
                          if Net.FJoinedMovePoints.IndexOf(pt) = -1 then
                          begin
                            PtObj := GetArchCornerByPoint(Net, pt);
                            if (PtObj <> nil) and (PtObj.ID = 115) then
                              EmptyProcedure;
                            Net.FJoinedMovePoints.Add(pt);
                            Net.FJoinedMovePointsDirections.Add(Pointer(Connection^.RelType));
                            Net.FJoinedMovePointsFixedState.Add(Pointer(Connection^.Fixed));
                          end;
                      end;
                    end;
                end;
              end
              // Если подключен сегмент
              else if IsArchTopComponByIsLine(Joined.IsLine) then
              begin
                if LoadObjectsForJoined(SegObj) then
                begin
                  // Запоминаем все точки сегмента для перемещения
                  for j := 0 to Joined.ChildReferences.Count - 1 do
                  begin
                    ChildObj := Joined.ChildReferences[j];
                    if IsArchCornerComponByIsLine(ChildObj.IsLine) then
                      AddPtToJoined(ChildObj);
                  end;
                end;
              end;
            end;
          end;
        end;
        SegObjList.Free;
      end;
      ArchObjList.Free;
    end;
  end;
end;

procedure TArchEngine.OnDoorChangePathQuery(Sender: TNetDoor; APath, ANewPath: TNetPath;
  var CanChange: Boolean);
begin
  if Sender.FComponID <> 0 then
    CanChange := APath = ANewPath;
end;

procedure TArchEngine.OnDeleteObj(Sender: TObject);
begin
  FDeletingObject := Sender;
  DelArchObjByCADObj(Sender);

  // Если удаляется сегмент, то переопределяем наименования углов комнаты
  if Sender is TNetPath then
    DefineArchWallCornersNamesByCadObj(Sender); //DefineArchRoomCornersNamesByCadObj(Sender);

  if Sender is TNet then
    if FNetsToDefHeights <> nil then
      FNetsToDefHeights.Remove(Sender);
end;

function TArchEngine.OnDeletePoint(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer;
var
  RoomObj: TSCSComponent;
  DelObj: TSCSComponent;
begin
  Result := AID;
  if Sender.FComponID <> 0 then
  begin
    RoomObj := GetArchObjByCADObj(Sender);
    if RoomObj <> nil then
    begin
      DelObj := RoomObj.GetComponentFromReferences(AID);
      if DelObj <> nil then
        DeleteComponInPM(DelObj.ListID, DelObj.ID, DelObj); ///Result := DelObj.ID;
    end;
  end;
end;

procedure TArchEngine.OnDuplicate(SrcObj, NewObj: TObject);
var
  SrcCompon: TSCSComponent;
  NewCompon: TSCSComponent;
  IDNewComponent: Integer;
  ArchObj: TSCSComponent;
  ArchContainer: TSCSCatalog;
  i, j: Integer;
  NewPath: TNetPath;
  NewDoor: TNetDoor;
  NewPt, SrcPt, TempPt: PDoublePoint;
  SrcPtID: Integer;
  NewPathObjs: TList;
  LookedSrcPoints: TList;
begin
  if (SrcObj is TNet) and (NewObj is TNet) then
  begin
    if (TNet(SrcObj).FComponID <> 0) then
    begin
      ArchContainer := GetArchContainerByCADObj(SrcObj);
      if ArchContainer <> nil then
      begin
        F_ProjMan.FindComponOrDirInTree(ArchContainer.ID, false);
        SrcCompon := GetArchObjByCadObj(SrcObj, ArchContainer);
        IDNewComponent := F_ProjMan.CopyComponentFromNbToPm(TForm(F_ProjMan), TForm(F_ProjMan), nil, ArchContainer.TreeViewNode, SrcCompon.ID, ckCompon);
        //IDNewComponent := CopyComponentFromNbToPm(TForm(F_ProjMan), TForm(F_ProjMan), nil, TrgNode, SrcComponent.ID, ckCompon);
        //NewCompon :=
        if IDNewComponent <> 0 then
        begin
          NewCompon := ArchContainer.GetComponentFromReferences(IDNewComponent);
          TNet(NewObj).FComponID := NewCompon.ID;

          NewPathObjs := TList.Create;

          // Определяем ID для сегментов, окон, дверей
          for i := 0 to TNet(NewObj).Paths.Count - 1 do
          begin
            NewPath := TNetPath(TNet(NewObj).Paths[i]);
            ArchObj := GetComponentByOldIDFromCompon(NewCompon, NewPath.Opath.FComponID);
            if ArchObj <> nil then
            begin
              NewPath.FComponID := ArchObj.ID;
              NewPathObjs.Add(NewPath);
            end;
            for j := 0 to NewPath.Doors.Count - 1 do
            begin
              NewDoor := TNetDoor(NewPath.Doors[j]);
              ArchObj := GetComponentByOldIDFromCompon(NewCompon, NewDoor.FSrcDoor.FComponID);
              if ArchObj <> nil then
                NewDoor.FComponID := ArchObj.ID;
            end;
            NewPath.Opath := nil;
          end;

          // Определяем ID точек-углов
          if TNet(NewObj).Points.Count > 0 then
          begin
            LookedSrcPoints := TList.Create;
            for i := 0 to TNet(NewObj).Points.Count - 1 do
            begin
              NewPt := TNet(NewObj).Points[i];
              SrcPt := TNet(SrcObj).GetPointByNear(NewPt^, LookedSrcPoints);
              if SrcPt <> nil then
              begin
                LookedSrcPoints.Add(SrcPt);
                SrcPtID := TNet(SrcObj).GetPointID(SrcPt);
                if SrcPtID <> 0 then
                begin
                  ArchObj := GetComponentByOldIDFromCompon(NewCompon, SrcPtID);
                  if ArchObj <> nil then
                  begin
                    TNet(NewObj).SetPointID(NewPt, ArchObj.ID);
                    DefineArchCornerName(ArchObj, TNet(NewObj));
                  end;
                end;
              end;
            end;
            LookedSrcPoints.Free;
          end;

          //for i := 0 to NewPathObjs.Count - 1 do
          //begin
          //  DefineArchWallCornersNamesByCadObj(TObject(NewPathObjs[i]));
          //end;
          NewPathObjs.Free;
        end;
        TNet(NewObj).FSrcNet := nil;
      end;
    end;
  end;
end;

function TArchEngine.OnGetHeight(Sender: TObject): Double;
var
  ArchObj: TSCSComponent;
begin
  Result := 0;
  if (Sender is TNetPath) and (TNetPath(Sender).FComponID <> 0) then
  begin
    ArchObj := GetArchObjByCADObj(Sender);
    if ArchObj <> nil then
      Result := ArchObj.GetPropertyValueAsFloat(pnHeight);
  end;
end;

function TArchEngine.OnGetHeightOfPt(Sender: TObject; pt: PDoublePoint): Double;
var
  Path: TNetPath;
  RelPathList: TList;
  RelPath: TNetPath;
  TopObj: TSCSComponent;
  ArchObj: TSCSComponent;
  i: integer;
  Corner: TSCSComponent;
  h: Double;
  ListOwner: TSCSList;
begin
  Result := 0;
  if (Sender is TNetPath) and (TNetPath(Sender).FComponID <> 0) then
  begin
    ListOwner := nil;
    Path := TNetPath(Sender);
    Corner := GetArchCornerByPoint(Path.Net, pt, Path.Opath <> nil);
    if Corner <> nil then
      Result := Corner.GetPropertyValueAsFloat(pnHeight);
    // Если на точке не задана высота, то берем максимальную с привязаных сегментов
    if Result = 0 then
    begin
      RelPathList := Path.Net.GetPathListByPoint(pt);
      if RelPathList.Count > 0 then
      begin
        TopObj := GetArchObjByCADObj(Path.Net);
        for i := 0 to RelPathList.Count - 1 do
        begin
          RelPath := TNetPath(RelPathList[i]);
          ArchObj := TopObj.GetComponentFromReferences(RelPath.FComponID);
          if (ArchObj = nil) and (RelPath.Opath <> nil) then
          begin
            if ListOwner = nil then
              ListOwner := TopObj.GetListOwner;
            if ListOwner <> nil then
              ArchObj := ListOwner.GetComponentFromReferences(RelPath.FComponID);
          end;
          if ArchObj <> nil then
          begin
            h := ArchObj.GetPropertyValueAsFloat(pnHeight);
            if h > Result then
              Result := h;
          end;
        end;
      end;
      RelPathList.Free;
    end;
  end;
end;

procedure TArchEngine.OnGetPathCheckOverlapMargin(Sender: TNet; Path, PathChk: TNetPath; var aMargin: Double);
var
  NetObj: TSCSComponent;
  Obj, ObjChk: TSCSComponent;
begin
  //Если сравнивается преегородка с чемто, то отступ будет 0, дабы перемещалися в притык
  if Sender.FComponID <> 0 then
  begin
    NetObj := GetArchObjByCADObj(Sender);
    if NetObj <> nil then
    begin
      Obj := NetObj.GetComponentFromReferences(Path.FComponID);
      if Obj <> nil then
        if Obj.IsLine = ctArhWallDivision then
          aMargin := 0;
      if aMargin <> 0 then
      begin
        ObjChk := NetObj.GetComponentFromReferences(Path.FComponID);
        if ObjChk <> nil then
          if ObjChk.IsLine = ctArhWallDivision then
            aMargin := 0;
      end;
    end;
  end;
end;

procedure TArchEngine.OnMovePath(Sender: TObject);
begin

end;

procedure TArchEngine.OnMergeNetPathsQuery(Sender: TNet; var CanMerge: Boolean);
begin
  CanMerge := Sender.FComponID = 0;
end;

procedure TArchEngine.OnMergeNetsQuery(ANet1, ANet2: TNet; var CanMerge: Boolean);
var
  Obj1, Obj2: TSCSComponent;
begin
  CanMerge := (ANet1.FComponID <> 0) and (ANet2.FComponID <> 0);
  if CanMerge then
  begin
    Obj1 := GetArchObjByCADObj(ANet1);
    Obj2 := GetArchObjByCADObj(ANet2);
    if Assigned(Obj1) and Assigned(Obj2) then
      CanMerge := Obj1.IsLine = Obj2.IsLine;
  end;
end;

procedure TArchEngine.OnMergePaths(AMainPath, APath: TNetPath);
var
  ArchObjMain, ArchObj: TSCSComponent;
begin
  if (AMainPath.FComponID <> 0) and (APath.FComponID <> 0) then
    if Not AMainPath.IsArc and Not APath.IsArc then
    begin
      //if AMainPath.Len > APath.Len then
      begin
        //ArchObjMain, ArchObj

        ArchObjMain := GetArchObjByCADObj(AMainPath);
        ArchObj := GetArchObjByCADObj(APath);

        APath.Width := AMainPath.Width;
        SetNetPathChildsWidth(ArchObj, APath, AMainPath.Width);
      end;
    end;
end;

procedure TArchEngine.OnMergePathsQuery(APath1, APath2: TNetPath; var CanMerge: Boolean);
var
  Obj1, Obj2: TSCSComponent;
begin
  Obj1 := GetArchObjByCADObj(APath1);
  Obj2 := GetArchObjByCADObj(APath2);
  CanMerge := (Obj1 <> nil) and (Obj2 <> nil) and
              (((Obj1.IsLine = ctArhWall) and (Obj2.IsLine = ctArhWall)) or ((Obj1.IsLine = ctArhRoofHip) and (Obj2.IsLine = ctArhRoofHip)));
end;

procedure TArchEngine.OnMove(Sender: TObject);
begin
  AddNetToDefHeights(Sender);
end;

procedure TArchEngine.OnMoveJoinedPoints(Sender: TObject);
begin
  AddNetToDefHeights(Sender);
end;


function TArchEngine.OnMovePoint(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer;
var
  ArchCorner: TSCSComponent;
  Prop: PProperty;
begin
  // Sender.FRelatedMPoint - чтобы для связанных точек не вызывать одно и тоже
  if (Sender.FComponID <> 0) and (Sender.FRelatedMPoint = nil) {and (Sender.FRelatedNets.Count = 0)} then
  begin
    ArchCorner := GetArchCornerByPoint(Sender, APoint);
    if ArchCorner <> nil then
    begin
      if ArchCorner.GetPropertyValueAsFloat(pnHeight) <> 0 then
      begin
        Prop := ArchCorner.GetPropertyBySysName(pnHeight);
        if Prop <> nil then
          OnSetArchObjProp(Prop, Prop, ArchCorner);
      end;
    end;

    // Является ли сегмент крыши выпуклым
    CheckNetRoofSegCortex(Sender, nil);
    AddNetToDefHeights(TNet(Sender));
  end;
end;

procedure TArchEngine.OnPathsOverlapQuery(APath, ACheckPath: TNetPath; Apt: PDoublePoint; var ACanOverlap: Boolean);
var
  ArchObj: TSCSComponent;
  ArchCheckObj: TSCSComponent;
  Objh1, Objh2: Double;
  ChkObjh1, ChkObjh2, ptH: Double;
begin
  ACanOverlap := false;
  if APath.Net = ACheckPath.Net then
  begin
    ArchObj := GetArchObjByCADObj(APath);
    ArchCheckObj := GetArchObjByCADObj(ACheckPath);
    if (ArchObj <> nil) and (ACheckPath <> nil) then
      if (ArchObj.IsLine = ctArhRoofHip) and (ArchCheckObj.IsLine = ctArhRoofHip) then
        //15.08.2011 if GetArchWallCornersHeights(ArchObj, Objh1, Objh2) and
        //15.08.2011    GetArchWallCornersHeights(ArchCheckObj, ChkObjh1, ChkObjh2) then
        begin
          {Objh1 := APath.GetHeightOfPt(APath.p1);
          Objh2 := APath.GetHeightOfPt(APath.p2);
          ChkObjh1 := ACheckPath.GetHeightOfPt(ACheckPath.p1);
          ChkObjh2 := ACheckPath.GetHeightOfPt(ACheckPath.p2);
          //15.08.2011
          //ptH := -1;
          //if Apt = APath.p1 then
          //  ptH := Objh1
          //else
          //if Apt = APath.p2 then
          //  ptH := Objh2;
          //if (ptH <> -1) and ((ptH <> ChkObjh1) or (ptH <> ChkObjh2)) then
          //  ACanOverlap := true;
          if (Objh1 <> ChkObjh1) or (Objh1 <> ChkObjh2) or (Objh2 <> ChkObjh1) or (Objh2 <> ChkObjh2) then}
            ACanOverlap := true;
        end;
  end;
end;

procedure TArchEngine.OnResize(Sender: TObject);
var
  Obj: TObject;
  ArchObj: TSCSComponent;
begin
  Obj := nil;
  if Sender is TNetDoor then
  begin
    Obj := TNetDoor(Sender).GetPath;

    // Подгружаем параметры окна/двери
    //ArchObj := GetArchObjByCADObj(Sender);
    //if ArchObj <> nil then
    //  LoadArchObjPropsFromCAD(ArchObj, Sender);
  end
  else
  begin
    // Если менял ширину сегмент, обновим длины дверей/окон...
    if Sender is TNetPath then
      TNetPath(Sender).Net.CalculatePathPoints
    else
    if Sender is TNet then
      TNet(Sender).CalculatePathPoints;

    Obj := GetNetFromCADObj(Sender);
  end;
  if Obj <> nil then
  begin
    ArchObj := GetArchObjByCADObj(Obj);
    if ArchObj <> nil then
    begin
      DefineArchObjPropsOnResize(ArchObj, Obj);
    end;

    // Является ли сегмент крыши выпуклым
    if Obj is TNet then
    begin
      CheckNetRoofSegCortex(TNet(Obj), ArchObj);
      AddNetToDefHeights(TNet(Obj));
    end
    else
    if Obj is TNetPath then
      AddNetToDefHeights(TNetPath(Obj).Net);
  end;
end;

procedure TArchEngine.OnScaleAfter(Sender: TObject);
begin
  FLookedPointsOnScale.Clear;
  FLookedPointNetsOnScale.Clear;
  ClearList(FSavedLookedPointsOnScale);
  FScaleObjectCount := FScaleObjectCount - 1;
  if FScaleObjectCount < 0 then
    FScaleObjectCount := 0;
end;

procedure TArchEngine.OnScaleBefore(Sender: TObject);
begin
  FLookedPointsOnScale.Clear;
  FLookedPointNetsOnScale.Clear;
  ClearList(FSavedLookedPointsOnScale);
  FScaleObjectCount := FScaleObjectCount + 1;
end;

procedure TArchEngine.OnScale(Sender: TObject; PercentX, PercentY: Double; rPoint: PDoublePoint);
var
  NetList: TList;
  RelatedNets: TList;
  i, j, k: Integer;
  Path: TNetPath;
  Net: TNet;
  NetMoved: Boolean;
  p1Saved, p2Saved, p1SavedScaled, p2SavedScaled: PDoublePoint;
  JoinedPt: PDoublePoint;
  JoinedPtId: Integer;
  JoinedSavedPt: PDoublePoint;
  RelType: Integer;
  FixedState: Integer;
  PtObj: TSCSComponent;
  LookedIdx: Integer;
  ptrSavedScalePt: PDoublePoint;
  pt: PDoublePoint;


  Log: TStringList;

  procedure AddToLog(Indent: Integer; const AStr: String);
  begin
    Log.Add(DupStr(' ', Indent*2) + AStr);
  end;
begin
  if (Sender is TNet) and (TNet(Sender).FComponID <> 0) and TNet(Sender).CanMoveJoined then
  begin
    // Определяем все связанные TNet
    RelatedNets := TNet(Sender).GetRelatedNetsByPoints(nil, nil, citNone, true);
    NetList := TList.Create;
    if RelatedNets <> nil then
      NetList.Assign(RelatedNets);
    NetList.Insert(0, TNet(Sender));

    Log := TStringList.Create;
    AddToLog(0, '');
    AddToLog(0, 'TNet(Sender).FComponID = ' + IntToStr(TNet(Sender).FComponID));
    AddToLog(0, 'NetList.Count = ' + IntToStr(NetList.Count));

    // OnDefineMoveObjects(Sender: TNet; Apt: PDoublePoint; APath: TNetPath; ANetList: TList): Boolean;
    // Перебираем все сегменты и смотрим еслть ли подключенные точки на них
    for i := 0 to TNet(Sender).Paths.Count - 1 do
    begin
      Path := TNetPath(TNet(Sender).Paths[i]);
      AddToLog(1, 'Path.FComponID = ' + IntToStr(Path.FComponID));

      // Обределяем связанные точки для сегмента Path,
      // флаг AllowNear = false чтобы не добавляли точку по координатам,
      // так как в список она может попасть по координатам раньше времени как не Fixed, а на другом подключении окажется что Fixed, но будет уже в пролете 
      if OnDefineMoveObjects(TNet(Sender), nil, Path, NetList, false) then
      begin
        p1Saved := TNet(Sender).GetSavedPtByPoint(Path.p1);
        p2Saved := TNet(Sender).GetSavedPtByPoint(Path.p2);
        if (p1Saved <> nil) and (p2Saved <> nil) then
          for j := 0 to NetList.Count - 1 do
          begin
            Net := TNet(NetList[j]);
            AddToLog(2, 'Net.FJoinedMovePoints.Count = ' + IntToStr(Net.FJoinedMovePoints.Count));
            if (Net.FJoinedMovePoints.Count > 0) and (Net.FJoinedMovePoints.Count = Net.FJoinedMovePointsDirections.Count) then
            begin
              NetMoved := false;
              for k := 0 to Net.FJoinedMovePoints.Count - 1 do
              begin
                JoinedPt := PDoublePoint(Net.FJoinedMovePoints[k]);
                JoinedPtId := Net.GetPointID(JoinedPt);
                AddToLog(3, 'JoinedPtId = ' + IntToStr(JoinedPtId));

                PtObj := GetArchCornerByPoint(Net, JoinedPt);
                if PtObj <> nil then
                  EmptyProcedure;
                LookedIdx := FLookedPointsOnScale.IndexOf(JoinedPt);
                if (FScaleObjectCount <= 1) or (LookedIdx = -1) then
                begin
                  {//23.09.2011
                  FLookedPointsOnScale.Add(JoinedPt);
                  GetMem(ptrSavedScalePt, SizeOf(TDoublePoint));
                  ptrSavedScalePt^ := JoinedPt^;
                  FSavedLookedPointsOnScale.Add(ptrSavedScalePt);}

                  RelType := Integer(Net.FJoinedMovePointsDirections[k]);
                  FixedState := Integer(Net.FJoinedMovePointsFixedState[k]);
                  if (FixedState = biTrue) and (RelType = crtDirect) then
                  begin
                    JoinedSavedPt := Net.GetSavedPtByPoint(JoinedPt);
                    if JoinedSavedPt <> nil then
                    begin
                      //JoinedPt^.x := JoinedSavedPt^.x + (Path.p1^.x - p1Saved^.x);
                      //JoinedPt^.y := JoinedSavedPt^.y + (Path.p1^.y - p1Saved^.y);

                      //23.09.2011 JoinedPt^.x := JoinedSavedPt^.x + (Path.p1^.x-p1Saved^.x + Path.p2^.x-p2Saved^.x)/2;
                      //23.09.2011 JoinedPt^.y := JoinedSavedPt^.y + (Path.p1^.y-p1Saved^.y + Path.p2^.y-p2Saved^.y)/2;

                      p1SavedScaled := TNet(Sender).GetSavedScaledPtByPoint(Path.p1);
                      p2SavedScaled := TNet(Sender).GetSavedScaledPtByPoint(Path.p2);
                      if (p1SavedScaled <> nil) and (p2SavedScaled <> nil) then
                      begin
                        JoinedPt^.x := JoinedSavedPt^.x + (p1SavedScaled^.x-p1Saved^.x + p2SavedScaled^.x-p2Saved^.x)/2;
                        JoinedPt^.y := JoinedSavedPt^.y + (p1SavedScaled^.y-p1Saved^.y + p2SavedScaled^.y-p2Saved^.y)/2;
                        NetMoved := true;
                      end;

                      FLookedPointsOnScale.Add(JoinedPt);
                      FLookedPointNetsOnScale.Add(Net);
                      GetMem(ptrSavedScalePt, SizeOf(TDoublePoint));
                      ptrSavedScalePt^ := JoinedPt^;
                      FSavedLookedPointsOnScale.Add(ptrSavedScalePt);
                    end;
                  end;
                  if NetMoved then
                    AddNetToDefHeights(TNet(Net));
                end
                // Если эта точка была перемещена, то возвращаем ее обратно
                else if LookedIdx <> -1 then
                begin
                  //JoinedPt^ := PDoublePoint(FSavedLookedPointsOnScale[LookedIdx])^;
                end;
              end;
            end;
          end;
      end;
    end;


    // Перемещаем точки которые были связанны до scale
    for i := 0 to FLookedPointsOnScale.Count - 1 do
    begin
      pt := PDoublePoint(FLookedPointsOnScale[i]);
      p1Saved := TNet(FLookedPointNetsOnScale[i]).GetSavedPtByPoint(pt);
      if p1Saved <> nil then
        for j := 0 to NetList.Count - 1 do
        begin
          Net := TNet(NetList[j]);
          for k := 0 to Net.Points.Count - 1 do
          begin
            JoinedPt := Net.Points[k];
            if FLookedPointsOnScale.IndexOf(JoinedPt) = -1 then
            begin
              p2Saved := Net.GetSavedPtByPoint(JoinedPt);
              if (p2Saved <> nil) and (PointNear(p1Saved^, p2Saved^)) then
                JoinedPt^ := pt^;
            end;
          end;
        end;
    end;
    NetList.Free;
    RelatedNets.Free;

    //Log.SaveToFile('C:\Temp\SCS\OnScale_'+IntToStr(TNet(Sender).FComponID)+'_norm.txt');
    Log.Free;

    AddNetToDefHeights(TNet(Sender));
  end;
end;

procedure TArchEngine.OnSetScale(Sender: TObject; OldScale, NewScale: Double);
var
  ArchObj, ArchChildObj: TSCSComponent;
  i: Integer;
  ScaleKoeff: Double;
begin
  ArchObj := GetArchObjByCADObj(Sender);
  if ArchObj <> nil then
  begin
    ScaleKoeff := NewScale / OldScale;
    // Изменяем ширины откосов
    {
    for i := 0 to ArchObj.ChildReferences.Count - 1 do
    begin
      ArchChildObj := ArchObj.ChildReferences[i];
      if IsSlopeComponByIsLine(ArchChildObj.IsLine) or IsArchBalconyChildComponByIsLine(ArchChildObj.IsLine) then
        ArchChildObj.MulPropertyValueAsFloat(pnWidth, ScaleKoeff);
    end;
    }
  end;
end;

procedure TArchEngine.OnSelectObj(Sender: TObject);
var
  Net: TNet;
  ArchObj: TSCSComponent;
  OrderType: Integer;
begin
  //SelectArchObjByCADObj(Sender);

  // Net на верхний план
  Net := GetNetFromCADObj(Sender);
  if (Net <> nil) and (Net.Owner <> nil) then
  begin
    ArchObj := GetArchObjByCADObj(Net);
    OrderType := 1;

    if (Sender is TNetPath) and (ArchObj <> nil) then
    begin
      //  TNetPath(Sender).TestShowPointsInfo;

      // Если выделено два ребра крыши, то отображаем угол спроецированный на 2D
      //if (ArchObj.IsLine = ctArhRoofSeg) then
      //  ShowNetSelPathsAngleInCAD(Net, ArchObj);

      // Если кликаем по сегменту с Alt, то даем возможность на след-м клике выбрать сегмент другого TNet
      //if ssAlt in GGlobalShiftState then
      //  OrderType := -1;
    end;

    if OrderType = 1 then
      {FigureBringToFront(Net) //}TPowerCad(Net.Owner).OrderFigureToFront(Net)
    else if OrderType = -1 then
      {FigureSendToBack(Net); //}TPowerCad(Net.Owner).OrderFigureToBack(Net);
  end;  
  SelectArchObjByCADObj(Sender);
  FPrevSelCADObj := Sender;
end;

function TArchEngine.OnSelectPoint(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer;
var
  ArchObj: TSCSComponent;
  PointObj: TSCSComponent;
begin
  if Sender.FComponID <> 0 then
  begin
    ArchObj := GetArchObjByCADObj(Sender);
    if ArchObj <> nil then
      TF_Main(ArchObj.ActiveForm).SelectComponByIDInTree(AID);
  end;
end;

procedure TArchEngine.SetLastDoorObjSize(aDoorObjType: TDoorObjType; aVal: Double);
begin
  SetLastObjSize(aoskPathDoorSize + IntToStr(Ord(aDoorObjType)), aVal);
end;

procedure TArchEngine.SetLastObjSize(const aKey: String; aVal: Double);
begin
  FLastObjsSizes.SetVal(aKey, FloatToStr(aVal));
end;
// Tolik 09/11/25017 --
procedure TArchEngine.SetLastObjParam(const aKey: String; aVal: string);
begin
  FLastObjsSizes.SetVal(aKey, aVal);
end;
procedure TArchEngine.SetHandlersToObj(AObject: TObject);
var
  NetDoor: TNetDoor;
  NetPath: TNetPath;
  Net: TNet;
begin
  if AObject is TNetDoor then
  begin
    NetDoor := TNetDoor(AObject);
    //if NetDoor.FComponID <> 0 then
    begin
      NetDoor.FOnDoorChangePathQuery := Self.OnDoorChangePathQuery;
      NetDoor.FOnDblClick := Self.OnDblClick;
      NetDoor.FOnDelete := Self.OnDeleteObj;
      NetDoor.FOnResize := Self.OnResize; //17.12.2010
      NetDoor.FOnSelect := Self.OnSelectObj;
    end;
  end
  else
  if AObject is TNetPath then
  begin
    NetPath := TNetPath(AObject);
    //if NetPath.FComponID <> 0 then
    begin
      NetPath.FOnAfterDiv := Self.OnAfterDivPath;
      NetPath.FOnBeforeDiv := Self.OnBeforeDivPath;
      NetPath.FOnDblClick := Self.OnDblClick;
      NetPath.FOnDelete := Self.OnDeleteObj;
      NetPath.FOnGetHeight := Self.OnGetHeight;
      NetPath.FOnGetHeightOfPt := Self.OnGetHeightOfPt;
      NetPath.FOnGetPathCheckOverlapMargin := Self.OnGetPathCheckOverlapMargin;
      NetPath.FOnSelect := Self.OnSelectObj;
    end;

    if NetPath.Net.Owner <> nil then
    begin
      //NetPath.FOnGetShowPathLength := TF_CAD(NetPath.Net.Owner.Owner).OnGetShowPathLength;
      //NetPath.FOnGetShowPathTraceLength := TF_CAD(NetPath.Net.Owner.Owner).OnGetShowPathTraceLength;
      NetPath.FOnGetShowPathLengthType := TF_CAD(NetPath.Net.Owner.Owner).OnGetShowPathLengthType;
      NetPath.FOnGetShowPathTraceLengthType := TF_CAD(NetPath.Net.Owner.Owner).OnGetShowPathTraceLengthType;
    end;
  end
  else
  if AObject is TNet then
  begin
    Net := TNet(AObject);
    //if Net.FComponID <> 0 then
    begin
      Net.FOnAddPoint := Self.OnAddPoint; //04.10.2010
      Net.FOnAutoAddPath := Self.OnAutoAddPath;
      Net.FOnDefineJoinedNets := Self.OnDefineJoinedNets;
      Net.FOnDefineMoveObjects := Self.OnDefineMoveObjects;
      Net.FOnDelete := Self.OnDeleteObj;
      Net.FOnDeletePoint := Self.OnDeletePoint; //04.10.2010
      Net.FOnDuplicate := Self.OnDuplicate; //16.05.2011
      Net.FOnMergeNetPathsQuery := Self.OnMergeNetPathsQuery;
      Net.FOnMergeNetsQuery := Self.OnMergeNetsQuery; //21.10.2010
      Net.FOnMergePaths := Self.OnMergePaths; //13.01.2011
      Net.FOnMergePathsQuery := Self.OnMergePathsQuery; //21.10.2010
      Net.FOnMove := Self.OnMove; //09.06.2011
      Net.FOnMoveJoinedPoints := Self.OnMoveJoinedPoints; //09.06.2011
      Net.FOnResize := Self.OnResize; //17.12.2010
      Net.FOnScale := Self.OnScale;
      Net.FOnScaleAfter := Self.OnScaleAfter;
      Net.FOnScaleBefore := Self.OnScaleBefore;
      Net.FOnSetScale := Self.OnSetScale;
      Net.FOnSelectPoint := Self.OnSelectPoint;
      Net.FOnMovePoint := Self.OnMovePoint;
      Net.FOnPathsOverlapQuery := Self.OnPathsOverlapQuery;
    end;
  end;
end;

procedure TArchEngine.SetRoomWallRectTool(ACAD: TForm);
begin
  FCADToSetTool := ACAD;
  FClassSetTool := TRoomWallRect;

  if FTimerSetTool = nil then
    FTimerSetTool := CreateTimer(200, FOnTimer);
  //08.06.2011 begin
  //  FTimerSetTool := TTimer.Create(nil);
  //  FTimerSetTool.Enabled := false;
  //  FTimerSetTool.Interval := 200;
  //  FTimerSetTool.OnTimer := FOnTimer;
  //end;
  FTimerSetTool.Enabled := true;
  FToolData := 0;
end;

constructor TArchEngine.Create;
begin
  FTimerSetTool := nil;
  FCADToSetTool := nil;
  FClassSetTool := nil;

  FTimerDefNetHeights := nil;
  FNetsToDefHeights := nil;

  FInsertingObjectType := ctNone;
  FInsertingObjectCount := 0;

  FInsrtedPointsID := TIntList.Create;
  FInsrtedCorners := TSCSComponents.Create(false);

  FLookedPointsOnScale := TList.Create;
  FLookedPointNetsOnScale := TList.Create; //23.09.2011
  FSavedLookedPointsOnScale := TList.Create;
  FScaleObjectCount := 0;

  FGroupingMode := false;

  FIsExporting := false;
  FExport := nil;

  FPrevSelCADObj := nil;

  FLastObjsSizes := TStringsHash.Create;
end;

destructor TArchEngine.Destroy;
begin
  if FTimerSetTool <> nil then
    FTimerSetTool.Free;
  if FTimerDefNetHeights <> nil then
    FTimerDefNetHeights.Free;
  if FNetsToDefHeights <> nil then
    FNetsToDefHeights.Free;
  FInsrtedPointsID.Free;
  FInsrtedCorners.Free;
  FLookedPointsOnScale.Free;
  FLookedPointNetsOnScale.Free;
  // Tolik 03/05/2019 --
  //FSavedLookedPointsOnScale.Free;
  FreeList(FSavedLookedPointsOnScale);
  //
  if FLastObjsSizes <> nil then
    FreeAndNil(FLastObjsSizes);
  inherited;
end;

procedure TArchEngine.BeginInsertObject(AObjectType: Integer);
begin
  if FInsertingObjectCount = 0 then
  begin
    FInsertingObjectType := AObjectType;
  end;
  FInsertingObjectCount := FInsertingObjectCount + 1;
end;

procedure TArchEngine.EndInsertObject(AID: Integer=0);
begin
  if FInsertingObjectCount > 0 then
  begin
    FInsertingObjectCount := FInsertingObjectCount - 1;
    if FInsertingObjectCount = 0 then
    begin
      // Определяет наименования для добавленых УГЛОВ СТЕНЫ
      DefineArchCornersNames(FInsrtedCorners);

      FInsertingObjectType := ctNone;
      FInsrtedPointsID.Clear;
      FInsrtedCorners.Clear;
    end;
  end;
end;

procedure TArchEngine.AddNetToDefHeights(ANet: TObject);
begin
  if (ANet is TNet) and (TNet(ANet).FComponID <> 0) and (TNet(ANet).DrawStyle <> dsTrace) then
  begin
    if FNetsToDefHeights = nil then
      FNetsToDefHeights := TList.Create;
    if FTimerDefNetHeights = nil then
      FTimerDefNetHeights := CreateTimer(500, FOnTimerDefNetHeights);
    if FNetsToDefHeights.IndexOf(ANet) = -1 then
    begin
      FNetsToDefHeights.Add(ANet);
      RestartTimer(FTimerDefNetHeights); //FTimerDefNetHeights.Enabled := true;
    end;
  end;
end;

function TArchEngine.CreateTimer(AInterval: Integer; AOnTimer: TNotifyEvent): TTimer;
begin
  Result := TTimer.Create(nil);
  Result.Enabled := false;
  Result.Interval := AInterval;
  Result.OnTimer := AOnTimer;
end;

procedure TArchEngine.FOnTimer(Sender: TObject);
var
  CurrPos: TPoint;
  CAD: TF_CAD;
begin
  if Sender = FTimerSetTool then
  begin
    TTimer(Sender).Enabled := False;

    if (FCADToSetTool <> nil) and (FClassSetTool <> nil) then
    begin
      CAD := TF_CAD(FCADToSetTool);
      GetCursorPos(CurrPos);
      CurrPos := CAD.PCad.ScreenToClient(CurrPos);

      RaiseActiveNet(CAD);
      if CAD.CurrentLayer <> lnArch then
        CAD.CurrentLayer := lnArch;

      CAD.PCad.SetTool(toFigure, FClassSetTool.ClassName, FToolData);
      CAD.PCad.SimulateUp(CAD.CurrX, CAD.CurrY);
    end;
  end;
end;

procedure TArchEngine.FOnTimerDefNetHeights(Sender: TObject);
var
  i: Integer;
begin
  TTimer(Sender).Enabled := false;
  try
    for i := 0 to FNetsToDefHeights.Count - 1 do
      DefineArchNetPointsHeight(TNet(FNetsToDefHeights[i]));
  finally
    FNetsToDefHeights.Clear;
  end;
end;


{ TArchObjPropExp }

procedure TArchObjPropExp.AddPropCorrespond(const AArchPropSN, ASCPropSN: String);
begin
  AddStrObjToStrings(FPropsCorrespond, AArchPropSN, ASCPropSN);
end;

function TArchObjPropExp.AddGrpPropObj(const APropSN: string; AValue: string): TStringList;
begin
  //Result := Self.GetGrpObj(APropSN);
  //if Result = nil then
  //begin
    Result := TStringList.Create;
    AddGUIDIDToStrings(APropSN, AValue, 0, Result);
    Self.FGroupedObjects.Add(Result);
    Self.FPropsSN.Add(APropSN);
  //end;
end;

procedure TArchObjPropExp.AddPropValToGrp(const AGrpPropSN, AGrpVal, APropSN: String; AVal: Double);
var
  GrpObject: TStringList;
  PropVal: String;
begin
  // Ищем групповой объект по имени свойства и значению
  GrpObject := GetGrpObj(AGrpPropSN, AGrpVal);
  // Если не нашли то создаем и добавляем групповое свойство
  if GrpObject = nil then
  begin
    GrpObject := AddGrpPropObj(APropSN);
    FGroupPropsSN.Add(AGrpPropSN);
    AddGUIDIDToStrings(AGrpPropSN, AGrpVal, 0, GrpObject);
  end;
  if GrpObject <> nil then
  begin
    PropVal := GetGUIDFromStrings(GrpObject, APropSN);
    if PropVal <> '' then
      PropVal := FloatToStrU(StrToFloatU(PropVal) + AVal)
    else
      PropVal := FloatToStrU(AVal);
    SetGUIDToStrings(GrpObject, PropVal, APropSN);
  end;
end;

function TArchObjPropExp.GetGrpObj(const AGrpPropSN, AGrpVal: String): TStringList;
var
  i: integer;
  CurrGrpObject: TStringList;
  GrpPropVal: String;
begin
  Result := nil;
  for i := 0 to Self.FGroupedObjects.Count - 1 do
  begin
    CurrGrpObject := TStringList(Self.FGroupedObjects[i]);
    GrpPropVal := GetGUIDFromStrings(CurrGrpObject, AGrpPropSN);
    if GrpPropVal = AGrpVal then
    begin
      Result := CurrGrpObject;
      Break; //// BREAK ////
    end;
  end;
end;

constructor TArchObjPropExp.Create;
begin
  inherited;
  FPropsSN := TStringList.Create;
  FGroupPropsSN := TStringList.Create;
  FGroupedObjects := TObjectList.Create(true);
  FObjectPropsSN := TStringList.Create;
  FAllObjectPropsSN := TStringList.Create;

  FPropsCorrespond := TStringList.Create;
end;

destructor TArchObjPropExp.Destroy;
var
  i: Integer;
  GrpObject: TStringList;
begin
  FGroupPropsSN.Free;
  FObjectPropsSN.Free;
  FAllObjectPropsSN.Free;

  for i := 0 to FGroupedObjects.Count - 1 do
  begin
    GrpObject := TStringList(FGroupedObjects[i]);
    RemoveGUIDIDFromStrings(GrpObject, true);
  end;
  FGroupedObjects.Free;

  FreeStringsObjects(FPropsCorrespond, true);
  FPropsCorrespond.Free;

  inherited;
end;

procedure TArchObjPropExp.DefineAllProps;
begin
  FAllObjectPropsSN.Clear;
  FAllObjectPropsSN.AddStrings(FPropsSN);
  FAllObjectPropsSN.AddStrings(FGroupPropsSN);
  FAllObjectPropsSN.AddStrings(FObjectPropsSN);
end;

{ TArchExport }

function StringListCompareAsFloat(List: TStringList; Index1, Index2: Integer): Integer;
begin
  //Result := List.CompareStrings(List.FList^[Index1].FString,
  //                              List.FList^[Index2].FString);
  Result := CompareValue(StrToFloat_My(List[Index1]), StrToFloat_My(List[Index2]));
end;


// Добавить материал в остатки
function TArchExport.AddMaterialToRemains(AMatType: Integer; AWidth, AHeight, ARemainsMinUseSize: Double; ACount: Integer): Boolean;
var
  Key: String;
  GrpIdx: Integer;
  HeightObj: TStringList;
  HeightIdx: Integer;
begin
  Result := false;
  if AHeight >= ARemainsMinUseSize then
  begin
    GrpIdx := GetMaterilaRemainsIndex(AMatType, AWidth, @Key);
    if GrpIdx = -1 then
    begin
      HeightObj := TStringList.Create;
      HeightObj.AddObject(FloatToStr(AHeight), TObject(ACount));
      GrpIdx := FMaterilaRemains.AddObject(Key, HeightObj);
    end
    else
    begin
      HeightObj := TStringList(FMaterilaRemains.Objects[GrpIdx]);
      HeightIdx := HeightObj.IndexOf(FloatToStr(AHeight));
      if HeightIdx = -1 then
      begin
        HeightObj.AddObject(FloatToStr(AHeight), TObject(ACount));
        // Сортируем по Float
        HeightObj.CustomSort(StringListCompareAsFloat);
      end
      else
        HeightObj.Objects[HeightIdx] := TObject(Integer(HeightObj.Objects[HeightIdx]) + ACount);
    end;
    Result := true;
  end;
end;

procedure TArchExport.AddPropToKey(const APropSN, AVal: String; var AKey: String);
begin
  if AKey <> '' then
    AKey := AKey + '|';
  AKey := AKey + APropSN+'='+AVal;
end;

function TArchExport.CanUseRemainByPercent(ARemainsH, AMatHeight: Double): Boolean;
begin
  Result := ARemainsH >= (AMatHeight * (Self.GetHeightPersentToRemains(AMatHeight) /100) );
end;

function TArchExport.GetHeightPersentToRemains(AHeight: Double): Double;
begin
  // за основу берем 30% для высоты материала 1м,
  // если высота больше то этот процент уменьшаем и наоборот - если высота меньше, то процент увеличиваем
  Result := 25 / (AHeight * 1/FScaleKoeff);
end;


function TArchExport.GetMaterilaRemainsIndex(AMatType: Integer; AWidth: Double; AKey: Pointer=nil): Integer;
var
  Key: String;
begin
  Key := '';
  AddPropToKey(pnMaterialType, IntToStr(AMatType), Key);
  AddPropToKey(pnMaterialWidthUsable, FloatToStr(AWidth), Key);
  Result := FMaterilaRemains.IndexOf(Key);
  if AKey <> nil then
    String(AKey^) := Key;
end;

function TArchExport.RemoveMaterialFromRemains(AMatType: Integer; AWidth, AHeight, ARemainsMinUseSize: Double; ACount: Integer): Integer;
var
  GrpIdx: Integer;
  HeightObj: TStringList;
  MatHeight: Double;
  MatCount: Integer;
  RemoveCount: Integer;
  MatHeightFree: Double;
  HaveRamains: Boolean; // Есть ли остатки в остатков
  i: Integer;
begin
  //TmpCompon.Clear;
  //TmpCompon.AddProperty(0, '', dtInteger, biFalse, biFalse, biFalse, IntToStr(AMatType), '', pnMaterialType);
  //TmpCompon.AddPropertyValueAsFloat(pnMaterialWidthUsable, AWidth, true);
  //TmpCompon.AddPropertyValueAsFloat(pnMaterialHeightUsable, AHeight, true);
  //TmpCompon.AddPropertyValueAsFloat(pnCuttingWithRemains, ACount, true);
  //ExpArchObjPropToGrpObject(TmpCompon, FMaterilaRemainsGrp, true);

  Result := 0;
  GrpIdx := GetMaterilaRemainsIndex(AMatType, AWidth);
  if GrpIdx <> -1 then
  begin
    HeightObj := TStringList(FMaterilaRemains.Objects[GrpIdx]);
    while True do
    begin
      HaveRamains := false;
      i := 0;
      while i < HeightObj.Count do
      begin
        MatHeight := StrToFloat_My(HeightObj[i]);
        if MatHeight > AHeight then
        begin
          MatCount := Integer(HeightObj.Objects[i]);
          if MatCount > 0 then
          begin
            RemoveCount := ACount - Result;
            if RemoveCount > MatCount then
              RemoveCount := MatCount;
            HeightObj.Objects[i] := TObject(MatCount - RemoveCount);
            Result := Result + RemoveCount;

            MatHeightFree := MatHeight - AHeight;
            // Учитываем остатки от остатков
            //if Self.CanUseRemainByPercent(MatHeightFree, AMatHeight) then
            begin
              if Self.AddMaterialToRemains(AMatType, AWidth, MatHeightFree, ARemainsMinUseSize, RemoveCount) then
                HaveRamains := true;
            end;
          end;
        end;
        Inc(i);
      end;

      // остаемсяв цыкле если не вытянули нужное кол-во материала и были остатки из остатков
      //if Not((Result < ACount) and HaveRamains) then
      //  Break; //// BREAK ////
      // Выходим из цыкла если вытянуто нужное кол-во остатков, или небыло остатков в остатков (условие выше будет работать аналогично)
      if (Result >= ACount) or Not HaveRamains then
        Break; //// BREAK ////
    end;
  end;
end;

procedure TArchExport.Clear;
begin
  TmpCompon.Clear;
  //FMaterilaRemainsGrp.Clear;
end;

constructor TArchExport.Create;
begin
  TmpCompon := TSCSComponent.Create(F_ProjMan);
  FMaterilaRemainsGrp := TArchObjPropExp.Create;
  FMaterilaRemainsGrp.FPropsSN.Add(pnCuttingWithRemains); // колво материала - суммируем
  FMaterilaRemainsGrp.FGroupPropsSN.Add(pnMaterialType);
  FMaterilaRemainsGrp.FGroupPropsSN.Add(pnMaterialWidthUsable);
  FMaterilaRemainsGrp.FGroupPropsSN.Add(pnMaterialHeightUsable);
  FMaterilaRemainsGrp.DefineAllProps;

  FMaterilaRemains := TStringList.Create;
end;

destructor TArchExport.Destroy;
begin
  TmpCompon.Free;
  FMaterilaRemainsGrp.Free;
  FMaterilaRemains.Free;
  inherited;
end;

initialization

  if FigureClasses.IndexOf(TWallDivPath) = -1 then
    FigureClasses.Add(TWallDivPath);

  if FigureClasses.IndexOf(TRoomWallRect) = -1 then
    FigureClasses.Add(TRoomWallRect);

  //if FigureClasses.IndexOf(TBrickWallRect) = -1 then
  //  FigureClasses.Add(TBrickWallRect);
  if FigureClasses.IndexOf(TWallPolyPath) = -1 then
    FigureClasses.Add(TWallPolyPath);


end.