mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-12 00:45:40 +02:00
2319 lines
78 KiB
ObjectPascal
2319 lines
78 KiB
ObjectPascal
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.
|