expertcad/SRC/ARCH/U_Arch3DNew.pas
2025-05-13 16:51:40 +03:00

15764 lines
528 KiB
ObjectPascal

unit U_Arch3DNew;
interface
uses
Windows, Forms, StdCtrls, Classes, ComCtrls, Controls, DrawEngine, PCTypesUtils, SysUtils, Dialogs, Math,
Contnrs, DrawObjects, PCDrawBox, PCDrawing, PowerCad, Graphics, U_Cad, U_ESCadClasess, fplan,
U_Common_Classes, U_BaseConstants, U_SCSComponent, VectorTypes, rrEllipses, GlColor;
const myDelta = 0.05;
type
// ìîäåëü
T3DModel = class;
// êîìíàòà
T3DRoom = class;
// ñòåíà
T3DWall = class;
// ýëåìåíò ñòåíû (îêíî, äâåðü, áàëêîí, íèøà, àðêà)
T3DWallElement = class;
// ýëåìåíò áàëêîíà (áàëêîííîå îêíî, áàëêîííàÿ äâåðü)
T3DBalconElement = class;
// îòêîñ (äâåðíîé, îêîíîííûé, áàëêîííûé)
T3DSlope = class;
// ãðàíü (ñòåíû, îêíà, äâåðè, îòêîñà è ò.ä) - ýòî òå îáüåêòû ïîëèãîíîâ è ìýøåé,
// êîòîðûå äîáàâëÿþòñÿ â Faces è îòðèñîâûâàþòñÿ
T3DSide = class;
// îáúåêòû ñ 3ds
T3DSObject = class;
T3DLineType = (lt_Line, lt_Raise, lt_FloorRaise);
T3DConnType = (ct_Empty, ct_Full);
TWallPoints = record
WallPoint1: double;
Wallpoint2: double;
end;
//Tolik -- 09/07/2018 --
TNetEntryInfo = record
NetPath: TNetPath;
P1EntryCount: integer;
P2EntryCount: integer;
end;
PNetEntryInfo = ^TNetEntryInfo;
//
T3DModel = class(TObject)
private
function FindRealWallByVirtualNetPath(aNetPath: TNetPath): T3DWall;
function FindWallByNetPath(aNetPath: TNetPath): T3DWall;
public
FClassName: string;
FName: string;
FRooms: TList;
FScsObjects: TList;
FHashs: TStringList;
F3DSHashs: TStringList;
isUserTransparency: Boolean; // Tolik 28/11/2018 --
FFiles: TStringList;
FFilesHashs: TStringList;
constructor Create;
//Tolik 23/07/0218 --
Destructor destroy;override;
//
function GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject;
procedure CollectModel(aFaces: TList; aNets: TList);
procedure CollectScsModel(aFaces: TList; aScsObjects: TList);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
T3DRoom = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FListID: Integer;
FPlanObject: TNet;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DModel;
FNetConture: TDoublePointArr;
FFloorConture: TDoublePointArr;
FCeilingConture: TDoublePointArr;
FFloorContureForNormal: TDoublePointArr; // Tolik 14/01/2020
// Tolik --20/06/2018 --
FCeilingContureList: Array of TDoublePointArr; // êîíòóðû ïîëîâ äëÿ ÑÊÑ -- çàñóíóòü âñå â îäíó êîìíàòó, òàê êàê â ÑÊÑ ÒÎËÜÊÎ ÎÄÈÍ TNET ....
// ñîîòâåòñòâåííî è êîìíàòó ñòðîèòü áóäåì, â îòëè÷èå îò ÃðàôÌîäóëÿ, ÒÎËÜÊÎ ÎÄÍÓ...
//
FWalls: TList;
F3DSObjects: TList;
FFloor: T3DSide;
FCeiling: T3DSide;
FVisible: Boolean;
FZOrder: double;
FCorner: TList;
constructor Create(aFaces: TList; aNet: TNet; aParent: T3DModel);
//Tolik 23/07/2018--
Destructor destroy; override;
//
//Tolik 17/07/2018 --
//procedure CollectRoom(aFaces: TList);
procedure CollectRoom(aFaces: TList; aSCSPathList: TList = nil);
//
// Tolik 13/01/2020
//procedure CollectFloor(aFaces: TList);
//procedure CollectCeiling(aFaces: TList);
procedure CollectFloor(aFaces: TList; aPathContureList: TList = nil);
procedure CollectCeiling(aFaces: TList; aPathContureList: TList = nil);
//
function GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject;
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
T3DWall = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FPlanObject: TNetPath;
FVPath: TNetPath; //12.06.2012
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DRoom;
FWallElements: TList;
FSides: TList;
FIsArc: Boolean;
FZOrder: Double;
FGLObject: TObject;
FFaceType: TFaceType;
FPoints: TDoublePointArr;
FGLPOints: T3DPointArray;
constructor Create(aFaces: TList; aNetPath: TNetPath; aParent: T3DRoom);
// Tolik
Destructor Destroy; override;
//
procedure ParseWallForInner(aFaces: TList; aVNetPath: TNetPath);
procedure ParseWallForOuter(aFaces: TList; aVNetPath: TNetPath);
procedure ParseWallForPerpendSides(aFaces: TList; aVNetPath: TNetPath); //23.05.2012 - Âíåñòè ïåðïåíäèêóëÿðíûå ãðàíè
//Tolik 31/08/2018 --
Procedure ParseWallForJoint(aPathList: TList; aFaces: TList; aPoint: PDoublePoint); // ñòûêè ñòåí ñ ðàçíîé òîëùèíîé íà ïåðåñå÷åíèè 3-õ ñòåí
//
function CollectInnerWall(aFaces: TList; ap: T3DPointArray; aWallViewType: TWallViewType; isRightInner: Boolean = False): TList;
function CollectOuterWall(aFaces: TList; ap: T3DPointArray; aWallViewType: TWallViewType; aKnotFlag: Byte=0; aSideFlag: Byte=0): TList;
function GetFullDoors: TList;
procedure SetWallTypeToWallSide(aWallSides: TList; aWallSideType: TWallSideType; aWallType: TFaceWallType; aWallElement: T3DWallElement);
function CalcPointHeight(p1, p2, Point: TDoublePoint; p1h, p2h: Double): Double;
function GetArcWallPoints(aPoints: T3DPointArray; isWall: boolean = False): T3DPointArray;
function GetKnotsCount(aNetPath: TNetPath; p: TDoublePoint): Byte;
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
//*************** ROOF ******************
T3DCorner = class(TMyObject)
public
FClassName: string;
FName: string;
FParent: T3DRoom;
FZOrder: Double;
FGLObject: TObject;
FFaceType: TFaceType;
JoinedWalls: TList;
FPoints: TDoublePoint;
FGLPOints: T3DPointArray;
FSCSCompon: TSCSComponent;
constructor Create(AParent: T3DRoom; AName: string);
destructor destroy; override;
end;
//*************** \ROOF *****************
T3DWallElement = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FPlanObject: TNetDoor;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DWall;
FElementType: TDoorObjType;
FSlopes: TList;
FBalconElements: TList;
FSides: TList;
constructor Create(aFaces: TList; aNetDoor: TNetDoor; aElementType: TDoorObjType; aParent: T3DWall);
// Tolik 24/07/2018 --
destructor destroy; override;
//
procedure CollectDoor(aFaces: TList; ap: T3DPointArray);
procedure CollectWindow(aFaces: TList; ap: T3DPointArray);
procedure CollectBalcon(aFaces: TList; ap1, ap2: T3DPointArray);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
T3DBalconElement = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DWallElement;
FElementType: TDoorObjType;
FSides: TList;
constructor Create(aFaces: TList; aElementType: TDoorObjType; aParent: T3DWallElement);
// Tolik 24/07/2018 --
Destructor destroy; override;
//
procedure CollectBalconDoor(aFaces: TList; ap1: T3DPointArray);
procedure CollectBalconWindow(aFaces: TList; ap2: T3DPointArray);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
T3DSlope = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DWallElement;
FSides: TList;
constructor Create(aFaces: TList; aNetDoor: TNetDoor; aParent: T3DWallElement);
// Tolik 24/07/2018 - -
Destructor destroy; override;
//
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
T3DSide = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FDescription: TStringList;
FParent: TObject;
FGLObject: TObject;
FFace: TFaceRecord;
FFaceType: TFaceType;
FWallType: TFaceWallType;
FSideType: TWallSideType;
FPoints: T3DPointArray;
FGLPoints: T3DPointArray;
FColor: TColor;
FTextureRotate: Integer;
FTextureScale: Integer;
FMirror: Boolean;
FAsArc: Boolean;
FTextureHash: string;
FTexture_ext: string;
FSubSides: TList;
FZOrder: double;
FNetPath: TNetPath; //29.05.2012
constructor Create(aFaceType: TFaceType; aWallType: TFaceWallType; aSideType: TWallSideType; aParent: TObject; aNetPath: TNetPath=nil);
// Tolik 24/07/2018 --
destructor destroy; override;
//
procedure CollectWallSide(aFaces: TList; ap: T3DPointArray);
procedure CollectWallSideEx(aFaces: TList; ap: T3DPointArray);
procedure CollectArcWallSide(aFaces: TList; ap: T3DPointArray);
procedure CollectWallElementSide(aFaces: TList; ap: T3DPointArray; fTrans: boolean = False);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
function GetArea: Double;
end;
T3DSObject = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FDescription: TStringList;
FParent: T3DRoom;
FGLObject: TObject;
FFace: TFaceRecord;
FPosition: T3DPoint;
FScale: T3DPoint;
FRotate: T3DPoint;
FObjectHash: string;
FTextureHash: string;
FTexture_ext: string;
FZOrder: double;
//FFiles: TStringList;
//FHashs: TStringList;
constructor Create(aParent: T3DRoom);
// Tolik 24/07/218 --
destructor destroy; override;
//
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
T3DConnector = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FIndex: Integer;
FDescription: TStringList;
FCaptions: TStringList;
FNotes: TStringList;
FListID: Integer;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DModel;
FGLObject: TObject;
FGLObject1: TObject;
FGLCaption: TObject;
FSCSObject: TConnectorObject;
FFace: TFaceRecord;
FPoint: T3DPoint;
FGLPoint: T3DPoint;
FOffset: T3DPoint;
FScale: T3DPoint;
FRotate: T3DPoint;
FObjectHash: string;
FTextureHash: string;
FTexture_ext: string;
FZOrder: double;
//FFiles: TStringList;
//FHashs: TStringList;
FColor: TVector4f;
FConnType: T3DConnType;
FJoinedConnectorsList: TList;
FJoinedLinesList: TList;
FPipeRadiusArray: array of Double; // Tolik 26/09/2018 --
T3DModelFile: String;
FisPipeElement: Boolean; // Tolik 24/09/2018 --
// Tolik 13/10/2018 --
F3dModelFileName: String;
FPipeRadius: Double;
F3D_Height: Double;
F3D_Width: Double;
F3D_Length: Double;
FUse3DSize: Boolean;
HasPipeElements: Boolean; // äëÿ ïóñòîãî êîííåêòîðà, åñëè íà íåì áóäóò ðèñîâàòüñÿ ïîâîðîòû òðóá, ãîôðû è ò.ï
FRelatedLines: TList; // Tolik 03/04/2025 -- òðàññû, ïî êîòîðûì ðèñóåòñÿ ÷àñòü òðóáíîãî ñîåäèíåíèÿ
FLength: Double; // Tolik 03/04/2025 äëèíà ñîåäèíåíèÿ
//
//Tolik -- 24//09/2018 --
//constructor Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel);
constructor Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel; aIsPipe: Boolean = False); virtual;
//
// Tolik 24/07/2018 --
destructor destroy; override;
//
procedure CollectConnector(aFaces: TList; ap: T3DPointArray);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
Function Get3DModelFileName(aSCSObject: TConnectorObject): String;
end;
//Tolik 17/10/2018 --
T3DComponent = Class(T3DConnector)
Public
AbsVector, AbsUpVector: TVector4F;
absMatrix: TMatrix4F;
isGroupedFigure: Boolean;
constructor Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel; aIsPipe: Boolean = False); override;
//Destructor Destroy;
end;
//
T3DLine = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FIndex: Integer;
FDescription: TStringList;
FCaptions: TStringList;
FLength: Double;
FNotes: TStringList;
FListID: Integer;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DModel;
FGLObject: TObject;
FGLCaption: TObject;
FSCSObject: TOrthoLine;
FFace: TFaceRecord;
FPoint1: T3DPoint;
FPoint2: T3DPoint;
FGLPoint1: T3DPoint;
FGLPoint2: T3DPoint;
FZOrder: double;
FColor: TColor;
FLineType: T3DLineType;
FJoinConnector1: T3DConnector; // ñîåäèíèòåëü 1
FJoinConnector2: T3DConnector; // ñîåäèíèòåëü 2
// Tolik 08/11/2018 - -
ComponDiameterList: TStringList; // ñïèñîê ìàêñ. äèàìåòðîâ êîìïîíåíò íà òðàññå (åñëè îíè åñòü)
//[0] -- êàáåëü
//[1] -- ãîôðà
//[2] -- êàá êàíàë
constructor Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel); virtual;
// Tolik 24/07/2018 --
destructor destroy; override;
//
procedure CollectLine(aFaces: TList; ap: T3DPointArray);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
// Tolik 18/10/2018 --
T3DLineComponent = class(T3DLine)
public
constructor Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel);override;
end;
//
// Tolik 18/09/20108 --
T3DTube = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FIndex: Integer;
FDescription: TStringList;
FCaptions: TStringList;
FLength: Double;
FTopDiameter: Double;
FBottomDiameter: Double;
FNotes: TStringList;
FListID: Integer;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DModel;
FGLObject: TObject;
FGLCaption: TObject;
FSCSObject: TOrthoLine;
FFace: TFaceRecord;
FPoint1: T3DPoint;
FPoint2: T3DPoint;
FGLPoint1: T3DPoint;
FGLPoint2: T3DPoint;
FZOrder: double;
FColor: TColor;
FLineType: T3DLineType;
FJoinConnector1: T3DConnector; // ñîåäèíèòåëü 1
FJoinConnector2: T3DConnector; // ñîåäèíèòåëü 2
constructor Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel; aSCSCompon: TSCSComponent; aTubeDiameter: Double; aTailTubeList: TList = nil);
destructor destroy; override;
procedure CollectCylinder(aFaces: TList; ap: T3DPointArray);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
T3DBooblick = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FIndex: Integer;
FDescription: TStringList;
FCaptions: TStringList;
FLength: Double;
FTopDiameter: Double;
FBottomDiameter: Double;
FNotes: TStringList;
FListID: Integer;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DModel;
FGLObject: TObject;
FGLCaption: TObject;
FSCSObject: TConnectorObject;
FFace: TFaceRecord;
FPoint1: T3DPoint;
FPoint2: T3DPoint;
FGLPoint1: T3DPoint;
FGLPoint2: T3DPoint;
FZOrder: double;
FColor: TColor;
FLineType: T3DLineType;
FJoinConnector1: T3DConnector; // ñîåäèíèòåëü 1
FJoinConnector2: T3DConnector; // ñîåäèíèòåëü 2
constructor Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel);
destructor destroy; override;
procedure CollectBooblick(aFaces: TList; ap: T3DPointArray);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
// ñðàâíåíèå êîîðäèíàò
function CoordsCMP(p1, p2: TDoublePoint): Boolean;
// ñðàâíåíèå óãëîâ
function AnglesCMP(a1, a2: Double): Boolean;
// ñðàâíåíèå äèñòàíöèè ìåæäó òî÷êàìè
function PointDistCMP(p: TDoublePoint; aNetPath: TNetPath): Boolean;
function FindVirtualNetPathByReal(aGrpNet: TNet; aNetPath: TNetPath; aExtCheck: Boolean=false): TNetPath;
// ïîëó÷èòü òèï ñòåíû ïî òèïó îáüåêòà TNetDoor
function GetWallTypeByDoorType(aDoor: TNetDoor): TFaceWallType;
// ïîëó÷èòü òî÷êè ñòåíû ñ ó÷åòîì îòêîñîâ îêíà/äâåðè/áàëêîíà
procedure GetWallPointsWithSlope(var da1, da2, db1, db2: TDoublePoint; hor_a1, hor_a2, hor_b1, hor_b2: double);
// ïîëó÷èòü òî÷êè äâåðè/îêíà/áàëêîíà ñ ó÷åòîì îòêîñîâ îêíà/äâåðè/áàëêîíà
procedure GetDoorPointsWithSlope(var c: TDoublePoint; d: TDoublePoint; depth: double);
// ïîëó÷èòü ñòðîêó Hash äëÿ ôàéëà òåêñòóðû
function GetImageHash(aFName: string): string;
function GetObjectHash(aFName: string): string;
function GetArcWallPointsAll(aPoints: T3DPointArray; FPlanObject: TNetPath; isWall: boolean = False): T3DPointArray;
function GetAllNets(aCad: TF_CAD): TList;
function GetVirtualNetPathsByRealNet(aNet, aGrpNet: TNet): TList;
function GetWorkDir: string;
Procedure GetCeilingConture(aNet: TNet; aPaths: Tlist; var aCeilingConture: TDoublePointArr);
function ConverResultToUom(aResult: Double; aIzm: String): Double; // Tolik 18/10/2018 --
Function GetPoint(aLine: TOrthoLine; PointNum: Integer; dist: Double): PDoublePoint; // Tolik 18/10/2018 --
Function GetPointA(apoint1, aPoint2: TDoublePoint; dist: Double): PDoublePoint; // Tolik 12/10/2025 --
const
{TODO}
FDeltaZ: Double = 0.030;
FDeltaZFloor: Double = 0.025; // 0.045
FDeltaZPlane: Double = 0.015;
FDeltaZSlope: Double = 0.035; // 0.025
// îòñòóï îò ïîëà
FFloorDelta: Double = 0.00; //.01
// îòñòóï äî ïîòîëêà îò âåðõíèõ ãðàíåé ñòåíû
FFCeilingDelta: Double = 0.00; //.01
// íà÷àëî ïîñòðîåíèå îáüåêòîâ îêíî, äâåðü, íèøà, áàëêîí
FStartDoorObject: Double = 0.0; // 0.03
// îòñòóï îò íèæíåé ãðàíè îáüåêòà äî âåðõíåé ãðàíè ñòåíû
// íàïðèìåð íàðèñîâàòü êóñîê ñòåíû ïîä îêíîì, ÷òîáû íèæíÿÿ ãðàíü îêíà íå ñëèâàëàñü ñ âåðõíåé ãðàíüþ ñòåíû
FDoorObjectDelta: Double = 0.0; //.01
// íàèìåíîâàíèÿ îáüåêòîâ ìîäåëè
{//15.08.2012
cModel = '3D Ìîäåëü';
cRoom = 'Êîìíàòà ';
cWall = 'Ñòåíà ';
cDoor = 'Äâåðíîé ïðîåì ';
cWindow = 'Îêîííûé ïðîåì ';
cBalcon = 'Áàëêîííûé ïðîåì ';
cNiche = 'Íèøà ';
cArc = 'Àðêà ';
cInnerSlope = 'Îòêîñ';
cOuterSlope = 'Âíåøíèé îòêîñ';
cSide = 'Ãðàíü ';
cFloor = 'Ïîë';
cCeiling = 'Ïîòîëîê';
cSubSide = 'Ïîäãðàíü ';}
var
InnerwallStream: TMemoryStream;
OuterwallStream: TMemoryStream;
FloorStream: TMemoryStream;
CeilingStream: TMemoryStream;
DoorStream: TMemoryStream;
WindowStream: TMemoryStream;
ArcStream: TMemoryStream;
BalconStream: TMemoryStream;
NicheStream: TMemoryStream;
tmpdir_a, tex_innerwall, tex_outerwall, tex_floor, tex_ceiling,
tex_doorslope, tex_windowslope, tex_arc, tex_balconslope, tex_niche: string;
FScaleDelta: Double;
FScaleDeltaSCS: Double;
FGroupNet: TNet;
//FSingleRoom: Boolean;
//06.06.2012
GArch3DInnerSidesFromVirtual: Boolean = true;
GArch3DAllowAlignPoint: Boolean = false;
implementation
uses U_BaseCommon, U_ArchCommon, U_Common, U_Protection, U_ProtectionCommon, Form3d,
U_Constants, GLTexture, U_MAIN;
// Tolik 25/12/2019 --
//function comparePoint(aCPoint1, ACPoint2: TDoublePoint): Boolean;
function comparePoint(aCPoint1, ACPoint2: TDoublePoint; aDelta: Double): Boolean;
var currDelta: Double;
begin
try
currDelta := ABS(aCPoint1.x - aCPoint2.x);
if CompareValue(currDelta, aDelta) = -1 then
begin
currDelta := ABS(aCPoint1.y - aCPoint2.y);
if CompareValue(currDelta, aDelta) = -1 then
Result := True
else
result := False;
end
else
result := False;
except
on e: Exception do
result := False;
end;
{
if CompareValue(aCPoint1.x, aCPoint2.x) = 0 then
begin
if CompareValue(aCPoint1.y, aCPoint2.y) = 0 then
Result := true
else
Result := False;
end
else
Result := False;}
end;
//
//Tolik 18/10/2018 --
function ConverResultToUom(aResult: Double; aIzm: String): Double;
var div_koeff: integer;
ProjUOM: Integer;
UomIzm, CadUomIzm: Double;
begin
Result := aResult;
UomIzm := -1;
if (aIzm = 'm') then
UomIzm := 1
else
if (aIzm = 'm.') then
UomIzm := 1
else
if (aIzm = 'ì') then
UomIzm := 1
else
if (aIzm = 'ì.') then
UomIzm := 1
else
if (aIzm = 'sm') then
UomIzm := 100
else
if (aIzm = 'sm.') then
UomIzm := 100
else
if (aIzm = 'ñì') then
UomIzm := 100
else
if (aIzm = 'ñì.') then
UomIzm := 100
else
if (aIzm = 'mm') then
UomIzm := 1000
else
if (aIzm = 'mm.') then
UomIzm := 1000
else
if (aIzm = 'ìì') then
UomIzm := 1000
else
if (aIzm = 'ìì.') then
UomIzm := 1000
else
if (aIzm = 'ft') then
UomIzm := 0.3
else
if (aIzm = 'ft.') then
UomIzm := 0.3
else
if (aIzm = 'ôò') then
UomIzm := 0.3
else
if (aIzm = 'ôò.') then
UomIzm := 0.3
else
if (aIzm = 'dm') then
UomIzm := 0.025
else
if (aIzm = 'dm.') then
UomIzm := 0.025
else
if (aIzm = 'äì') then
UomIzm := 0.025
else
if (aIzm = 'äì.') then
UomIzm := 0.025;
if UomIzm <> -1 then
begin
ProjUOM := F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure;
Case ProjUom of
umSantimetr : CadUomIzm := 100;
umMetr : CadUomIzm := 1;
umInch : CadUomIzm := 0.025;
umFoot : CadUomIzm := 0.3;
end;
Result := aResult * (CadUomIzm/UomIzm);
//Result := aResult * (UomIzm/CadUomIzm);
end;
end;
Function GetPoint(aLine: TOrthoLine; PointNum: Integer; dist: Double): PDoublePoint;
var p1, p2: TDoublePoint;
i: Integer;
TubeCompon: TSCSComponent;
distx, disty, distz, koefx, koefy, koefz, LineLen: Double;
LineCatalog: TSCSCatalog;
CirclePoint: PDoublePoint;
RealRadius: Double;
PointsAngle: Double;
Conn1,Conn2: TConnectorObject;
MaxX, MaxY, MinX, MinY, DistToPoint: Double;
begin
Result := Nil;
New(Result);
DistToPoint := Dist;
Conn1 := TConnectorObject(aLine.JoinConnector1);
Conn2 := TConnectorObject(aLine.JoinConnector2);
if Conn1.JoinedConnectorsList.Count > 0 then
begin
Conn1 := TConnectorObject(Conn1.JoinedConnectorsList[0]);
if PointNum = 1 then
begin
Conn1.GetBounds(MaxX, MaxY, MinX, MinY);
DistTopoint := DistToPoint + ((Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))) / (UOMToMetre(1000 / GCadForm.PCad.MapScale)))/4;
end;
end;
if Conn2.JoinedConnectorsList.Count > 0 then
begin
Conn2 := TConnectorObject(Conn2.JoinedConnectorsList[0]);
if PointNum = 2 then
begin
Conn2.GetBounds(MaxX, MaxY, MinX, MinY);
DistTopoint := DistToPoint + ((Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))) / (UOMToMetre(1000 / GCadForm.PCad.MapScale)))/4;
end;
end;
if PointNum = 1 then
begin
p1.x := Conn1.ap1.x;
p1.y := Conn1.ap1.y;
p1.z := UomToMetre(Conn1.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale));
//p1.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1];
p2.x := Conn2.ap1.x;
p2.y := Conn2.ap1.y;
p2.z := UomToMetre(Conn2.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale));
//p2.z := TConnectorObject(aLine.JoinConnector2).ActualZOrder[1];
end
else
if PointNum = 2 then
begin
p2.x := Conn1.ap1.x;
p2.y := Conn1.ap1.y;
p2.z := UomToMetre(Conn1.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale));
//p2.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1];
p1.x := Conn2.ap1.x;
p1.y := Conn2.ap1.y;
p1.z := (UomToMetre(Conn2.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)));
//p1.z := TConnectorObject(aLine.JoinConnector2).ActualZOrder[1];
end
else
begin
Dispose(Result);
Result := Nil;
exit;
end;
LineLen := SQRT(SQR(p1.x - p2.x) + SQR(p1.y - p2.y) + SQR(p1.z - p2.z));
koefx := (p2.x - p1.x)/LineLen;
koefy := (p2.y - p1.y)/LineLen;
koefz := (p2.z - p1.z)/LineLen;
Result.x := p1.x + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx);
Result.y := p1.y + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy);
Result.z := MetreToUom(p1.z + DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz)/(UOMToMetre(1000 / GCadForm.PCad.MapScale));
//Result.x := p1.x + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx);
//Result.y := p1.y + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy);
//Result.z := MetreToUom((p1.z + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz))/(UOMToMetre(1000 / GCadForm.PCad.MapScale)));
end;
// Äëÿ ðàñ÷åòà òî÷åê ïîïåðå÷íîé îòðèñîâêè ñåòêè (åñëè ýòî, íàïðèìåð, ïðîâîëî÷íûé ëîòîê)
Function GetPointA(aPoint1, aPoint2: TDoublePoint; dist: Double): PDoublePoint; // Tolik 12/10/2025 --
var
p1, p2: TDoublePoint;
distx, disty, distz, koefx, koefy, koefz, LineLen: Double;
DistToPoint: Double;
begin
Result := Nil;
New(Result);
DistToPoint := Dist;
p1.x := aPoint1.x;
p1.y := aPoint1.y;
p1.z := UomToMetre(aPoint1.z) * (UOMToMetre(1000 / GCadForm.PCad.MapScale));
//p1.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1];
p2.x := aPoint2.x;
p2.y := aPoint2.y;
p2.z := UomToMetre(aPoint2.z) * (UOMToMetre(1000 / GCadForm.PCad.MapScale));
LineLen := SQRT(SQR(P1.x - P2.x) + SQR(P1.y - P2.y) + SQR(P1.z - P2.z));
koefx := (P2.x - P1.x)/LineLen;
koefy := (P2.y - P1.y)/LineLen;
koefz := (P2.z - P1.z)/LineLen;
Result.x := P1.x + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx);
Result.y := P1.y + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy);
Result.z := MetreToUom(P1.z + DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz)/(UOMToMetre(1000 / GCadForm.PCad.MapScale));
//Result.x := p1.x + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx);
end;
function GetTubeRadius(aSCSCompon: TSCSComponent): Double;
var i : Integer;
NBProp: TNBProperty;
PipeDiameter_edIzm: String;
currProp: PProperty;
begin
Result := -1;
for i := 0 to aSCScompon.Properties.Count - 1 do
begin
if UPPERCASE(PProperty(aSCSCompon.Properties[i]).SysName) = pnOutDiametr then
begin
try
currProp := PProperty(aSCSCompon.Properties[i]);
Result := StrToFloat_My(PProperty(aSCSCompon.Properties[i]).Value)/2;
//PropValueInUOM(Result, UPPERCASE(PProperty(aSCSCompon.Properties[i]).SysName), ProjUOM, ProjUOM);
NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(currProp.GuidProperty);
if NbProp <> nil then
begin
PipeDiameter_edIzm := NbProp.PropertyData.Izm;
Result := ConverResultToUom(Result, PipeDiameter_edIzm);
end;
except
end;
if Result <> -1 then
break;
end;
end;
end;
Function getLineComponOutRadius(aLineComponent: TSCSComponent): double;
var LineComponProp: PProperty;
NBProp: TNBProperty;
OutDiam: Double;
LineComponCatalog: TSCSCatalog;
SideString, SideString1: String;
Side1, Side2: Double;
CharPos: integer;
ED_Izm: string;
begin
Result := -1;
ED_Izm := 'mm';
if (aLineComponent.ComponentType.SysName <> ctsnCableChannel) or (aLineComponent.ComponentType.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}') then
begin
LineComponProp := aLineComponent.GetPropertyBySysName(pnOutDiametr);
if LineComponProp <> nil then
begin
OutDiam := StrToFloat_My(LineComponProp.Value);
if OutDiam > 0 then
begin
NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty);
if NbProp <> nil then
//Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm)
ED_Izm := NbProp.PropertyData.Izm
else
begin
OutDiam := 0;
LineComponProp := Nil;
end;
end;
end
else
//if isCableComponent(aLineComponent) then // if Cable
begin
LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection);
if LineComponProp <> nil then
begin
OutDiam := StrToFloat_My(LineComponProp.Value);
if OutDiam > 0 then
begin
OutDiam := SQRT(OutDiam);
NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty);
if NbProp <> nil then
//Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm);
ED_Izm := NbProp.PropertyData.Izm
else
begin
OutDiam := 0;
LineComponProp := Nil;
end;
end;
end
end;
if LineComponProp = nil then // try to find in_section or inside diameter
begin
LineComponProp := aLineComponent.GetPropertyBySysName(pnInDiametr);
if LineComponProp <> nil then
begin
Outdiam := StrToFloat_My(LineComponProp.Value);
if OutDiam > 0 then
begin
OutDiam := SQRT(OutDiam);
NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty);
if NbProp <> nil then
//Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm);
ED_Izm := NbProp.PropertyData.Izm
else
begin
OutDiam := 0;
LineComponProp := Nil;
end;
end;
end;
end;
if LineComponProp = nil then
begin
LineComponProp := aLineComponent.GetPropertyBySysName(pnInSection);
if LineComponProp <> nil then
begin
Outdiam := StrToFloat_My(LineComponProp.Value);
if OutDiam > 0 then
begin
OutDiam := SQRT(OutDiam);
NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty);
if NbProp <> nil then
//Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm);
ED_Izm := NbProp.PropertyData.Izm
else
begin
OutDiam := 0;
LineComponProp := Nil;
end;
end;
end;
end;
end
else
begin
LineComponProp := aLineComponent.GetPropertyBySysName(pnCableChannelSideSection);// ðàçìåð ñòîðîíû êàá êàíàëà
//LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); // íàðóæíîå ñå÷åíèå
if LineComponProp <> nil then
begin
SideString := UpperCase(LineComponProp.Value);
if SideString <> '' then
begin
SideString := StringReplace(SideString,'Õ','X',[rfReplaceAll]);
CharPos := Pos('X', SideString);
if CharPos > 1 then
begin
SideString1 := copy(SideString, 1, CharPos - 1);
Delete(SideString,1,CharPos);
Try
Side1 := StrToFloat_My(SideString);
Side2 := StrToFloat_My(SideString1);
except
on E: Exception do
LineComponProp := Nil;
end;
if LineComponProp <> nil then
begin
OutDiam := SQRT(Side1 * Side2);
Result := ConverResultToUom(OutDiam/2, 'mm');
end;
end
else
LineComponProp := Nil;
end;
end
else
begin
LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); // íàðóæíîå ñå÷åíèå
if LineComponprop <> nil then
begin
OutDiam := StrToFloat_My(LineComponProp.Value);
if OutDiam > 0 then
begin
OutDiam := SQRT(OutDiam);
Result := ConverResultToUom(OutDiam/2, 'mm');
end
else
LineComponProp := nil;
end;
end;
end;
if LineComponProp = nil then
begin
LineComponCatalog := aLineComponent.GetfirstParentCatalog;
if LineComponCatalog <> nil then
AddExceptionToLogEx('Tfrm3D: ', _3DNotSetSideSection + LineComponCatalog.GetNameForVisible(False) +'\'+ aLineComponent.GetNameForVisible(False));
end;
Result := ConverResultToUom(OutDiam/2, 'mm');
end;
//
//Tolik 09/07/2018 --
Function CollectSCSWallEntries(aPathList: TList): TList; //
var i, j: Integer;
PathInfo: PNetEntryInfo;
currPath: TNetPath;
//f: TextFile;
//PathList: TList;
begin
Result := TList.Create;
//PathList := TList.Create;
{for i := 0 to aPathList.Count - 1 do
begin
currPath := TNetPath(aPathList[i]);
if (CompareValue(currPath.p1.x, currPath.p2.x) <> 0) or (CompareValue(currPath.p1.y, currPath.p2.y) <> 0) then
if PathList.IndexOf(currPath) = -1 then
PathList.Add(currPath);
end;}
// AssignFile(f, 'd:\PathPoints.txt');
// rewrite(f);
//for i := 0 to PathList.Count - 1 do
for i := 0 to aPathList.Count - 1 do
begin
//if not currPath.ISClosed then
begin
currPath := TNetPath(aPathList[i]);
//23/12/2019 -- ïðîâåðêà è îòñåèâàíèå ïóòåé, ó êîòîðûõ íà÷àëî è êîíåö â îäíîé òî÷êå (äëÿ ñòàðûõ ïðîåêòîâ)
if comparePoint(currPath.p1^, currPath.p2^, myDelta) then
Continue;
{ writeln(f, 'Path ' + inttostr(i) + ': P1.x = ' + FloatTostr(currPath.p1.x) + ' P1.y = ' + FloatTostr(currPath.p1.y));
writeln(f, 'Path ' + inttostr(i) + ': P2.x = ' + FloatTostr(currPath.p2.x) + ' P2.y = ' + FloatTostr(currPath.p2.y));
writeln(f,' ');}
New(PathInfo);
PathInfo.NetPath := currPath;
PathInfo.P1EntryCount := 1;
PathInfo.P2EntryCount := 1;
for j := 0 to aPathList.Count - 1 do
begin
if TNetPath(aPathList[j]) <> currPath then
begin
if comparePoint(TNetPath(aPathList[j]).p1^, currPath.p1^, myDelta) then
Inc(PathInfo.P1EntryCount);
if comparePoint(TNetPath(aPathList[j]).p2^, currPath.p2^, myDelta) then
Inc(PathInfo.P2EntryCount);
if comparePoint(TNetPath(aPathList[j]).p2^, currPath.p1^, myDelta) then
Inc(PathInfo.P1EntryCount);
if comparePoint(TNetPath(aPathList[j]).p1^, currPath.p2^, myDelta) then
Inc(PathInfo.P2EntryCount);
end;
end;
end;
Result.Add(PathInfo);
end;
// CloseFile(f);
// PathList.Free;
end;
Function GetContureListFromNet(aNets: TNet; var aFloorsConturesList, aNormalList: TList): TList; // âåðíåò ñïèñîê èç îòäåëüíûõ ñòåí è êîíòóðîâ(ñïèñîê ñïèñêîâ)
var i, j: Integer;
CanProceed: Boolean;
NetList: TList;
CurrNet: TNet;
PathList: TList;
Path1, Path2, currPath, StartPath: TNetPath;
RemovedPathList: TList;
NetContureL, NetContureR, LeftNormalConture, RightNormalConture: TList;
LeftContureLen, RightContureLen, LeftLen, RightLen: Double;
LeftFloorConture, RightFloorConture: TList;
cp: PDoublePoint;
currPointOrder: Integer; // Tolik 25/12/2019 -- ïîêàêîé òî÷êå èäåì
// 1 - r1
// 2 - r2
// 3 - l1
// 4 - l2
PassedList: TList; // 24/12/2019 --
PathPoint: PDoublePoint;
PrevPoint: TDoublePoint;
LastArcPathLen: Double;
PathToDel: TNetPath;
f: TextFile;
s: string;
Procedure RemovepathFromList(aPath: TNetPath; aRemovePath: Boolean = true);
var i: Integer;
currEntryInfo: PNetEntryInfo;
begin
currEntryInfo := Nil;
for i := 0 to PathList.Count - 1 do
begin
if PNetEntryInfo(PathList[i]).NetPath <> aPath then
begin
if comparePoint(PNetEntryInfo(PathList[i]).NetPath.p1^, aPath.p1^,myDelta) then
Dec(PNetEntryInfo(PathList[i]).P1EntryCount);
if comparePoint(PNetEntryInfo(PathList[i]).NetPath.p2^, aPath.p2^, myDelta) then
Dec(PNetEntryInfo(PathList[i]).P2EntryCount);
if comparePoint(PNetEntryInfo(PathList[i]).NetPath.p1^, aPath.p2^, myDelta) then
Dec(PNetEntryInfo(PathList[i]).P1EntryCount);
if comparePoint(PNetEntryInfo(PathList[i]).NetPath.p2^, aPath.p1^, myDelta) then
Dec(PNetEntryInfo(PathList[i]).P2EntryCount);
end
else
currEntryInfo := PNetEntryInfo(PathList[i]);
end;
if currEntryInfo <> nil then
begin
if aRemovePath then
begin
// óäàëèòü èç ñïèñêà
for i := 0 to PathList.Count - 1 do
begin
if PNetEntryInfo(PathList[i]).NetPath = aPath then
begin
PathList.Delete(i);
break;
end;
end;
Dispose(currEntryInfo);
end;
end;
end;
Function HasRelatedPoint(aPath1, aPath2: TNetPath): Boolean;
begin
if comparePoint(aPath1.p1^, aPath2.p1^, myDelta) then
begin
Result := True;
exit;
end;
if comparePoint(aPath1.p1^, aPath2.p2^, myDelta) then
begin
Result := True;
exit;
end;
if comparePoint(aPath1.p2^, aPath2.p1^, myDelta) then
begin
Result := True;
exit;
end;
if comparePoint(aPath1.p2^, aPath2.p2^, myDelta) then
begin
Result := True;
exit;
end;
end;
Procedure RemovePassedPaths;
var i: Integer;
canRemove: Boolean;
currPathInfo: PNetEntryInfo;
begin
CanRemove := True;
while canRemove do
begin
canRemove := False;
for i := PathList.Count - 1 downto 0 do
begin
if ((PNetEntryInfo(PathList[i]).P1EntryCount <= 1) or (PNetEntryInfo(PathList[i]).P2EntryCount <= 1)) then
begin
CanRemove := True;
currPathInfo := PNetEntryInfo(PathList[i]);
PathList.Delete(i);
Dispose(currPathInfo);
end;
end;
end;
end;
Procedure RemoveEntry(aPath: TNetPath);
var i: Integer;
currEntryInfo: PNetEntryInfo;
begin
currEntryInfo := Nil;
for i := 0 to PathList.Count - 1 do
begin
if PNetEntryInfo(PathList[i]).NetPath = aPath then
begin
currEntryInfo := PNetEntryInfo(PathList[i]);
PathList.Delete(i);
Dispose(currEntryInfo);
break;
end
end;
end;
function GetClosedConture(aPath: TNetPath; var aFlContList, aNormalList: TList; aLeft: Boolean = false): TList;
var i, BreakCounter, PathConnPoint: Integer;
ConnectedPathList: TList;
StartPoint, NextPoint: TDoublePoint;
NextPath, PrevPath: TNetPath;
ConturePoint: PDoublePoint;
function CheckInListById(aList: TList; aPath: TNetPath): Boolean;
var i: integer;
begin
Result := False;
for i := 0 to aList.Count - 1 do
begin
if TNetPath(aList[i]).Id = aPath.Id then
begin
Result := True;
break;
end;
end;
end;
Function GetConnPathsBySide(aConPath: TNetPath; aSide: integer): TList;
var i: Integer;
cp: TDoublePoint;
cpp: TNetPath;
begin
Result := TList.Create;
if aSide = 1 then
begin
cp.x := aConPath.p1.x;
cp.y := aConPath.p1.y;
end
else
begin
cp.x := aConPath.p2.x;
cp.y := aConPath.p2.y;
end;
for i := 0 to aPath.Net.Paths.Count - 1 do
begin
cpp := TNetPath(aPath.Net.Paths[i]);
if cpp <> aConPath then
begin
if comparePoint(cpp.p1^, cp, myDelta) or
comparePoint(cpp.p2^, cp, myDelta) then
if Result.IndexOf(cpp) = -1 then
Result.Add(cpp);
end;
end;
end;
Procedure AddPointToFloorConture(aPoint: TDoublePoint; addNormal: Boolean = False);
begin
New(ConturePoint);
ConturePoint.z := 0;
ConturePoint.x := APoint.x;
ConturePoint.y := APoint.y;
aFlContList.Add(ConturePoint);
if addNormal then
begin
New(ConturePoint);
ConturePoint.z := 0;
ConturePoint.x := APoint.x;
ConturePoint.y := APoint.y;
aNormalList.Add(ConturePoint);
end;
end;
//Function isUniquePoint(aPoint: TDoublePoint; aPath: TNetPath): Boolean;
Function isUniquePoint(aPoint: TDoublePoint; aPath: TNetPath; aSide: integer = 1): Boolean;
var i: Integer;
cPath: TNetPath;
PathList: TList;
begin
Result := True;
PathList := nil;
PathList := GetConnPathsBySide(aPath, aSide);
//for i := 0 to aNets.Paths.Count - 1 do
for i := 0 to PathList.Count - 1 do
begin
cPath := TNetPath(PathList[i]);
if cPath <> aPath then
begin
if (
((CompareValue(aPoint.x, cPath.r1.x) = 0) and (CompareValue(aPoint.y, cPath.r1.y) = 0)) or
((CompareValue(aPoint.x, cPath.l1.x) = 0) and (CompareValue(aPoint.y, cPath.l1.y) = 0)) or
((CompareValue(aPoint.x, cPath.r2.x) = 0) and (CompareValue(aPoint.y, cPath.r2.y) = 0)) or
((CompareValue(aPoint.x, cPath.l2.x) = 0) and (CompareValue(aPoint.y, cPath.l2.y) = 0))
) then
begin
Result := False;
break;
end;
end;
end;
freeAndnil(PathList);
end;
(*
Function isUniquePoint(aPoint: TDoublePoint; aPath: TNetPath): Boolean;
var i: Integer;
cPath: TNetPath;
begin
Result := True;
{
for i := 0 to ConnectedPathList.Count - 1 do
begin
cPath := TNetPath(ConnectedPathList[i]);
if cPath <> aPath then
begin
cPath := TNetPath(ConnectedPathList[i]);
if (
((CompareValue(aPoint.x, cPath.r1.x) = 0) and (CompareValue(aPoint.y, cPath.r1.y) = 0)) or
((CompareValue(aPoint.x, cPath.r2.x) = 0) and (CompareValue(aPoint.y, cPath.r2.y) = 0)) or
((CompareValue(aPoint.x, cPath.l1.x) = 0) and (CompareValue(aPoint.y, cPath.l1.y) = 0)) or
((CompareValue(aPoint.x, cPath.l2.x) = 0) and (CompareValue(aPoint.y, cPath.l2.y) = 0))
) then
begin
Result := False;
break;
end;
end;
end;
}
for i := 0 to aNets.Paths.Count - 1 do
begin
cPath := TNetPath(aNets.Paths[i]);
if cPath <> aPath then
begin
if (
((CompareValue(aPoint.x, cPath.r1.x) = 0) and (CompareValue(aPoint.y, cPath.r1.y) = 0)) or
((CompareValue(aPoint.x, cPath.r2.x) = 0) and (CompareValue(aPoint.y, cPath.r2.y) = 0)) or
((CompareValue(aPoint.x, cPath.l1.x) = 0) and (CompareValue(aPoint.y, cPath.l1.y) = 0)) or
((CompareValue(aPoint.x, cPath.l2.x) = 0) and (CompareValue(aPoint.y, cPath.l2.y) = 0))
) then
begin
Result := False;
break;
end;
end;
end;
end;
*)
Procedure AddArcToFloorConture(aPath: TNetPath; var aLen: Double; aDirection: Integer; aStartP: TDoublePoint);
var i, range: Integer;
Point1, Point2: TDoublePoint;
arcPoints: T2DPointArray;
CCPoint: PDoublePoint;
Rad, ang1, ang2: Double;
invertarray: Boolean;
dxfModeFlag: Boolean;
LineLen1, LineLen2: double;
begin
if not aPath.isArc then
exit;
case aDirection of
1: begin
if aPath.Inverted then
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.l1);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.l2);
end
else
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.l2);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.l1);
end;
Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.l1.x) + sqr(aPath.ArcCenter.y - aPath.l1.y));
end;
2: begin
if aPath.Inverted then
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.l1);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.l2);
end
else
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.l2);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.l1);
end;
Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.l1.x) + sqr(aPath.ArcCenter.y - aPath.l1.y));
end;
3: begin
if aPath.Inverted then
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.r1);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.r2);
end
else
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.r2);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.r1);
end;
Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.r1.x) + sqr(aPath.ArcCenter.y - aPath.r1.y));
end;
4: begin
if aPath.Inverted then
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.r1);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.r2);
end
else
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.r2);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.r1);
end;
Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.r1.x) + sqr(aPath.ArcCenter.y - aPath.r1.y));
end;
end; // end case
if ang2 = 0 then
ang2 := 2 * pi;
dxfModeFlag := dxfMode32;
dxfMode32 := true;
BezierArcPoints(arcPoints, aPath.ArcCenter.x, aPath.ArcCenter.y, Rad, ang1, ang2);
dxfMode32 := dxfModeFlag;
range := Length(arcPoints) - 2;
LineLen1 := SQRT(sqr(aStartP.x - t2DPoint(arcPoints[0]).x) + sqr(aStartP.y - t2dPoint(arcPoints[0]).y));
LineLen2 := SQRT(sqr(aStartP.x - t2DPoint(arcPoints[range + 1]).x) + sqr(aStartP.y - t2dPoint(arcPoints[range + 1]).y));
if compareValue(LineLen1, LineLen2) = 1 then
invertarray := True
else
invertarray := False;
for i := 0 to range do
begin
aLen := aLen + SQRT(sqr(t2dPoint(arcPoints[i]).x - t2DPoint(arcPoints[i + 1]).x) + sqr(t2dPoint(arcPoints[i]).y - t2dPoint(arcPoints[i + 1]).y));
end;
inc(Range);
if invertarray then
begin
for i := 0 to range do
begin
New(CCPoint);
CCPoint.x := t2dPoint(ArcPoints[i]).x;
CCPoint.y := t2dPoint(ArcPoints[i]).y;
CCPoint.z := 0;
aFlContList.Add(CCPoint);
end;
end
else
begin
for i := range downto 0 do
begin
New(CCPoint);
CCPoint.x := t2dPoint(ArcPoints[i]).x;
CCPoint.y := t2dPoint(ArcPoints[i]).y;
CCPoint.z := 0;
aFlContList.Add(CCPoint);
end;
end;
New(CCPoint);
CCPoint.x := aStartP.x;
CCPoint.y := aStartP.y;
CCPoint.z := 0;
aNormalList.Add(CCPoint);
SetLength(arcPoints,0);
if aPath.Inverted then
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.p1^);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.p2^);
end
else
begin
ang1 := GetRadOfLine(aPath.ArcCenter, aPath.p2^);
ang2 := GetRadOfLine(aPath.ArcCenter, aPath.p1^);
end;
Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.p1.x) + sqr(aPath.ArcCenter.y - aPath.p1.y));
dxfModeFlag := dxfMode32;
dxfMode32 := true;
BezierArcPoints(arcPoints, aPath.ArcCenter.x, aPath.ArcCenter.y, Rad, ang1, ang2);
dxfMode32 := dxfModeFlag;
range := Length(arcPoints) - 2;
for i := 0 to range do
begin
LastArcPathLen := LastArcPathLen + SQRT(sqr(t2dPoint(arcPoints[i]).x - t2DPoint(arcPoints[i + 1]).x) + sqr(t2dPoint(arcPoints[i]).y - t2dPoint(arcPoints[i + 1]).y));
end;
SetLength(arcPoints,0);
{
SetLength(arcPoints, 2);
arcPoints[0] := FromPoint;
arcPoints[1] := ToPoint;
resArcPoints := GetArcWallPointsAll(arcPoints, aPath);
range := Length(resArcPoints) - 2;
for i := 0 to range do //êîíòóð ïîëà
begin
New(CCPoint);
CCPoint^ := resArcPoints[i];
CCPoint.z := 0;
aFlContList.Add(CCPoint);
end;
inc(Range);
Point1 := resArcPoints[0]; // çäåñü ïîñ÷èòàòü äëèíó ïðîéäåííîé äóãè ê îáùåé ïðîéäåííîé äëèíå
for i := 1 to range do //êîíòóð ïîëà
begin
Point2 := resArcPoints[i];
aLen := aLen + SQRT(sqr(Point1.x - Point2.x) + sqr(Point1.y - Point2.y));
Point1 := Point2;
end;
SetLength(arcPoints, 0);
SetLength(resArcPoints, 0);
}
end;
Function GetPathWithUniquePoint(var aLen: Double): TNetPath;
var i, j, pct: Integer;
currPath, AddedPath: TNetPath;
PathFound: Boolean;
PathPoint: TDoublePoint;
p1Connection: Boolean;
PointList: TList;
Dist, mindist: Double;
AddPoint: TDoublePoint;
f: TextFile;
s: String;
ff: TStringList;
begin
{ff := TStringList.Create;
//AssignFile(f,'c:\users\Tolik\Documents\netpaths.txt');
//rewrite(f);
for i := 0 to aNets.Paths.Count - 1 do
begin
currPath := TNetPath(aNets.Paths[i]);
s := 'P1.X = '+ ';' + FloatTostr(currPath.p1.x) + ';' + 'P1.Y = ' + ';' + FloatTostr(currPath.p1.y);
ff.add(s);
s := 'P2.X = ' + ';'+ FloatTostr(currPath.p2.x) + ';' + 'P2.Y = ' + ';'+ FloatTostr(currPath.p2.y);
ff.add(s);
//writeln(f,s);
s := 'R1.Y = ' + ';'+ FloatTostr(currPath.r1.x) + ';' + 'R1.Y = ' + ';'+ FloatTostr(currPath.r1.y);
ff.add(s);
//writeln(f,s);
s := 'R2.X = ' + ';'+ FloatTostr(currPath.r2.x) + ';' + 'R2.Y = ' + ';'+ FloatTostr(currPath.r2.y);
ff.add(s);
//writeln(f,s);
s := 'L1.Y = ' + ';'+ FloatTostr(currPath.l1.x) + ';' + 'L1.Y = '+ ';' + FloatTostr(currPath.l1.y);
ff.add(s);
//writeln(f,s);
s := 'L2.X = ' + ';'+ FloatTostr(currPath.l2.x) + ';' + 'L2.Y = ' + ';'+ FloatTostr(currPath.l2.y);
ff.add(s);
//writeln(f,s);
ff.add(' ');
//writeln(f, '');
end;
//CloseFile(f);
}
Result := Nil;
mindist := -1;
AddedPath := nil;
pct := 0;
for i := 0 to ConnectedPathList.Count - 1 do
begin
if TNetPath(ConnectedPathList[i]) <> PrevPath then
begin
CurrPath := TNetPath(ConnectedPathList[i]);
p1Connection := (
((CompareValue(currPath.p1.x, PrevPath.p1.x) = 0) and (CompareValue(currPath.p1.y, PrevPath.p1.y) = 0)) or
((CompareValue(currPath.p1.x, PrevPath.p2.x) = 0) and (CompareValue(currPath.p1.y, PrevPath.p2.y) = 0))
);
if p1Connection then
begin
if isUniquePoint(currPath.r1, currPath, 1) then
begin
dist := sqrt(sqr(NextPoint.x - currPath.r1.x)+ sqr(NextPoint.y - currPath.r1.y));
if ((CompareValue(dist, mindist) = -1) or (minDist = -1)) then
begin
//Result := currPath;
//if RemovedPathList.IndexOf(NextPath) = -1 then
//begin
pct := 1;
AddedPath := currPath;
mindist := dist;
//AddPointToFloorConture(currPath.r1);
{
NextPoint.x := currPath.r2.x;
NextPoint.y := currPath.r2.y;
}
end;
//end
end
else
if isUniquePoint(currPath.l1, currPath, 1) then
begin
dist := sqrt(sqr(NextPoint.x - currPath.l1.x)+ sqr(NextPoint.y - currPath.l1.y));
if ((CompareValue(dist, mindist) = -1) or (minDist = -1)) then
begin
pct := 2;
//AddPointToFloorConture(currPath.l1);
AddedPath := currPath;
mindist := dist;
{
Result := currPath;
NextPoint.x := currPath.l2.x;
NextPoint.y := currPath.l2.y;
}
end;
end;
end
else
begin
if isUniquePoint(currPath.r2, currPath, 2) then
begin
dist := sqrt(sqr(NextPoint.x - currPath.r2.x)+ sqr(NextPoint.y - currPath.r2.y));
if ((CompareValue(dist, mindist) = -1) or (minDist = -1)) then
begin
mindist := dist;
pct := 3;
//AddPointToFloorConture(currPath.r2);
AddedPath := currPath;
{
Result := currPath;
NextPoint.x := currPath.r1.x;
NextPoint.y := currPath.r1.y;
}
end;
end
else
if isUniquePoint(currPath.l2, currPath, 2) then
begin
dist := sqrt(sqr(NextPoint.x - currPath.l2.x)+ sqr(NextPoint.y - currPath.l2.y));
if ((CompareValue(dist, mindist) = -1) or (minDist = -1)) then
begin
//AddPointToFloorConture(currPath.l2);
AddedPath := currPath;
mindist := dist;
pct := 4;
{
Result := currPath;
NextPoint.x := currPath.l1.x;
NextPoint.y := currPath.l1.y;
}
end;
end;
end;
end;
{if Result <> nil then
exit;}
end;
if AddedPath <> nil then
begin
case pct of
1:
begin
AddPointToFloorConture(AddedPath.r1);
NextPoint := AddedPath.r2;
aLen := aLen + Sqrt(sqr(AddedPath.r1.x - AddedPath.r2.x) + sqr(AddedPath.r1.y - AddedPath.r2.y) );//minDist;
end;
2:
begin
AddPointToFloorConture(AddedPath.l1);
NextPoint := AddedPath.l2;
aLen := aLen + Sqrt(sqr(AddedPath.l1.x - AddedPath.l2.x) + sqr(AddedPath.l1.y - AddedPath.l2.y) ); //minDist;
end;
3:
begin
AddPointToFloorConture(AddedPath.r2);
NextPoint := AddedPath.r1;
aLen := aLen + Sqrt(sqr(AddedPath.r1.x - AddedPath.r2.x) + sqr(AddedPath.r1.y - AddedPath.r2.y) );//+ minDist;
end;
4:
begin
AddPointToFloorConture(AddedPath.l2);
NextPoint := AddedPath.l1;
aLen := aLen + Sqrt(sqr(AddedPath.l1.x - AddedPath.l2.x) + sqr(AddedPath.l1.y - AddedPath.l2.y) );//+ minDist;
end;
end;
Result := AddedPath;
end;
end;
{
Function GetPathWithUniquePoint: TNetPath;
var i, j: Integer;
currPath: TNetPath;
PathFound: Boolean;
PathPoint: TDoublePoint;
p1Connection: Boolean;
PointList: TList;
begin
Result := Nil;
for i := 0 to ConnectedPathList.Count - 1 do
begin
if TNetPath(ConnectedPathList[i]) <> PrevPath then
begin
CurrPath := TNetPath(ConnectedPathList[i]);
p1Connection := (
((CompareValue(currPath.p1.x, PrevPath.p1.x) = 0) and (CompareValue(currPath.p1.y, PrevPath.p1.y) = 0)) or
((CompareValue(currPath.p1.x, PrevPath.p2.x) = 0) and (CompareValue(currPath.p2.y, PrevPath.p2.y) = 0))
);
if p1Connection then
begin
if isUniquePoint(currPath.r1, currPath, 1) then
begin
Result := currPath;
//if RemovedPathList.IndexOf(NextPath) = -1 then
//begin
AddPointToFloorConture(currPath.r1);
NextPoint.x := currPath.r2.x;
NextPoint.y := currPath.r2.y;
//end
end
else
if isUniquePoint(currPath.l1, currPath, 1) then
begin
AddPointToFloorConture(currPath.l1);
Result := currPath;
NextPoint.x := currPath.l2.x;
NextPoint.y := currPath.l2.y;
end;
end
else
begin
if isUniquePoint(currPath.r2, currPath, 2) then
begin
AddPointToFloorConture(currPath.r2);
Result := currPath;
NextPoint.x := currPath.r1.x;
NextPoint.y := currPath.r1.y;
end
else
if isUniquePoint(currPath.l2, currPath, 2) then
begin
AddPointToFloorConture(currPath.l2);
Result := currPath;
NextPoint.x := currPath.l1.x;
NextPoint.y := currPath.l1.y;
end;
end;
end;
if Result <> nil then
exit;
end;
end;
}
function GetNextPathByPoint(var aStartPoint: TDoublePoint; var aLen, aPathLen: double): TNetPath;
var i: Integer;
currPath: TNetPath;
seekPath: Boolean;
SeekPoint: TDoublePoint;
PointList: TList;
UPoint: PDoublePoint;
SavedPathList: TList;
Procedure FillConnectedbyPoint(aPoint: TDoublePoint);
var i: Integer;
NPath: TNetPath;
begin
ConnectedPathList.Clear;
for i := 0 to NextPath.Net.Paths.Count - 1 do
begin
NPath := TNetPath(NextPath.Net.Paths[i]);
if NPath.ID <> NextPath.Id then
begin
if comparePoint(NPath.P1^, aPoint, myDelta) or
comparePoint(NPath.P2^, aPoint, myDelta) then
if ConnectedPathList.IndexOf(NPath) = -1 then
ConnectedPathList.Add(NPath);
end;
end;
end;
Function GetNextUniquePoint: TNetPath;
var i: Integer;
Len1, Len2: Double;
ConnPath: TNetPath;
LastPoint: TDoublePoint;
begin
Result := Nil;
{Len1 := 1000000000;
for i := 0 to ConnectedPathList.Count - 1 do
begin
ConnPath := TNetPath(ConnectedPathList[i]);
if isUniquePoint(ConnPath.r1, ConnPath) then
begin
Len2 := Sqrt(sqr(ConnPath.r1.x - NextPoint.x) + sqr(ConnPath.r1.y - NextPoint.y));
if CompareValue(Len1,Len2) = 1 then
begin
Len1 := Len2;
Result := ConnPath;
LastPoint.x := ConnPath.r1.x;
LastPoint.y := ConnPath.r1.y;
end;
end;
if isUniquePoint(ConnPath.r2, ConnPath) then
begin
Len2 := (Sqrt(sqr(ConnPath.r2.x - NextPoint.x) + sqr(ConnPath.r2.y - NextPoint.y)));
if CompareValue(Len1,Len2) = 1 then
begin
Len1 := Len2;
Result := ConnPath;
LastPoint.x := ConnPath.r2.x;
LastPoint.y := ConnPath.r2.y;
end;
end;
if isUniquePoint(ConnPath.l1, ConnPath) then
begin
Len2 := (Sqrt(sqr(ConnPath.l1.x - NextPoint.x) + sqr(ConnPath.l1.y - NextPoint.y)));
if CompareValue(Len1,Len2) = 1 then
begin
Len1 := Len2;
Result := ConnPath;
LastPoint.x := ConnPath.l1.x;
LastPoint.y := ConnPath.l1.y;
end;
end;
if isUniquePoint(ConnPath.l2, ConnPath) then
begin
Len2 := (Sqrt(sqr(ConnPath.l2.x - NextPoint.x) + sqr(ConnPath.l2.y - NextPoint.y)));
if CompareValue(Len1,Len2) = 1 then
begin
Len1 := Len2;
Result := ConnPath;
LastPoint.x := ConnPath.l2.x;
LastPoint.y := ConnPath.l2.y;
end;
end;
end;}
if Result <> nil then
begin
aLen := aLen + Len1;
NextPoint.x := LastPoint.x;
NextPoint.y := LastPoint.y;
if (((CompareValue(NextPoint.x, NextPath.r1.x) = 0) and (CompareValue(NextPoint.y, NextPath.r1.y) = 0)) or
((CompareValue(NextPoint.x, NextPath.l1.x) = 0) and (CompareValue(NextPoint.y, NextPath.l1.y) = 0))) then
ConnectedPathList := GetConnPathsBySide(NextPath, 1)
else
ConnectedPathList := GetConnPathsBySide(NextPath, 2);
end;
end;
function GoAroundPath: TNetpath;
var NextPathPoint, p1,p2,p3: TDoublePoint;
oldOrder, Side: integer;
PassedPathLen, PathLen: double;
PointOrder: integer;
begin
Result := Nil;
if comparePoint(aStartPoint, NextPath.r1, myDelta) then
PointOrder := 1
else
if comparePoint(aStartPoint, NextPath.r2, myDelta) then
PointOrder := 2
else
if comparePoint(aStartPoint, NextPath.l1, myDelta) then
PointOrder := 3
else
if comparePoint(aStartPoint, NextPath.l2, myDelta) then
PointOrder := 4;
PathLen := Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + Sqr(NextPath.p1.y - NextPath.p2.y));
case PointOrder of
1: // r1
begin
PassedPathLen := Sqrt(sqr(NextPath.l1.x - NextPath.l2.x) + Sqr(NextPath.l1.y - NextPath.l2.y));
NextPathPoint := NextPath.p1^;
currPointOrder := 4;
Side := 2;
AddPointToFloorConture(aStartPoint);
AddPointToFloorConture(NextPath.l1);
aStartPoint := NextPath.l2;
end;
2: // r2
begin
NextPathPoint := NextPath.p2^;
PassedPathLen := Sqrt(sqr(NextPath.l1.x - NextPath.l2.x) + Sqr(NextPath.l1.y - NextPath.l2.y));
currPointOrder := 3;
Side := 1;
AddPointToFloorConture(aStartPoint);
AddPointToFloorConture(NextPath.l2);
aStartPoint := NextPath.l1;
end;
3: // l1
begin
NextPathPoint := NextPath.p1^;
PassedPathLen := Sqrt(sqr(NextPath.r1.x - NextPath.r2.x) + Sqr(NextPath.r1.y - NextPath.r2.y));
currPointOrder := 2;
Side := 2;
AddPointToFloorConture(aStartPoint);
AddPointToFloorConture(NextPath.r1);
aStartPoint := NextPath.r2;
end;
4: // l2
begin
NextPathPoint := NextPath.p2^;
PassedPathLen := Sqrt(sqr(NextPath.r1.x - NextPath.r2.x) + Sqr(NextPath.r1.y - NextPath.r2.y));
currPointOrder := 1;
Side := 1;
AddPointToFloorConture(aStartPoint);
AddPointToFloorConture(NextPath.r2);
aStartPoint := NextPath.r1;
end;
end;
//ConnectedPathList.Clear;
FreeAndNil(ConnectedPathList);
//FillConnectedbyPoint(p1);
ConnectedPathList := GetConnPathsBySide(NextPath, Side);
aLen := aLen + PassedPathLen;
//aPathLen := aPathLen + PathLen;
if ConnectedPathList.Count > 0 then
PAssedList.remove(NextPath);
//Result := GetNextPathByPoint(NextPoint, aLen, aPathLen);
Result := NextPath;
end;
Procedure GetNearestRelatedPathAndPoint;
var i: integer;
dist, d1, d2, MinDist: Double;
rp1, rp2: TDoublePoint;
relPath, currPath: TNetPath;
isFirstPoint: Boolean;
PointOrder: integer;
relPoint, CurrPoint: PDoublePoint;
sPoint, kPoint: TDoublePoint;
StartSide, CurrSide: Integer;
begin
relPoint := nil;
currPath := nil;
Dist := 10000000;
MinDist := -1;
sPoint.x := -100;
sPoint.y := -100;
PointOrder := -1;
if comparePoint(aStartPoint, NextPath.r1, myDelta) then
PointOrder := 1
else
if comparePoint(aStartPoint, NextPath.r2, myDelta) then
PointOrder := 2
else
if comparePoint(aStartPoint, NextPath.l1, myDelta) then
PointOrder := 1
else
if comparePoint(aStartPoint, NextPath.l2, myDelta) then
PointOrder := 2;
case PointOrder of
1: relPoint := NextPath.p1;
2: relPoint := NextPath.p2;
end;
if PointOrder <> -1 then
begin
for i := 0 to ConnectedPathList.Count - 1 do
begin
relPath := TNetPath(ConnectedPathList[i]);
{
case PointOrder of
1: relPoint := NextPath.p1;
2: relPoint := NextPath.p2;
end;}
//r1, l1
if ((CompareValue(relPoint.x, relPath.p1.x, myDelta) = 0) and
(CompareValue(relPoint.y, relPath.p1.y, myDelta) = 0 )) then
begin
d1 := sqrt(sqr(aStartPoint.x - relPath.r1.x) + sqr(aStartPoint.y - relPath.r1.y));
d2 := sqrt(sqr(aStartPoint.x - relPath.l1.x) + sqr(aStartPoint.y - relPath.l1.y));
MinDist := min(d1, d2);
if mindist < Dist then
begin
Dist := MinDist;
currPath := relPath;
if CompareValue(d1, d2) = 1 then
begin
sPoint.x := relPath.l2.x;
sPoint.y := relPath.l2.y;
kPoint.x := relPath.l1.x;
kPoint.y := relPath.l1.y;
end
else
begin
sPoint.x := relPath.r2.x;
sPoint.y := relPath.r2.y;
kPoint.x := relPath.r1.x;
kPoint.y := relPath.r1.y;
end;
end;
end
else
//r2, l2
if ((CompareValue(relPoint.x, relPath.p2.x, myDelta) = 0) and
(CompareValue(relPoint.y, relPath.p2.y, myDelta) = 0 )) then
begin
d1 := sqrt(sqr(aStartPoint.x - relPath.r2.x) + sqr(aStartPoint.y - relPath.r2.y));
d2 := sqrt(sqr(aStartPoint.x - relPath.l2.x) + sqr(aStartPoint.y - relPath.l2.y));
MinDist := min(d1, d2);
if mindist < Dist then
begin
dist := MinDist;
currPath := relPath;
if CompareValue(d1, d2) = 1 then
begin
sPoint.x := relPath.l1.x;
sPoint.y := relPath.l1.y;
kPoint.x := relPath.l2.x;
kPoint.y := relPath.l2.y;
end
else
begin
sPoint.x := relPath.r1.x;
sPoint.y := relPath.r1.y;
kPoint.x := relPath.r2.x;
kPoint.y := relPath.r2.y;
end;
end;
end
else
continue;
end;
if Dist <> 10000000 then
begin
aLen := aLen + Dist;// + sqrt(sqr(currPath.p1.x - currPath.p2.x) + sqr(currPath.p1.y - currPath.p2.y));
aStartPoint := sPoint;
AddPointToFloorConture(kPoint);
Result := currPath;
end;
end;
end;
begin
Result := Nil;
SeekPath := True;
CurrPath := Nil;
inc(BreakCounter);
if BreakCounter > 2000 then exit;
//if (ConnectedPathList.Count > 0){ and isUniquePoint(NextPoint, NextPath))} then // no connections (wall break)
{begin
Result := GetNextUniquePoint;
end
else}
begin
if ConnectedPathList.Count > 0 then
begin
for i := 0 to ConnectedPathList.Count - 1 do
begin
currPath := TNetPath(ConnectedPathList[i]);
//if PassedList.IndexOf(currPath) = -1 then
begin
if comparePoint(currPath.r1, aStartPoint, myDelta) then
begin
if currPath.isArc then
//AddArcToFloorConture(currPath, aStartPoint, currPath.r2, currPath.p1^, currPAth.p2^, aLen)
AddArcToFloorConture(currPath, aLen, 3, currPath.r2)
else
aLen := aLen + SQRT(sqr(currPath.r1.x - currPath.r2.x) + sqr(currPath.r1.y - currPath.r2.y));
currPointOrder := 2;
aStartPoint.x := currPath.r2.x;
aStartPoint.y := currPath.r2.y;
Result := currPath;
SeekPath := False;
end
else
if comparePoint(currPath.r2, aStartPoint, myDelta) then
begin
if currPath.isArc then
//AddArcToFloorConture(currPath, aStartPoint, currPath.r1, currPath.p2^, currPAth.p1^, aLen)
AddArcToFloorConture(currPath, aLen, 4, currPath.r1)
else
aLen := aLen + SQRT(sqr(currPath.r1.x - currPath.r2.x) + sqr(currPath.r1.y - currPath.r2.y));
aStartPoint.x := currPath.r1.x;
aStartPoint.y := currPath.r1.y;
currPointOrder := 1;
Result := currPath;
SeekPath := False;
end
else
if comparePoint(currPath.l2, aStartPoint, myDelta) then
begin
if currPath.isArc then
//AddArcToFloorConture(currPath, aStartPoint, currPath.l1, currPath.p2^, currPAth.p1^, aLen)
AddArcToFloorConture(currPath, aLen, 2, currPath.l1)
else
aLen := aLen + SQRT(sqr(currPath.l1.x - currPath.l2.x) + sqr(currPath.l1.y - currPath.l2.y));
aStartPoint.x := currPath.l1.x;
aStartPoint.y := currPath.l1.y;
currPointOrder := 3;
Result := currPath;
SeekPath := False;
end
else
if comparePoint(currPath.l1, aStartPoint, myDelta) then
begin
if currPath.isArc then
//AddArcToFloorConture(currPath, aStartPoint, currPath.l2, currPath.p1^, currPAth.p2^, aLen)
AddArcToFloorConture(currPath, aLen, 1, currPath.l2)
else
aLen := aLen + SQRT(sqr(currPath.l1.x - currPath.l2.x) + sqr(currPath.l1.y - currPath.l2.y));
aStartPoint.x := currPath.l2.x;
aStartPoint.y := currPath.l2.y;
currPointOrder := 4;
Result := currPath;
SeekPath := False;
end;
if result <> nil then
break
else
begin
SavedPathList := TList.Create;
SavedPathList.Assign(ConnectedPathList);
//if NextPath.Width <> currPath.Width then
if (ABS(NextPath.Width - currPath.Width) > 0.01) then
begin
UPoint := Nil;
case currPointOrder of
1: UPoint := NextPath.epr1;
2: UPoint := NextPath.epr2;
3: UPoint := NextPath.epl1;
4: UPoint := NextPath.epl2;
end;
if UPoint <> nil then
begin
aLen := aLen + SQRT(sqr(UPoint.x - aStartPoint.x) + sqr(UPoint.y - aStartPoint.y));
AddPointToFloorConture(aStartPoint);
//NextPoint := UPoint^;
aStartPoint := UPoint^;
Result := GetNextPathByPoint(aStartPoint, aLen, aPathLen);
if Result <> nil then
break
else
begin
ConnectedPathList.Clear;
ConnectedPathList.Assign(SavedPAthList);
SavedPathList.free;
end;
end
else
begin
case currPointOrder of
1: UPoint := currPath.epr1;
2: UPoint := currPath.epr2;
3: UPoint := currPath.epl1;
4: UPoint := currPath.epl2;
end;
end;
if UPoint <> nil then
begin
aLen := aLen + SQRT(sqr(UPoint.x - NextPoint.x) + sqr(UPoint.y - NextPoint.y));
AddPointToFloorConture(NextPoint);
//NextPoint := UPoint^;
aStartPoint := UPoint^;
end;
end;
SavedPathList.free;
end;
end;
end;
//Tolik 08/12/2021 -- ðàçðûâ êîíòóðà âñëåäñòâèå ðàçíîé òîëùèíû ñòåí ...
if Result = nil then
begin
//GetNearestRelatedPathAndPoint;
end;
end
else
begin
if Result = nil then // äîøëè äî íåñâÿçàííîãî êðàß ñòåíû, ïðèïèçäÿ÷åííîé ê êîíòóðó
begin
// êðàé ñòåíû èëè ïåðåãîðîäêè âíóòðè êîìíàòû
Result := GoAroundPath;
if Result <> nil then
exit;
{else
begin
ConnectedPathList.Clear;
ConnectedPathList.Assign(SavedPAthList);
SavedPathList.free;
end;}
if RemovedPathList.IndexOf(NextPath) <> -1 then // êðàé ñòåíû
begin
if CompareValue(NextPath.r1.x, aStartPoint.x) = 0 then
if CompareValue(NextPath.r1.y, aStartPoint.y) = 0 then
begin
if Not NextPath.isArc then
begin
AddPointToFloorConture(NextPath.r1);
AddPointToFloorConture(NextPath.r2);
//aLen := aLen + SQRT(sqr(NextPath.r1.x - NextPath.r2.x) + sqr(NextPath.r1.y - NextPath.r2.y));
end;
NextPoint.x := NextPath.l2.x;
NextPoint.y := NextPath.l2.y;
//aLen := aLen + SQRT(sqr(NextPath.r2.x - NextPath.l2.x) + sqr(NextPath.r2.y - NextPath.l2.y));
SeekPoint.x := NextPath.p2.x;
SeekPoint.y := NextPath.p2.y;
FillConnectedbyPoint(SeekPoint);
{
if ConnectedPathList.Count = 0 then
begin
AddPointToFloorConture(NextPath.l2);
aLen := aLen + SQRT(sqr(NextPath.l1.x - NextPath.l2.x) + sqr(NextPath.l1.y - NextPath.l2.y));
NextPoint.x := NextPath.l1.x;
NextPoint.y := NextPath.l1.y;
SeekPoint.x := NextPath.p1.x;
SeekPoint.y := NextPath.p1.y;
FillConnectedbyPoint(SeekPoint);
end;}
Result := GetNextPathByPoint(NextPoint, aLen, aPathLen);
SeekPath := False;
end;
if SeekPath then
if CompareValue(NextPath.r2.x, aStartPoint.x) = 0 then
if CompareValue(NextPath.r2.y, aStartPoint.y) = 0 then
begin
if Not NextPath.isArc then
begin
AddPointToFloorConture(NextPath.r2);
AddPointToFloorConture(NextPath.r1);
//aLen := aLen + SQRT(sqr(NextPath.r1.x - NextPath.r2.x) + sqr(NextPath.r1.y - NextPath.r2.y));
end;
NextPoint.x := NextPath.l1.x;
NextPoint.y := NextPath.l1.y;
SeekPoint.x := NextPath.p1.x;
SeekPoint.y := NextPath.p1.y;
FillConnectedbyPoint(SeekPoint);
{
if ConnectedPathList.Count = 0 then
begin
AddPointToFloorConture(NextPath.l1);
aLen := aLen + SQRT(sqr(NextPath.l1.x - NextPath.l2.x) + sqr(NextPath.l1.y - NextPath.l2.y));
NextPoint.x := NextPath.l2.x;
NextPoint.y := NextPath.l2.y;
SeekPoint.x := NextPath.p2.x;
SeekPoint.y := NextPath.p2.y;
FillConnectedbyPoint(SeekPoint);
end;
}
Result := GetNextPathByPoint(NextPoint, aLen, aPathLen);
SeekPath := False;
end;
if SeekPath then
if CompareValue(NextPath.l2.x, aStartPoint.x) = 0 then
if CompareValue(NextPath.l2.y, aStartPoint.y) = 0 then
begin
if Not NextPath.isArc then
begin
AddPointToFloorConture(NextPath.l2);
AddPointToFloorConture(NextPath.l1);
//aLen := aLen + SQRT(sqr(NextPath.l1.x - NextPath.l2.x) + sqr(NextPath.l1.y - NextPath.l2.y));
end;
NextPoint.x := NextPath.r1.x;
NextPoint.y := NextPath.r1.y;
SeekPoint.x := NextPath.p1.x;
SeekPoint.y := NextPath.p1.y;
FillConnectedbyPoint(SeekPoint);
{
if ConnectedPathList.Count = 0 then
begin
AddPointToFloorConture(NextPath.r1);
aLen := aLen + SQRT(sqr(NextPath.r1.x - NextPath.r2.x) + sqr(NextPath.r1.y - NextPath.r2.y));
NextPoint.x := NextPath.r2.x;
NextPoint.y := NextPath.r2.y;
SeekPoint.x := NextPath.p2.x;
SeekPoint.y := NextPath.p2.y;
FillConnectedbyPoint(SeekPoint);
end;
}
Result := GetNextPathByPoint(NextPoint, aLen, aPathLen);
SeekPath := False;
end;
if SeekPath then
if CompareValue(NextPath.l1.x, aStartPoint.x) = 0 then
if CompareValue(NextPath.l1.y, aStartPoint.y) = 0 then
begin
if Not NextPath.isArc then
begin
AddPointToFloorConture(NextPath.l1);
AddPointToFloorConture(NextPath.l2);
//aLen := aLen + SQRT(sqr(NextPath.l1.x - NextPath.l2.x) + sqr(NextPath.l1.y - NextPath.l2.y));
end;
NextPoint.x := NextPath.r2.x;
NextPoint.y := NextPath.r2.y;
SeekPoint.x := NextPath.p2.x;
SeekPoint.y := NextPath.p2.y;
FillConnectedbyPoint(SeekPoint);
{
if ConnectedPathList.Count = 0 then
begin
AddPointToFloorConture(NextPath.r2);
aLen := aLen + SQRT(sqr(NextPath.r1.x - NextPath.r2.x) + sqr(NextPath.r1.y - NextPath.r2.y));
NextPoint.x := NextPath.r1.x;
NextPoint.y := NextPath.r1.y;
SeekPoint.x := NextPath.p1.x;
SeekPoint.y := NextPath.p1.y;
FillConnectedbyPoint(SeekPoint);
end;
}
Result := GetNextPathByPoint(NextPoint, aLen, aPathLen);
SeekPath := False;
end;
end;
end;
end;
end;
end;
(*
Procedure AddArcToFloorConture(aPoint: TDoublePoint; aPath: TNetPath);
var ArcPoints, Points: T3DPointArray;
DirectOrder: Boolean;
i, ArrayLen: Integer;
SecondPoint: TDoublePoint;
BeginIndex, EndIndex: Integer;
function GetArcPoints: T3DPointArray;
var
i, ModVal, Cnt: Integer;
Radius, a1, a2: Double;
OldDxfMode: Boolean;
Fpoints: T2DPointArray;
currPoint: PDoublePoint;
begin
//SecondPoint
if ((CompareValue(aPath.r1.x, aPoint.x) = 0) and (CompareValue(aPath.r1.y, aPoint.y) = 0)) then
begin
SecondPoint.x := aPath.r2.x;
SecondPoint.y := aPath.r2.y;
end
else
if ((CompareValue(aPath.r2.x, aPoint.x) = 0) and (CompareValue(aPath.r2.y, aPoint.y) = 0)) then
begin
SecondPoint.x := aPath.r1.x;
SecondPoint.y := aPath.r1.y;
end
else
if ((CompareValue(aPath.l1.x, aPoint.x) = 0) and (CompareValue(aPath.l1.y, aPoint.y) = 0)) then
begin
SecondPoint.x := aPath.l2.x;
SecondPoint.y := aPath.l2.y;
end
else
if ((CompareValue(aPath.l2.x, aPoint.x) = 0) and (CompareValue(aPath.l2.y, aPoint.y) = 0)) then
begin
SecondPoint.x := aPath.l1.x;
SecondPoint.y := aPath.l1.y;
end;
ModVal := 12; //10;
Radius := GetLineLenght(aPoint, APath.ArcCenter);
a1 := GetRadOfLine(APath.ArcCenter, APoint);
a2 := GetRadOfLine(APath.ArcCenter, SecondPoint);
if Not APath.Inverted then
ExchangeDouble(a1, a2);
OldDxfMode := DxfMode; // ïîâûøàåì òî÷íîñòü - êîëè÷åñòâî òî÷åê äëÿ äóãè
DxfMode := True;
try
BezierArcPoints(FPoints, APath.ArcCenter.x, APath.ArcCenter.y, Radius, a1, a2);
finally
DxfMode := OldDxfMode;
end;
Cnt := Length(FPoints) - 1;
if Cnt > 2 then
begin
if ((CompareValue(FPoints[0].x, APoint.x) = 0) and (CompareValue(FPoints[0].y, APoint.y) = 0)) then
begin
for i := 0 to Cnt do
begin
if i mod 10 = 0 then
Begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1].x := FPoints[i].x;
Result[Length(Result) - 1].y := FPoints[i].y;
end;
end;
end
else
begin
for i := Cnt downto 0 do
begin
if i mod 10 = 0 then
Begin
SetLength(Result, Length(Result) + 1);
Result[Length(Result) - 1].x := FPoints[i].x;
Result[Length(Result) - 1].y := FPoints[i].y;
end;
end;
end;
end;
SetLength(FPoints, 0);
end;
Function getDirectOrder(aArcPoints: T3DPointArray): Boolean;
var DistToFirstArcPoint, DistToLastArcPoint: Double;
begin
//Result := True;
Result := False;
if Length(ArcPoints) > 0 then
begin
DistToFirstArcPoint := SQRT( SQR(aArcPoints[BeginIndex].x - aPoint.x) + SQR(aArcPoints[BeginIndex].y - aPoint.y) );
DistToLastArcPoint := SQRT( SQR(aArcPoints[EndIndex].x - aPoint.x) + SQR(aArcPoints[EndIndex].y - aPoint.y) );
if CompareValue(DistToLastArcPoint, DistToFirstArcPoint) = 1 then
//result := False;
Result := True;
end;
end;
begin
SetLength(Points, 2);
// r path side
if (((CompareValue(aPath.r1.x, aPoint.x) = 0) and (CompareValue(aPath.r1.y, aPoint.y) = 0)) or
((CompareValue(aPath.r2.x, aPoint.x) = 0) and (CompareValue(aPath.r2.y, aPoint.y) = 0))) then
begin
Points[0].x := aPath.r1.x;
Points[0].y := aPath.r1.y;
Points[1].x := aPath.r2.x;
Points[1].y := aPath.r2.y;
end
else
if (((CompareValue(aPath.l1.x, aPoint.x) = 0) and (CompareValue(aPath.l1.y, aPoint.y) = 0)) or
((CompareValue(aPath.l2.x, aPoint.x) = 0) and (CompareValue(aPath.l2.y, aPoint.y) = 0))) then
begin
Points[0].x := aPath.l1.x;
Points[0].y := aPath.l1.y;
Points[1].x := aPath.l2.x;
Points[1].y := aPath.l2.y;
end;
ArcPoints := GetArcPoints;//(Points, aPath, True);
if Length(ArcPoints) > 2 then
begin
BeginIndex := 0;
EndIndex := Length(ArcPoints) - 1;
if (((CompareValue(ArcPoints[0].x, aPoint.x) = 0) and (CompareValue(ArcPoints[0].y, aPoint.y) = 0)) or
((CompareValue(ArcPoints[0].x, SecondPoint.x) = 0) and (CompareValue(ArcPoints[0].y, SecondPoint.y) = 0))) then
inc(BeginIndex);
if (((CompareValue(ArcPoints[EndIndex].x, aPoint.x) = 0) and (CompareValue(ArcPoints[EndIndex].y, aPoint.y) = 0)) or
((CompareValue(ArcPoints[EndIndex].x, SecondPoint.x) = 0) and (CompareValue(ArcPoints[EndIndex].y, SecondPoint.y) = 0))) then
Dec(EndIndex);
DirectOrder := getDirectOrder(ArcPoints);//((CompareValue(ArcPoints[0].x, aPoint.x) = 0) and (CompareValue(ArcPoints[0].y, aPoint.y) = 0));
if DirectOrder then
for i := EndIndex downto BeginIndex do
AddPointToFloorConture(TDoublePoint(ArcPoints[i]))
else
for i := BeginIndex to EndIndex do
AddPointToFloorConture(TDoublePoint(ArcPoints[i]));
AddPointToFloorConture(aPoint);
end;
end;
*)
function CalcArcLen(aPath: TNetPath): Double;
var i, range: Integer;
Point1, Point2: TDoublePoint;
arcPoints, resArcPoints: T3DPointArray;
begin
Result := 0;
if aPath = nil then
exit;
if not aPath.isArc then
exit;
SetLength(arcPoints, 2);
arcPoints[0] := aPath.p1^;
arcPoints[1] := aPath.p2^;
resArcPoints := GetArcWallPointsAll(arcPoints, aPath);
range := Length(resArcPoints) - 1;
Point1 := resArcPoints[0];
for i := 1 to range do
begin
Point2 := resArcPoints[i];
Result := Result + SQRT(sqr(Point1.x - Point2.x) + sqr(Point1.y - Point2.y));
Point1 := Point2;
end;
SetLength(arcPoints, 0);
SetLength(resArcPoints, 0);
end;
Procedure AddPrevPathLen;
begin
if aLeft then
begin
if NextPath.isArc then
begin
//LeftLen := LeftLen + CalcArcLen(NextPath)
//LeftLen := LeftLen + LastArcPathLen;
LeftContureLen := LeftContureLen + LastArcPathLen;
LastArcPathLen := 0;
end
else
begin
LeftContureLen := LeftContureLen + Sqrt(sqr(PrevPath.l1.x - PrevPath.l2.x) + sqr(PrevPath.l1.y - PrevPath.l2.y));
//LeftLen := LeftLen + Sqrt(sqr(PrevPath.p1.x - PrevPath.p2.x) + sqr(PrevPath.p1.y - PrevPath.p2.y));
end;
end
else
begin
if NextPath.isArc then
begin
//RightLen := RightLen + CalcArcLen(NextPath)
//RightLen := RightLen + LastArcPathLen;
RightContureLen := RightContureLen + LastArcPathLen;
LastArcPathLen := 0;
end
else
begin
RightContureLen := RightContureLen + Sqrt(sqr(PrevPath.r1.x - PrevPath.r2.x) + sqr(PrevPath.r1.y - PrevPath.r2.y));
//RightLen := RightLen + Sqrt(sqr(PrevPath.p1.x - PrevPath.p2.x) + sqr(PrevPath.p1.y - PrevPath.p2.y));
end;
end;
end;
begin
Result := TList.Create;
PassedList := TList.Create;
StartPoint.z := 0;
NextPoint.z := 0;
PathConnPoint := 1;
PathPoint := aPath.p1;
if aLeft then
begin
StartPoint.x := aPath.l1.x;
StartPoint.y := aPath.l1.y;
currPointOrder := 3;
end
else
begin
StartPoint.x := aPath.r1.x;
StartPoint.y := aPath.r1.y;
currPointOrder := 1;
end;
//AddPointToFloorConture(StartPoint);
BreakCounter := 0;
//FreeAndNil(ConnectedPathList);
ConnectedPathList := GetConnPathsBySide(aPath, 1);
if ConnectedPathList.Count > 0 then
begin
for i := ConnectedPathList.Count - 1 downto 0 do
begin
if ComparePoint(TNetPath(ConnectedPathList[i]).p1^, TNetPath(ConnectedPathList[i]).p2^, myDelta) then
ConnectedPathList.Delete(i);
end;
end;
{for i := 0 to aPath.Net.Paths.Count - 1 do
begin
currPath := TNetPath(aPath.Net.Paths[i]);
if currPath <> aPath then
if aPath.Connected(currPath) then
ConnectedPathList.Add(currPath);
end;}
NextPath := aPath;
NextPoint.x := StartPoint.x;
NextPoint.y := StartPoint.y;
if NextPath <> nil then
begin
CanProceed := True;
PrevPath := NextPAth;
//AddPrevPathLen;
end;
while CanProceed do
begin
PrevPath := NextPath;
if not NextPath.isArc then
AddPointToFloorConture(NextPoint, true);
{else
AddArcToFloorConture(NextPoint, NextPath);}
// ïðåðûâàíèå öèêëà (íà âñÿêèé)
inc(BreakCounter);
if BreakCounter > 2000 then
begin
//ConnectedPathList.Free;
FreeAndNil(ConnectedPathList);
FreeAndNil(Result);
break;
end;
//Tolik 14/12/2021 --
if aLeft then
NextPath := GetNextPathByPoint(NextPoint, LeftContureLen, LeftLen)
else
NextPath := GetNextPathByPoint(NextPoint, RightContureLen, RightLen);
{
if aLeft then
NextPath := GetNextPathByPoint(NextPoint, LeftLen, LeftContureLen)
else
NextPath := GetNextPathByPoint(NextPoint, RightLen, RightContureLen);
}
//
if NextPath = nil then
begin
//Tolik 16/12/2021 --
//NextPath := GetPathWithUniquePoint;
if aLeft then
NextPath := GetPathWithUniquePoint(LeftContureLen)
else
NextPath := GetPathWithUniquePoint(RightContureLen);
//
if NextPath = nil then
begin
//ConnectedPathList.Free;
FreeAndNil(ConnectedPathList);
FreeAndNil(Result);
break;
end
else
begin
// PrevPath := NextPath;
// addPrevPathLen;
end;
end;
//Tolik 14/12/2021 - -
//else
if NextPath <> nil then
//
begin
if aLeft then
begin
if NextPath.isArc then
begin
//LeftLen := LeftLen + CalcArcLen(NextPath)
LeftLen := LeftLen + LastArcPathLen;
//LeftContureLen := LeftContureLen + LastArcPathLen;
LastArcPathLen := 0;
end
else
LeftLen := LeftLen + Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + sqr(NextPath.p1.y - NextPath.p2.y));
//LeftContureLen := LeftContureLen + Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + sqr(NextPath.p1.y - NextPath.p2.y));
end
else
begin
if NextPath.isArc then
begin
//RightLen := RightLen + CalcArcLen(NextPath)
RightLen := RightLen + LastArcPathLen;
//RightContureLen := RightContureLen + LastArcPathLen;
LastArcPathLen := 0;
end
else
RightLen := RightLen + Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + sqr(NextPath.p1.y - NextPath.p2.y));
//RightContureLen := RightContureLen + Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + sqr(NextPath.p1.y - NextPath.p2.y));
end;
//ConnectedPathList.free;
FreeAndNil(ConnectedPathList);
if (((CompareValue(NextPoint.x, NextPath.r1.x) = 0) and (CompareValue(NextPoint.y, NextPath.r1.y) = 0)) or
((CompareValue(NextPoint.x, NextPath.l1.x) = 0) and (CompareValue(NextPoint.y, NextPath.l1.y) = 0))) then
ConnectedPathList := GetConnPathsBySide(NextPath, 1)
else
ConnectedPathList := GetConnPathsBySide(NextPath, 2);
if ConnectedPathList.Count > 0 then
begin
for i := ConnectedPathList.Count - 1 downto 0 do
begin
if ComparePoint(TNetPath(ConnectedPathList[i]).p1^, TNetPath(ConnectedPathList[i]).p2^, myDelta) then
ConnectedPathList.Delete(i);
end;
end;
{for i := 0 to NextPath.Net.Paths.Count - 1 do
begin
currPath := TNetPath(NextPath.Net.Paths[i]);
if currPath <> NextPath then
if NextPath.Connected(currPath) then
ConnectedPathList.Add(currPath);
end;}
if RemovedPathList.IndexOf(NextPath) = -1 then
begin
if not CheckInListById(Result, NextPath) then
begin
Result.Add(NextPath);
PassedList.Assign(Result, laOR);
end;
end;
if CompareValue(StartPoint.x, NextPoint.x) = 0 then
if CompareValue(StartPoint.y, NextPoint.y) = 0 then
CanProceed := False;
end;
end;
end;
//function CheckNoContureInList(aResList, aList: TList): Boolean;
function CheckNoContureInList(aResList, aList, aContureList: TList): Boolean;
var i, j, k: integer;
resList: TList;
resPath, currPath: TNetPath;
SamePaths: Boolean;
function CheckNoPointinList(aList: TList; aPoint: PDoublePoint) : boolean;
var i: Integer;
begin
Result := False;
for i := 0 to aList.Count - 1 do
begin
if ((Comparevalue(PdoublePoint(aList[i]).x, aPoint.x) = 0) and
(Comparevalue(PdoublePoint(aList[i]).y, aPoint.y) = 0)) then
begin
Result := True;
break;
end;
end;
end;
begin
Result := True;
for i := 0 to aResList.Count - 1 do
begin
SamePaths := True;
resList := TList(aResList[i]);
if resList.Count = aList.Count then
begin
for j := 0 to aList.Count - 1 do
begin
currPath := TNetPath(aList[j]);
SamePaths := (ResList.IndexOf(currPath) <> -1);
if not SamePaths then
break;
end;
if SamePaths then
begin
Result := False;
break;
end;
end;
end;
if not Result then
begin
Result := True;
for i := 0 to aFloorsConturesList.Count - 1 do
begin
ResList := TList(aFloorsConturesList[i]);
if ResList.Count = aContureList.Count then
begin
for j := 0 to ResList.Count - 1 do
begin
if ChecknoPointinList(ResList, PDoublePoint(aContureList[j])) then
begin
Result := False;
break;
end;
end;
end;
if not Result then
break;
end;
end;
end;
Procedure AddNoAddedPaths(aList: TList);
var i, j: Integer;
currPath: TNetPath;
PathList, PathsToAdd: TList;
PathExists: Boolean;
begin
PathsToAdd := TList.Create;
for i := 0 to aNets.Paths.Count - 1 do
begin
currPath := TNetPath(aNets.Paths[i]);
if (CompareValue(currPath.p1.x, CurrPath.p2.x) = 0) and (CompareValue(currPath.p1.y, CurrPath.p2.y) = 0) then
Continue;
PathExists := false;
for j := 0 to aList.Count - 1 do
begin
PathList := TList(aList[j]);
if PathList.IndexOf(currPath) <> -1 then
begin
PathExists := True;
break;
end;
end;
if not PathExists then
if PathsToAdd.IndexOf(currPath) = -1 then
PathsToAdd.Add(currPath);
end;
for i := 0 to PathsToAdd.Count - 1 do
begin
currPath := TNetPath(PathsToAdd[i]);
LeftFloorConture := TList.Create;
new(cp);
cp.x := currPath.r1.x;
cp.y := currPath.r1.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := currPath.r2.x;
cp.y := currPath.r2.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := currPath.l2.x;
cp.y := currPath.l2.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := currPath.l1.x;
cp.y := currPath.l1.y;
LeftFloorConture.Add(cp);
aFloorsConturesList.Add(LeftFloorConture);
PathList := TList.Create;
PathList.Add(currPath);
aList.Add(PathList);
aNormalList.Add(nil);
end;
end;
function GetEntryCount(aList: TList; aPath: TNetPath): integer;
var i, j: integer;
currList: TList;
begin
Result := 0;
for i := 0 to aList.Count - 1 do
begin
currList := TList(aList[i]);
for j := 0 to currList.Count - 1 do
begin
if TNetPath(currList[j]).id = aPath.Id then
begin
inc(Result);
if Result > 1 then
break;
end;
end;
if Result > 1 then
break;
end;
end;
function CheckIsConture(aList: TList): boolean;
var FirstPath, LastPath: TNetPath;
begin
Result := False;
if aList.Count > 2 then
begin
FirstPath := TNetPath(aList[0]);
LastPath := tNetPath(aList[aList.count - 1 ]);
if ((CompareValue(FirstPath.p1.x, LastPath.p1.x) = 0) and (CompareValue(FirstPath.p1.y, LastPath.p1.y) = 0)) or
((CompareValue(FirstPath.p1.x, LastPath.p2.x) = 0) and (CompareValue(FirstPath.p1.y, LastPath.p2.y) = 0)) or
((CompareValue(FirstPath.p2.x, LastPath.p1.x) = 0) and (CompareValue(FirstPath.p2.y, LastPath.p1.y) = 0)) or
((CompareValue(FirstPath.p2.x, LastPath.p2.x) = 0) and (CompareValue(FirstPath.p2.y, LastPath.p2.y) = 0)) then
Result := True;
end;
end;
begin
Result := TList.Create;
if aNets.Paths = nil then
exit;
if aNets.Paths.Count = 0 then
exit;
// assignFile(f, 'd:\Tolik\PathPoints.txt');
// rewrite(f);
//Tolik 16/12/2021 --
for i := aNets.Paths.Count - 1 downto 0 do
begin
PAthToDel := aNets.Paths[i];
{
s := 'Path ' + inttostr(i) + ' ID = ' + inttostr(PAthToDel.ID);
writeln(f,s);
s := 'P1 = '+ FloatToStr(PathTodel.P1.x) + ' ' + FloatToStr(PathTodel.P1.y) + ' ' + FloatToStr(PathTodel.P1.z);
writeln(f,s);
s := 'P2 = '+ FloatToStr(PathTodel.P2.x) + ' ' + FloatToStr(PathTodel.P2.y) + ' ' + FloatToStr(PathTodel.P2.z);
writeln(f,s);
s := 'L1 = '+ FloatToStr(PathTodel.l1.x) + ' ' + FloatToStr(PathTodel.l1.y) + ' ' + FloatToStr(PathTodel.l1.z);
writeln(f,s);
s := 'R1 = '+ FloatToStr(PathTodel.r1.x) + ' ' + FloatToStr(PathTodel.r1.y) + ' ' + FloatToStr(PathTodel.r1.z);
writeln(f,s);
s := 'L2 = '+ FloatToStr(PathTodel.l2.x) + ' ' + FloatToStr(PathTodel.l2.y) + ' ' + FloatToStr(PathTodel.l2.z);
writeln(f,s);
s := 'R2 = '+ FloatToStr(PathTodel.r2.x) + ' ' + FloatToStr(PathTodel.r2.y) + ' ' + FloatToStr(PathTodel.r2.z);
writeln(f,s);
s := '----------------------------------------------------------------------------';
writeln(f,s);
}
if comparePoint(PAthTodel.p1^, PathTodel.p2^, 0.0001) then
aNets.DeletePath(PathTodel);
end;
//closeFile(f);
//
RemovedPathList := TList.Create;
PathList := CollectSCSWallEntries(aNets.Paths);
CanProceed := True;
LastArcPathLen := 0;
// ïðîñòî ñòåíû (â íåçàìêíóòûõ êîíòóðàõ) ïî èäåå, âñå íåçàìêíóòûå êîíòóðà ðîàçîáüþòñÿ íà îòäåëüíûå ñòåíû
{ while CanProceed do
begin
CanProceed := False;
for i := PathList.Count - 1 downto 0 do
begin
if PNetEntryInfo(PathList[i]).P1EntryCount = 1 then // ïîðîã èñêëþ÷åííèÿ - îäíî ñîåäèíåíèå íà òî÷êå
begin
CanProceed := True;
NetList := TList.Create;
NetList.Add(PNetEntryInfo(PathList[i]).NetPath);
Result.Add(NetList);
RemovedPathList.Add(PNetEntryInfo(PathList[i]).NetPath);
LeftFloorConture := TList.Create;
new(cp);
cp.x := PNetEntryInfo(PathList[i]).NetPath.r1.x;
cp.y := PNetEntryInfo(PathList[i]).NetPath.r1.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := PNetEntryInfo(PathList[i]).NetPath.r2.x;
cp.y := PNetEntryInfo(PathList[i]).NetPath.r2.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := PNetEntryInfo(PathList[i]).NetPath.l2.x;
cp.y := PNetEntryInfo(PathList[i]).NetPath.l2.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := PNetEntryInfo(PathList[i]).NetPath.l1.x;
cp.y := PNetEntryInfo(PathList[i]).NetPath.l1.y;
LeftFloorConture.Add(cp);
aFloorsConturesList.Add(LeftFloorConture);
//aFloorsConturesList.Add(nil);
RemovepathFromList(PNetEntryInfo(PathList[i]).NetPath);
end
else
if PNetEntryInfo(PathList[i]).P2EntryCount = 1 then
begin
CanProceed := True;
NetList := TList.Create;
NetList.Add(PNetEntryInfo(PathList[i]).NetPath);
Result.Add(NetList);
RemovedPathList.Add(PNetEntryInfo(PathList[i]).NetPath); // äîáàâèòü â ñïèñîê óäàëåííûõ
LeftFloorConture := TList.Create;
new(cp);
cp.x := PNetEntryInfo(PathList[i]).NetPath.r1.x;
cp.y := PNetEntryInfo(PathList[i]).NetPath.r1.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := PNetEntryInfo(PathList[i]).NetPath.r2.x;
cp.y := PNetEntryInfo(PathList[i]).NetPath.r2.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := PNetEntryInfo(PathList[i]).NetPath.l2.x;
cp.y := PNetEntryInfo(PathList[i]).NetPath.l2.y;
LeftFloorConture.Add(cp);
new(cp);
cp.x := PNetEntryInfo(PathList[i]).NetPath.l1.x;
cp.y := PNetEntryInfo(PathList[i]).NetPath.l1.y;
LeftFloorConture.Add(cp);
aFloorsConturesList.Add(LeftFloorConture);
//aFloorsConturesList.Add(nil);
RemovepathFromList(PNetEntryInfo(PathList[i]).NetPath);
end;
end;
end;}
// çäåñü - ïîèñê çàìêíóòûõ êîíòóðîâ
if PathList.Count > 0 then
begin
for i := 0 to PathList.Count - 1 do
begin
StartPath := PNetEntryInfo(PathList[i]).NetPath;
if GetEntryCount(Result, StartPath) < 2 then
begin
LeftContureLen := 0;
RightContureLen := 0;
//LeftContureLen := Sqrt(sqr(StartPath.l1.x - StartPath.l2.x) + sqr(StartPath.l1.y - StartPath.l2.y));
//RightContureLen := Sqrt(sqr(StartPath.r1.x - StartPath.r2.x) + sqr(StartPath.r1.y - StartPath.r2.y));
//LeftLen := Sqrt(sqr(StartPath.p1.x - StartPath.p2.x) + sqr(StartPath.p1.y - StartPath.p2.y));
//RightLen := LeftLen;
LeftLen := 0;
RightLen := 0;
LeftFloorConture := TList.Create;
RightFloorConture:= TList.Create;
LeftNormalConture := TList.Create;
RightNormalConture := TList.Create;
NetContureL := GetClosedConture(StartPath, LeftFloorConture, LeftNormalConture, true);
NetContureR := GetClosedConture(StartPath, RightFloorConture, RightNormalConture);
if NetContureL <> nil then
begin
if CheckIsConture(NetContureL) then
begin
if compareValue(LeftLen, LeftContureLen) > 0 then
begin
if CheckNoContureInList(Result, NetContureL, LeftFloorConture) then
begin
Result.Add(NetContureL);
aFloorsConturesList.Add(LeftFloorConture);
aNormalList.Add(LeftNormalConture);
end
else
begin
FreeAndNil(NetContureL);
//FreeList(LeftFloorConture);
FreeAndDisposeList(LeftFloorConture);
FreeAndDisposeList(LeftNormalConture);
end;
end;
end
else
begin
FreeAndNil(NetContureL);
//FreeList(LeftFloorConture);
FreeAndDisposeList(LeftFloorConture);
FreeAndDisposeList(LeftNormalConture);
end;
end;
if NetContureR <> nil then
begin
if CheckIsConture(NetContureR) then
begin
if compareValue(RightLen, RightContureLen) > 0 then
begin
if CheckNoContureInList(Result, NetContureR, RightFloorConture) then
begin
Result.Add(NetContureR);
aFloorsConturesList.Add(RightFloorConture);
aNormalList.Add(RightNormalConture);
end
else
begin
FreeAndNil(NetContureR);
//FreeList(RightFloorConture);
FreeAndDisposeList(RightFloorConture);
FreeAndDisposeList(RightNormalConture);
end;
end;
end
else
begin
FreeAndNil(NetContureR);
FreeAndDisposeList(RightFloorConture);
FreeAndDisposeList(RightNormalConture);
end;
end;
end;
end;
end;
AddNoAddedPaths(Result); // äîáàâèòü òå ñåãìåíòû, ÷òî íå ïîïàëè ...
if PathList.Count > 0 then
for i := 0 to PathList.Count - 1 do
begin
PNetEntryInfo(PathList[i]).NetPath := nil;
Dispose(PNetEntryInfo(PathList[i]));
end;
PathList.Free;
RemovedPathList.Free;
end;
//
function CoordsCMP(p1, p2: TDoublePoint): Boolean;
begin
try
result := (abs(p1.x - p2.x) < 0.1) and (abs(p1.y - p2.y) < 0.1);
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.CoordsCMP', E.Message);
end;
end;
function GetAllNets(aCad: TF_CAD): TList;
var
i: integer;
xFigure: TFigure;
begin
try
Result := TList.create;
for i := 0 to aCad.PCad.Figures.Count - 1 do
begin
xFigure := TFigure(aCad.PCad.Figures[i]);
if xFigure is TNet then
if TNet(xFigure).Paths.Count > 0 then
Result.Add(xFigure);
end;
except
on E: Exception do AddExceptionToLogEx('GetAllNets', E.Message);
end;
end;
function GetVirtualNetPathsByRealNet(aNet, aGrpNet: TNet): TList;
var
i, j: Integer;
SrcPath: TNetPath;
vPath: TNetPath;
NetBndRect: TDoubleRect;
begin
Result := TList.Create;
{//26.06.2012}
if aGrpNet <> nil then
begin
NetBndRect := aNet.GetBoundRect;
NetBndRect.Left := NetBndRect.Left - aNet.WallThick;
NetBndRect.Top := NetBndRect.Top - aNet.WallThick;
NetBndRect.Right := NetBndRect.Right + aNet.WallThick;
NetBndRect.Bottom := NetBndRect.Bottom + aNet.WallThick;
for i := 0 to aGrpNet.Paths.Count - 1 do
begin
vPath := TNetPath(aGrpNet.Paths[i]);
for j := 0 to vPath.FSrcPaths.Count - 1 do
begin
SrcPath := TNetPath(vPath.FSrcPaths[j]);
if (SrcPath.Net = aNet) and (vPath.p1 <> vPath.p2) and Not EQDP(vPath.p1^, vPath.p2^) then
if PointInRect(vPath.p1^, NetBndRect) and PointInRect(vPath.p2^, NetBndRect) then
begin
Result.Add(vPath);
Break; //// BREAK ////
end;
end;
end;
end;
{if aNet <> nil then
begin
for i := 0 to aNet.Paths.Count - 1 do
begin
vPath := FindVirtualNetPathByReal(aGrpNet, TNetPath(aNet.Paths[i]), false);
if vPath <> nil then
Result.Add(vPath);
end;
end;}
end;
function AnglesCMP(a1, a2: Double): Boolean;
var
a: double;
begin
try
result := false;
a := abs(a1 - a2);
a := StrToFloat_My(FormatFloat('0.00', a));
while a >= 3.14 do
begin
a := a - pi;
end;
if a < 0.1 then
Result := True;
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.AnglesCMP', E.Message);
end;
end;
function PointDistCMP(p: TDoublePoint; aNetPath: TNetPath): Boolean;
begin
try
Result := True;
if GetLineLenght(p, aNetPath.p1^) < 1 then
Result := false;
if GetLineLenght(p, aNetPath.p2^) < 1 then
Result := false;
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.PointDistCMP', E.Message);
end;
end;
function FindVirtualNetPathByReal(aGrpNet: TNet; aNetPath: TNetPath; aExtCheck: Boolean=false): TNetPath;
var
TmpPath: TNetPath;
i, j: Integer;
MinDLen: Double;
NetPathLen, PathLen: Double;
begin
Result := nil;
if aGrpNet <> nil then
begin
MinDLen := -1;
NetPathLen := GetLineLenght(aNetPath.p1^, aNetPath.p2^);
for i := 0 to aGrpNet.Paths.Count - 1 do
begin
TmpPath := TNetPath(aGrpNet.Paths[i]);
if TmpPath.FSrcPaths.Count > 0 then
for j := 0 to TmpPath.FSrcPaths.Count - 1 do
begin
if TmpPath.FSrcPaths[j] = aNetPath then
begin
if Not aExtCheck or
((TmpPath.p1 <> TmpPath.p2) and Not PointNear(TmpPath.p1^, TmpPath.p2^)) then
begin
PathLen := GetLineLenght(TmpPath.p1^, TmpPath.p2^);
if (MinDLen = -1) or (Abs(NetPathLen - PathLen) < MinDLen) then
begin
MinDLen := Abs(NetPathLen - PathLen);
Result := TmpPath;
//Break; //// BREAK ////
end;
end;
end;
end;
end;
end;
end;
function GetWallTypeByDoorType(aDoor: TNetDoor): TFaceWallType;
begin
try
Result := fwtNone;
if aDoor.DoorObjType = dotDoor then
Result := fwtDoorSlope;
if aDoor.DoorObjType = dotWindow then
Result := fwtWindowSlope;
if aDoor.DoorObjType = dotArc then
Result := fwtArc;
if aDoor.DoorObjType = dotBalcony then
Result := fwtBalconSlope;
if aDoor.DoorObjType = dotNiche then
Result := fwtNiche;
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.GetWallTypeByDoorType', E.Message);
end;
end;
procedure GetWallPointsWithSlope(var da1, da2, db1, db2: TDoublePoint; hor_a1, hor_a2, hor_b1, hor_b2: double);
var
inner_len, outer_len: double;
begin
try
outer_len := GetLineLenght(da1, da2);
inner_len := GetLineLenght(db1, db2);
// Tolik 03/01/2020 - -
if outer_len <> 0 then
begin
hor_a1 := hor_a1 / outer_len;
hor_a2 := hor_a2 / outer_len;
end;
if inner_len <> 0 then
begin
hor_b1 := hor_b1 / inner_len;
hor_b2 := hor_b2 / inner_len;
end;
da1.x := da1.x + (da1.x - da2.x) * hor_a1;
da1.y := da1.y + (da1.y - da2.y) * hor_a1;
da2.x := da2.x + (da2.x - da1.x) * hor_a2;
da2.y := da2.y + (da2.y - da1.y) * hor_a2;
db1.x := db1.x + (db1.x - db2.x) * hor_b1;
db1.y := db1.y + (db1.y - db2.y) * hor_b1;
db2.x := db2.x + (db2.x - db1.x) * hor_b2;
db2.y := db2.y + (db2.y - db1.y) * hor_b2;
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.GetWallPointsWithSlope', E.Message);
end;
end;
procedure GetDoorPointsWithSlope(var c: TDoublePoint; d: TDoublePoint; depth: double);
var
d_len: double;
begin
try
d_len := GetLineLenght(c, d);
if (d_len <> 0) and (depth <> 0) then
begin
depth := depth / d_len;
c.x := d.x - (d.x - c.x) * depth;
c.y := d.y - (d.y - c.y) * depth;
end;
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.GetDoorPointsWithSlope', E.Message);
end;
end;
function GetImageHash(aFName: string): string;
var
Buffer: PByte;
Size: Integer;
xStream: TFileStream;
begin
// xStream := TFileStream.Create(aFName, fmOpenRead);
try
// size := xStream.Size;
// GetMem(Buffer, Size + 1);
// xStream.Position := 0;
// xStream.Read(Buffer^, Size);
//Result := BuildBuffHash(Buffer, Size);
Result := BuildFileHash(aFName);
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.GetImageHash', E.Message);
end;
// FreeMem(Buffer, size);
// FreeAndNil(xStream);
end;
function GetObjectHash(aFName: string): string;
var
Buffer: PByte;
Size: Integer;
xStream: TFileStream;
begin
// xStream := TFileStream.Create(aFName, fmOpenRead);
try
// size := xStream.Size;
// GetMem(Buffer, Size + 1);
// xStream.Position := 0;
// xStream.Read(Buffer^, Size);
//Result := BuildBuffHash(Buffer, Size);
Result := BuildFileHash(aFName);
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.GetImageHash', E.Message);
end;
// FreeMem(Buffer, size);
// FreeAndNil(xStream);
end;
{ T3DModel }
procedure T3DModel.CollectModel(aFaces: TList; aNets: TList);
var
i, j, k, l: integer;
xNets: TList;
xNet, FullNet: TNet;
xNetPath: TNetPath;
xRoom, NextRoom: T3DRoom;
xWall, xSecondWall: T3DWall;
isRoof: boolean;
// Tolik -- 17/07/2018 --
NetList, RoomList, PathList, FloorsConturesList, FloorConture, NormalsContureList: TList; // Tolik 20/06/2018 -- ñïèñîê çàìêíóòûõ êîíòóðîâ, ïîëó÷åííûõ ñ TNet'a, åñëè èñïîëüçóåì íå Ãðàôìîäóëü à ÑÊÑ
FloorContureLen: Integer;
AllPathsNet: TNet;
xCorner: T3DCorner;
ip: TDoublePoint;
CornerName: String;
refreshFlag: Boolean;
PassedList: TList;
IsPathListConture: Boolean;
TmpPath: TNetPath;
Procedure AddPointsToNet(aNet: TNet);
var i: Integer;
currPath, NextPath: TNetPath;
cp: PDoublePoint;
begin
if aNet.Paths.Count > 0 then
begin
currPath := TNetPath(aNet.Paths[0]);
if aNet.Paths.Count = 1 then
begin
New(cp);
cp.x := currPath.p1.x;
cp.y := currPath.p1.y;
cp.z := 0;
aNet.Points.Add(cp);
New(cp);
cp.x := currPath.p2.x;
cp.y := currPath.p2.y;
cp.z := 0;
aNet.Points.Add(cp);
exit;
end;
NextPath := TNetPath(aNet.Paths[1]);
New(cp);
cp.x := currPath.p1.x;
cp.y := currPath.p1.y;
cp.z := 0;
if (((CompareValue(cp.x, NextPath.p1.x) = 0) and (CompareValue(cp.y, NextPath.p1.y) = 0)) or
((CompareValue(cp.x, NextPath.p2.x) = 0) and (CompareValue(cp.y, NextPath.p2.y) = 0))) then
begin
cp.x := currPath.p2.x;
cp.y := currPath.p2.y;
aNet.Points.Add(cp);
New(cp);
cp.x := currPath.p1.x;
cp.y := currPath.p1.y;
cp.z := 0;
aNet.Points.Add(cp);
end
else
begin
aNet.Points.Add(cp);
New(cp);
cp.x := currPath.p2.x;
cp.y := currPath.p2.y;
cp.z := 0;
aNet.Points.Add(cp);
end;
for i := 1 to aNet.Paths.Count - 1 do
begin
NextPath := TNetPath(aNet.Paths[i]);
if (((CompareValue(NextPath.p1.x, currPath.p1.x) = 0) and (CompareValue(NextPath.p1.y, currPath.p1.y) = 0)) or
((CompareValue(NextPath.p1.x, currPath.p2.x) = 0) and (CompareValue(NextPath.p1.y, currPath.p2.y) = 0))) then
begin
New(cp);
cp.x := NextPath.p2.x;
cp.y := NextPath.p2.y;
cp.z := 0;
aNet.Points.Add(cp);
end
else
begin
if (((CompareValue(NextPath.p2.x, currPath.p1.x) = 0) and (CompareValue(NextPath.p2.y, currPath.p1.y) = 0)) or
((CompareValue(NextPath.p2.x, currPath.p2.x) = 0) and (CompareValue(NextPath.p2.y, currPath.p2.y) = 0))) then
begin
New(cp);
cp.x := NextPath.p1.x;
cp.y := NextPath.p1.y;
cp.z := 0;
aNet.Points.Add(cp);
end
else
break;
end;
currPath := NextPath;
end;
end;
end;
//
Procedure CalcWithRelatedPoints(aNet: TNet);
var cTNet: tNet;
currPath, netPath: TNetPath;
AddedPathList: TList;
i, j, k: Integer;
CanAddPAth: Boolean;
begin
cTNet := TNet(aNets[0]);
AddedPathList := TList.Create;
for i := 0 to aNet.Paths.Count - 1 do
begin
netPath := TNetPath(aNet.Paths[i]);
for j := 0 to cTNet.Paths.Count - 1 do
begin
currPath := TNetPath(cTNet.Paths[j]);
if currPath.Connected(netPath) then
begin
if AddedPathList.IndexOf(currPath) = -1 then
begin
CanAddPath := True;
for k := 0 to aNet.Paths.Count - 1 do
begin
if TNetPath(aNet.Paths[k]).AreYou(currPath.p1, currPath.p2) then
begin
CanAddPath := False;
break;
end;
end;
if CanAddPAth then
AddedPathList.Add(currPAth);
end;
end;
end;
end;
for i := 0 to AddedPathList.Count - 1 do
aNet.Paths.Add(TNetPath(AddedPathList[i]));
aNet.RefreshPaths(True);
for i := aNet.Paths.Count - 1 downto 0 do
begin
currPath := TNetPath(aNet.Paths[i]);
if AddedPathList.IndexOf(currPath) <> -1 then
aNet.Paths.delete(i);
end;
AddedPathList.free;
end;
Function CheckIsPathListConture(aPathList: tList): Boolean;
begin
Result := False;
if aPathList.Count > 2 then
begin
if TNetPath(aPathList[0]).Connected(TNetPath(aPathList[aPathList.Count - 1])) then
Result := True;
end;
end;
// Tolik 30/10/2019 -- äëÿ ñìåæíûõ êîìíàò -- êç -- äëÿ ñòåí òèïà ïåðåãîðîäîê âíóòðè êîìíàò - ñîéäåò
Procedure DefineInsidePaths;
var i, j, k, l: Integer;
currRoom, CheckRoom: T3DRoom;
currWall: T3DWall;
begin
for i := 0 to fRooms.Count - 1 do
begin
CurrRoom := T3DRoom(FRooms[i]);
for j := 0 to FRooms.Count - 1 do
begin
if j <> i then
begin
CheckRoom := T3DRoom(FRooms[j]);
if Length(CheckRoom.FNetConture) > 0 then
begin
for k := 0 to CurrRoom.FWalls.Count - 1 do
begin
currWall := T3DWall(CurrRoom.FWalls[k]);
if currWall.FPlanObject <> nil then
begin
l := 0;
{if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.p1^) and
PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.p2^)) then
currWall.FPlanObject.FIsInner := True;}
if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.r1)) then
inc(l);
if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.l1)) then
inc(l);
if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.r2)) then
inc(l);
if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.l2)) then
inc(l);
if l > 2 then
currWall.FPlanObject.FIsInner := True;
end;
end;
end;
end;
end;
end;
end;
Procedure DefineInnerPaths(aNetList: TList);
var i, j, k, l: Integer;
currNet, NextNet : TNet;
CurrPath, NextPath: TNetPath;
begin
for i := 0 to aNetList.Count - 1 do
begin
currNet := TNet(aNetList[i]);
for j := 0 to currNet.Paths.Count - 1 do
begin
currPath := TNetPath(currNet.Paths[j]);
currPath.op1 := @currPath.el1;
currPath.op2 := @currPath.el2;
currPath.ip1 := @currPath.er1;
currPath.ip2 := @currPath.er2;
if not currPath.FIsInner then
if i < (aNetList.Count - 1) then
begin
for k := (i+1) to aNetList.Count - 1 do
begin
NextNet := TNet(aNetList[k]);
for l := 0 to NextNet.Paths.Count - 1 do
begin
NextPath := TNetpath(NextNet.Paths[l]);
//if currPath = NextPath then
if ((CompareValue(currPath.p1.x, NextPath.p1.x) = 0) and
(CompareValue(currPath.p1.y, NextPath.p1.y) = 0) and
(CompareValue(currPath.p2.x, NextPath.p2.x) = 0) and
(CompareValue(currPath.p2.y, NextPath.p2.y) = 0))
or
((CompareValue(currPath.p2.x, NextPath.p1.x) = 0) and
(CompareValue(currPath.p2.y, NextPath.p1.y) = 0) and
(CompareValue(currPath.p1.x, NextPath.p2.x) = 0) and
(CompareValue(currPath.p1.y, NextPath.p2.y) = 0)) then
begin
currPath.FIsInner := True;
break;
end;
end;
if currPath.FIsInner then
break;
end;
end;
end;
end;
end;
function GetSCSRoomConture(aNet: tNet): TDoublePointArr;
var startPoint, NextPoint, LastPoint: PDoublePoint;
Side, ResultLength, i, j, range, currResLength: Integer;
currPath, NextPath: TNetPath;
Rad, ang1, ang2: Double;
invertarray: Boolean;
dxfModeFlag: Boolean;
LineLen1, LineLen2: double;
arcPoints: T2DPointArray;
function GetConnSide(aPoint: PDoublePoint; aPath: TNetPath): Integer;
begin
Result := 0;
if ((CompareValue(aPoint.x, aPath.p1.x) = 0) and (CompareValue(aPoint.y, aPath.p1.y) = 0)) then
Result := 1
else
if ((CompareValue(aPoint.x, aPath.p2.x) = 0) and (CompareValue(aPoint.y, aPath.p2.y) = 0)) then
Result := 2;
end;
begin
SetLength(Result, 0);
ResultLength := 0;
if aNet.Paths.Count = 0 then
exit;
if aNet.Paths.Count = 1 then
begin
{
SetLength(Result, 2);
Result[0].x := TNetPath(aNet.Paths[0]).p1.x;
Result[0].y := TNetPath(aNet.Paths[0]).p1.y;
Result[0].z := 0;
Result[1].x := TNetPath(aNet.Paths[0]).p2.x;
Result[1].y := TNetPath(aNet.Paths[0]).p2.y;
Result[1].z := 0;
exit;
}
SetLength(Result, 4);
Result[0].x := TNetPath(aNet.Paths[0]).l1.x;
Result[0].y := TNetPath(aNet.Paths[0]).l1.y;
Result[0].z := 0;
Result[1].x := TNetPath(aNet.Paths[0]).l2.x;
Result[1].y := TNetPath(aNet.Paths[0]).l2.y;
Result[1].z := 0;
Result[2].x := TNetPath(aNet.Paths[0]).r2.x;
Result[2].y := TNetPath(aNet.Paths[0]).r2.y;
Result[2].z := 0;
Result[3].x := TNetPath(aNet.Paths[0]).r1.x;
Result[3].y := TNetPath(aNet.Paths[0]).r1.y;
Result[3].z := 0;
exit;
end;
currPath := TNetPath(aNet.Paths[0]);
StartPoint := currPath.p1;
Side := 1;
LastPoint := currPath.p2;
NextPath := TNetPath(aNet.Paths[1]);
Side := 0;
Side := GetConnSide(StartPoint, NextPath);
if Side = 0 then
begin
StartPoint := currPath.p2;
LastPoint := currPath.p1;
Side := GetConnSide(StartPoint, NextPath);
end;
if Side = 0 then
exit; // -- íå ñëîæèëîñü ...
// Tolik 10/01/2020 -- íå ó÷òåíû ñòåíû â âèäå äóãè...
if currPath.isArc then
begin
if currPath.Inverted then
begin
ang1 := GetRadOfLine(currPath.ArcCenter, currPath.p1^);
ang2 := GetRadOfLine(currPath.ArcCenter, currPath.p2^);
end
else
begin
ang1 := GetRadOfLine(currPath.ArcCenter, currPath.p2^);
ang2 := GetRadOfLine(currPath.ArcCenter, currPath.p1^);
end;
Rad := Sqrt(sqr(currPath.ArcCenter.x - currPath.p1.x) + sqr(currPath.ArcCenter.y - currPath.p1.y));
if ang2 = 0 then
ang2 := 2 * pi;
dxfModeFlag := dxfMode32;
dxfMode32 := true;
BezierArcPoints(arcPoints, currPath.ArcCenter.x, currPath.ArcCenter.y, Rad, ang1, ang2);
dxfMode32 := dxfModeFlag;
range := Length(arcPoints) - 1;
LineLen1 := SQRT(sqr(StartPoint.x - t2DPoint(arcPoints[0]).x) + sqr(StartPoint.y - t2dPoint(arcPoints[0]).y));
LineLen2 := SQRT(sqr(StartPoint.x - t2DPoint(arcPoints[range]).x) + sqr(StartPoint.y - t2dPoint(arcPoints[range]).y));
if compareValue(LineLen1, LineLen2) = 1 then
invertarray := True
else
invertarray := False;
currResLength := Length(Result);
SetLength(Result, Length(Result) + range + 1);
if invertArray then
begin
for i := range downto 0 do
begin
Result[currResLength + i].x := t2DPoint(arcPoints[i]).x;
Result[currResLength + i].y := t2DPoint(arcPoints[i]).y;
Result[currResLength + i].z := 0;
end;
end
else
begin
for i := 0 to range do
begin
Result[currResLength + i].x := t2DPoint(arcPoints[i]).x;
Result[currResLength + i].y := t2DPoint(arcPoints[i]).y;
Result[currResLength + i].z := 0;
end;
end;
end
else
begin
//
ResultLength := Length(Result); // Tolik 10/01/2020
INC(ResultLength);
SetLength(Result, ResultLength);
Result[ResultLength - 1].x := StartPoint.x;
Result[ResultLength - 1].y := StartPoint.y;
Result[ResultLength - 1].z := 0;
end;
for i := 1 to aNet.Paths.Count - 1 do
begin
NextPath := TNetPath(aNet.Paths[i]);
if ((CompareValue(NextPath.p1.x, StartPoint.x) <> 0) or
(CompareValue(NextPath.p1.y, StartPoint.y) <> 0)) then
StartPoint := NextPath.p1
else
if ((CompareValue(NextPath.p2.x, StartPoint.x) <> 0) or
(CompareValue(NextPath.p2.y, StartPoint.y) <> 0)) then
StartPoint := NextPath.p2
else
StartPoint := Nil;
if StartPoint = nil then
exit;
//Tolik 10/01/2020 -- íå ó÷òåíû ñòåíû â âèäå äóãè...
if NextPath.isArc then
begin
if NextPath.Inverted then
begin
ang1 := GetRadOfLine(NextPath.ArcCenter, NextPath.p1^);
ang2 := GetRadOfLine(NextPath.ArcCenter, NextPath.p2^);
end
else
begin
ang1 := GetRadOfLine(NextPath.ArcCenter, NextPath.p2^);
ang2 := GetRadOfLine(NextPath.ArcCenter, NextPath.p1^);
end;
Rad := Sqrt(sqr(NextPath.ArcCenter.x - NextPath.p1.x) + sqr(NextPath.ArcCenter.y - NextPath.p1.y));
if ang2 = 0 then
ang2 := 2 * pi;
dxfModeFlag := dxfMode32;
dxfMode32 := true;
BezierArcPoints(arcPoints, NextPath.ArcCenter.x, NextPath.ArcCenter.y, Rad, ang1, ang2);
dxfMode32 := dxfModeFlag;
range := Length(arcPoints) - 1;
LineLen1 := SQRT(sqr(StartPoint.x - t2DPoint(arcPoints[0]).x) + sqr(StartPoint.y - t2dPoint(arcPoints[0]).y));
LineLen2 := SQRT(sqr(StartPoint.x - t2DPoint(arcPoints[range]).x) + sqr(StartPoint.y - t2dPoint(arcPoints[range]).y));
if compareValue(LineLen1, LineLen2) = 1 then
invertarray := True
else
invertarray := False;
currResLength := Length(Result);
SetLength(Result, Length(Result) + range + 1);
if invertArray then
begin
for j := range downto 0 do
begin
Result[currResLength + j].x := t2DPoint(arcPoints[j]).x;
Result[currResLength + j].y := t2DPoint(arcPoints[j]).y;
Result[currResLength + j].z := 0;
end;
end
else
begin
for j := 0 to range do
begin
Result[currResLength + j].x := t2DPoint(arcPoints[j]).x;
Result[currResLength + j].y := t2DPoint(arcPoints[j]).y;
Result[currResLength + j].z := 0;
end;
end;
end
else
begin
ResultLength := Length(Result); // Tolik 10/01/2020
INC(ResultLength);
SetLength(Result, ResultLength);
Result[ResultLength - 1].x := StartPoint.x;
Result[ResultLength - 1].y := StartPoint.y;
Result[ResultLength - 1].z := 0;
end;
end;
end;
function GetRelatedPaths(aNet: TNet; aPoint: PDoublePoint): TList;
var i: Integer;
currPath: TNetPath;
begin
Result := TList.Create;
for i := 0 to aNet.Paths.Count - 1 do
begin
currPath := TNetPath(aNet.Paths[i]);
if ((CompareValue(aPoint.x, currPath.p1.x) = 0) and (CompareValue(aPoint.y, currPath.p1.y) = 0)) or
((CompareValue(aPoint.x, currPath.p2.x) = 0) and (CompareValue(aPoint.y, currPath.p2.y) = 0)) then
if Result.IndexOf(currPath)= -1 then
Result.Add(currPath);
end;
if Result.Count < 2 then
FreeAndNil(Result);
end;
// Tolik 31/10/2019 --
Procedure DropInnerPaths;
var i: Integer;
currNet: TNet;
begin
currNet := TNet(aNets[0]);
for i := 0 to currNet.Paths.Count - 1 do
TNetPath(currNet.Paths[i]).FIsInner := False;
end;
//
begin
refreshFlag := GCanRefreshCaD;
GCanRefreshCad := False;
try
FGroupNet := nil;
RoomList := Nil;
FloorsConturesList := Nil;
NormalsContureList := nil;
FloorConture := Nil;
NetList := nil;
isRoof := False;
if aNets.Count > 0 then
if IfFiguraIsRoof(aNets[0]) then
isRoof := True;
//31.05.2012 - ãðóïïîâîé ñòðîèì âíà÷àëå, äàáû ñðàçó âñå ìîäèôèêàöèè îïðåäåëèëèñü
if IsRoof then
begin
// GCurrentRoom3DView := F_ProjMan.GetActualSelectedComponent;
GArch3DInnerSidesFromVirtual := False;
for i := 0 to aNets.Count - 1 do
begin
xNet := TNet(aNets[i]);
xRoom := T3DRoom.Create(aFaces, xNet, self);
FRooms.Add(xRoom);
end;
GArch3DInnerSidesFromVirtual := True;
//GCurrentRoom3DView := nil;
end
else
begin
{$if Defined(ES_GRAPH_SC)}
if GCurrentRoom3DView = nil then
FGroupNet := GroupRoomNets(GCadForm);
for i := 0 to aNets.Count - 1 do
begin
xNet := TNet(aNets[i]);
xRoom := T3DRoom.Create(aFaces, xNet, self);
FRooms.Add(xRoom);
end;
//Exit; ///// EXIT /////
{$else} // Tolik
if aNets.Count > 0 then
begin
DropInnerPaths; // Tolik 31/10/2019 -- ÷òîáû ïåðåîïðåäåëèëèñü íà ïàðñèíãå è íå ïðîïàëè íóæíûå ñòåíû â ïðîöåññå ...
FloorsConturesList := TList.Create; // ñïèñîê êîíòóðîâ ïîëîâ äëÿ êîìíàò
NormalsContureList := TList.Create;
TNet(aNets[0]).CalculatePathPoints;
TNet(aNets[0]).IntersectPaths(False);
TNet(aNets[0]).RefreshPaths();
TNet(aNets[0]).RefreshPoints;
//RoomList := GetContureListFromNet(TNet(aNets[0]), FloorsConturesList); // ïîñòðîèò ñïèñîê ñòåí/êîìíàò è çàîäíî êîíòóðû ïîëîâ äëÿ êàæäîé êîìíàòû
RoomList := GetContureListFromNet(TNet(aNets[0]), FloorsConturesList, NormalsContureList); // ïîñòðîèò ñïèñîê ñòåí/êîìíàò è çàîäíî êîíòóðû ïîëîâ äëÿ êàæäîé êîìíàòû
NetList := TList.Create;
if RoomList.Count > 0 then
begin
for i := 0 to RoomList.Count - 1 do
begin
PathList := RoomList[i];
IsPathListConture := CheckIsPathListConture(PathList);
xNet := TNet.create(8, mydsNormal, GCadForm.PCad);
xNet.FAllowAddPathWithSamePoints := True;
for j := 0 to PathList.Count - 1 do
begin
xNetPath := TNetPath(PathList[j]);
xNet.Paths.Add(xNetPath);
xNetPath.FIsConture := IsPathListConture;
end;
AddPointsToNet(xNet);
NetList.Add(xNet);
end;
end;
DefineInnerPaths(NetList); // îïðåäåëèòü ïóòè ìåæäó êîíòóðàìè (ñìåæíûå)
FGroupNet := GroupRoomNets(GCadForm, NetList);
FGroupNet.RefreshPaths(True);//
GArch3DInnerSidesFromVirtual := False;
for i := 0 to NetList.Count - 1 do
begin
xNet := TNet(NetList[i]);
xRoom := T3DRoom.Create(aFaces, xNet, self);
if FloorsConturesList[i] <> nil then
begin
FloorConture := TList(FloorsConturesList[i]);
SetLength(xRoom.FCeilingConture, FloorConture.Count);
SetLength(xRoom.FFloorConture, FloorConture.Count);
for j := 0 to FloorConture.Count - 1 do
begin
xRoom.FCeilingConture[j].x := PDoublePoint(FloorConture[j]).x;
xRoom.FCeilingConture[j].y := PDoublePoint(FloorConture[j]).y;
//Tolik 25/08/2021 -- FScaleDeltaSCS
//xRoom.FCeilingConture[j].z := Get3DWallHeight * FScaleDelta;
xRoom.FCeilingConture[j].z := Get3DWallHeight * FScaleDeltaSCS;
//
xRoom.FFloorConture[j].x := PDoublePoint(FloorConture[j]).x;
xRoom.FFloorConture[j].y := PDoublePoint(FloorConture[j]).y;
xRoom.FFloorConture[j].z := 0;
end;
xRoom.FNetConture := GetSCSRoomConture(xNet);
end;
if NormalsContureList <> nil then
if NormalsContureList.Count > 0 then
if (NormalsContureList.Count - 1) >= i then
if NormalsContureList[i] <> nil then
begin
FloorConture := TList(NormalsContureList[i]);
SetLength(xRoom.FFloorContureForNormal, FloorConture.Count);
for j := 0 to FloorConture.Count - 1 do
begin
xRoom.FFloorContureForNormal[j] := PDoublePoint(FloorConture[j])^;
end;
FreeAndDisposeList(TList(NormalsContureList[i]));
NormalsContureList[i] := nil;
end;
if aFaces <> nil then
xRoom.CollectRoom(aFaces, xNet.Paths);
// xRoom.FVisible := False;
FRooms.Add(xRoom);
end;
GArch3DInnerSidesFromVirtual := True;
end;
{$ifEnd}
{$if Defined(ES_GRAPH_SC)}
//25.06.2012 - Íàñûïàåì âíóòðåííèå ãðàíè ïî ãðóïïîâîìó TNet
if GArch3DInnerSidesFromVirtual and Assigned(FGroupNet) then
begin
//
for i := 0 to FGroupNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(FGroupNet.Paths[i]);
for j := 0 to FRooms.Count - 1 do
begin
xRoom := T3DRoom(FRooms[j]);
for k := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[k]);
if xNetPath.FSrcPaths.IndexOf(xWall.FPlanObject) <> -1 then
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForInner(aFaces, xNetPath);
end;
end;
//xWall := FindRealWallByVirtualNetPath(xNetPath);
//if xWall <> nil then
// xWall.ParseWallForInner(aFaces, xNetPath)
//else
// EmptyProcedure;
end;
//GArch3DInnerSidesFromVirtual := True;
end;
if GCurrentRoom3DView = nil then
begin
//31.05.2012 FGroupNet := GroupRoomNets(GCadForm);
for i := 0 to FGroupNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(FGroupNet.Paths[i]);
xWall := FindRealWallByVirtualNetPath(xNetPath);
if xWall <> nil then
begin
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForOuter(aFaces, xNetPath);
//xWall.ParseWallForOuter(aFaces, xWall.FPlanObject)
end
else
EmptyProcedure;
end;
//FreeAndNil(FGroupNet);
end
else
begin
xNet := GetNetByComponID(GCurrentRoom3DView.ID, GCadForm);
for i := 0 to xNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(xNet.Paths[i]);
xWall := FindWallByNetPath(xNetPath);
if xWall <> nil then
begin
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForOuter(aFaces, xNetPath)
//xWall.ParseWallForOuter(aFaces, xWall.FPlanObject)
end
else
EmptyProcedure;
end;
end;
// ParseWallForPerpendSides
if GCurrentRoom3DView = nil then
begin
for i := 0 to FGroupNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(FGroupNet.Paths[i]);
xWall := FindRealWallByVirtualNetPath(xNetPath);
if xWall <> nil then
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForPerpendSides(aFaces, xNetPath)
else
EmptyProcedure;
end;
//FreeAndNil(FGroupNet);
end
else
begin
xNet := GetNetByComponID(GCurrentRoom3DView.ID, GCadForm);
for i := 0 to xNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(xNet.Paths[i]);
xWall := FindWallByNetPath(xNetPath);
if xWall <> nil then
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForPerpendSides(aFaces, xNetPath)
else
EmptyProcedure;
end;
end;
{$else}
if aNets.Count > 0 then
begin
//if GArch3DInnerSidesFromVirtual and Assigned(FGroupNet) then
begin
//
PassedList := TList.Create;
//GArch3DInnerSidesFromVirtual := False;
for i := 0 to FGroupNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(FGroupNet.Paths[i]);
//if PassedList.IndexOf(xNetPath) = -1 then
begin
for j := 0 to FRooms.Count - 1 do
begin
xRoom := T3DRoom(FRooms[j]);
for k := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[k]);
if xNetPath.FSrcPaths.IndexOf(xWall.FPlanObject) <> -1 then
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForInner(aFaces, xNetPath);
end;
end;
PassedList.Add(xNetPath);
end;
end;
//GArch3DInnerSidesFromVirtual := True;
end;
PassedList.Clear;
// GArch3DInnerSidesFromVirtual := False;
if GCurrentRoom3DView = nil then
begin
//31.05.2012 FGroupNet := GroupRoomNets(GCadForm);
for i := 0 to FGroupNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(FGroupNet.Paths[i]);
//if PassedList.IndexOf(xNetPath) = -1 then
begin
xWall := FindRealWallByVirtualNetPath(xNetPath);
if xWall <> nil then
begin
xWall.ParseWallForOuter(aFaces, xNetPath);
//xWall.ParseWallForOuter(aFaces, xWall.FPlanObject)
end
else
EmptyProcedure;
PassedList.Add(xNetPath);
end;
end;
//FreeAndNil(FGroupNet);
end
else
begin
xNet := GetNetByComponID(GCurrentRoom3DView.ID, GCadForm);
for i := 0 to xNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(xNet.Paths[i]);
//if PassedList.IndexOf(xNetPath) = -1 then
begin
xWall := FindWallByNetPath(xNetPath);
if xWall <> nil then
begin
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForOuter(aFaces, xNetPath)
//xWall.ParseWallForOuter(aFaces, xWall.FPlanObject)
end
else
EmptyProcedure;
PassedList.Add(xNetPath);
end;
end;
end;
PassedList.Clear;
// ParseWallForPerpendSides
if GCurrentRoom3DView = nil then
begin
for i := 0 to FGroupNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(FGroupNet.Paths[i]);
//if PassedList.IndexOf(xNetPath) = -1 then
begin
xWall := FindRealWallByVirtualNetPath(xNetPath);
if xWall <> nil then
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForPerpendSides(aFaces, xNetPath)
else
EmptyProcedure;
PassedList.Add(xNetPath);
end;
end;
//FreeAndNil(FGroupNet);
end
else
begin
xNet := GetNetByComponID(GCurrentRoom3DView.ID, GCadForm);
for i := 0 to xNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(xNet.Paths[i]);
//if PassedList.IndexOf(xNetPath) = -1 then
begin
xWall := FindWallByNetPath(xNetPath);
if xWall <> nil then
//Åñëè â êîíòåêñòå íå èìååòñÿ ÷òî-ëèáî,ñâÿçàííîå ñ êðûøåé,òîãäà òîëüêî äîáàâëÿåì
xWall.ParseWallForPerpendSides(aFaces, xNetPath)
else
EmptyProcedure;
PassedList.Add(xNetPath);
end;
end;
end;
PassedList.Free;
// Tolik -- 31/08/2018 -- áîêîâóøêà íà ñòûêå ñòåí ðàçíîé òîëùèíû (â ñòåíó ñ íàèáîëüøåé òîëùèíîé)
for i := 0 to FGroupNet.Points.Count - 1 do
begin
PassedList := GetRelatedPaths(FGroupNet, PDoublePoint(FGroupNet.Points[i]));
if PassedList <> nil then
begin
{
for j := 0 to PassedList.Count - 1 do
begin
xNetPath := TNetPath(PassedList[j]);
xWall := FindRealWallByVirtualNetPath(xNetPath);
if xWall <> nil then
begin
xWall.ParseWallForJoint(PassedList, aFaces, PDoublePoint(FGroupNet.Points[i]));
break;
end;
end;
}
xNetPath := nil;
for j := 0 to PassedList.Count - 1 do
begin
if xNetPath = nil then
xNetPath := TNetPath(PassedList[j])
else
if CompareValue(xNetPath.Width, TNetPath(PassedList[j]).Width) = -1 then
xNetPath := TNetPath(PassedList[j]);
end;
xWall := FindRealWallByVirtualNetPath(xNetPath);
if xWall <> nil then
begin
xWall.ParseWallForJoint(PassedList, aFaces, PDoublePoint(FGroupNet.Points[i]));
end;
end;
PassedList.Free;
end;
end;
{$ifEnd}
end;
if FGroupNet <> nil then
FreeAndNil(FGroupNet);
// Tolik 30/10/2019 --
DefineInsidePaths;
for i := 0 to FRooms.Count - 1 do
begin
for k := 0 to T3DRoom(FRooms[i]).FWalls.Count - 1 do
begin
if T3DWall(T3DRoom(FRooms[i]).FWalls[k]).FPlanObject.FIsInner then
begin
for j := 0 to T3DWall(T3DRoom(FRooms[i]).FWalls[k]).FSides.Count - 1 do
begin
if (T3DSide(T3DWall(T3DRoom(FRooms[i]).FWalls[k]).FSides[j]).FFace <> nil) then
TFaceRecord(T3DSide(T3DWall(T3DRoom(FRooms[i]).FWalls[k]).FSides[j]).FFace).FFaceWallType := fwtInner;
end;
end;
end;
end;
//
if RoomList <> nil then
begin
for i := 0 to RoomList.Count - 1 do
TList(RoomList[i]).Free;
RoomList.Free;
end;
if FloorsConturesList <> nil then
begin
FloorsConturesList.Pack;
for i := 0 to FloorsConturesList.Count - 1 do
begin
FreeAndDisposeList(TList(FloorsConturesList[i]));
end;
FloorsConturesList.Free;
end;
if NormalsContureList <> nil then
begin
NormalsContureList.Pack;
for i := 0 to NormalsContureList.Count - 1 do
begin
FreeAndDisposeList(TList(NormalsContureList[i]));
end;
NormalsContureList.Free;
end;
if NetList <> nil then
begin
for i := 0 to NetList.Count - 1 do
begin
xNet := TNet(NetList[i]);
xNet.Paths.Clear;
xNet.Free;
end;
NetList.Free;
end;
except
on E: Exception do AddExceptionToLogEx('T3DModel.CollectModel', E.Message);
end;
GCanRefreshCad := refreshFlag;
end;
procedure T3DModel.CollectScsModel(aFaces, aScsObjects: TList);
var
i, j, k: integer;
aFace: TFaceRecord;
a3DPointArr: T3DPointArray;
x3DConnector: T3DConnector;
x3DLine: T3DLine;
xLine: TOrthoLine;
xConn, GetConn: TConnectorObject;
xFigure, InFigure: TFigure;
xFigureGrp: TSCSFigureGrp;
//Tolik 17/09/2018 --
TubeList: TList;
x3DTube: T3dTube;
x3DBooblick: T3DBooblick;
TailTubeList: TList;
TubePoint: PDoublePoint;
TubeRadius: Double;
PipeList, PassedLineList: TList;
ComponOffset: Double;
Function GetPoint(aLine: TOrthoLine; PointNum: Integer; dist: Double): PDoublePoint;
var p1, p2: TDoublePoint;
i: Integer;
TubeCompon: TSCSComponent;
distx, disty, distz, koefx, koefy, koefz, LineLen: Double;
LineCatalog: TSCSCatalog;
CirclePoint: PDoublePoint;
RealRadius: Double;
PointsAngle: Double;
Conn1,Conn2: TConnectorObject;
MaxX, MaxY, MinX, MinY, DistToPoint: Double;
begin
Result := Nil;
New(Result);
DistToPoint := Dist;
Conn1 := TConnectorObject(aLine.JoinConnector1);
Conn2 := TConnectorObject(aLine.JoinConnector2);
if Conn1.JoinedConnectorsList.Count > 0 then
begin
Conn1 := TConnectorObject(Conn1.JoinedConnectorsList[0]);
if PointNum = 1 then
begin
Conn1.GetBounds(MaxX, MaxY, MinX, MinY);
DistTopoint := DistToPoint + ((Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))) / (UOMToMetre(1000 / GCadForm.PCad.MapScale)))/4;
end;
end;
if Conn2.JoinedConnectorsList.Count > 0 then
begin
Conn2 := TConnectorObject(Conn2.JoinedConnectorsList[0]);
if PointNum = 2 then
begin
Conn2.GetBounds(MaxX, MaxY, MinX, MinY);
DistTopoint := DistToPoint + ((Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))) / (UOMToMetre(1000 / GCadForm.PCad.MapScale)))/4;
end;
end;
if PointNum = 1 then
begin
p1.x := Conn1.ap1.x;
p1.y := Conn1.ap1.y;
p1.z := UomToMetre(Conn1.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale));
//p1.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1];
p2.x := Conn2.ap1.x;
p2.y := Conn2.ap1.y;
p2.z := UomToMetre(Conn2.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale));
//p2.z := TConnectorObject(aLine.JoinConnector2).ActualZOrder[1];
end
else
if PointNum = 2 then
begin
p2.x := Conn1.ap1.x;
p2.y := Conn1.ap1.y;
p2.z := UomToMetre(Conn1.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale));
//p2.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1];
p1.x := Conn2.ap1.x;
p1.y := Conn2.ap1.y;
p1.z := (UomToMetre(Conn2.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)));
//p1.z := TConnectorObject(aLine.JoinConnector2).ActualZOrder[1];
end
else
begin
Dispose(Result);
Result := Nil;
exit;
end;
LineLen := SQRT(SQR(p1.x - p2.x) + SQR(p1.y - p2.y) + SQR(p1.z - p2.z));
koefx := (p2.x - p1.x)/LineLen;
koefy := (p2.y - p1.y)/LineLen;
koefz := (p2.z - p1.z)/LineLen;
Result.x := p1.x + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx);
Result.y := p1.y + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy);
Result.z := MetreToUom(p1.z + DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz)/(UOMToMetre(1000 / GCadForm.PCad.MapScale));
//Result.x := p1.x + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx);
//Result.y := p1.y + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy);
//Result.z := MetreToUom((p1.z + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz))/(UOMToMetre(1000 / GCadForm.PCad.MapScale)));
end;
Function GetTubeList(aLine: TOrthoLine): TList;
var i: integer;
LineCatalog: TSCSCatalog;
begin
Result := TList.Create;
if aLine <> nil then
if not aLine.Deleted then
begin
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aLine.ID);
if LineCatalog <> nil then
begin
for i := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
if LineCatalog.ComponentReferences[i].ComponentType.SysName = ctsnTube then
if Result.IndexOf(LineCatalog.ComponentReferences[i]) = -1 then
begin
Result.Add(LineCatalog.ComponentReferences[i]);
//break;
end;
end;
end;
end;
end;
Function CheckisPipeElement(AConn: TConnectorObject): Boolean;
var i, j, TubeCount: Integer;
LineCatalog: TSCSCatalog;
LineSCSComponent: TSCSComponent;
begin
Result := False;
TubeCount := 0;
for i := 0 to AConn.JoinedOrtholinesList.Count - 1 do
begin
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrthoLine(aConn.JoinedOrthoLinesList[i]).ID);
if LineCatalog <> nil then
begin
for j := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
LineSCSComponent := LineCatalog.ComponentReferences[j];
if LineSCSComponent.ComponentType.SysName = ctsnTube then
begin
inc(TubeCount);
break;
end;
end;
end;
end;
Result := (TubeCount > 0);
end;
Procedure CreatePipeElement(aConn: TConnectorObject); // Cable
var i, j, k : Integer;
MaxPipeRadius, PrevPipeRadius, PipeRadius: Double;
LineCatalog: TSCSCatalog;
LineComponent, LineComponent1: TSCSComponent;
LineList, TubeList: TList;
PipePoint, PrevPipePoint, addPoint: PDoublePoint;
apArray: T3DPointArray;
TubeLine, TubeLine1: TOrthoLine;
JoinedConn: TConnectorObject;
CableList: TList;
CableOffset: Double;
ConnSide: integer;
exVals: Boolean;
//Tolik 12/11/2021 -- ïðîâåðêà íà íàëè÷èå â òî÷å÷íîì îáúåêòå ýëåìåíòà òðóáíîãî ñîåäèíåíèÿ
function CheckisPipeElement(aConnector: TConnectorObject): Boolean;
var i: integer;
SCSCatalog: TSCSCatalog;
Cad: TF_Cad;
SCSList: TSCSList;
begin
Result := False;
if aConnector.ConnectorType = ct_Nb then
begin
SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(aConnector.Owner.Owner).FCADListID);
if SCSList <> nil then
begin
SCSCatalog := SCSList.GetCatalogFromReferencesBySCSID(aConnector.ID);
if SCSCatalog <> nil then
begin
for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
if SCSCatalog.ComponentReferences[i].ComponentType.SysName = ctsnTubeElement then
begin
Result := True;
break;
end;
end;
end;
end;
end;
end;
begin
LineList := TList.Create;
TubeList := TList.Create;
PipeList := TList.Create;
CableList:= TList.Create;
PipePoint := nil;
PrevPipePoint := nil;
//Collect Lines
//Tolik 12/11/2021 --
//if aConn.ConnectorType = ct_Clear then
if (aConn.ConnectorType = ct_Clear) or (not CheckisPipeElement(aConn)) then
//
begin
if aConn.ConnectorType = ct_Clear then // Tolik 12/11/2021 - -
begin
for i := 0 to aConn.JoinedOrthoLineslist.Count - 1 do
begin
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrthoLine(aConn.JoinedOrthoLineslist[i]).ID);
if LineCatalog <> nil then
if PassedLineList.IndexOf(LineCatalog) = -1 then
begin
for j := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
LineComponent := LineCatalog.ComponentReferences[j];
if LineComponent.ComponentType.SysName = ctsnTube then
begin
LineList.Add(TOrthoLine(aConn.JoinedOrthoLineslist[i]));
TubeList.Add(LineComponent);
// if isCableComponent(LineComponent) then
if CableList.IndexOf(LineComponent) = - 1 then
CableList.Add(LineComponent);
break;
end;
if isCableComponent(LineComponent) then
if CableList.IndexOf(LineComponent) = - 1 then
CableList.Add(LineComponent);
end;
end;
end;
end;
end
else
begin
for j := 0 to aConn.JoinedconnectorsList.count - 1 do
begin
Joinedconn := TconnectorObject(aConn.JoinedconnectorsList[j]);
for i := 0 to Joinedconn.JoinedOrthoLinesList.Count - 1 do
begin
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrthoLine(Joinedconn.JoinedOrthoLineslist[i]).ID);
if LineCatalog <> nil then
if PassedLineList.IndexOf(LineCatalog) = -1 then
begin
for k := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
LineComponent := LineCatalog.ComponentReferences[k];
if LineComponent.ComponentType.SysName = ctsnTube then
begin
LineList.Add(TOrthoLine(JoinedConn.JoinedOrthoLineslist[i]));
TubeList.Add(LineComponent);
break;
end
else
begin
if isCableComponent(LineComponent) then
if CableList.IndexOf(LineComponent) = - 1 then
CableList.Add(LineComponent);
end;
end;
end;
end;
end;
end;
(*
for i := 0 to CableList.Count - 1 do
begin
SetLength(apArray, 3);
TubeLine := TOrthoLine(LineList[0]);
LineComponent := TSCSComponent(TubeList[0]);
PipeRadius := GetTubeRadius(LineComponent);
if PipeRadius = -1 then //Tolik 28/03/2025 -- åñëè íà çàäàí ðàäèóñ òðóáû - âûõîäèì
Exit;
PipeRadius := PipeRadius + PipeRadius /10;
PipePoint := nil;
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TubeLine, 1, PipeRadius)
else
PipePoint := GetPoint(TubeLine, 2, PipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then
PipePoint := GetPoint(TubeLine, 1, PipeRadius)
else
PipePoint := GetPoint(TubeLine, 2, PipeRadius)
end;
apArray[0].x := PipePoint.x;
apArray[0].y := PipePoint.y;
apArray[0].z := PipePoint.z;
DisPose(PipePoint); // 21/12/2019 -- Tolik
PipePoint := nil;
apArray[1].x := aConn.ap1.x;
apArray[1].y := aConn.ap1.y;
apArray[1].z := aConn.ActualZOrder[1];
if LineList.Count > 1 then
begin
for j := 1 to LineList.Count - 1 do
begin
PrevPipePoint := nil;
AddPoint := nil;
TubeLine := TOrthoLine(LineList[0]);
LineComponent := TSCSComponent(TubeList[0]);
PrevPipeRadius := GetTubeRadius(LineComponent);
PrevPipeRadius := PrevPipeRadius + PrevPipeRadius /10;
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then
PrevPipePoint := GetPoint(TubeLine, 1, PrevPipeRadius)
else
PrevPipePoint := GetPoint(TubeLine, 2, PrevPipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then
PrevPipePoint := GetPoint(TubeLine, 1, PrevPipeRadius)
else
PrevPipePoint := GetPoint(TubeLine, 2, PrevPipeRadius)
end;
TubeLine := TOrthoLine(LineList[i]);
LineComponent := TSCSComponent(TubeList[j]);
PipeRadius := GetTubeRadius(LineComponent);
PipeRadius := PipeRadius + PipeRadius /10;
if PipeRadius <> -1 then // !!!!
begin
SetLength(apArray, 2);
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TubeLine, 1, PipeRadius)
else
PipePoint := GetPoint(TubeLine, 2, PipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then
PipePoint := GetPoint(TubeLine, 1, PipeRadius)
else
PipePoint := GetPoint(TubeLine, 2, PipeRadius)
end;
apArray[0].x := PrevPipePoint.x;
apArray[0].y := PrevPipePoint.y;
apArray[0].z := PrevPipePoint.z;
apArray[1].x := aConn.ap1.x;
apArray[1].y := aConn.ap1.y;
apArray[1].z := aConn.ActualZOrder[1];
if CompareValue(PipeRadius, PrevPipeRadius) = 0 then
begin
SetLength(apArray, 3);
apArray[2].x := PipePoint.x;
apArray[2].y := PipePoint.y;
apArray[2].z := PipePoint.z;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := PipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
end
else
begin //
SetLength(apArray, 2);
if CompareValue(PrevPipeRadius, PipeRadius) = -1 then
begin
TubeLine := TOrthoLine(LineList[0]);
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then
addPoint := GetPoint(TubeLine, 1, PrevPipeRadius + PipeRadius)
else
addPoint := GetPoint(TubeLine, 2, PrevPipeRadius + PipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then
addPoint := GetPoint(TubeLine, 1, PrevPipeRadius + PipeRadius)
else
addPoint := GetPoint(TubeLine, 2, PrevPipeRadius + PipeRadius);
end;
apArray[0].x := PipePoint.x;
apArray[0].y := PipePoint.y;
apArray[0].z := PipePoint.z;
end
else
begin
TubeLine := TOrthoLine(LineList[i]);
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then
addPoint := GetPoint(TubeLine, 1, PrevPipeRadius + PipeRadius)
else
addPoint := GetPoint(TubeLine, 2, PrevPipeRadius + PipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then
addPoint := GetPoint(TubeLine, 1, PrevPipeRadius + PipeRadius)
else
addPoint := GetPoint(TubeLine, 2, PrevPipeRadius + PipeRadius);
end;
end;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := Max(PipeRadius, PrevPipeRadius);
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
SetLength(apArray, 3);
apArray[0].x := PipePoint.x;
apArray[0].y := PipePoint.y;
apArray[0].z := PipePoint.z;
apArray[1].x := aConn.ap1.x;
apArray[1].y := aConn.ap1.y;
apArray[1].z := aConn.ActualZOrder[1];
apArray[2].x := PrevPipePoint.x;
apArray[2].y := PrevPipePoint.y;
apArray[2].z := PrevPipePoint.z;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := Min(PipeRadius, PrevPipeRadius) + MetreToUom(0.001);
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
SetLength(apArray, 2);
apArray[0].x := addPoint.x;
apArray[0].y := addPoint.y;
apArray[0].z := addPoint.z;
if CompareValue(PrevPipeRadius, PipeRadius) = -1 then
begin
apArray[1].x := PrevPipePoint.x;
apArray[1].y := PrevPipePoint.y;
apArray[1].z := PrevPipePoint.z;
end
else
begin
apArray[1].x := PipePoint.x;
apArray[1].y := PipePoint.y;
apArray[1].z := PipePoint.z;
end;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := Min(PipeRadius, PrevPipeRadius) + MetreToUom(0.001);
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
end;
end;
if PipePoint <> nil then
begin
Dispose(PipePoint);
PipePoint := nil;
end;
if AddPoint <> nil then
begin
Dispose(AddPoint);
AddPoint := nil;
end;
if PrevPipePoint <> nil then
begin
Dispose(PrevPipePoint);
PrevPipePoint := nil;
end;
end;
SetLength(apArray, 0);
end
else
begin
SetLength(apArray, 2);
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := PipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
SetLength(apArray, 0);
end;
end;
*)
//Ñáðîñèòü òðàññû ñ òðóáàìè, ãäå íå óêàçàí äèàìåòð ñàìîé òðóáû
for i := LineList.Count - 1 downto 0 do
begin
LineComponent := TSCSComponent(TubeList[i]);
PipeRadius := GetTubeRadius(LineComponent);
if PipeRadius = -1 then
begin
LineList.Delete(i);
TubeList.Delete(i);
CableList.Delete(i);
end;
end;
if LineList.Count > 0 then
begin
if LineList.Count = 1 then //çàãëóøêà
begin
SetLength(apArray, 2);
TubeLine := TOrthoLine(LineList[0]);
LineComponent := TSCSComponent(TubeList[0]);
PipeRadius := GetTubeRadius(LineComponent);
PipeRadius := PipeRadius + PipeRadius /10;
PipePoint := nil;
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TubeLine, 1, PipeRadius)
else
PipePoint := GetPoint(TubeLine, 2, PipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then
PipePoint := GetPoint(TubeLine, 1, PipeRadius)
else
PipePoint := GetPoint(TubeLine, 2, PipeRadius)
end;
apArray[1].x := PipePoint.x;
apArray[1].y := PipePoint.y;
apArray[1].z := PipePoint.z;
DisPose(PipePoint); // 21/12/2019 -- Tolik
PipePoint := nil;
apArray[0].x := aConn.ap1.x;
apArray[0].y := aConn.ap1.y;
apArray[0].z := aConn.ActualZOrder[1];
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := PipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
x3DConnector.FRelatedLines.Add(TubeLine);
x3DConnector.FLength := PipeRadius;
end
else // ñòûê äâóõ òðóá èëè êîëåíî
if LineList.Count = 2 then
begin
PipeRadius := GetTubeRadius(TSCSComponent(TubeList[0]));
PipeRadius := PipeRadius + PipeRadius /10;
PipePoint := nil;
PrevPipeRadius := GetTubeRadius(TSCSComponent(TubeList[1]));
PrevPipeRadius := PrevPipeRadius + PrevPipeRadius /10;
if CompareValue(PipeRadius, PrevPipeRadius) = 0 then // äâå òðàññû, òðóáà îäèíàêîâîãî äèàìåòðà
begin
SetLength(apArray, 3 );
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TOrthoLine(LineList[0]).JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TOrthoLine(LineList[0]), 1, PipeRadius)
else
PipePoint := GetPoint(TOrthoLine(LineList[0]), 2, PipeRadius);
if TConnectorObject(TOrthoLine(LineList[1]).JoinConnector1).Id = aConn.ID then
PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 1, PipeRadius)
else
PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 2, PipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[0]).JoinConnector1)) <> -1 then
PipePoint := GetPoint(TOrthoLine(LineList[0]), 1, PipeRadius)
else
PipePoint := GetPoint(TOrthoLine(LineList[0]), 2, PipeRadius);
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[1]).JoinConnector1)) <> -1 then
PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 1, PipeRadius)
else
PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 2, PipeRadius);
end;
SetLength(apArray, 3);
apArray[0].x := PipePoint.x;
apArray[0].y := PipePoint.y;
apArray[0].z := PipePoint.z;
DisPose(PipePoint);
PipePoint := nil;
apArray[1].x := aConn.ap1.x;
apArray[1].y := aConn.ap1.y;
apArray[1].z := aConn.ActualZOrder[1];
apArray[2].x := PrevPipePoint.x;
apArray[2].y := PrevPipePoint.y;
apArray[2].z := PrevPipePoint.z;
Dispose(PrevPipePoint);
PrevPipePoint := nil;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := PipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
x3DConnector.FRelatedLines.Add(TOrthoLine(LineList[0]));
x3DConnector.FRelatedLines.Add(TOrthoLine(LineList[1]));
x3DConnector.FLength := PipeRadius;
end
else
begin
exVals := False;
if CompareValue(PipeRadius, PrevPiperadius) = -1 then
begin
ExchangeDouble(PipeRadius, PrevPipeRadius); // âûáðàòü áîëüøèé ðàäèóñ êàê îñíîâó
exVals := True;
end;
SetLength(apArray, 3);
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TOrthoLine(LineList[0]).JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TOrthoLine(LineList[0]), 1, PipeRadius)
else
PipePoint := GetPoint(TOrthoLine(LineList[0]), 2, PipeRadius);
if TConnectorObject(TOrthoLine(LineList[1]).JoinConnector1).Id = aConn.ID then
PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 1, PipeRadius)
else
PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 2, PipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[0]).JoinConnector1)) <> -1 then
PipePoint := GetPoint(TOrthoLine(LineList[0]), 1, PipeRadius)
else
PipePoint := GetPoint(TOrthoLine(LineList[0]), 2, PipeRadius);
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[1]).JoinConnector1)) <> -1 then
PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 1, PipeRadius)
else
PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 2, PipeRadius);
end;
SetLength(apArray, 3);
apArray[0].x := PipePoint.x;
apArray[0].y := PipePoint.y;
apArray[0].z := PipePoint.z;
DisPose(PipePoint);
PipePoint := nil;
apArray[1].x := aConn.ap1.x;
apArray[1].y := aConn.ap1.y;
apArray[1].z := aConn.ActualZOrder[1];
apArray[2].x := PrevPipePoint.x;
apArray[2].y := PrevPipePoint.y;
apArray[2].z := PrevPipePoint.z;
Dispose(PrevPipePoint);
PrevPipePoint := nil;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := PipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
x3DConnector.FRelatedLines.Add(TOrthoLine(LineList[0]));
x3DConnector.FRelatedLines.Add(TOrthoLine(LineList[1]));
x3DConnector.FLength := PipeRadius;
if exVals then
TubeLine := LineList[0]
else
TubeLine := LineList[1];
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TubeLine, 1, PipeRadius + PrevPipeRadius)
else
PipePoint := GetPoint(TubeLine, 2, PipeRadius + PrevPipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TubeLine.JoinConnector1) <> -1 then
PipePoint := GetPoint(TubeLine, 1, PipeRadius + PrevPipeRadius)
else
PipePoint := GetPoint(TubeLine, 2, PipeRadius + PrevPipeRadius);
end;
SetLength(apArray, 2);
apArray[0].x := aConn.ap1.x;
apArray[0].y := aConn.ap1.y;
apArray[0].z := aConn.ActualZOrder[1];
apArray[1].x := PipePoint.x;
apArray[1].y := PipePoint.y;
apArray[1].z := PipePoint.z;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := PrevPipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
x3DConnector.FRelatedLines.Add(TubeLine);
x3DConnector.FLength := PipeRadius + PrevPipeRadius;
end;
end
else
if LineList.Count > 2 then
begin
MaxPipeRadius := -1;
TubeLine1 := nil;
TubeLine := nil;
for i := 0 to TubeList.Count - 1 do //get Max tube Radius
begin
PipeRadius := GetTubeRadius(TSCSComponent(TubeList[i]));
if CompareValue(MaxPipeRadius, PipeRadius) = -1 then
begin
MaxPipeRadius := PipeRadius;
TubeLine := TOrthoLine(LineList[i]);
LineComponent := TSCSComponent(TubeList[i]);
j := i;
end;
end;
Tubelist.Delete(j); // óäàëÿåì âûáðàííóþ òðàññó è òðóáó èç ñïèñêà
LineList.Delete(j);
CableList.Delete(j);
for i := 0 to TubeList.Count - 1 do //get next tube with Max Radius
begin
PipeRadius := GetTubeRadius(TSCSComponent(TubeList[i]));
if CompareValue(MaxPipeRadius, PipeRadius) = 0 then
begin
TubeLine1 := TOrthoLine(LineList[i]);
LineComponent1 := TSCSComponent(Tubelist[i]);
j := i;
break;
end;
end;
MaxPipeRadius := MaxPipeRadius + MaxPipeRadius/10;
if TubeLine1 = nil then //åñëè íåò òðóá áîëüøå ñ ìàêñ ðàäèóñîì, áåðåì òðóáó ñ ìàêñ ðàäèóñîì èç òåõ, ÷òî îñòàëèñü
begin
PipeRadius := -1;
for i := 0 to LineList.Count - 1 do
begin
PrevPipeRadius := GetTubeRadius(TSCSComponent(TubeList[i]));
if CompareValue(PipeRadius, PrevPipeRadius) = -1 then
begin
PipeRadius := PrevPipeRadius;
TubeLine1 := TOrthoLine(LineList[i]);
LineComponent1 := TSCSComponent(TubeList[i]);
j := i;
end;
end;
end;
PipeRadius := PipeRadius + PipeRadius/10;
Tubelist.Delete(j); // óäàëÿåì âòîðóþ âûáðàííóþ òðàññó è òðóáó èç ñïèñêà
LineList.Delete(j);
CableList.Delete(j);
//ïåðâîå êîëåíî ìàêñ ðàäèóñîì
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TOrthoLine(TubeLine).JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TOrthoLine(TubeLine), 1, MaxPipeRadius)
else
PipePoint := GetPoint(TOrthoLine(TubeLine), 2, MaxPipeRadius);
if TConnectorObject(TOrthoLine(TubeLine1).JoinConnector1).Id = aConn.ID then
PrevPipePoint := GetPoint(TOrthoLine(TubeLine1), 1, MaxPipeRadius)
else
PrevPipePoint := GetPoint(TOrthoLine(TubeLine1), 2, MaxPipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(TubeLine).JoinConnector1)) <> -1 then
PipePoint := GetPoint(TOrthoLine(TubeLine), 1, MaxPipeRadius)
else
PipePoint := GetPoint(TOrthoLine(TubeLine), 2, MaxPipeRadius);
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(TubeLine1).JoinConnector1)) <> -1 then
PrevPipePoint := GetPoint(TOrthoLine(TubeLine1), 1, MaxPipeRadius)
else
PrevPipePoint := GetPoint(TOrthoLine(TubeLine1), 2, MaxPipeRadius);
end;
SetLength(apArray, 3);
apArray[0].x := PipePoint.x;
apArray[0].y := PipePoint.y;
apArray[0].z := PipePoint.z;
DisPose(PipePoint);
PipePoint := nil;
apArray[1].x := aConn.ap1.x;
apArray[1].y := aConn.ap1.y;
apArray[1].z := aConn.ActualZOrder[1];
apArray[2].x := PrevPipePoint.x;
apArray[2].y := PrevPipePoint.y;
apArray[2].z := PrevPipePoint.z;
Dispose(PrevPipePoint);
PrevPipePoint := nil;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := MaxPipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
x3DConnector.FRelatedLines.Add(TubeLine);
x3DConnector.FRelatedLines.Add(TubeLine1);
x3DConnector.FLength := MaxPipeRadius;
//åñëè ïåðâûå äâå òðóáû ðàçíîãî ðàäèóñà - äîêèíóòü õâîñòîâèê ñîåäèíåíèÿ äëÿ òîíüøåé òðóáû
if CompareValue(MaxPipeRadius, PipeRadius) <> 0 then
begin
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TOrthoLine(TubeLine1).JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TOrthoLine(TubeLine1), 1, PipeRadius + MaxPipeRadius)
else
PipePoint := GetPoint(TOrthoLine(TubeLine1), 2, PipeRadius + MaxPipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(TubeLine1).JoinConnector1)) <> -1 then
PipePoint := GetPoint(TOrthoLine(TubeLine1), 1, PipeRadius + MaxPipeRadius)
else
PipePoint := GetPoint(TOrthoLine(TubeLine1), 2, PipeRadius + MaxPipeRadius);
end;
SetLength(apArray, 2);
apArray[0].x := aConn.ap1.x;
apArray[0].y := aConn.ap1.y;
apArray[0].z := aConn.ActualZOrder[1];
apArray[1].x := PipePoint.x;
apArray[1].y := PipePoint.y;
apArray[1].z := PipePoint.z;
Dispose(PipePoint);
PipePoint := nil;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := PipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
x3DConnector.FRelatedLines.Add(TubeLine1);
x3DConnector.FLength := PipeRadius + MaxPipeRadius;
end;
//äîðèñîâàòü îñòàëüíûå
for i := 0 to TubeList.Count - 1 do
begin
PipeRadius := GetTubeRadius(TSCSComponent(TubeList[i]));
PipeRadius := PipeRadius + PipeRadius/10;
if aConn.ConnectorType = ct_Clear then
begin
if TConnectorObject(TOrthoLine(LineList[i]).JoinConnector1).Id = aConn.ID then
PipePoint := GetPoint(TOrthoLine(LineList[i]), 1, PipeRadius + MaxPipeRadius)
else
PipePoint := GetPoint(TOrthoLine(LineList[i]), 2, PipeRadius + MaxPipeRadius);
end
else
begin
if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[i]).JoinConnector1)) <> -1 then
PipePoint := GetPoint(TOrthoLine(LineList[i]), 1, PipeRadius + MaxPipeRadius)
else
PipePoint := GetPoint(TOrthoLine(LineList[i]), 2, PipeRadius + MaxPipeRadius);
end;
SetLength(apArray, 2);
apArray[0].x := aConn.ap1.x;
apArray[0].y := aConn.ap1.y;
apArray[0].z := aConn.ActualZOrder[1];
apArray[1].x := PipePoint.x;
apArray[1].y := PipePoint.y;
apArray[1].z := PipePoint.z;
Dispose(PipePoint);
PipePoint := nil;
x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True);
x3DConnector.CollectConnector(aFaces, apArray);
x3DConnector.FPipeRadius := PipeRadius;
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
x3DConnector.FColor := ConvertWinColor(clGreen);
x3DConnector.FRelatedLines.Add(LineList[i]);
x3DConnector.FLength := PipeRadius + MaxPipeRadius;
end;
end;
LineList.Free;
TubeList.Free;
PipeList.Free;
CableList.Free;
end;
end;
//
Function Get3dModelFileName(aConn: TConnectorObject): String;
var i, j: Integer;
ConnDir: TSCSCatalog;
currCompon: TSCSComponent;
componProp: pProperty;
begin
Result := '';
if aConn.ConnectorType = ct_Nb then
begin
ConnDir := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aConn.ID);
if ConnDir <> nil then
begin
For i := 0 to ConnDir.ComponentReferences.Count - 1 do
begin
currCompon := ConnDir.ComponentReferences[i];
if currCompon.IsTop then
begin
for j := 0 to currCompon.Properties.Count - 1 do
begin
if UpperCase(PProperty(currCompon.Properties[j]).SysName) = '3DS_MODEL' then
begin
Result := PProperty(currCompon.Properties[j]).Value;
break;
end;
end;
end;
if Result <> '' then
break;
end;
end;
end;
end;
Procedure DefineConnProperties(aConn: TConnectorObject; var a3DConn: T3DConnector);
var i: Integer;
SCSCompon: TSCSComponent;
CadList: TF_Cad;
SCSList: TSCSList;
SCSCatalog: TSCSCatalog;
SCSComponent: TSCSComponent;
Length3D, Width3D, Height3D: Double;
NbProp: TNBProperty;
begin
CadList := nil;
if aConn.Owner <> nil then
if TPowerCad(aConn.Owner).Owner <> nil then
CadList := TF_Cad(TPowerCad(aConn.Owner).Owner);
if CadList <> nil then
begin
SCSComponent := nil;
SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(CadList.FCADListID);
if SCSList <> nil then
begin
SCSCatalog := SCSList.GetCatalogFromReferencesBySCSID(aConn.ID);
if SCSCatalog <> nil then
begin
for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
if SCSCatalog.ComponentReferences[i].IsTop then
begin
SCSComponent := SCSCatalog.ComponentReferences[i];
break;
end;
end;
end;
end;
end
else
exit;
if SCSComponent <> nil then
begin
Length3D := -1;
Width3D := -1;
Height3D := -1;
for i := 0 to SCSComponent.Properties.Count - 1 do
begin
if PProperty(SCSComponent.Properties[i]).SysName = '3DS_MODEL' then
a3DConn.F3dModelFileName := PProperty(SCSComponent.Properties[i]).Value
else
if PProperty(SCSComponent.Properties[i]).SysName = '3D_WIDTH' then
begin
NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(PProperty(SCSComponent.Properties[i]).GUIDProperty);
if NbProp <> nil then
begin
Width3D := StrToFloat_My(PProperty(SCSComponent.Properties[i]).Value);
Width3D := ConverResultToUom(Width3D, NbProp.PropertyData.Izm);
end;
end
else
if PProperty(SCSComponent.Properties[i]).SysName = '3D_HEIGHT' then
begin
NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(PProperty(SCSComponent.Properties[i]).GUIDProperty);
if NbProp <> nil then
begin
Height3D := StrToFloat_My(PProperty(SCSComponent.Properties[i]).Value);
Height3D := ConverResultToUom(Height3D, NbProp.PropertyData.Izm);
end;
end
else
if PProperty(SCSComponent.Properties[i]).SysName = '3D_LENGTH' then
begin
NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(PProperty(SCSComponent.Properties[i]).GUIDProperty);
if NbProp <> nil then
begin
Length3D := StrToFloat_My(PProperty(SCSComponent.Properties[i]).Value);
Length3D := ConverResultToUom(Length3D, NbProp.PropertyData.Izm);
end;
end
end;
end;
if a3DConn.F3dModelFileName <> '' then
if Length3D <> -1 then
if Width3D <> -1 then
if Height3D <> -1 then
begin
a3DConn.F3D_Height := Height3D;
a3DConn.F3D_Length := Length3D;
a3DConn.F3D_Width := Width3D;
a3DConn.FUse3DSize := True;
end;
end;
// Tolik -- çîíû êàìåð íàáëþäåíèÿ (ïðîáà)
Procedure CheckAddZones(aConn: TConnectorObject);
var i: Integer;
TPieFigure: TPie;
begin
for i := 0 to aConn.DrawFigure.InFigures.Count - 1 do
begin
if TFigure(aConn.DrawFigure.InFigures[i]).isAutoCreatedFigure = biTrue then
if TFigure(aConn.DrawFigure.InFigures[i]).ClassName = 'TPie' then
begin
TPieFigure := TPie(aConn.DrawFigure.InFigures[i]);
end;
end;
end;
begin
PassedLineList := TList.Create;
ComponOffset := 0;
try
for i := 0 to aScsObjects.Count - 1 do
begin
xFigure := TFigure(aScsObjects[i]);
if xFigure.ClassName = 'TConnectorObject' then
begin
// Tolik -- 14/02/2020 -- îòñåÿòü ïîäúåçäû äîìîâ (åñëè ïîïàäóòñÿ), ò.ê. íà 3Ä òàì ïîêàçûâàòü íå÷åãî (ïîêà ÷òî...)
if TConnectorObject(xFigure).FisApproach then
continue;
//
xConn := TConnectorObject(xFigure);
SetLength(a3DPointArr, 1);
a3DPointArr[0].x := xConn.ActualPoints[1].x;
a3DPointArr[0].y := xConn.ActualPoints[1].y;
{TODO ZCoord}
a3DPointArr[0].z := xConn.ActualZOrder[1];
//a3DPointArr[0].z := MetreToUOM(xConn.ActualZOrder[1]); // NEW
if (xConn.Name <> 'Anchor') then
begin
if xConn.ConnectorType <> ct_Clear then
begin
x3DConnector := T3DConnector.Create(aFaces, xConn, Self);
x3DConnector.CollectConnector(aFaces, a3DPointArr);
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
DefineConnProperties(xConn, x3DConnector);
//x3DConnector.F3dModelFileName := Get3dModelFileName(xConn);
//Tolik 04/11/2019 --
if xConn.DrawFigure <> nil then
CheckAddZones(xConn);
//
end
//Tolik 08/04/2025 --
//else if xConn.JoinedConnectorsList.Count >= 0 then
else
if ((xConn.JoinedConnectorsList.Count >= 0) and (not CheckisPipeElement(xConn))) then
//
begin
x3DConnector := T3DConnector.Create(aFaces, xConn, Self);
x3DConnector.CollectConnector(aFaces, a3DPointArr);
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
// Tolik 13/10/2018 -*-
{if xConn.JoinedConnectorsList.Count > 0 then
DefineConnProperties(TConnectorObject(xConn.JoinedConnectorsList[0]), x3DConnector);}
//
end;
end;
// Tolik 24/09/2018 --
if (xConn.Name <> 'Anchor') then
if xConn.ConnectorType = ct_Clear then
if CheckisPipeElement(xConn) then
begin
if xConn.JoinedConnectorsList.Count > 0 then
CreatePipeElement(TConnectorObject(xConn.JoinedConnectorsList[0]))
else
CreatePipeElement(xConn);
end;
// Tolik 20/09/2018 --
{
if xConn.ConnectorType = ct_Clear then
begin
x3DBooblick := T3dBooblick.Create(aFaces, xConn, Self);
x3DBooblick.CollectBooblick(aFaces, a3DPointArr);
FScsObjects.Add(x3DConnector);
x3DBooblick.FSCSObject.F3DObject := x3DBooblick;
end;
}
//
// Tolik 21/09/2018 --
//
end;
if xFigure.ClassName = 'TOrthoLine' then
begin
xLine := TOrthoLine(xFigure);
SetLength(a3DPointArr, 2);
a3DPointArr[0].x := xLine.ActualPoints[1].x;
a3DPointArr[0].y := xLine.ActualPoints[1].y;
{TODO ZCoord}
a3DPointArr[0].z := xLine.ActualZOrder[1];
//a3DPointArr[0].z := MetreToUOM(xLine.ActualZOrder[1]); // new
a3DPointArr[1].x := xLine.ActualPoints[2].x;
a3DPointArr[1].y := xLine.ActualPoints[2].y;
{TODO ZCoord}
a3DPointArr[1].z := xLine.ActualZOrder[2];
//a3DPointArr[1].z := MetreToUOM(xLine.ActualZOrder[2]); // new
x3DLine := T3DLine.Create(aFaces, xLine, Self);
x3dLine.CollectLine(aFaces, a3DPointArr);
FScsObjects.Add(x3DLine);
x3DLine.FSCSObject.F3DObject := x3DLine;
// Tolik 17/09/2018 -- òðóáû íà òðàññå
TubeList := GetTubeList(xLine); //15/09/2021 --
//TubeList := nil;
ComponOffset := 0;
if TubeList <> nil then
begin
TailTubeList := Nil;
for j := 0 to TubeList.Count - 1 do
begin
TubeRadius := GetTubeRadius(TSCSComponent(TubeList[j]));
(*
if TubeRadius <> -1 then
begin
x3DTube := T3DTube.create(aFaces, xLine, Self, TSCSComponent(TubeList[j]), TubeRadius*2, TailTubeList);
TubePoint := GetPoint(TOrthoLine(xFigure), 1, TubeRadius);
if TubePoint <> nil then
begin
a3DPointArr[0].x := TubePoint.x + ComponOffset;
a3DPointArr[0].y := TubePoint.y;
a3DPointArr[0].z := TubePoint.z;
DisPose(TubePoint);
end;
TubePoint := GetPoint(TOrthoLine(xFigure), 2, TubeRadius);
if TubePoint <> nil then
begin
a3DPointArr[1].x := TubePoint.x + ComponOffset;
a3DPointArr[1].y := TubePoint.y;
a3DPointArr[1].z := TubePoint.z;
DisPose(TubePoint);
end;
x3DTube.CollectCylinder(aFaces, a3DPointArr);
FScsObjects.Add(x3DTube);
x3DTube.FSCSObject.F3DObject := x3DTube;
end;
ComponOffset := ComponOffset + TubeRadius * 2;
*)
{
if TailTubeList <> nil then // ýòî, òèïà, åñëè áóäóò òîðöû, îòðèñîâàííûå öèëèíäðàìè, â çàâèñèìîñòè îò ñâîéñòâ êîìïîíåíòà "òðóáà"
begin
for k := 0 to TailTubeList.count - 1 do
begin
x3DTube := T3DTube(TailTubeList[k]);
FScsObjects.Add(x3DTube);
x3DTube.FSCSObject.F3DObject := x3DTube;
end;
end;
}
end;
TubeList.Free;
end;
//
end;
if xFigure.ClassName = 'TSCSFigureGrp' then
begin
xFigureGrp := TSCSFigureGrp(xFigure);
for j := 0 to xFigureGrp.InFigures.Count - 1 do
begin
InFigure := Tfigure(xFigureGrp.InFigures[j]);
if InFigure.ClassName = 'TConnectorObject' then
begin
xConn := TConnectorObject(InFigure);
SetLength(a3DPointArr, 1);
a3DPointArr[0].x := xConn.ActualPoints[0].x;
a3DPointArr[0].y := xConn.ActualPoints[0].y;
{TODO ZCoord}
a3DPointArr[0].z := xConn.ActualZOrder[0];
//a3DPointArr[0].z := MetreToUOM(xConn.ActualZOrder[0]); // new
if (xConn.Name <> 'Anchor') then
begin
if xConn.ConnectorType <> ct_Clear then
begin
x3DConnector := T3DConnector.Create(aFaces, xConn, Self);
x3DConnector.CollectConnector(aFaces, a3DPointArr);
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
end
else if xConn.JoinedConnectorsList.Count >= 0 then
begin
x3DConnector := T3DConnector.Create(aFaces, xConn, Self);
x3DConnector.CollectConnector(aFaces, a3DPointArr);
FScsObjects.Add(x3DConnector);
x3DConnector.FSCSObject.F3DObject := x3DConnector;
end;
end;
end;
(* if InFigure.ClassName = 'TOrthoLine' then
begin
xLine := TOrthoLine(InFigure);
SetLength(a3DPointArr, 2);
a3DPointArr[0].x := xLine.ActualPoints[0].x;
a3DPointArr[0].y := xLine.ActualPoints[0].y;
{TODO ZCoord}
a3DPointArr[0].z := xLine.ActualZOrder[0];
//a3DPointArr[0].z := MetreToUOM(xLine.ActualZOrder[0]); // new
a3DPointArr[1].x := xLine.ActualPoints[1].x;
a3DPointArr[1].y := xLine.ActualPoints[1].y;
{TODO ZCoord}
a3DPointArr[1].z := xLine.ActualZOrder[1];
//a3DPointArr[1].z := MetreToUOM(xLine.ActualZOrder[1]); // new
x3DLine := T3DLine.Create(aFaces, xLine, Self);
x3dLine.CollectLine(aFaces, a3DPointArr);
FScsObjects.Add(x3DLine);
x3DLine.FSCSObject.F3DObject := x3DLine;
end;
*)
end;
end;
end;
// *** Set Joined Objects **************************************************
for i := 0 to FScsObjects.Count - 1 do
begin
//Tolik 15/09/2021 --
//if TObject(FScsObjects[i]) is T3DConnector then
if TObject(FScsObjects[i]).ClassName = 'T3DConnector' then
begin
x3DConnector := T3DConnector(FScsObjects[i]);
xConn := x3DConnector.FSCSObject;
for j := 0 to xConn.JoinedConnectorsList.Count - 1 do
begin
GetConn := TConnectorObject(xConn.JoinedConnectorsList[j]);
x3DConnector.FJoinedConnectorsList.Add(T3DConnector(GetConn.F3DObject));
end;
for j := 0 to xConn.JoinedOrtholinesList.Count - 1 do
begin
xLine := TOrthoLine(xConn.JoinedOrtholinesList[j]);
// Tolik 27/014/2018 --
if x3DConnector.FJoinedLinesList.IndexOf(T3DLine(xLine.F3DObject)) = -1 then
//
x3DConnector.FJoinedLinesList.Add(T3DLine(xLine.F3DObject));
end;
end;
// Tolik 19/11/2018 ---
//if TObject(FScsObjects[i]) is T3DLine then
if TObject(FScsObjects[i]).ClassName = 'T3DLine' then
begin
x3DLine := T3DLine(FScsObjects[i]);
xLine := x3DLine.FSCSObject;
GetConn := TConnectorObject(xLine.JoinConnector1);
x3DLine.FJoinConnector1 := T3DConnector(GetConn.F3dObject);
GetConn := TConnectorObject(xLine.JoinConnector2);
x3DLine.FJoinConnector2 := T3DConnector(GetConn.F3dObject);
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DModel.CollectScsModel', E.Message);
end;
PassedLineList.Free;
end;
function GetWorkDir: string;
var
aDir: string;
begin
Result := '';
aDir := AddCreateDirToPath(ExtractFileDir(Application.ExeName), dnSave);
aDir := AddCreateDirToPath(aDir, sdPictures);
Result := aDir;
end;
constructor T3DModel.Create;
var
HashStr, tmpdir, tex_from, tex_to: string;
begin
try
inherited Create;
FClassName := 'T3DModel';
//Tolik 28/01/2024 --
//FScaleDelta := UOMToMetre(1000 / GCadForm.PCad.MapScale);
//FScaleDeltaSCS := 1000 / GCadForm.PCad.MapScale;
FScaleDelta := ABS(UOMToMetre(1000 / GCadForm.PCad.MapScale));
FScaleDeltaSCS := ABS(1000 / GCadForm.PCad.MapScale);
//
FRooms := TList.Create;
FScsObjects := TList.Create;
FName := cModel;
FGroupNet := nil;
FHashs := TStringList.Create;
F3DSHashs := TStringList.Create;
FFiles := TStringList.Create;
FFilesHashs := TStringList.Create;
tmpdir := GetWorkDir; //ExtractDirByCategoryType(20{dctPictures});
{$IF DEFINED(SCS_PE)} //Tolik 25/08/2021 -- äëÿ ÐÅ íåìíîæêî ïîìåíÿåì öâåòà ñòåí, ïîòîëêà, ïîëà....
tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp';
HashStr := GetImageHash(tex_from); //Îòäåëÿåì èìÿ êàðòèíêè
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\floor_PE.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\ceiling_PE.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
{$ELSE} //Tolik 25/08/2021 -- äëÿ ÐÓÑ/ÓÊÐ - ïîêà ÷òî - êàê áûëî.
tex_from := ExeDir + '\3DTextures\inner_wall.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\outer_wall.bmp';
HashStr := GetImageHash(tex_from); //Îòäåëÿåì èìÿ êàðòèíêè
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\floor.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\ceiling.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\door_slope.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\window_slope.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\balcon_slope.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
{$IFEND}
tex_from := ExeDir + '\3DTextures\arc.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\niche.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
tex_from := ExeDir + '\3DTextures\empty.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
isUserTransparency := False; // Tolik 28/11/2018 --
except
on E: Exception do AddExceptionToLogEx('T3DModel.Create', E.Message);
end;
end;
// Tolik --23/07/2018 --
Destructor T3DModel.destroy;
var i: Integer;
begin
// FreeList(FRooms);
for i := 0 to FRooms.Count - 1 do
begin
T3DRoom(FRooms[i]).free;
end;
FRooms.Free;
//20/09/2021 --
for i := 0 to FScsObjects.Count - 1 do
TObject(FScsObjects[i]).Free;
FScsObjects.free;
//
FGroupNet := nil;
FHashs.free;
F3DSHashs.free;
FFiles.free;
FFilesHashs.free;
inherited;
end;
//
function T3DModel.FindRealWallByVirtualNetPath(aNetPath: TNetPath): T3DWall;
var
i, j: integer;
rNetPath: TNetPath;
xRoom: T3DRoom;
xWall: T3DWall;
begin
try
Result := nil;
if aNetPath.FSrcPaths.Count > 0 then
begin
rNetPath := TNetPath(aNetPath.FSrcPaths[0]);
for i := 0 to FRooms.Count - 1 do
begin
xRoom := T3DRoom(FRooms[i]);
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
if rNetPath = xWall.FPlanObject then
begin
Result := xWall;
exit;
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DModel.FindRealWallByVirtualNetPath', E.Message);
end;
end;
function T3DModel.FindWallByNetPath(aNetPath: TNetPath): T3DWall;
var
i, j: integer;
rNetPath: TNetPath;
xRoom: T3DRoom;
xWall: T3DWall;
begin
try
Result := nil;
for i := 0 to FRooms.Count - 1 do
begin
xRoom := T3DRoom(FRooms[i]);
for j := 0 to xRoom.FWalls.Count - 1 do
begin
xWall := T3DWall(xRoom.FWalls[j]);
if xWall.FPlanObject = aNetPath then
begin
Result := xWall;
exit;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DModel.FindWallByNetPath', E.Message);
end;
end;
function T3DModel.GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject;
var
i: Integer;
begin
Result := nil;
for i := 0 to FRooms.Count - 1 do
begin
Result := T3DRoom(FRooms[i]).GetObjectBySCSCompon(ASCSCompon);
if Result <> nil then
Break; //// BREAK ////
end;
end;
// Tolik 04/04/2019 -- ñòàðàÿ çàêîììåí÷åíà íèæå
procedure T3DModel.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize: Integer;
j, intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
CanAdd: Boolean;
xStr: AnsiString;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
end;
if (xCode >= 181) and (xCode <= 219) then
begin
CanAdd := True;
for j := 0 to FHashs.Count - 1 do
begin
if FHashs[j] = StrVal then
CanAdd := False;
end;
if CanAdd then
FHashs.Add(strVal);
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end
else
if (xCode = 241) then
begin
Stream.Read(intVal, sizeof(intVal));
if intVal > 0 then
begin
SetLength(xStr, intVal);
Stream.Read(PAnsiChar(xStr)^, intVal);
FHashs.Text := String(xStr);
end
else
FHashs.Text := '';
end
else
if (xCode = 242) then
begin
Stream.Read(intVal, sizeof(intVal));
if intVal > 0 then
begin
SetLength(xStr, intVal);
Stream.Read(PAnsiChar(xStr)^, intVal);
F3DSHashs.Text := String(xStr);
end
else
F3DSHashs.Text := '';
end
else
if (xCode = 243) then
begin
Stream.Read(intVal, sizeof(intVal));
if intVal > 0 then
begin
SetLength(xStr, intVal);
Stream.Read(PAnsiChar(xStr)^, intVal);
FFiles.Text := String(xStr);
end
else
FFiles.Text := '';
end
else
if (xCode = 244) then
begin
Stream.Read(intVal, sizeof(intVal));
if intVal > 0 then
begin
SetLength(xStr, intVal);
Stream.Read(PAnsiChar(xStr)^, intVal);
FFilesHashs.Text := String(xStr);
end
else
FFilesHashs.Text := '';
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DModel.ReadFromStream', E.Message);
end;
end;
{
procedure T3DModel.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize: Integer;
i, j, intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
CanAdd: Boolean;
xStr: string;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
end;
if (xCode >= 181) and (xCode <= 219) then
begin
CanAdd := True;
for j := 0 to FHashs.Count - 1 do
begin
if FHashs[j] = StrVal then
CanAdd := False;
end;
if CanAdd then
FHashs.Add(strVal);
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end
else
if (xCode = 241) then
begin
Stream.Read(intVal, sizeof(intVal));
if intVal > 0 then
begin
SetLength(xStr, intVal);
Stream.Read(pchar(xStr)^, intVal);
FHashs.Text := xStr;
end
else
FHashs.Text := '';
end
else
if (xCode = 242) then
begin
Stream.Read(intVal, sizeof(intVal));
if intVal > 0 then
begin
SetLength(xStr, intVal);
Stream.Read(pchar(xStr)^, intVal);
F3DSHashs.Text := xStr;
end
else
F3DSHashs.Text := '';
end
else
if (xCode = 243) then
begin
Stream.Read(intVal, sizeof(intVal));
if intVal > 0 then
begin
SetLength(xStr, intVal);
Stream.Read(pchar(xStr)^, intVal);
FFiles.Text := xStr;
end
else
FFiles.Text := '';
end
else
if (xCode = 244) then
begin
Stream.Read(intVal, sizeof(intVal));
if intVal > 0 then
begin
SetLength(xStr, intVal);
Stream.Read(pchar(xStr)^, intVal);
FFilesHashs.Text := xStr;
end
else
FFilesHashs.Text := '';
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DModel.ReadFromStream', E.Message);
end;
end;
}
procedure T3DModel.SetRelations;
begin
try
except
on E: Exception do AddExceptionToLogEx('T3DModel.SetRelations', E.Message);
end;
end;
// Tolik 04/04/2019 --
procedure T3DModel.WriteToStream(Stream: TStream);
var
xStr: AnsiString;
xInt: integer;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
//for i := 0 to FHashs.Count - 1 do
//begin
// xStr := FHashs[i];
// if ((181 + i) <= 219) then
// WriteStrField(181 + i, Stream, xStr);
//end;
xStr := AnsiString(FHashs.Text);
xInt := Length(xStr);
WriteField(241, Stream, xInt, sizeof(xInt));
if xInt > 0 then
Stream.Write(PAnsiChar(xStr)^,length(xStr));
xStr := AnsiString(F3DSHashs.Text);
xInt := Length(xStr);
WriteField(242, Stream, xInt, sizeof(xInt));
if xInt > 0 then
Stream.Write(PAnsiChar(xStr)^,length(xStr));
xStr := AnsiString(FFiles.Text);
xInt := Length(xStr);
WriteField(243, Stream, xInt, sizeof(xInt));
if xInt > 0 then
Stream.Write(PAnsiChar(xStr)^,length(xStr));
xStr := AnsiString(FFilesHashs.Text);
xInt := Length(xStr);
WriteField(244, Stream, xInt, sizeof(xInt));
if xInt > 0 then
Stream.Write(PAnsiChar(xStr)^,length(xStr));
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DModel.WriteToStream', E.Message);
end;
end;
{
procedure T3DModel.WriteToStream(Stream: TStream);
var
i: integer;
xStr: string;
xInt: integer;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
//for i := 0 to FHashs.Count - 1 do
//begin
// xStr := FHashs[i];
// if ((181 + i) <= 219) then
// WriteStrField(181 + i, Stream, xStr);
//end;
xStr := FHashs.Text;
xInt := Length(xStr);
WriteField(241, Stream, xInt, sizeof(xInt));
if xInt > 0 then
Stream.Write(pchar(xStr)^,length(xStr));
xStr := F3DSHashs.Text;
xInt := Length(xStr);
WriteField(242, Stream, xInt, sizeof(xInt));
if xInt > 0 then
Stream.Write(pchar(xStr)^,length(xStr));
xStr := FFiles.Text;
xInt := Length(xStr);
WriteField(243, Stream, xInt, sizeof(xInt));
if xInt > 0 then
Stream.Write(pchar(xStr)^,length(xStr));
xStr := FFilesHashs.Text;
xInt := Length(xStr);
WriteField(244, Stream, xInt, sizeof(xInt));
if xInt > 0 then
Stream.Write(pchar(xStr)^,length(xStr));
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DModel.WriteToStream', E.Message);
end;
end;
}
{ T3DRoom }
procedure T3DRoom.CollectCeiling(aFaces: TList; aPathContureList: TList = nil);
var
i, j: integer;
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
Cnt: Integer;
xSide: T3DSide;
CeilingHeight: Double;
begin
try
xSide := T3DSide.Create(ftNetCeiling, fwtNone, wstNone, self);
Cnt := Length(FCeilingConture);
SetLength(xSide.FPoints, Cnt{ * 2});
SetLength(xSide.FGLPoints, Cnt{ * 2});
for i := 0 to Cnt - 1 do
begin
xSide.FPoints[i] := FCeilingConture[i];
end;
aFace := TFaceRecord.Create(xSide.FPoints, xSide.FColor, ftNetCeiling, 1, False, nil);
// Tolik 13/01/2020
j := Length(FFloorContureForNormal);
if j > 0 then
begin
if cnt > 0 then
begin
CeilingHeight := FCeilingConture[0].z;
SetLength(aFace.PointsForNormal, j);
for i := 0 to j - 1 do
begin
aFace.PointsForNormal[i] := FFloorContureForNormal[i];
aFace.PointsForNormal[i].z := CeilingHeight;
end;
end;
end;
{if aPathContureList <> nil then
begin
if cnt > 0 then
begin
CeilingHeight := FCeilingConture[0].y;
SetLength(aFace.PointsForNormal, aPathContureList.Count);
for i := 0 to aPathContureList.Count - 1 do
begin
aFace.PointsForNormal[i] := PDoublePoint(aPathContureList[i])^;
aFace.PointsForNormal[i].y := CeilingHeight;
end;
end;
end;}
//
aFaces.Add(aFace);
xSide.FFace := aFace;
xSide.FName := cCeiling;
FCeiling := xSide;
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.CollectCeiling', E.Message);
end;
end;
function T3DRoom.GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject;
var
i: Integer;
begin
Result := nil;
if ASCSCompon = FSCSCompon then
Result := self;
//else
//for i := 0 to FWalls.Count - 1 do
//begin
// Result := T3DWall(FRooms[i]).GetObjectBySCSCompon(ASCSCompon);
// if Result <> nil then
// Break; //// BREAK ////
//end;
end;
procedure T3DRoom.CollectFloor(aFaces: TList; aPathContureList: TList = nil);
var
i, j: integer;
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
Cnt: Integer;
xSide: T3DSide;
begin
try
xSide := T3DSide.Create(ftNetFloor, fwtNone, wstNone, Self);
Cnt := Length(FFloorConture);
SetLength(xSide.FPoints, Cnt{ * 2});
SetLength(xSide.FGLPoints, Cnt{ * 2});
for i := 0 to Cnt - 1 do
begin
xSide.FPoints[i] := FFloorConture[i];
end;
aFace := TFaceRecord.Create(xSide.FPoints, xSide.FColor, ftNetFloor, 1, False, nil);
// Tolik 13/01/2020
j := Length(FFloorContureForNormal);
if j > 0 then
begin
SetLength(aFace.PointsForNormal, j);
for i := 0 to j - 1 do
begin
aFace.PointsForNormal[i] := FFloorContureForNormal[i];
end;
end;
{if aPathContureList <> nil then
begin
SetLength(aFace.PointsForNormal, aPathContureList.Count);
for i := 0 to aPathContureList.Count - 1 do
begin
aFace.PointsForNormal[i] := PDoublePoint(aPathContureList[i])^;
end;
end;}
aFaces.Add(aFace);
xSide.FFace := aFace;
xSide.FName := cFloor;
FFloor := xSide;
except
on E: Exception do AddExceptionToLogEx('T3DRoom.CollectFloor', E.Message);
end;
end;
{TODO}
{
procedure T3DRoom.CollectRoom(aFaces: TList);
var
xNetPath: TNetPath;
i, j, k: integer;
WallComponID: Integer;
Room: TSCSComponent;
SCSCompon: TSCSComponent;
xWall: T3DWall;
begin
try
Room := GCurrentRoom3DView;
if Room = nil then
begin
FSingleRoom := False;
for i := 0 to FPlanObject.Paths.Count - 1 do
begin
xNetPath := TNetPath(FPlanObject.Paths[i]);
xWall := T3DWall.Create(aFaces, xNetPath, Self);
FWalls.Add(xWall);
end;
CollectFloor(aFaces);
CollectCeiling(aFaces);
end
else
begin
if Room.ID = FSCSComponID then
begin
FSingleRoom := True;
for i := 0 to FPlanObject.Paths.Count - 1 do
begin
xNetPath := TNetPath(FPlanObject.Paths[i]);
xWall := T3DWall.Create(aFaces, xNetPath, Self);
FWalls.Add(xWall);
end;
CollectFloor(aFaces);
CollectCeiling(aFaces);
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DRoom.CollectRoom', E.Message);
end;
end;
}
Function IfStackedPoints(aNet: TNet): boolean;
var i,j: integer;
P: PDoublepoint;
RelPoints: TList;
xPath: TNetPath;
begin
Result := false;
RelPoints := Tlist.Create;
for i := 0 to aNet.Points.Count - 1 do
begin
P := aNet.Points[i];
RelPoints.Clear;
for j := 0 to aNet.Paths.Count - 1 do
begin
xPath := TNetPath(aNet.Paths[j]);
if (EQDP(P^,xPath.p1^))then
RelPoints.Add(xPath.p1);
if (EQDP(P^,xPath.p2^))then
RelPoints.Add(xPath.p2);
end;
if RelPoints.Count > 2 then
begin
Result := true;
Break;
end;
end;
FreeAndNil(RelPoints);
end;
// MARK
//procedure T3DRoom.CollectRoom(aFaces: TList);
procedure T3DRoom.CollectRoom(aFaces: TList; aSCSPathList: TList = nil);
var
xNetPath: TNetPath;
i, j, k: integer;
WallComponID: Integer;
Room: TSCSComponent;
SCSCompon: TSCSComponent;
xWall,xSecondWall: T3DWall;
ItSRoof: Boolean;
CornerName: string;
xCorner: T3DCorner;
xRoom: T3DRoom;
ip: TDoublePoint;
p: PDoublePoint;
xFigure: TFigure;
ID: Integer;
ArchObj: TSCSComponent;
Node: TTreeNode;
HeightWall1,HeightWall2: Double;
HeightWallPoints1,HeightWallpoints2: TWallPoints;
begin
try
ItSRoof := False;
xSecondWall := nil;
{$if Defined(ES_GRAPH_SC)} // Tolik 15/06/2018 -- îòâÿçàòü îò êîìïîíåíòà, åñëè íå ãðàôìîäóëü
if FPlanObject.Paths.Count > 0 then
begin
xNetPath := TNetPath(FPlanObject.Paths[0]);
xWall := T3DWall.Create(aFaces, xNetPath, Self);
//26.11.2013 - äîáàâëåíî Ìèòÿé Äìèòðèé
for j := 0 to xWall.FParent.FSCSCompon.Properties.Count - 1 do
begin
if PProperty(xWall.FParent.FSCSCompon.Properties[j]).SysName = 'MATERIAL_TYPE' then
begin
ItSRoof := True;
Break;
end;
if PProperty(xWall.FParent.FSCSCompon.Properties[j]).SysName = 'RESIDUE' then
begin
ItSRoof := true;
Break;
end;
end;
if ItsRoof then
begin
SetLength(xWall.FPoints,2);
SetLength(xWall.FGLPoints,2);
xWall.FPoints[0] := xWall.FPlanObject.el1;
xWall.FPoints[1] := xWall.FPlanObject.el2;
end;
end;
for i := 0 to FPlanObject.Paths.Count - 1 do
begin
xNetPath := TNetPath(FPlanObject.Paths[i]);
if i > 0 then
begin
xWall := T3DWall.Create(aFaces, xNetPath, Self);
if ItsRoof then
begin
SetLength(xWall.FPoints,2);
SetLength(xWall.FGLPoints,2);
xWall.FPoints[0] := xWall.FPlanObject.el1;
xWall.FPoints[1] := xWall.FPlanObject.el2;
end;
end;
FWalls.Add(xWall);
end;
{$Else} {Tolik 17/07/2018 -- -- åñëè ÑÊÑ}
{ if aSCSPathList <> nil then
begin
for i := 0 to aSCSPathList.Count - 1 do
begin
xNetPath := TNetPath(aSCSPathList[i]);
xWall := T3DWall.Create(aFaces, xNetPath, Self);
if ItsRoof then
begin
SetLength(xWall.FPoints,2);
SetLength(xWall.FGLPoints,2);
xWall.FPoints[0].x := xNetPath.p1.x;
xWall.FPoints[0].y := xNetPath.p1.y;
xWall.FPoints[1].x := xNetPath.p2.x;
xWall.FPoints[1].y := xNetPath.p2.y;
end;
FWalls.Add(xWall);
end;
end;}
for i := 0 to FPlanObject.Paths.Count - 1 do
begin
xNetPath := TNetPath(FPlanObject.Paths[i]);
xWall := T3DWall.Create(aFaces, xNetPath, Self);
FWalls.Add(xWall);
end;
{$ifend}
//*****************ROOF***********************
if ItSRoof then
begin
ArchObj := GetArchObjByCADObj(FPlanObject);
for i := 0 to FWalls.Count - 1 do
begin
xWall := T3DWall(FWalls[i]);
for j := i+1 to FWalls.Count - 1 do
begin
xSecondWall := T3DWall(FWalls[j]);
// if LinesCross(xSecondWall.FPlanObject.p1^, xSecondWall.FPlanObject.p2^, xWall.FPlanObject.p1^, xWall.FPlanObject.p2^) then
// if IfStackedPoints(FPlanObject) then
begin
//íàõîäèì òî÷êó ïåðåñå÷åíèÿ
// if GetInterSectionPoint(xSecondWall.FPlanObject.p1^, xSecondWall.FPlanObject.p2^, xWall.FPlanObject.p1^, xWall.FPlanObject.p2^, ip) then
begin
if xWall.FPlanObject.Connected(xSecondWall.FPlanObject) then
begin
CornerName := _3DCornerName + xSecondWall.FName + '/' + xWall.FName;
xRoom := T3DRoom(xWall.FParent);
xCorner := T3DCorner.Create(xRoom,CornerName);
xCorner.JoinedWalls.Add(xWall);
xCorner.JoinedWalls.Add(xSecondWall);
HeightWallPoints1.WallPoint1 := GetZPoint(FPlanObject,xWall.FPlanObject.p1);
HeightWallPoints1.WallPoint2 := GetZPoint(FPlanObject,xWall.FPlanObject.p2);
HeightWallPoints2.WallPoint1 := GetZPoint(FPlanObject,xSecondWall.FPlanObject.p1);
HeightWallPoints2.WallPoint2 := GetZPoint(FPlanObject,xSecondWall.FPlanObject.p2);
if (HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint1)and
(HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint2)and
(HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint1)and
(HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint2)and
(HeightWallPoints2.WallPoint1 = HeightWallPoints1.WallPoint1)and
(HeightWallPoints2.WallPoint1 = HeightWallPoints1.WallPoint2)and
(HeightWallPoints2.WallPoint2 = HeightWallPoints1.WallPoint1)and
(HeightWallPoints2.WallPoint2 = HeightWallPoints1.WallPoint2)then
begin
if GetInterSectionPoint(xSecondWall.FPlanObject.p1^, xSecondWall.FPlanObject.p2^, xWall.FPlanObject.p1^, xWall.FPlanObject.p2^, ip) then
if EQDP(ip,xWall.FPlanObject.p1^) then
begin
ip := xWall.FPlanObject.p1^;
ID := FPlanObject.GetPointID(xWall.FPlanObject.p1);
end
else
begin
ip := xWall.FPlanObject.p2^;
ID := FPlanObject.GetPointID(xWall.FPlanObject.p2);
end;
end
else
if (HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint1)and
(HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint2) then
begin
ip := xWall.FPlanObject.p1^;
ID := FPlanObject.GetPointID(xWall.FPlanObject.p1);
end
else
if (HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint1)and
(HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint2) then
begin
ip := xWall.FPlanObject.p2^;
ID := FPlanObject.GetPointID(xWall.FPlanObject.p2);
end
else
if (HeightWallPoints2.WallPoint1 = HeightWallPoints1.WallPoint1)and
(HeightWallPoints2.WallPoint1 = HeightWallPoints1.WallPoint2) then
begin
ip := xSecondWall.FPlanObject.p1^;
ID := FPlanObject.GetPointID(xSecondWall.FPlanObject.p1);
end
else
if (HeightWallPoints2.WallPoint2 = HeightWallPoints1.WallPoint1)and
(HeightWallPoints2.WallPoint2 = HeightWallPoints1.WallPoint2) then
begin
ip := xSecondWall.FPlanObject.p2^;
ID := FPlanObject.GetPointID(xSecondWall.FPlanObject.p2);
end
else
begin
if (EQDP(xWall.FPlanObject.p1^,xSecondWall.FPlanObject.p1^))and
(HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint1)then
begin
ip := xWall.FPlanObject.p1^;
ID := FPlanObject.GetPointID(xWall.FPlanObject.p1);
end
else
if (EQDP(xWall.FPlanObject.p1^,xSecondWall.FPlanObject.p2^))and
(HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint2)then
begin
ip := xWall.FPlanObject.p1^;
ID := FPlanObject.GetPointID(xWall.FPlanObject.p1);
end
else
if (EQDP(xWall.FPlanObject.p2^,xSecondWall.FPlanObject.p1^))and
(HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint1)then
begin
ip := xWall.FPlanObject.p2^;
ID := FPlanObject.GetPointID(xWall.FPlanObject.p2);
end
else
if (EQDP(xWall.FPlanObject.p2^,xSecondWall.FPlanObject.p2^))and
(HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint2)then
begin
ip := xWall.FPlanObject.p2^;
ID := FPlanObject.GetPointID(xWall.FPlanObject.p2);
end;
end;
//Óçíàåì íîóä
Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true);
//óçíàåì ÑÊÑ êîìïîíåíò
if Node <> nil then
xCorner.FSCSCompon := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node);
xCorner.FPoints := ip;
if xCorner.FSCSCompon <> nil then
HeightWall1 := xCorner.FSCSCompon.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(FPlanObject.Owner).MapScale);
//óñòàíàâëèâàåì óãëó òî÷êó Z
xCorner.FPoints.z := HeightWall1;
FCorner.add(xCorner);
end;
end;
{ end
else
if LinesCross(xSecondWall.FPlanObject.el1, xSecondWall.FPlanObject.el2, xWall.FPlanObject.el1, xWall.FPlanObject.el2) then
begin
//íàõîäèì òî÷êó ïåðåñå÷åíèÿ
if GetInterSectionPoint(xSecondWall.FPlanObject.el1, xSecondWall.FPlanObject.el2, xWall.FPlanObject.el1, xWall.FPlanObject.el2, ip) then
begin
CornerName := 'Óãîë äëÿ: ' + xSecondWall.FName + '/' + xWall.FName;
xRoom := T3DRoom(xWall.FParent);
xCorner := T3DCorner.Create(xRoom,CornerName);
xCorner.JoinedWalls.Add(xWall);
xCorner.JoinedWalls.Add(xSecondWall);
//Òàê êàê òî÷êó ïåðåñå÷åíèÿ íàõîäèò íå ñîâñåì òî÷íî, äåëàåì äîïîëíèòåëüíóþ ïðîâåðêó, ÷òîá
//íàéòè èìåííî òó òî÷êó, êîòîðàÿ íàì íóæíà...
if EQDP(ip,xWall.FPlanObject.el1) then
ip := xWall.FPlanObject.el1
else
if EQDP(ip,xWall.FPlanObject.el2) then
ip := xWall.FPlanObject.el2;
//åñëè ó äâóõ ñòåí òî÷êè íå ëåæàò äðóã íà äðóãå
if (not EQDP(xWall.FPlanObject.el1,xWall.FPlanObject.el2))and
(not EQDP(xSecondWall.FPlanObject.el1,xSecondWall.FPlanObject.el2)) then
begin
//Óçíàåì ID òî÷êè//////////////////////////////////////////////
for k := 0 to FPlanObject.Points.Count - 1 do //
if EQDP(ip,PDoublepoint(FPlanObject.Points[k])^) then //
break; //
ID := Integer(FPlanObject.FPointIDs[k]); //
//Óçíàåì íîóä
Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true);
//óçíàåì ÑÊÑ êîìïîíåíò
xCorner.FSCSCompon := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node);
xCorner.FPoints := ip;
HeightWall1 := xCorner.FSCSCompon.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(FPlanObject.Owner).MapScale);
//óñòàíàâëèâàåì óãëó òî÷êó Z
xCorner.FPoints.z := HeightWall1;
end;
FCorner.add(xCorner);
end;}
end;
end;
end;
end
else
begin
//Òóò ðàñïàðñèòü óãëû.Òàê êàê ïî÷òè âñÿ ïðîãà ïîñòðîåíà íà óêàçàòåëÿõ è ëèñòàõ,
//øàã âïðàâî, øàã âëåâî - âçðûâ))) Ïîòîìó äîáàâëÿòü óãëû áóäåì ñëåäóþùèì îáðàçîì:
//Áåðåì äâå ñòåíû, òî÷íåå - èõ êîîðäèíàòû, è ïðîâåðÿåì íà ïåðåñåêàåìîñòü.
//Åñëè åñòü òî÷êà ïåðåñå÷åíèÿ - çíà÷èò ýòî óãîë, äîáàâëÿåì åãî. Ïîêà òàê...
for i := 0 to FWalls.Count - 1 do
begin
xWall := T3DWall(FWalls[i]);
for j := i+1 to FWalls.Count - 1 do
begin
xSecondWall := T3DWall(FWalls[j]);
if LinesCross(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^) then
begin
//íàõîäèì òî÷êó ïåðåñå÷åíèÿ
if GetInterSectionPoint(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^, ip) then
begin
CornerName := _3DCornerName + xSecondWall.FName + '/' + xWall.FName;
xRoom := T3DRoom(xWall.FParent);
xCorner := T3DCorner.Create(xRoom,CornerName);
xCorner.JoinedWalls.Add(xWall);
xCorner.JoinedWalls.Add(xSecondWall);
xCorner.FPoints := ip;
{ xFigure := GCadForm.PCad.CheckByPoint(8, ip.x, ip.y);
p^ := ip;
if xFigure <> nil then
if xFigure is TNet then
xCorner.FSCSCompon := GetArchCornerByPoint(Tnet(xFigure),p);
{ p^ := ip;
xCorner.FSCSCompon := GetArchCornerByPoint(xSecondWall.FPlanObject.Net,p);}
FCorner.add(xCorner);
end;
end;
end;
//Tolik 23/12/2021 -- íå äîáàâëåíî ïåðåñå÷åíèå ïîñëåäíåé è ïåðâîé ñòåíû
if i = FWalls.count - 1 then
begin
j := 0;
xSecondWall := T3DWall(FWalls[j]);
if LinesCross(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^) then
begin
//íàõîäèì òî÷êó ïåðåñå÷åíèÿ
if GetInterSectionPoint(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^, ip) then
begin
CornerName := _3DCornerName + xSecondWall.FName + '/' + xWall.FName;
xRoom := T3DRoom(xWall.FParent);
xCorner := T3DCorner.Create(xRoom,CornerName);
xCorner.JoinedWalls.Add(xWall);
xCorner.JoinedWalls.Add(xSecondWall);
xCorner.FPoints := ip;
{ xFigure := GCadForm.PCad.CheckByPoint(8, ip.x, ip.y);
p^ := ip;
if xFigure <> nil then
if xFigure is TNet then
xCorner.FSCSCompon := GetArchCornerByPoint(Tnet(xFigure),p);
{ p^ := ip;
xCorner.FSCSCompon := GetArchCornerByPoint(xSecondWall.FPlanObject.Net,p);}
FCorner.add(xCorner);
end;
end;
end;
//
end;
end;
//*****************\ROOF**********************
{$if Defined(ES_GRAPH_SC)}
if not ItSRoof then
CollectFloor(aFaces);
CollectCeiling(aFaces);
{$else} // Tolik 31/08/2018 -- äëÿ ÑÊÑ
if fWalls.Count > 2 then
begin
// Tolik 13/01/2020
if Length(FNetConture) > 0 then
begin
if (aSCSPathList <> nil) and (aSCSPathList.Count > 0) then
begin
CollectFloor(aFaces, TNetPath(aSCSPathList[0]).Net.Points);
CollectCeiling(aFaces, TNetPath(aSCSPathList[0]).Net.Points);
end
else
begin
CollectFloor(aFaces, nil);
CollectCeiling(aFaces, nil);
end;
end
else
begin
FFloor := nil;
FCeiling := nil;
end;
end
else
begin
FFloor := nil;
FCeiling := nil;
end;
{$ifEnd}
except
on E: Exception do AddExceptionToLogEx('T3DRoom.CollectRoom', E.Message);
end;
end;
{TODO}
{
constructor T3DRoom.Create(aFaces: TList; aNet: TNet; aParent: T3DModel);
begin
try
inherited Create;
FClassName := 'T3DRoom';
FPlanObject := aNet;
if aNet <> nil then
begin
FSCSCompon := GetArchObjByCADObj(aNet);
FSCSComponID := FSCSCompon.ID;
FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark;
FNetConture := aNet.GetRoomConture;
FFloorConture := aNet.GetFloorConture;
FCeilingConture := aNet.GetCeilingConture;
end;
FWalls := TList.Create;
F3DSObjects := TList.Create;
FParent := aParent;
if aFaces <> nil then
CollectRoom(aFaces);
except
on E: Exception do AddExceptionToLogEx('T3DRoom.Create', E.Message);
end;
end;
}
function CheckByNetPath(aNet:TNet; Point1,POint2: TDoublepoint): boolean;
var
i: integer;
xPath: TnetPath;
begin
result := false;
for i := 0 to aNet.Paths.Count - 1 do
begin
xPath := TNetPath(aNet.Paths[i]);
if xPath.AreYou(point1,point2) then
begin
result := true;
break;
end;
end;
end;
Procedure FillCeilingBySortOut(aNet: TNet; var aCeilingConture: TDoublePointArr);
var
i,j: integer;
Startpoint: TDoublePoint;
EndPoint: PDoublePOint;
xPath: TNetPath;
xPaths: Tlist;
begin
xPaths := Tlist.Create;
if aCeilingConture = nil then
SetLength(aCeilingConture, aNet.Points.Count+1);
//íà÷àëüíàÿ è êîíå÷íàÿ òî÷êè ïåðâîãî ðåáðà(TNetPath)
xPath := TNetPath(aNet.Paths[0]);
Startpoint := PDoublepoint(xPath.p1)^;
Startpoint.z := GetZPoint(aNet,xPath.p1);
EndPoint := xPath.p2;
aCeilingConture[0] := Startpoint;
for i := 1 to Length(aCeilingConture) - 2 do
begin
xPaths.Clear;
aNet.GetPathsOfKnot(EndPOint,xPaths);
xPaths.Remove(xPath);
for j := 0 to xPaths.Count - 1 do
begin
xPath := TNetPath(xPaths[j]);
if EQDP(EndPOint^,xPath.p1^) then
begin
Startpoint := PDoublepoint(xPath.p1)^;
Startpoint.z := GetZPoint(aNet,xPath.p1);
aCeilingConture[i] := Startpoint;
EndPoint := xPath.p2;
end
else
begin
Startpoint := PDoublepoint(xPath.p2)^;
Startpoint.z := GetZPoint(aNet,xPath.p2);
aCeilingConture[i] := Startpoint;
EndPoint := xPath.p1;
end;
end;
end;
FreeAndNil(xPaths);
end;
Procedure GetCeilingConture(aNet: TNet; aPaths: Tlist; var aCeilingConture: TDoublePointArr);
var i,j, ID: integer;
Heightcorner: double;
xNetPath: TNetPath;
xSCSCompon,CornerSCS: TSCSComponent;
Point1,Point2,StartPoint: TDoublePoint;
ArchContainer: TSCSCatalog;
Node: TTreeNode;
ArchObj: TSCSComponent;
ObjData: TObjectData;
WrongPath: Boolean;
begin
SetLength(aCeilingConture, 0);
WrongPath := false;
if aNet.FComponID <> 0 then
begin
ArchObj := GetArchObjByCADObj(aNet);
if ArchObj <> nil then
begin
SetLength(aCeilingConture, aNet.Points.Count+1);
StartPOint := PDoublepoint(aNet.Points[0])^;
for i := 0 to aNet.Points.Count - 1 do
begin
ID := Integer(anet.FPointIDs[i]);
Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true);
CornerSCS := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node);
Heightcorner := CornerSCS.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(aNet.Owner).MapScale);
aCeilingConture[i] := PDoublepoint(aNet.Points[i])^;
aCeilingConture[i].z := Heightcorner;
if i > 0 then
if not CheckByNetPath(aNet,StartPOint, PDoublepoint(aNet.Points[i])^) then
begin
SetLength(aCeilingConture, 0);
SetLength(aCeilingConture, aNet.Points.Count+1);
WrongPath := true;
break;
end;
StartPOint := PDoublepoint(aNet.Points[i])^;
end;
end;
if WrongPath then
begin
FillCeilingBySortOut(aNet,aCeilingConture);
aCeilingConture[4] := aCeilingConture[0];
end
else
aCeilingConture[i] := aCeilingConture[0];
end;
end;
// MARK
constructor T3DRoom.Create(aFaces: TList; aNet: TNet; aParent: T3DModel);
var
i: integer;
vPaths: TList;
begin
try
inherited Create;
FClassName := 'T3DRoom';
FPlanObject := aNet;
FListID := GCadForm.FCADListID;
SetLength(FFloorContureForNormal, 0); // Tolik 14/01/2020
if aNet <> nil then
begin
VPaths := Nil;
{$if Defined (ES_GRAPH_SC)}
FSCSCompon := GetArchObjByCADObj(aNet);
FSCSComponID := FSCSCompon.ID;
FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark;
{$else}
FName := _3DRoomName;
{$ifEnd}
vPaths := GetVirtualNetPathsByRealNet(aNet, FGroupNet);
{$if Defined (ES_GRAPH_SC)}
if GArch3DInnerSidesFromVirtual and Assigned(FGroupNet) then
begin
FNetConture := FGroupNet.GetRoomConture(vPaths);
GetPathsConturePoints(vPaths, nil, @FCeilingConture, true, nil, nil, nil, nil); //28.05.2012
end
else
begin
if not IfFiguraIsRoof(aNet) then
begin
FNetConture := aNet.GetRoomConture(aNet.Paths);
GetPathsConturePoints(aNet.Paths, nil, @FCeilingConture, true, nil, nil, nil, nil); //28.05.2012
end
else
begin
FNetConture := aNet.GetRoomConture(aNet.Paths);
GetCeilingConture(aNet,aNet.Paths,FCeilingConture);
end;
end;
if (aNet.Paths.Count > 0) and (TNetPath(aNet.Paths[0]).FIsConture) then
begin
//FFloorConture := aNet.GetFloorConture;
//FCeilingConture := aNet.GetCeilingConture;
if Length(FCeilingConture) > 0 then
SetLength(FCeilingConture, Length(FCeilingConture)-1);
SetLength(FFloorConture, Length(FCeilingConture));
for i := 0 to Length(FCeilingConture) - 1 do
begin
FFloorConture[i] := FCeilingConture[i];
FFloorConture[i].z := 0;
//FCeilingConture[i].z := FCeilingConture[i].z * FScaleDelta + FFCeilingDelta;
FCeilingConture[i].z := FCeilingConture[i].z + FFCeilingDelta;
end;
end;
{$else}
{if GArch3DInnerSidesFromVirtual and Assigned(FGroupNet) then
begin
FNetConture := FGroupNet.GetRoomConture(vPaths);
//GetPathsConturePoints(vPaths, nil, @FCeilingConture, true, nil, nil, nil, nil); //28.05.2012
end
else
begin
if not IfFiguraIsRoof(aNet) then
begin
FNetConture := aNet.GetRoomConture(aNet.Paths);
//GetPathsConturePoints(aNet.Paths, nil, @FCeilingConture, true, nil, nil, nil, nil); //28.05.2012
end
else
begin
FNetConture := aNet.GetRoomConture(aNet.Paths);
//GetCeilingConture(aNet,aNet.Paths,FCeilingConture);
end;
end;}
{$ifEnd}
FreeAndNil(vPaths);
end;
FWalls := TList.Create;
FCorner := TList.Create;
F3DSObjects := TList.Create;
FParent := aParent;
FVisible := True;
{$if Defined (ES_GRAPH_SC)}
if aFaces <> nil then
begin
if GCurrentRoom3DView = nil then
begin
CollectRoom(aFaces);
end
else
begin
if FSCSComponID = GCurrentRoom3DView.ID then
CollectRoom(aFaces)
else
begin
CollectRoom(aFaces);
FVisible := False;
end;
end;
end;
{$ifEnd}
except
on E: Exception do AddExceptionToLogEx('T3DRoom.Create', E.Message);
end;
end;
destructor T3DRoom.destroy;
begin
try
{$if Defined (ES_GRAPH_SC)}
{$else}
SetLength(FNetConture, 0);
SetLength(FFloorConture, 0);
SetLength(FCeilingConture, 0);
SetLength(FFloorContureForNormal, 0); // Tolik 14/01/2020
FreeObjectList(FWalls);
FreeObjectList(F3DSObjects);
if FFloor <> nil then
FFloor.Free;
if FCeiling <> nil then
FCeiling.Free;
FreeObjectList(FCorner);
{$ifEnd}
inherited;
except
on E: Exception do AddExceptionToLogEx('T3DRoom.Destroy', E.Message);
end;
end;
procedure T3DRoom.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
20: FParentIndex := IntVal;
21: FSCSComponID := intVal;
22: FListID := intVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
case xCode of
90: begin
if byteVal = 0 then
FVisible := False
else
FVisible := True;
end;
end;
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DRoom.ReadFromStream', E.Message);
end;
end;
procedure T3DRoom.SetRelations;
begin
try
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DModel(ModelObjectsList.Items[FParentIndex]);
T3DModel(FParent).FRooms.Add(self);
end;
except
on E: Exception do AddExceptionToLogEx('T3DRoom.SetRelations', E.Message);
end;
end;
procedure T3DRoom.WriteToStream(Stream: TStream);
var
xInt: Integer;
xByte: Byte;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
if FVisible then
xByte := 1
else
xByte := 0;
WriteField(90, Stream, xByte, sizeof(xByte));
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DRoom.WriteToStream', E.Message);
end;
end;
{ T3DSide }
procedure T3DSide.CollectWallElementSide(aFaces: TList; ap: T3DPointArray; fTrans: boolean = False);
var
aFace: TFaceRecord;
begin
try
SetLength(FPoints, 4);
SetLength(FGLPoints, 4);
FPoints[0] := ap[0];
FPoints[1] := ap[1];
FPoints[2] := ap[2];
FPoints[3] := ap[3];
aFace := TFaceRecord.Create(FPoints, clGray, FFaceType, 1, fTrans, nil);
aFace.FFaceWallType := FWallType;
aFace.FWallSideType := FSideType;
aFaces.Add(aFace);
FFace := aFace;
except
on E: Exception do AddExceptionToLogEx('T3DSide.CollectWallElementSide', E.Message);
end;
end;
procedure T3DSide.CollectWallSide(aFaces: TList; ap: T3DPointArray);
var
aFace: TFaceRecord;
begin
try
SetLength(FPoints, 4);
SetLength(FGLPoints, 4);
FPoints[0] := ap[0];
FPoints[1] := ap[1];
FPoints[2] := ap[3];
FPoints[3] := ap[2];
aFace := TFaceRecord.Create(FPoints, clGray, FFaceType, 1, False, nil);
aFace.FFaceWallType := FWallType;
aFace.FWallSideType := FSideType;
aFaces.Add(aFace);
FFace := aFace;
except
on E: Exception do AddExceptionToLogEx('T3DSide.CollectWallSide', E.Message);
end;
end;
procedure T3DSide.CollectWallSideEx(aFaces: TList; ap: T3DPointArray);
var
i: integer;
aFace: TFaceRecord;
begin
try
SetLength(FPoints, Length(ap));
SetLength(FGLPoints, Length(ap));
for i := 0 to Length(ap) - 1 do
FPoints[i] := ap[i];
aFace := TFaceRecord.Create(FPoints, clGray, FFaceType, 1, False, nil);
aFace.FFaceWallType := FWallType;
aFace.FWallSideType := FSideType;
aFaces.Add(aFace);
FFace := aFace;
except
on E: Exception do AddExceptionToLogEx('T3DSide.CollectWallSide', E.Message);
end;
end;
procedure T3DSide.CollectArcWallSide(aFaces: TList; ap: T3DPointArray);
var
i: integer;
j: integer;
aFace: TFaceRecord;
aFPoints: T3DPointArray;
begin
try
SetLength(aFPoints, 4);
if (FSideType = wstUpper) or (FSideType = wstUnder) then
begin
SetLength(FPoints, Length(ap));
SetLength(FGLPoints, Length(ap));
for i := 0 to Length(ap) - 1 do
FPoints[i] := ap[i];
aFace := TFaceRecord.Create(FPoints, clGray, FFaceType, 1, False, nil);
aFace.FFaceWallType := FWallType;
aFace.FWallSideType := FSideType;
aFaces.Add(aFace);
FFace := aFace;
FAsArc := True;
end
else
begin
SetLength(FPoints, 4);
SetLength(FGLPoints, 4);
j := 0;
while j + 1 < (Length(ap) div 2) do
begin
aFPoints[0] := ap[j];
aFPoints[1] := ap[j + 1];
//aFPoints[2] := ap[Length(ap) - j - 2];
//aFPoints[3] := ap[Length(ap) - j - 1];
aFPoints[2] := ap[(Length(ap) div 2) + 1 + j];
aFPoints[3] := ap[(Length(ap) div 2) + j];
//aFPoints[2] := ap[j + 2];
//aFPoints[3] := ap[j + 3];
if j = 0 then
begin
FPoints[0] := aFPoints[0];
FPoints[1] := aFPoints[1];
FPoints[2] := aFPoints[2];
FPoints[3] := aFPoints[3];
end;
aFace := TFaceRecord.Create(aFPoints, clGray, FFaceType, 1, False, nil);
aFace.FFaceWallType := FWallType;
aFace.FWallSideType := FSideType;
aFaces.Add(aFace);
if j = 0 then
FFace := aFace;
FAsArc := True;
j := j + 1;
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DSide.CollectWallSide', E.Message);
end;
end;
constructor T3DSide.Create(aFaceType: TFaceType; aWallType: TFaceWallType; aSideType: TWallSideType; aParent: TObject; aNetPath: TNetPath=nil);
begin
try
inherited Create;
FClassName := 'T3DSide';
FColor := clGray;
FFaceType := aFaceType;
FWallType := aWallType;
FSideType := aSideType;
FParent := aParent;
FGLObject := nil;
FFace := nil;
FDescription := TStringList.Create;
FTextureRotate := 0;
FTextureScale := 100;
FMirror := False;
FAsArc := False;
FTextureHash := '';
FTexture_ext := '';
FSubSides := TList.Create;
FNetPath := aNetPath; //29.05.2012
if FParent <> nil then
begin
if FParent is T3DWall then
begin
FName := cSide + ' ' + IntToStr(T3DWall(FParent).FSides.Count + 1);
end;
if FParent is T3DWallElement then
begin
FName := cSide + ' ' + IntToStr(T3DWallElement(FParent).FSides.Count + 1);
end;
if FParent is T3DBalconElement then
begin
FName := cSide + ' ' + IntToStr(T3DBalconElement(FParent).FSides.Count + 1);
end;
if FParent is T3DSlope then
begin
FName := cSide + ' ' + IntToStr(T3DSlope(FParent).FSides.Count + 1);
end;
if FParent is T3DSide then
begin
FName := cSubSide + ' ' + IntToStr(T3DSide(FParent).FSubSides.Count + 1);
end;
end;
if FNetPath <> nil then
begin
if FNetPath.FComponID in [128,133,150,148] then
begin
EmptyProcedure;
if aWallType = fwtOuter then
begin
EmptyProcedure;
if FNetPath.FComponID = 128 then
EmptyProcedure;
if FNetPath.FComponID = 133 then
EmptyProcedure;
if FNetPath.FComponID = 150 then
EmptyProcedure;
if FNetPath.FComponID = 158 then
EmptyProcedure;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DSide.Create', E.Message);
end;
end;
// Tolik 24/07/2018 --
destructor T3DSide.destroy;
begin
FDescription.Free;
FreeAndNil(FSubSides);
SetLength(FPoints, 0);
SetLength(FGLPoints, 0);
inherited;
end;
//
procedure T3DSide.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
i, xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
xd, yd, zd: Double;
pCnt: Integer;
mStr: TMemoryStream;
fStr: TFileStream;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xCode of
20: FParentIndex := IntVal;
21: FFaceType := TFaceType(IntVal);
22: FWallType := TFaceWallType(IntVal);
23: FSideType := TWallSideType(IntVal);
24: FColor := IntVal;
25: FTextureRotate := IntVal;
26: FTextureScale := IntVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
case xCode of
90: begin
if byteVal = 0 then
FMirror := False
else
FMirror := True;
end;
91: begin
if byteVal = 0 then
FAsArc := False
else
FAsArc := True;
end;
end;
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
Case xcode of
150: begin
pCnt := xSize div 24;
SetLength(FPoints, pCnt);
for i := 0 to pCnt - 1 do
begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPoints[i].x := xd;
FPoints[i].y := yd;
FPoints[i].z := zd;
end;
end;
151: begin
pCnt := xSize div 24;
SetLength(FGLPoints, pCnt);
for i := 0 to pCnt - 1 do
begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FGLPoints[i].x := xd;
FGLPoints[i].y := yd;
FGLPoints[i].z := zd;
end;
end;
// 152: begin
// mStr := TMemoryStream.Create;
// StreamToStream(Stream, mStr, xSize);
// mStr.Position := 0;
// mStr.SaveToFile('C:\govno_test.bmp');
// FreeAndNil(mStr);
// end;
end;
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strVal := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
181: FDescription.Text := strVal;
182: FTextureHash := strVal;
183: FTexture_ext := strVal;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DSide.ReadFromStream', E.Message);
end;
end;
procedure T3DSide.SetRelations;
begin
try
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := TObject(ModelObjectsList.Items[FParentIndex]);
if FParent is T3DRoom then
begin
if FFaceType = ftNetCeiling then
T3DRoom(FParent).FCeiling := self;
if FFaceType = ftNetFloor then
T3DRoom(FParent).FFloor := self;
end;
if FParent is T3DWall then
begin
T3DWall(FParent).FSides.Add(self);
end;
if FParent is T3DWallElement then
begin
T3DWallElement(FParent).FSides.Add(self);
end;
if FParent is T3DBalconElement then
begin
T3DBalconElement(FParent).FSides.Add(self);
end;
if FParent is T3DSlope then
begin
T3DSlope(FParent).FSides.Add(self);
end;
if FParent is T3DSide then
begin
T3DSide(FParent).FSubSides.Add(self);
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DSide.SetRelations', E.Message);
end;
end;
function T3DSide.GetArea: Double;
var
PointCnt: Integer;
begin
Result := 0;
PointCnt := Length(Self.FPoints);
if PointCnt = 4 then
Result := GetTriangleArea3D(Self.FPoints[0], Self.FPoints[1], Self.FPoints[2])+
GetTriangleArea3D(Self.FPoints[2], Self.FPoints[3], Self.FPoints[0]);
end;
// Tolik 04/04/2019 -- ñòàðàÿ çàêîììåí÷åíà íèæå
procedure T3DSide.WriteToStream(Stream: TStream);
var
i, xCount, xInt: Integer;
xByte: Byte;
aPoints: pInt;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
xInt := Ord(FFaceType);
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := Ord(FWallType);
WriteField(22, Stream, xInt, sizeof(xInt));
xInt := Ord(FSideType);
WriteField(23, Stream, xInt, sizeof(xInt));
xInt := FColor;
WriteField(24, Stream, xInt, sizeof(xInt));
xInt := FTextureRotate;
WriteField(25, Stream, xInt, sizeof(xInt));
xInt := FTextureScale;
WriteField(26, Stream, xInt, sizeof(xInt));
if FMirror then
xByte := 1
else
xByte := 0;
WriteField(90, Stream, xByte, sizeof(xByte));
if FAsArc then
xByte := 1
else
xByte := 0;
WriteField(91, Stream, xByte, sizeof(xByte));
xCount := Length(FPoints);
GetMem(aPoints, xCount * 24);
for i := 0 to xCount - 1 do
begin
pDouble(PAnsiChar(aPoints) + (i * 24) + 0)^ := FPoints[i].x;
pDouble(PAnsiChar(aPoints) + (i * 24) + 8)^ := FPoints[i].y;
pDouble(PAnsiChar(aPoints) + (i * 24) + 16)^ := FPoints[i].z;
end;
WriteBinField(150, Stream, pByte(aPoints), xCount * 24);
FreeMem(aPoints, xCount * 24);
xCount := Length(FGLPoints);
GetMem(aPoints, xCount * 24);
for i := 0 to xCount - 1 do
begin
pDouble(PAnsiChar(aPoints) + (i * 24) + 0)^ := FGLPoints[i].x;
pDouble(PAnsiChar(aPoints) + (i * 24) + 8)^ := FGLPoints[i].y;
pDouble(PAnsiChar(aPoints) + (i * 24) + 16)^ := FGLPoints[i].z;
end;
WriteBinField(151, Stream, pByte(aPoints), xCount * 24);
FreeMem(aPoints, xCount * 24);
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(182, Stream, FTextureHash);
WriteStrField(183, Stream, FTexture_ext);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DSide.WriteToStream', E.Message);
end;
end;
{
procedure T3DSide.WriteToStream(Stream: TStream);
var
i, xCount, xInt: Integer;
xByte: Byte;
xStr: string;
xDouble: Double;
aPoints, bPoints: pInt;
xFName: string;
xStream: TFileStream;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
xInt := Ord(FFaceType);
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := Ord(FWallType);
WriteField(22, Stream, xInt, sizeof(xInt));
xInt := Ord(FSideType);
WriteField(23, Stream, xInt, sizeof(xInt));
xInt := FColor;
WriteField(24, Stream, xInt, sizeof(xInt));
xInt := FTextureRotate;
WriteField(25, Stream, xInt, sizeof(xInt));
xInt := FTextureScale;
WriteField(26, Stream, xInt, sizeof(xInt));
if FMirror then
xByte := 1
else
xByte := 0;
WriteField(90, Stream, xByte, sizeof(xByte));
if FAsArc then
xByte := 1
else
xByte := 0;
WriteField(91, Stream, xByte, sizeof(xByte));
xCount := Length(FPoints);
GetMem(aPoints, xCount * 24);
for i := 0 to xCount - 1 do
begin
pDouble(pChar(aPoints) + (i * 24) + 0)^ := FPoints[i].x;
pDouble(pChar(aPoints) + (i * 24) + 8)^ := FPoints[i].y;
pDouble(pChar(aPoints) + (i * 24) + 16)^ := FPoints[i].z;
end;
WriteBinField(150, Stream, pByte(aPoints), xCount * 24);
FreeMem(aPoints, xCount * 24);
xCount := Length(FGLPoints);
GetMem(aPoints, xCount * 24);
for i := 0 to xCount - 1 do
begin
pDouble(pChar(aPoints) + (i * 24) + 0)^ := FGLPoints[i].x;
pDouble(pChar(aPoints) + (i * 24) + 8)^ := FGLPoints[i].y;
pDouble(pChar(aPoints) + (i * 24) + 16)^ := FGLPoints[i].z;
end;
WriteBinField(151, Stream, pByte(aPoints), xCount * 24);
FreeMem(aPoints, xCount * 24);
// Write Texture
// xFName := frm3D.GetImageFileByHash(FTextureHash);
// if xFName <> '' then
// begin
// xStream := TFileStream.Create(xFName, fmOpenRead);
// WriteStreamField(152, Stream, xStream);
// FreeAndNil(xStream);
// end;
//
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(182, Stream, FTextureHash);
WriteStrField(183, Stream, FTexture_ext);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DSide.WriteToStream', E.Message);
end;
end;
}
{ T3DWall }
function T3DWall.CalcPointHeight(p1, p2, Point: TDoublePoint; p1h, p2h: Double): Double;
var
x, y: Double;
p: TDoublePoint;
begin
try
Result := 0;
// Êîîðäèíàòó Ó áóäåì ðàññìàòðèâàòü êàê Z
// ÷òîáû íîðìàëèçèðîâàòü Y (òîåñòü äëÿ p1, p2 áûë îäèíàêîâûé), áóäåì ñ÷èòàòü îò íîëÿ, ñ÷èòàÿ îñòàïëüíûå êîîðäèíàòû ïî äëèíàì
x := GetLineLenght(p1, Point);
y := 1;
p := LineIntersect(DoublePoint(0, p1h), DoublePoint(GetLineLenght(p1, p2), p2h), DoublePoint(x,0), DoublePoint(x,1000));
x := GetLineLenght(p1, Point)+1;
PointToLine(DoublePoint(1, p1h+1), DoublePoint(GetLineLenght(p1, p2)+1, p2h+1), x, y);
Result := y;
Result := p.y;
except
on E: Exception do AddExceptionToLogEx('T3DWall.CalcPointHeight', E.Message);
end;
end;
function T3DWall.CollectInnerWall(aFaces: TList; ap: T3DPointArray; aWallViewType: TWallViewType; isRightInner: Boolean = False): TList;
var
i: integer;
a3DPointArr, a3DPointArrArc: T3DPointArray;
aFace: TFaceRecord;
WallSideConture: TDoublePointArr;
pp: PDoublePoint;
p: TDoublePoint;
l1, l2: TDoublePoint;
xSide: T3DSide;
begin
try
Result := TList.Create;
SetLength(a3DPointArr, 4);
// Íèæíÿÿ ãðàíü ************************************************************
if not (wvtNoUnder in aWallViewType) then
begin
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[2];
a3DPointArr[3] := ap[3];
if PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3]) then
xSide := T3DSide.Create(ftNetPath, fwtInner, wstUnder, self, FPlanObject)
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUnder, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
xSide.CollectWallSide(aFaces, a3DPointArr);
// new ***
FSides.Add(xSide);
Result.Add(xSide);
end;
// Âåðõíÿÿ ãðàíü ***********************************************************
if not (wvtNoUpper in aWallViewType) then
begin
a3DPointArr[0] := ap[4];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[6];
a3DPointArr[3] := ap[7];
if PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3]) then
xSide := T3DSide.Create(ftNetPath, fwtInner, wstUpper, self, FPlanObject)
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUpper, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
xSide.CollectWallSide(aFaces, a3DPointArr);
// new ***
FSides.Add(xSide);
Result.Add(xSide);
end;
// Ëåâàÿ ãðàíü *************************************************************
if not (wvtNoLeft in aWallViewType) then
begin
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[4];
a3DPointArr[3] := ap[5];
if (PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2])) or (PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3])) then
begin
xSide := T3DSide.Create(ftNetPath, fwtInner, wstLeft, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr, True);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
xSide.CollectWallSide(aFaces, a3DPointArr);
// new ***
FSides.Add(xSide);
Result.Add(xSide);
end;
end;
// Ïðàâàÿ ãðàíü
if not (wvtNoRight in aWallViewType) then
begin
a3DPointArr[0] := ap[2];
a3DPointArr[1] := ap[3];
a3DPointArr[2] := ap[6];
a3DPointArr[3] := ap[7];
if (PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2])) or (PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3])) then
begin
xSide := T3DSide.Create(ftNetPath, fwtInner, wstRight, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr, True);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
xSide.CollectWallSide(aFaces, a3DPointArr);
// new ***
FSides.Add(xSide);
Result.Add(xSide);
end
else if isRightInner then
begin
xSide := T3DSide.Create(ftNetPath, fwtInner, wstRight, self, FPlanObject);
xSide.CollectWallSide(aFaces, a3DPointArr);
FSides.Add(xSide);
Result.Add(xSide);
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.CollectWall', E.Message);
end;
end;
function T3DWall.CollectOuterWall(aFaces: TList; ap: T3DPointArray; aWallViewType: TWallViewType;
aKnotFlag: Byte=0; aSideFlag: Byte=0): TList;
var
i: integer;
a3DPointArr, a3DPointArrArc: T3DPointArray;
aFace: TFaceRecord;
WallSideConture: TDoublePointArr;
pp: PDoublePoint;
p: TDoublePoint;
l1, l2: TDoublePoint;
xSide: T3DSide;
function CheckSideInWall(aSide: T3DSide): Boolean;
var i: Integer;
CurrSide: T3DSide;
function SamePoints(aPoint1, aPoint2: TDoublePoint): Boolean;
begin
Result := False;
if (CompareValue(aPoint1.x, aPoint2.x) = 0) then
if (CompareValue(aPoint1.y, aPoint2.y) = 0) then
if (CompareValue(aPoint1.z, aPoint2.z) = 0) then
Result := True;
end;
begin
Result := False;
for i := 0 to FSides.Count - 1 do
begin
currSide := T3DSide(FSides[i]);
if SamePoints(currSide.FPoints[0], aSide.FPoints[0]) and SamePoints(currSide.FPoints[1], aSide.FPoints[1]) and
SamePoints(currSide.FPoints[2], aSide.FPoints[2]) and SamePoints(currSide.FPoints[3], aSide.FPoints[3]) then
begin
Result := True;
exit;
end;
end;
end;
begin
try
Result := TList.Create;
// Íèæíÿÿ ãðàíü ************************************************************
if not (wvtNoUnder in aWallViewType) then
begin
if (aKnotFlag = 0) or FIsArc then
begin
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[2];
a3DPointArr[3] := ap[3];
end
else if not FIsArc then
begin
if aKnotFlag = 1 then
begin
SetLength(a3DPointArr, 5);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[3];
a3DPointArr[3] := ap[2];
a3DPointArr[4] := ap[8];
end
else if aKnotFlag = 2 then
begin
SetLength(a3DPointArr, 5);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[9];
a3DPointArr[3] := ap[3];
a3DPointArr[4] := ap[2];
end
else if aKnotFlag = 12 then
begin
SetLength(a3DPointArr, 6);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[9];
a3DPointArr[3] := ap[3];
a3DPointArr[4] := ap[2];
a3DPointArr[5] := ap[8];
end;
end;
if PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3]) then
xSide := T3DSide.Create(ftNetPath, fwtInner, wstUnder, self, FPlanObject)
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUnder, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
begin
if aKnotFlag = 0 then
xSide.CollectWallSide(aFaces, a3DPointArr)
else
xSide.CollectWallSideEx(aFaces, a3DPointArr);
end;
// new ***
if CheckSideInWall(xSide) then
begin
xSide.Free;
aFaces.Delete(aFaces.Count - 1);
end
else
begin
FSides.Add(xSide);
Result.Add(xSide);
end;
end;
// Âåðõíÿÿ ãðàíü ***********************************************************
if not (wvtNoUpper in aWallViewType) then
begin
if (aKnotFlag = 0) or FIsArc then
begin
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[4];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[6];
a3DPointArr[3] := ap[7];
end
else if Not FIsArc then
begin
if aKnotFlag = 1 then
begin
SetLength(a3DPointArr, 5);
a3DPointArr[0] := ap[4];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[7];
a3DPointArr[3] := ap[6];
a3DPointArr[4] := ap[10];
end
else if aKnotFlag = 2 then
begin
SetLength(a3DPointArr, 5);
a3DPointArr[0] := ap[4];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[11];
a3DPointArr[3] := ap[7];
a3DPointArr[4] := ap[6];
end
else if aKnotFlag = 12 then
begin
SetLength(a3DPointArr, 6);
a3DPointArr[0] := ap[4];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[11];
a3DPointArr[3] := ap[7];
a3DPointArr[4] := ap[6];
a3DPointArr[5] := ap[10];
end;
end;
if PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3]) then
xSide := T3DSide.Create(ftNetPath, fwtInner, wstUpper, self, FPlanObject)
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUpper, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
begin
if aKnotFlag = 0 then
xSide.CollectWallSide(aFaces, a3DPointArr)
else
xSide.CollectWallSideEx(aFaces, a3DPointArr);
end;
// new ***
if CheckSideInWall(xSide) then
begin
xSide.Free;
aFaces.Delete(aFaces.Count - 1);
end
else
begin
FSides.Add(xSide);
Result.Add(xSide);
end;
end;
// Ëåâàÿ ãðàíü *************************************************************
if not (wvtNoLeft in aWallViewType) then
begin
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[4];
a3DPointArr[3] := ap[5];
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstLeft, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr, True);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
xSide.CollectWallSide(aFaces, a3DPointArr);
// new ***
if CheckSideInWall(xSide) then
begin
xSide.Free;
aFaces.Delete(aFaces.Count - 1);
end
else
begin
FSides.Add(xSide);
Result.Add(xSide);
end;
end;
// ëåâàÿ áîêîâàÿ ãðàíü
if (aSideFlag = 1) or (aSideFlag = 12) then
begin
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[4];
a3DPointArr[2] := ap[2];
a3DPointArr[3] := ap[6];
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstLeftSide, self, FPlanObject);
xSide.CollectWallSide(aFaces, a3DPointArr);
if CheckSideInWall(xSide) then
begin
xSide.Free;
aFaces.Delete(aFaces.Count - 1);
end
else
begin
FSides.Add(xSide);
Result.Add(xSide);
end;
end;
// Tolik -- 28/08/2018-
{$if DEFINED (ES_GRAPH_SC)}
//29.05.2012 - Ïðàâàÿ ãðàíü (åñëè ñòåíà ñàìà ïî ñåáå ñ îäíîé ñòîðîíû íå ïîäêëþ÷åíà ê äðóãîé ñòåíå)
if Not FPlanObject.FIsConture then //if (aKnotFlag = 0) and (aSideFlag = 1) then
begin
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[2];
a3DPointArr[1] := ap[3];
a3DPointArr[2] := ap[6];
a3DPointArr[3] := ap[7];
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstRight, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr, True);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
xSide.CollectWallSide(aFaces, a3DPointArr);
// new ***
FSides.Add(xSide);
Result.Add(xSide);
end;
{$else}
begin
if Not FPlanObject.FIsInner then //if (aKnotFlag = 0) and (aSideFlag = 1) then
begin
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[2];
a3DPointArr[1] := ap[3];
a3DPointArr[2] := ap[6];
a3DPointArr[3] := ap[7];
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstRight, self, FPlanObject);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr, True);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
end
else
xSide.CollectWallSide(aFaces, a3DPointArr);
// new ***
if CheckSideInWall(xSide) then
begin
xSide.Free;
aFaces.Delete(aFaces.Count - 1);
end
else
begin
FSides.Add(xSide);
Result.Add(xSide);
end;
end;
end;
{$ifEnd}
// ïðàâàÿ áîêîâàÿ ãðàíü
if (aSideFlag = 2) or (aSideFlag = 12) then
begin
a3DPointArr[0] := ap[1];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[3];
a3DPointArr[3] := ap[7];
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstRightSide, self, FPlanObject);
xSide.CollectWallSide(aFaces, a3DPointArr);
if CheckSideInWall(xSide) then
begin
xSide.Free;
aFaces.Delete(aFaces.Count - 1);
end
else
begin
FSides.Add(xSide);
Result.Add(xSide);
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.CollectOuterWall', E.Message);
end;
end;
constructor T3DWall.Create(aFaces: TList; aNetPath: TNetPath; aParent: T3DRoom);
begin
try
inherited Create;
FClassName := 'T3DWall';
FPlanObject := aNetPath;
FVPath := nil;
if aNetPath <> nil then
begin
FIsArc := FPlanObject.isArc;
{$if Defined(ES_GRAPH_SC)} // Tolik 15/06/2018 -- îòâÿçàòü îò êîìïîíåíòà, åñëè íå ãðàôìîäóëü
FSCSCompon := GetArchObjByCADObj(aNetPath);
FSCSComponID := FSCSCompon.ID;
FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark;
{$ELSE}
FName := _3DWallName;
{$ifend}
end;
FWallElements := TList.Create;
FSides := TList.Create;
FParent := aParent;
if aFaces <> nil then
if Not GArch3DInnerSidesFromVirtual or Not Assigned(FGroupNet) then
if Not IfFiguraIsRoof(aNetPath) then
//Tolik --17/07/2018 --
begin
// ParseWallForInner(aFaces, nil);
{$if Defined(ES_GRAPH_SC)}
ParseWallForInner(aFaces, nil);
{$Else}
//ParseWallForInner(aFaces, aNetPath);
{$IfEnd}
end;
//
FFaceType := ftLine;
FGLObject := nil;
FZOrder := 0;
except
on E: Exception do AddExceptionToLogEx('T3DWall.Create', E.Message);
end;
end;
// Tolik 24/07/2018 --
Destructor T3DWall.Destroy;
begin
FPlanObject := nil;
FreeObjectList(FWallElements);
FreeObjectList(FSides);
inherited;
end;
//
function GetArcWallPointsAll(aPoints: T3DPointArray; FPlanObject: TNetPath; isWall: boolean = False): T3DPointArray;
var
Fpoints: T2DPointArray;
Radius: Double;
a1,a2: Double;
Cnt: Integer;
i, idx: Integer;
p1Join, p2Join, pJoin, PathPt: PDoublePoint;
p1, p2: TDoublePoint;
FPointsInOrder: Boolean; // Íîâûå òî÷êè äîáàâëÿòü â ïîðÿäêå êîòîðîì ïðèøëè, èëè îáðàòíîì
OldDxfMode: Boolean;
ModVal: Integer;
PathPoints: TList;
PointsJoin: TList;
arcPoints: TList;
arcLPoints: TList;
procedure DefineJoinPoints(aNum: Integer);
var
i, j: integer;
begin
p1Join := nil;
p2Join := nil;
PathPoints.Clear;
PathPoints.Add(@p1);
PathPoints.Add(@p2);
for i := 0 to PointsJoin.Count - 1 do
begin
PathPt := PathPoints[i];
for j := 0 to arcPoints.Count - 1 do
begin
if CmpPoints(PDoublePoint(arcPoints[j])^, PathPt^) then
begin
if Not EQDP(PDoublePoint(arcPoints[j])^, PDoublePoint(arcLPoints[j])^) then
begin
if aNum = 2 then
EmptyProcedure;
Pointer(PointsJoin[i]^) := arcLPoints[j];
Break; //// BREAK ////
end;
end
else if CmpPoints(PDoublePoint(arcLPoints[j])^, PathPt^) then
begin
if Not EQDP(PDoublePoint(arcLPoints[j])^, PDoublePoint(arcPoints[j])^) then
begin
// Èíîãäà íóæíî âèäåòü äîï êóñîê âíåøíåé ãðàíè
Pointer(PointsJoin[i]^) := arcPoints[i];
Break; //// BREAK ////
//EmptyProcedure;
end;
end;
end;
end;
end;
procedure AddPointToArray(APoint: TDoublePoint; var AArray: T3DPointArray);
begin
SetLength(AArray, Length(AArray)+1);
AArray[Length(AArray)-1] := APoint;
end;
procedure AddFirstPointToArray(APoint: TDoublePoint; aPtJoin: PDoublePoint; var AArray: T3DPointArray);
begin
if aPtJoin <> nil then
AddPointToArray(DoublePoint(aPtJoin^.x, aPtJoin^.y, APoint.z), AArray);
AddPointToArray(APoint, AArray);
end;
procedure AddLastPointToArray(APoint: TDoublePoint; aPtJoin: PDoublePoint; var AArray: T3DPointArray);
begin
AddPointToArray(APoint, AArray);
if aPtJoin <> nil then
AddPointToArray(DoublePoint(aPtJoin^.x, aPtJoin^.y, APoint.z), AArray);
end;
function IsPointsInOrder(aFirstPt: PDoublePoint): Boolean;
begin
Result := GetLineLength(aFirstPt^, DoublePoint(FPoints[0].x, FPoints[0].y)) < GetLineLength(aFirstPt^, DoublePoint(FPoints[cnt-1].x, FPoints[cnt-1].y));
end;
begin
try
SetLength(Result, 0);
// 1-st ARC
p1 := aPoints[0];
p2 := aPoints[1];
PathPoints := Tlist.Create;
PointsJoin := TList.Create;
PointsJoin.Add(@p1Join);
PointsJoin.Add(@p2Join);
arcPoints := TList.Create;
arcLPoints := TList.Create;
FPlanObject.FillArcJoinPoints(arcPoints, arcLPoints);
ModVal := 5; //10;
DefineJoinPoints(1); //12.06.2012
Radius := GetLineLenght(p1, FPlanObject.ArcCenter);
a1 := GetRadOfLine(FPlanObject.ArcCenter, p1);
a2 := GetRadOfLine(FPlanObject.ArcCenter, p2);
if Not FPlanObject.Inverted then
ExchangeDouble(a1, a2);
OldDxfMode := DxfMode; // ïîâûøàåì òî÷íîñòü - êîëè÷åñòâî òî÷åê äëÿ äóãè
DxfMode := True;
try
BezierArcPoints(FPoints, FPlanObject.ArcCenter.x, FPlanObject.ArcCenter.y, Radius, a1, a2);
finally
DxfMode := OldDxfMode;
end;
Cnt := Length(FPoints);
AddFirstPointToArray(p1, p1Join, Result);
if Cnt > 2 then
begin
//15.06.2012 FPointsInOrder := EQDP(p1, DoublePoint(FPoints[0].x, FPoints[0].y));
FPointsInOrder := IsPointsInOrder(@p1);
for i := 1 to cnt - 2 do
begin
if FPointsInOrder then
idx := i
else
idx := cnt - i - 1;
if (i mod ModVal) = 0 then
AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p1.z), Result);
end;
end;
AddLastPointToArray(p2, p2Join, Result);
if length(aPoints) > 3 then
begin
// 2-nd ARC
p1 := aPoints[2];
p2 := aPoints[3];
DefineJoinPoints(2); //12.06.2012
Radius := GetLineLenght(p1, FPlanObject.ArcCenter);
a1 := GetRadOfLine(FPlanObject.ArcCenter, p1);
a2 := GetRadOfLine(FPlanObject.ArcCenter, p2);
if Not FPlanObject.Inverted then
ExchangeDouble(a1, a2);
OldDxfMode := DxfMode; // ïîâûøàåì òî÷íîñòü - êîëè÷åñòâî òî÷åê äëÿ äóãè
DxfMode := True;
try
BezierArcPoints(FPoints, FPlanObject.ArcCenter.x, FPlanObject.ArcCenter.y, Radius, a1, a2);
finally
DxfMode := OldDxfMode;
end;
Cnt := Length(FPoints);
if isWall then
begin
AddFirstPointToArray(p1, p1Join, Result);
if Cnt > 2 then
begin
//15.06.2012 FPointsInOrder := EQDP(p1, DoublePoint(FPoints[0].x, FPoints[0].y));
FPointsInOrder := IsPointsInOrder(@p1);
for i := 1 to cnt - 2 do
begin
if FPointsInOrder then
idx := i
else
idx := cnt - i - 1;
if (i mod ModVal) = 0 then
AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p2.z), Result);
end;
end;
AddLastPointToArray(p2, p2Join, Result);
end
else
begin
AddFirstPointToArray(p2, p2Join, Result);
if Cnt > 2 then
begin
//15.06.2012 FPointsInOrder := EQDP(p2, DoublePoint(FPoints[0].x, FPoints[0].y));
FPointsInOrder := IsPointsInOrder(@p2);
for i := 1 to cnt - 2 do
begin
if FPointsInOrder then
idx := i
else
idx := cnt - i - 1;
if (i mod ModVal) = 0 then
AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p2.z), Result);
end;
end;
AddLastPointToArray(p1, p1Join, Result);
end;
end;
PathPoints.Free;
PointsJoin.Free;
arcPoints.Free;
arcLPoints.Free;
except
on E: Exception do AddExceptionToLogEx('T3DWall.GetArcWallPoints', E.Message);
end;
end;
function T3DWall.GetArcWallPoints(aPoints: T3DPointArray; isWall: boolean = False): T3DPointArray;
begin
if FVPath = nil then
Result := GetArcWallPointsAll(aPoints, FPlanObject, isWall)
else
Result := GetArcWallPointsAll(aPoints, FVPath, isWall);
end;
function T3DWall.GetFullDoors: TList;
var
i, j: integer;
CAD: TF_CAD;
CADWallChilds: TList;
WallChild: TNetDoor;
WallConture: TDoublePointArr;
xl1, xr1, da1, da2, db1, db2: TDoublePoint;
xlen, ylen, len1, len2: double;
Inserted: Boolean;
begin
try
Result := TList.Create;
for i := 0 to FPlanObject.Doors.Count - 1 do
Result.Add(FPlanObject.Doors[i]);
// èñêàòü ñî ñìåæíûõ ñòåí îáùèå îáüåêòû
CAD := TF_CAD(TPowerCad(FPlanObject.Net.Owner).Owner);
CADWallChilds := GetAllWallChildsFromCAD(CAD, []);
if CADWallChilds.Count > 0 then
begin
FPlanObject.DefineDoorsOwner;
WallConture := FPlanObject.GetConturePolygon;
// Ïåðåáèðàåì âñå îáúåêòû è ñìîòðèì ïîïàäàþò ëè îíè â ñòåíó ïî êîîðäèíàòàì
for i := 0 to CADWallChilds.Count - 1 do
begin
WallChild := TNetDoor(CADWallChilds[i]);
if WallChild.FPath <> FPlanObject then
begin
if IsPtInPolygon(WallChild.p1, WallConture) and IsPtInPolygon(WallChild.p2, WallConture) then
begin
len1 := GetLineLenght(FPlanObject.l1, WallChild.a1);
len2 := GetLineLenght(FPlanObject.l1, WallChild.a2);
ylen := Min(len1, len2);
Inserted := False;
for j := 0 to Result.Count - 1 do
begin
len1 := GetLineLenght(FPlanObject.l1, TNetDoor(Result[j]).a1);
len2 := GetLineLenght(FPlanObject.l1, TNetDoor(Result[j]).a2);
xlen := Min(len1, len2);
if ylen < xlen then
begin
Result.Insert(j, WallChild);
Inserted := True;
break;
end;
end;
if not Inserted then
Result.Add(WallChild);
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.GetFullDoors', E.Message);
end;
end;
function T3DWall.GetKnotsCount(aNetPath: TNetPath; p: TDoublePoint): Byte;
var
i, j, xCount: integer;
xNets: TList;
xNet: TNet;
xNetPath: TNetPath;
begin
try
Result := 0;
if FGroupNet <> nil then
begin
xNet := FGroupNet;
for j := 0 to xNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(xNet.Paths[j]);
if xNetPath <> aNetPath then
begin
if EQDP(xNetPath.p1^, p) or EQDP(xNetPath.p2^, p) then
Result := Result + 1;
end;
end;
end;
{
xNets := GetAllNets(GCadForm);
for i := 0 to xNets.Count - 1 do
begin
xNet := TNet(xNets[i]);
for j := 0 to xNet.Paths.Count - 1 do
begin
xNetPath := TNetPath(xNet.Paths[j]);
if xNetPath <> aNetPath then
begin
if EQDP(xNetPath.p1^, p) or EQDP(xNetPath.p2^, p) then
Result := Result + 1;
end;
end;
end;
}
except
on E: Exception do AddExceptionToLogEx('T3DWall.GetKnotsCount', E.Message);
end;
end;
procedure T3DWall.ParseWallForInner(aFaces: TList; aVNetPath: TNetPath);
var
aDoor, PrevDoor: TNetDoor;
i, j, k: integer;
WallComponID: Integer;
l1, l2, r1, r2: TDoublePoint;
DoorSCSCompon, PrevDoorSCSCompon, BalconDoor, BalconWnd, InnerSlope, OuterSlope: TSCSComponent;
wall_h1, wall_h2, door_h1, door_h2, wnd_h1, wnd_h2, w, door_w, wnd_w, corner_side1, corner_side2: double;
Points, Points1, Points2: T3DPointArray;
oxl1, oxr1, oxl2, oxr2, xl1, xr1, xl2, xr2, da1, da2, db1, db2: TDoublePoint;
ba1, ba2, ba3, bb1, bb2, bb3: TDoublePoint;
ca1, ca2, cb1, cb2: TDoublePoint;
AllDoors, WallSides: TList;
len1, len2: double;
hor_a1, hor_a2, hor_b1, hor_b2, ver_a, ver_b, depth, depth_a, depth_b: double;
WallType: TFaceWallType;
WallViewType: TWallViewType;
xWallElement, xPrevWallElement: T3DWallElement;
xSlope: T3DSlope;
xSide: T3DSide;
Corners: TSCSComponents;
lenminb: Double;
lenmina: Double;
NetPath: TNetPath;
TmpPath: TNetPath;
IsConture: Boolean;
{
function checkisCrossPoint: Boolean;
begin
Result := not ((((CompareValue(FPlanObject.p1.x, aVNetPath.p1.x) = 0) and
(CompareValue(FPlanObject.p1.y, aVNetPath.p1.y) = 0)) and
((CompareValue(FPlanObject.p2.x, aVNetPath.p2.x) = 0) and
(CompareValue(FPlanObject.p2.y, aVNetPath.p2.y) = 0))) or
(((CompareValue(FPlanObject.p1.x, aVNetPath.p2.x) = 0) and
(CompareValue(FPlanObject.p1.y, aVNetPath.p2.y) = 0)) and
((CompareValue(FPlanObject.p2.x, aVNetPath.p1.x) = 0) and
(CompareValue(FPlanObject.p2.y, aVNetPath.p1.y) = 0))));
if Result then
Result := (((CompareValue(FPlanObject.p1.x, aVNetPath.p1.x) = 0) and
(CompareValue(FPlanObject.p1.y, aVNetPath.p1.y) = 0)) or
((CompareValue(FPlanObject.p1.x, aVNetPath.p2.x) = 0) and
(CompareValue(FPlanObject.p1.y, aVNetPath.p2.y) = 0)) or
((CompareValue(FPlanObject.p2.x, aVNetPath.p1.x) = 0) and
(CompareValue(FPlanObject.p2.y, aVNetPath.p1.y) = 0)) or
((CompareValue(FPlanObject.p2.x, aVNetPath.p2.x) = 0) and
(CompareValue(FPlanObject.p2.y, aVNetPath.p2.y) = 0)));
end;
}
begin
try
{
//Tolik 23/12/2021 -- èñêëþ÷àåì ñàñ ñ ñîáîé è òå, ÷òî íå êàñàþòñÿ
if FPlanObject.id = aVNetPath.Id then
exit;
if not checkisCrossPoint then
exit;
//
}
//if Not FPlanObject.FIsConture then
// Exit; ///// EXIT /////
//06.06.2012
NetPath := FPlanObject;
IsConture := FPlanObject.FIsConture;
//06.06.2012 Èøåì âèðòóàëüíûé ñåãìåíò ïî FPlanObject
xSlope := Nil; //Tolik 17/07/2018 --
if GArch3DInnerSidesFromVirtual then
begin
if aVNetPath = nil then
begin
TmpPath := FindVirtualNetPathByReal(FGroupNet, FPlanObject);
if TmpPath <> nil then
begin
NetPath := TmpPath;
FVPath := TmpPath;
end;
end
else
begin
NetPath := aVNetPath;
FVPath := aVNetPath;
end;
if NetPath = FPlanObject then
EmptyProcedure;
end;
{//02.07.2012
WallComponID := FSCSComponID;
wall_h1 := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
wall_h2 := wall_h1 + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
Corners := GetArchCornersForWall(FSCSCompon);
corner_side1 := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if corner_side1 = 0 then
corner_side1 := wall_h2;
corner_side2 := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if corner_side2 = 0 then
corner_side2 := wall_h2;{}
{$if Defined(ES_GRAPH_SC)} // Tolik 22/08/2018 --
WallComponID := FSCSComponID;
wall_h1 := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
wall_h2 := wall_h1 + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if NetPath = FPlanObject then
begin
Corners := GetArchCornersForWall(FSCSCompon);
corner_side1 := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
corner_side2 := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
end
else
begin
corner_side1 := NetPath.p1H * FScaleDelta;
corner_side2 := NetPath.p2H * FScaleDelta;
end;
if corner_side1 = 0 then
corner_side1 := wall_h2;
if corner_side2 = 0 then
corner_side2 := wall_h2; {}
SetLength(Points, 8);
WallSides := nil;
if GArch3DInnerSidesFromVirtual and (NetPath <> FPlanObject) then
begin
AllDoors := TList.Create;
AllDoors.Assign(NetPath.Doors);
end
else
begin
// âñå äâåðè ñ ó÷åòîì ñìåæíûõ
AllDoors := GetFullDoors;
end;
// åñëè âíóòðè åñòü äâåðè, îêíà ... (àëãîðèòì ïîñòðîåíèÿ ¹1)
if AllDoors.Count > 0 then
begin
// l - âíåøíèå
// r - âíóòðåííèå
// a - âíåøíèå
// b - âíóòðåííèå
//if Not GArch3DInnerSidesFromVirtual then //18.06.2012
begin
//îïðåäåëèòü êàêàÿ äåéñòâèòåëüíî âíóòðåííÿÿ!!!
if PtInPolygon(FParent.FNetConture, NetPath.l1) then
begin
xl1 := NetPath.r1;
xr1 := NetPath.l1;
xl2 := NetPath.r2;
xr2 := NetPath.l2;
oxl1 := NetPath.r1;
oxr1 := NetPath.l1;
oxl2 := NetPath.r2;
oxr2 := NetPath.l2;
end
else
begin
if PtInPolygon(FParent.FNetConture, NetPath.r1) then
begin
xl1 := NetPath.l1;
xr1 := NetPath.r1;
xl2 := NetPath.l2;
xr2 := NetPath.r2;
oxl1 := NetPath.l1;
oxr1 := NetPath.r1;
oxl2 := NetPath.l2;
oxr2 := NetPath.r2;
end
else
begin
xl1 := NetPath.r1;
xr1 := NetPath.l1;
xl2 := NetPath.r2;
xr2 := NetPath.l2;
oxl1 := NetPath.r1;
oxr1 := NetPath.l1;
oxl2 := NetPath.r2;
oxr2 := NetPath.l2;
end
end;
end;
//else
//begin
// xl1 := NetPath.op1^;
// xr1 := NetPath.ip1^;
// xl2 := NetPath.op2^;
// xr2 := NetPath.ip2^;
// oxl1 := NetPath.op1^;
// oxr1 := NetPath.ip1^;
// oxl2 := NetPath.op2^;
// oxr2 := NetPath.ip2^;
//end;
//13.06.2012
//xl1 := NetPath.ip1^;
//xr1 := NetPath.op1^;
//xl2 := NetPath.ip2^;
//xr2 := NetPath.op2^;
//oxl1 := NetPath.ip1^;
//oxr1 := NetPath.op1^;
//oxl2 := NetPath.ip2^;
//oxr2 := NetPath.op2^;
PrevDoor := nil;
PrevDoorSCSCompon := nil;
xPrevWallElement := nil;
for j := 0 to AllDoors.Count - 1 do
begin
aDoor := TNetDoor(AllDoors[j]);
xWallElement := T3DWallElement.Create(aFaces, aDoor, aDoor.DoorObjType, Self);
FWallElements.Add(xWallElement);
DoorSCSCompon := GetArchObjByCADObj(aDoor);
//if Not GArch3DInnerSidesFromVirtual then //18.06.2012
begin
// îïðåäåëèòü ÷àñòü ñòåíû, îò íà÷àëà äî ñëåä. îáüåêòà
if PtInPolygon(FParent.FNetConture, aDoor.b1) then
begin
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.a2);
if len1 < len2 then
begin
da1 := aDoor.a1;
da2 := aDoor.a2;
db1 := aDoor.b1;
db2 := aDoor.b2;
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;
end
else
begin
da1 := aDoor.a2;
da2 := aDoor.a1;
db1 := aDoor.b2;
db2 := aDoor.b1;
ca1 := aDoor.ca2;
ca2 := aDoor.ca1;
cb1 := aDoor.cb2;
cb2 := aDoor.cb1;
end;
end
else
begin
len1 := GetLineLenght(xl1, aDoor.b1);
len2 := GetLineLenght(xl1, aDoor.b2);
if len1 < len2 then
begin
da1 := aDoor.b1;
da2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
ca1 := aDoor.cb1;
ca2 := aDoor.cb2;
cb1 := aDoor.ca1;
cb2 := aDoor.ca2;
end
else
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
ca1 := aDoor.cb2;
ca2 := aDoor.cb1;
cb1 := aDoor.ca2;
cb2 := aDoor.ca1;
end;
end;
end;
//else
//begin
// da1 := aDoor.a1;
// da2 := aDoor.a2;
// db1 := aDoor.b1;
// db2 := aDoor.b2;
//
// ca1 := aDoor.ca1;
// ca2 := aDoor.ca2;
// cb1 := aDoor.cb1;
// cb2 := aDoor.cb2;
//end;
{
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.a2);
lenmina := min(len1, len2);
lenminb := min(GetLineLenght(xl1, aDoor.b1), GetLineLenght(xl1, aDoor.b2));
if lenmina > lenminb then
begin
len1 := GetLineLenght(xl1, aDoor.b1);
len2 := GetLineLenght(xl1, aDoor.b2);
if len1 < len2 then
begin
da1 := aDoor.b1;
da2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;
end
else
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
ca1 := aDoor.ca2;
ca2 := aDoor.ca1;
cb1 := aDoor.cb2;
cb2 := aDoor.cb1;
end;
end
else
begin
if len1 < len2 then
begin
// half work
//da1 := aDoor.a1;
//da2 := aDoor.a2;
//db1 := aDoor.b1;
//db2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
da1 := aDoor.b1;
da2 := aDoor.b2;
ca1 := aDoor.cb1;
ca2 := aDoor.cb2;
cb1 := aDoor.ca1;
cb2 := aDoor.ca2;
end
else
begin
// half work
//da1 := aDoor.a2;
//da2 := aDoor.a1;
//db1 := aDoor.b2;
//db2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
da1 := aDoor.b2;
da2 := aDoor.b1;
ca1 := aDoor.cb2;
ca2 := aDoor.cb1;
cb1 := aDoor.ca2;
cb2 := aDoor.ca1;
end;
end;
//ca1 := aDoor.ca1;
//ca2 := aDoor.ca2;
//cb1 := aDoor.cb1;
//cb2 := aDoor.cb2;
}
// ñêîððåêòèðîâàòü òî÷êè ñòåíû ñ ó÷åòîì îòêîñîâ
hor_a1 := 0;
hor_b1 := 0;
hor_a2 := 0;
hor_b2 := 0;
WallViewType := [wvtNoLeftSide, wvtNoRightSide];
WallType := GetWallTypeByDoorType(aDoor);
if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then
begin
InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Âíóòðåííèé îòêîñ
// Îêíî
if WallType = fwtWindowSlope then
begin
OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Âíåøíèé îòêîñ
// åñòü îêíî è íå ñìåæíàÿ ñòåíà, òî áðàòü âíåøíèå îòêîñû
if (OuterSlope <> nil) then
begin
hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a2 := hor_a1;
ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_a := 0;
depth_a := 0;
end;
if InnerSlope <> nil then
begin
hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_b2 := hor_b1;
ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_b := 0;
depth_b := 0;
end;
end
else
// Äâåðü
if WallType = fwtDoorSlope then
begin
if InnerSlope <> nil then
begin
hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a2 := hor_a1;
hor_b1 := hor_a1;
hor_b2 := hor_a1;
ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
ver_b := ver_a;
depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_a := 0;
ver_b := 0;
depth_a := 0;
depth_b := 0;
end;
end
else
// Áàëêîí
if WallType = fwtBalconSlope then
begin
if InnerSlope <> nil then
begin
BalconDoor := GetChildComponByIsLine(DoorSCSCompon, ctArhDoor); // Äâåðü áàëêîíà
hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a2 := hor_a1;
hor_b1 := hor_a1;
hor_b2 := hor_a1;
ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - BalconDoor.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
ver_b := ver_a;
depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_a := 0;
ver_b := 0;
depth_a := 0;
depth_b := 0;
end;
end;
end;
GetWallPointsWithSlope(da1, da2, db1, db2, hor_a1, hor_a2, hor_b1, hor_b2);
//if PtInPolygon(FParent.FNetConture, FPlanObject.l1) then
//begin
// len1 := depth_a;
// depth_a := depth_b;
// depth_b := len1;
//end;
GetDoorPointsWithSlope(ca1, da1, depth_a);
GetDoorPointsWithSlope(ca2, da2, depth_a);
GetDoorPointsWithSlope(cb1, db1, depth_b);
GetDoorPointsWithSlope(cb2, db2, depth_b);
Points[0] := xl1;
Points[0].z := wall_h1;
Points[1] := da1;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
Points[3] := db1;
Points[3].z := wall_h1;
if IsConture then //13.06.2012
begin
// ïåðâûé áëîê - âçÿòü âûñîòó ñ ìîäïîèíòà
if j = 0 then
begin
Points[4] := xl1;
Points[4].z := corner_side1;
Points[5] := da1;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[6] := xr1;
Points[6].z := corner_side1;
Points[7] := db1;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
end
else
begin
Points[4] := xl1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, xl1, corner_side1, corner_side2);
Points[5] := da1;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[6] := xr1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, xr1, corner_side1, corner_side2);
Points[7] := db1;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
end;
WallViewType := WallViewType + [wvtNoUpper, wvtNoUnder];
WallSides := CollectInnerWall(aFaces, Points, WallViewType);
// ïîñòàâèòü òèï ñòåíû ïî ïðåäûäóùåìó îáüåêòó TNetDoor
if (j > 0) and (PrevDoor <> nil) then
begin
WallType := GetWallTypeByDoorType(PrevDoor);
if WallType in [fwtNiche, fwtArc] then
SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement);
end;
// ïîñòàâèòü òèï ñòåíû ïî ñëåäóþùåìó îáüåêòó TNetDoor
WallType := GetWallTypeByDoorType(aDoor);
if WallType in [fwtNiche, fwtArc] then
SetWallTypeToWallSide(WallSides, wstRightSide, WallType, xWallElement);
end;
//if PtInPolygon(FParent.FNetConture, da2) then
//begin
// xl1 := db2;
// xr1 := da2;
//end
//else
begin
//xl1 := da2;
//xr1 := db2;
xl1 := da2;
xr1 := db2;
end;
// Îáüåêò - Äâåðü
if aDoor.DoorObjType = dotDoor then
begin
door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth);
// ïîñòðîèòü äâåðü
Points[0] := ca1;
Points[0].z := door_h1;
Points[1] := ca2;
Points[1].z := door_h1;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h1;
Points[4] := ca1;
Points[4].z := door_h2;
Points[5] := ca2;
Points[5].z := door_h2;
Points[6] := cb1;
Points[6].z := door_h2;
Points[7] := cb2;
Points[7].z := door_h2;
xWallElement.CollectDoor(aFaces, Points);
if IsConture then //13.06.2012
begin
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
SetWallTypeToWallSide(WallSides, wstUpper, fwtDoorSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2);
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
end;
// ïîñòðîèòü îòêîñû äëÿ äâåðè
if InnerSlope <> nil then
begin
xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement);
xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope);
xSlope.FSCSComponID := xSlope.FSCSCompon.ID;
xSlope.FName := xSlope.FSCSCompon.Name;
xWallElement.FSlopes.Add(xSlope);
// âíåøíèå
Points[0] := da1;
Points[0].z := door_h1;
Points[1] := da1;
Points[1].z := door_h2 + ver_a;
Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := ca1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := da2;
Points[0].z := door_h1;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := ca2;
Points[2].z := door_h1;
Points[3] := ca2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := ca1;
Points[0].z := door_h2;
Points[1] := ca2;
Points[1].z := door_h2;
Points[2] := da1;
Points[2].z := door_h2 + ver_a;
Points[3] := da2;
Points[3].z := door_h2 + ver_a;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
if OuterSlope <> nil then
begin
// âíóòðåííèå
Points[0] := db1;
Points[0].z := door_h1;
Points[1] := db1;
Points[1].z := door_h2 + ver_b;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := db2;
Points[0].z := door_h1;
Points[1] := db2;
Points[1].z := door_h2 + ver_b;
Points[2] := cb2;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := cb1;
Points[0].z := door_h2;
Points[1] := cb2;
Points[1].z := door_h2;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
end;
// Îáüåêò - Îêíî
if aDoor.DoorObjType = dotWindow then
begin
door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth);
// ïîñòðîèòü îêíî
Points[0] := ca1;
Points[0].z := door_h1;
Points[1] := ca2;
Points[1].z := door_h1;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h1;
Points[4] := ca1;
Points[4].z := door_h2;
Points[5] := ca2;
Points[5].z := door_h2;
Points[6] := cb1;
Points[6].z := door_h2;
Points[7] := cb2;
Points[7].z := door_h2;
xWallElement.CollectWindow(aFaces, Points);
if IsConture then //13.06.2012
begin
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
SetWallTypeToWallSide(WallSides, wstUpper, fwtWindowSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2);
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
end;
// ïîñòðîèòü îòêîñû äëÿ îêíà
// âíóòðåííèå
{TODO} // äëÿ âíåøíèõ ñäåëàòü àíàëîãè÷íî è äëÿ âñåõ îñòàëüíûõ îáúåêòîâ!!!
if InnerSlope <> nil then
begin
xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement);
xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope);
xSlope.FSCSComponID := xSlope.FSCSCompon.ID;
xSlope.FName := xSlope.FSCSCompon.Name;
xWallElement.FSlopes.Add(xSlope);
Points[0] := db1;
Points[0].z := door_h1;
Points[1] := db1;
Points[1].z := door_h2 + ver_b;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := db2;
Points[0].z := door_h1;
Points[1] := db2;
Points[1].z := door_h2 + ver_b;
Points[2] := cb2;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := cb1;
Points[0].z := door_h2;
Points[1] := cb2;
Points[1].z := door_h2;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
// âíåøíèå
if OuterSlope <> nil then
begin
xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement);
xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhOuterSlope);
xSlope.FSCSComponID := xSlope.FSCSCompon.ID;
xSlope.FName := xSlope.FSCSCompon.Name;
xWallElement.FSlopes.Add(xSlope);
// end;
Points[0] := da1;
Points[0].z := door_h1;
Points[1] := da1;
Points[1].z := door_h2 + ver_a;
Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := ca1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := da2;
Points[0].z := door_h1;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := ca2;
Points[2].z := door_h1;
Points[3] := ca2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := ca1;
Points[0].z := door_h2;
Points[1] := ca2;
Points[1].z := door_h2;
Points[2] := da1;
Points[2].z := door_h2 + ver_a;
Points[3] := da2;
Points[3].z := door_h2 + ver_a;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
end;
// Îáüåêò - Áàëêîí
if aDoor.DoorObjType = dotBalcony then
begin
BalconDoor := GetChildComponByIsLine(DoorSCSCompon, ctArhDoor); // Äâåðü áàëêîíà
BalconWnd := GetChildComponByIsLine(DoorSCSCompon, ctArhWindow); // Îêíî áàëêîíà
door_h1 := BalconDoor.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
door_h2 := door_h1 + BalconDoor.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
door_w := BalconDoor.GetPropertyValueAsFloat(pnWidth) * FScaleDelta;
wnd_h1 := door_h2 - BalconWnd.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if wnd_h1 < FStartDoorObject then
wnd_h1 := FStartDoorObject;
wnd_h2 := door_h2;
wnd_w := BalconWnd.GetPropertyValueAsFloat(pnWidth) * FScaleDelta;
// âû÷èñëèòü òî÷êè äëÿ äâåðè è îêíà
ba1 := ca1;
ba3 := ca2;
bb1 := cb1;
bb3 := cb2;
//GetParallelPoints(ba1, bb1, ba2, bb2, -door_w);
if PtInPolygon(FParent.FNetConture, NetPath.l1) then
GetParallelPoints(ba1, bb1, ba2, bb2, door_w)
else
GetParallelPoints(ba1, bb1, ba2, bb2, -door_w);
Setlength(Points1, 8);
Setlength(Points2, 8);
// äëÿ áàëêîííîé äâåðè
Points1[0] := ba1;
Points1[0].z := door_h1;
Points1[1] := ba2;
Points1[1].z := door_h1;
Points1[2] := bb1;
Points1[2].z := door_h1;
Points1[3] := bb2;
Points1[3].z := door_h1;
Points1[4] := ba1;
Points1[4].z := door_h2;
Points1[5] := ba2;
Points1[5].z := door_h2;
Points1[6] := bb1;
Points1[6].z := door_h2;
Points1[7] := bb2;
Points1[7].z := door_h2;
// äëÿ áàëêîííîãî îêíà
Points2[0] := ba2;
Points2[0].z := wnd_h1;
Points2[1] := ba3;
Points2[1].z := wnd_h1;
Points2[2] := bb2;
Points2[2].z := wnd_h1;
Points2[3] := bb3;
Points2[3].z := wnd_h1;
Points2[4] := ba2;
Points2[4].z := wnd_h2;
Points2[5] := ba3;
Points2[5].z := wnd_h2;
Points2[6] := bb2;
Points2[6].z := wnd_h2;
Points2[7] := bb3;
Points2[7].z := wnd_h2;
xWallElement.CollectBalcon(aFaces, Points1, Points2);
if IsConture then //13.06.2012
begin
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
SetWallTypeToWallSide(WallSides, wstUpper, fwtBalconSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2);
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
end;
// äîñòðîèòü áëîê ñòåíû â ïðîåì
ba1 := da1;
ba3 := da2;
bb1 := db1;
bb3 := db2;
//GetParallelPoints(ba1, bb1, ba2, bb2, -door_w);
if PtInPolygon(FParent.FNetConture, FPlanObject.l1) then
GetParallelPoints(ba1, bb1, ba2, bb2, door_w)
else
GetParallelPoints(ba1, bb1, ba2, bb2, -door_w);
Points[0] := ba2;
Points[0].z := door_h1;
Points[1] := ba3;
Points[1].z := door_h1;
Points[2] := bb2;
Points[2].z := door_h1;
Points[3] := bb3;
Points[3].z := door_h1;
Points[4] := ba2;
Points[4].z := wnd_h1 - FDoorObjectDelta;
Points[5] := ba3;
Points[5].z := wnd_h1 - FDoorObjectDelta;
Points[6] := bb2;
Points[6].z := wnd_h1 - FDoorObjectDelta;
Points[7] := bb3;
Points[7].z := wnd_h1 - FDoorObjectDelta;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
if Not IsConture then
begin
//13.06.2012 - âíóòðåííèå ìåíÿåì íà âíåøíèå
for k := 0 to WallSides.Count - 1 do
begin
xSide := T3DSide(WallSides[k]);
if xSide.FWallType = fwtInner then
begin
xSide.FWallType := fwtOuter;
xSide.FFace.FFaceWallType := fwtOuter;
end;
end;
end;
SetWallTypeToWallSide(WallSides, wstUpper, fwtBalconSlope, xWallElement);
SetWallTypeToWallSide(WallSides, wstLeftSide, fwtBalconSlope, xWallElement);
// ïîñòðîèòü îòêîñû äëÿ áàëêîíà
if InnerSlope <> nil then
begin
xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement);
xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope);
xSlope.FSCSComponID := xSlope.FSCSCompon.ID;
xSlope.FName := xSlope.FSCSCompon.Name;
xWallElement.FSlopes.Add(xSlope);
// âíåøíèå
Points[0] := da1;
Points[0].z := door_h1;
Points[1] := da1;
Points[1].z := door_h2 + ver_a;
Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := ca1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := da2;
Points[0].z := wnd_h1;
Points[1] := da2;
Points[1].z := wnd_h2 + ver_a;
Points[2] := ca2;
Points[2].z := wnd_h1;
Points[3] := ca2;
Points[3].z := wnd_h2;
xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := ca1;
Points[0].z := door_h2;
Points[1] := ca2;
Points[1].z := door_h2;
Points[2] := da1;
Points[2].z := door_h2 + ver_a;
Points[3] := da2;
Points[3].z := door_h2 + ver_a;
xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
// âíóòðåííèå
if OuterSlope <> nil then
begin
Points[0] := db1;
Points[0].z := door_h1;
Points[1] := db1;
Points[1].z := door_h2 + ver_b;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := db2;
Points[0].z := wnd_h1;
Points[1] := db2;
Points[1].z := wnd_h2 + ver_b;
Points[2] := cb2;
Points[2].z := wnd_h1;
Points[3] := cb2;
Points[3].z := wnd_h2;
xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := cb1;
Points[0].z := door_h2;
Points[1] := cb2;
Points[1].z := door_h2;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
end;
// Îáüåêò - Àðêà
if aDoor.DoorObjType = dotArc then
begin
door_h1 := 0;
door_h2 := DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth);
// ïîñòðîèòü àðêó
//Points[0] := aDoor.a1;
Points[0] := da1;
Points[0].z := door_h1;
//Points[1] := aDoor.b1;
Points[1] := db1;
Points[1].z := door_h1;
//Points[2] := aDoor.a1;
Points[2] := da1;
Points[2].z := door_h2;
//Points[3] := aDoor.b1;
Points[3] := db1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtArc, wstNone, xWallElement, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xWallElement.FSides.Add(xSide);
//Points[0] := aDoor.a2;
Points[0] := da2;
Points[0].z := door_h1;
//Points[1] := aDoor.b2;
Points[1] := db2;
Points[1].z := door_h1;
//Points[2] := aDoor.a2;
Points[2] := da2;
Points[2].z := door_h2;
//Points[3] := aDoor.b2;
Points[3] := db2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtArc, wstNone, xWallElement, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xWallElement.FSides.Add(xSide);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
if IsConture then
begin
//Points[0] := aDoor.a1;
Points[0] := da1;
Points[0].z := door_h2;
//Points[1] := aDoor.a2;
Points[1] := da2;
Points[1].z := door_h2;
//Points[2] := aDoor.b1;
Points[2] := db1;
Points[2].z := door_h2;
//Points[3] := aDoor.b2;
Points[3] := db2;
Points[3].z := door_h2;
//Points[4] := aDoor.a1;
Points[4] := da1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
//Points[5] := aDoor.a2;
Points[5] := da2;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2);
//Points[6] := aDoor.b1;
Points[6] := db1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
//Points[7] := aDoor.b2;
Points[7] := db2;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2);
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoLeftSide, wvtNoRightSide]);
SetWallTypeToWallSide(WallSides, wstUnder, fwtArc, xWallElement);
end;
end;
// Îáüåêò - Íèøà
if aDoor.DoorObjType = dotNiche then
begin
door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth);
depth := DoorSCSCompon.GetPropertyValueAsFloat(pnDepth);
// ïîñòðîèòü íèøó
Points[0] := aDoor.b1;
//Points[0] := db1;
Points[0].z := door_h1;
Points[1] := aDoor.ca1;
//Points[1] := ca1;
Points[1].z := door_h1;
Points[2] := aDoor.b1;
//Points[2] := db1;
Points[2].z := door_h2;
Points[3] := aDoor.ca1;
//Points[3] := ca1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtNiche, wstNone, xWallElement);
xSide.CollectWallSide(aFaces, Points);
xWallElement.FSides.Add(xSide);
Points[0] := aDoor.b2;
//Points[0] := db2;
Points[0].z := door_h1;
Points[1] := aDoor.ca2;
//Points[1] := ca2;
Points[1].z := door_h1;
Points[2] := aDoor.b2;
//Points[2] := db2;
Points[2].z := door_h2;
Points[3] := aDoor.ca2;
//Points[3] := ca2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtNiche, wstNone, xWallElement);
xSide.CollectWallSide(aFaces, Points);
xWallElement.FSides.Add(xSide);
Points[0] := aDoor.b1;
//Points[0] := db1;
Points[0].z := door_h1;
Points[1] := aDoor.b2;
//Points[1] := db2;
Points[1].z := door_h1;
Points[2] := aDoor.ca1;
//Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := aDoor.ca2;
//Points[3] := ca2;
Points[3].z := door_h1;
xSide := T3DSide.Create(ftNetPath, fwtNiche, wstNone, xWallElement);
xSide.CollectWallSide(aFaces, Points);
xWallElement.FSides.Add(xSide);
Points[0] := aDoor.b1;
//Points[0] := db1;
Points[0].z := door_h2;
Points[1] := aDoor.b2;
//Points[1] := db2;
Points[1].z := door_h2;
Points[2] := aDoor.ca1;
//Points[2] := ca1;
Points[2].z := door_h2;
Points[3] := aDoor.ca2;
//Points[3] := ca2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtNiche, wstNone, xWallElement);
xSide.CollectWallSide(aFaces, Points);
xWallElement.FSides.Add(xSide);
// äîñòðîèòü áëîê ñòåíû îò íèøû
Points[0] := aDoor.a1;
//Points[0] := da1;
Points[0].z := door_h1;
Points[1] := aDoor.a2;
//Points[1] := da2;
Points[1].z := door_h1;
Points[2] := aDoor.ca1;
//Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := aDoor.ca2;
//Points[3] := ca2;
Points[3].z := door_h1;
Points[4] := aDoor.a1;
//Points[4] := da1;
Points[4].z := door_h2;
Points[5] := aDoor.a2;
//Points[5] := da2;
Points[5].z := door_h2;
Points[6] := aDoor.ca1;
//Points[6] := ca1;
Points[6].z := door_h2;
Points[7] := aDoor.ca2;
//Points[7] := ca2;
Points[7].z := door_h2;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide], True);
SetWallTypeToWallSide(WallSides, wstRight, fwtNiche, xWallElement);
if IsConture then //13.06.2012
begin
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := aDoor.a1;
//Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := aDoor.a2;
//Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := aDoor.b1;
//Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := aDoor.b2;
//Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := aDoor.a1;
//Points[4] := da1;
Points[4].z := door_h1;
Points[5] := aDoor.a2;
//Points[5] := da2;
Points[5].z := door_h1;
Points[6] := aDoor.b1;
//Points[6] := db1;
Points[6].z := door_h1;
Points[7] := aDoor.b2;
//Points[7] := db2;
Points[7].z := door_h1;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
SetWallTypeToWallSide(WallSides, wstUpper, fwtNiche, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := aDoor.a1;
//Points[0] := da1;
Points[0].z := door_h2;
Points[1] := aDoor.a2;
//Points[1] := da2;
Points[1].z := door_h2;
Points[2] := aDoor.b1;
//Points[2] := db1;
Points[2].z := door_h2;
Points[3] := aDoor.b2;
//Points[3] := db2;
Points[3].z := door_h2;
Points[4] := aDoor.a1;
//Points[4] := da1;
{TODO} // ãëÿíóòü òàê ëè çäåñü âûñîòû äîëæíû îïðåäåëÿòüñÿ!!!
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[5] := aDoor.a2;
//Points[5] := da2;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2);
Points[6] := aDoor.b1;
//Points[6] := db1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
Points[7] := aDoor.b2;
//Points[7] := db2;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2);
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
SetWallTypeToWallSide(WallSides, wstUnder, fwtNiche, xWallElement);
end;
end;
PrevDoor := aDoor;
PrevDoorSCSCompon := DoorSCSCompon;
xPrevWallElement := xWallElement;
end;
WallViewType := [wvtNoLeftSide, wvtNoRightSide];
WallType := fwtNone;
if PrevDoor <> nil then
WallType := GetWallTypeByDoorType(PrevDoor);
if IsConture then //13.06.2012
begin
Points[0] := xl1;
Points[0].z := wall_h1;
Points[1] := xl2;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
Points[3] := xr2;
Points[3].z := wall_h1;
Points[4] := xl1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, xl1, corner_side1, corner_side2);
Points[5] := xl2;
Points[5].z := corner_side2;
Points[6] := xr1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, xr1, corner_side1, corner_side2);
Points[7] := xr2;
Points[7].z := corner_side2;
WallViewType := WallViewType + [wvtNoUpper, wvtNoUnder, wvtNoRightSide];
WallSides := CollectInnerWall(aFaces, Points, WallViewType);
// ïîñòàâèòü òèï ñòåíû ïî ñëåäóþùåìó îáüåêòó TNetDoor
if WallType in [fwtNiche, fwtArc] then
SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement);
end;
end
else
// åñëè âíóòðè íè÷åãî íåò (àëãîðèòì ïîñòðîåíèÿ ¹2)
begin
if IsConture then //13.06.2012
begin
{//08.06.2012 s
Points[0] := NetPath.l1;
Points[0].z := wall_h1;
Points[1] := NetPath.l2;
Points[1].z := wall_h1;
Points[2] := NetPath.r1;
Points[2].z := wall_h1;
Points[3] := NetPath.r2;
Points[3].z := wall_h1;
Points[4] := NetPath.l1;
Points[4].z := corner_side1;
Points[5] := NetPath.l2;
Points[5].z := corner_side2;
Points[6] := NetPath.r1;
Points[6].z := corner_side1;
Points[7] := NetPath.r2;
Points[7].z := corner_side2;}
if GArch3DInnerSidesFromVirtual then
begin
{if NetPath.FIsInner then
begin
Points[0] := NetPath.op1^;
Points[1] := NetPath.op2^;
Points[4] := NetPath.op1^;
Points[5] := NetPath.op2^;
end
else
begin
Points[0] := NetPath.ip1^;
Points[1] := NetPath.ip2^;
Points[4] := NetPath.ip1^;
Points[5] := NetPath.ip2^;
end;}
Points[0] := NetPath.op1^;
Points[1] := NetPath.op2^;
Points[4] := NetPath.op1^;
Points[5] := NetPath.op2^;
Points[2] := NetPath.ip1^;
Points[3] := NetPath.ip2^;
Points[6] := NetPath.ip1^;
Points[7] := NetPath.ip2^;
end
else
begin
Points[0] := NetPath.l1;
Points[1] := NetPath.l2;
Points[2] := NetPath.r1;
Points[3] := NetPath.r2;
Points[4] := NetPath.l1;
Points[5] := NetPath.l2;
Points[6] := NetPath.r1;
Points[7] := NetPath.r2;
end;
Points[0].z := wall_h1;
Points[1].z := wall_h1;
Points[2].z := wall_h1;
Points[3].z := wall_h1;
Points[4].z := corner_side1;
Points[5].z := corner_side2;
Points[6].z := corner_side1;
Points[7].z := corner_side2;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
end;
end;
{$else} //Tolik 22/08/2018 -- ýòî äëÿ ÑÊÑ !!!
WallComponID := FSCSComponID;
wall_h1 := 0;
Wall_h2 := 0;
corner_side1 := -1;
corner_side2 := -1;
if NetPath <> nil then
begin
if ((NetPath.p1H < 0) or (NetPath.p2H < 0)) then
//Tolik 25/08/2021 -- FScaleDeltaSCS
{
Wall_h2 := Get3DWallHeight * FScaleDelta
else
wall_h2 := Max(NetPath.p1H, NetPath.p2H) * FScaleDelta;
if NetPath.p1H >= 0 then
corner_side1 := NetPath.p1H * FScaleDelta;
if NetPath.p2H >= 0 then
corner_side2 := NetPath.p2H * FScaleDelta;
end;
if Wall_h2 = 0 then
wall_h2 := Get3DWallHeight * FScaleDelta;
}
Wall_h2 := Get3DWallHeight * FScaleDeltaSCS
else
wall_h2 := Max(NetPath.p1H, NetPath.p2H) * FScaleDeltaSCS;
if NetPath.p1H >= 0 then
corner_side1 := NetPath.p1H * FScaleDeltaSCS;
if NetPath.p2H >= 0 then
corner_side2 := NetPath.p2H * FScaleDeltaSCS;
end;
if Wall_h2 = 0 then
wall_h2 := Get3DWallHeight * FScaleDeltaSCS;
//
if corner_side1 = -1 then
corner_side1 := wall_h2;
if corner_side2 = -1 then
corner_side2 := wall_h2;
{corner_side1 := Get3DWallHeight * FScaleDelta;
corner_side2 := Get3DWallHeight * FScaleDelta;}
SetLength(Points, 8);
WallSides := nil;
//if GArch3DInnerSidesFromVirtual and (NetPath <> FPlanObject) then
//begin
AllDoors := TList.Create;
AllDoors.Assign(NetPath.Doors);
//end
//else
//begin
// âñå äâåðè ñ ó÷åòîì ñìåæíûõ
// AllDoors := GetFullDoors;
//end;
// åñëè âíóòðè åñòü äâåðè, îêíà ... (àëãîðèòì ïîñòðîåíèÿ ¹1)
if AllDoors.Count > 0 then
begin
// l - âíåøíèå
// r - âíóòðåííèå
// a - âíåøíèå
// b - âíóòðåííèå
//if Not GArch3DInnerSidesFromVirtual then //18.06.2012
begin
//îïðåäåëèòü êàêàÿ äåéñòâèòåëüíî âíóòðåííÿÿ!!!
if PtInPolygon(FParent.FNetConture, NetPath.l1) then
begin
xl1 := NetPath.r1;
xr1 := NetPath.l1;
xl2 := NetPath.r2;
xr2 := NetPath.l2;
oxl1 := NetPath.r1;
oxr1 := NetPath.l1;
oxl2 := NetPath.r2;
oxr2 := NetPath.l2;
end
else
begin
if PtInPolygon(FParent.FNetConture, NetPath.r1) then
begin
xl1 := NetPath.l1;
xr1 := NetPath.r1;
xl2 := NetPath.l2;
xr2 := NetPath.r2;
oxl1 := NetPath.l1;
oxr1 := NetPath.r1;
oxl2 := NetPath.l2;
oxr2 := NetPath.r2;
end
else
begin
xl1 := NetPath.r1;
xr1 := NetPath.l1;
xl2 := NetPath.r2;
xr2 := NetPath.l2;
oxl1 := NetPath.r1;
oxr1 := NetPath.l1;
oxl2 := NetPath.r2;
oxr2 := NetPath.l2;
end
end;
end;
PrevDoor := nil;
PrevDoorSCSCompon := nil;
xPrevWallElement := nil;
for j := 0 to AllDoors.Count - 1 do
begin
aDoor := TNetDoor(AllDoors[j]);
xWallElement := T3DWallElement.Create(aFaces, aDoor, aDoor.DoorObjType, Self);
FWallElements.Add(xWallElement);
//DoorSCSCompon := GetArchObjByCADObj(aDoor);
//if Not GArch3DInnerSidesFromVirtual then //18.06.2012
begin
// îïðåäåëèòü ÷àñòü ñòåíû, îò íà÷àëà äî ñëåä. îáüåêòà
if PtInPolygon(FParent.FNetConture, aDoor.b1) then
begin
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.a2);
if len1 < len2 then
begin
da1 := aDoor.a1;
da2 := aDoor.a2;
db1 := aDoor.b1;
db2 := aDoor.b2;
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;
end
else
begin
da1 := aDoor.a2;
da2 := aDoor.a1;
db1 := aDoor.b2;
db2 := aDoor.b1;
ca1 := aDoor.ca2;
ca2 := aDoor.ca1;
cb1 := aDoor.cb2;
cb2 := aDoor.cb1;
end;
end
else
begin
len1 := GetLineLenght(xl1, aDoor.b1);
len2 := GetLineLenght(xl1, aDoor.b2);
if len1 < len2 then
begin
da1 := aDoor.b1;
da2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
ca1 := aDoor.cb1;
ca2 := aDoor.cb2;
cb1 := aDoor.ca1;
cb2 := aDoor.ca2;
end
else
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
ca1 := aDoor.cb2;
ca2 := aDoor.cb1;
cb1 := aDoor.ca2;
cb2 := aDoor.ca1;
end;
end;
end;
// ñêîððåêòèðîâàòü òî÷êè ñòåíû ñ ó÷åòîì îòêîñîâ
hor_a1 := 0;
hor_b1 := 0;
hor_a2 := 0;
hor_b2 := 0;
WallViewType := [wvtNoLeftSide, wvtNoRightSide];
WallType := GetWallTypeByDoorType(aDoor);
if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then
begin
//InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Âíóòðåííèé îòêîñ
InnerSlope := nil;
// Îêíî
if WallType = fwtWindowSlope then
begin
//OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Âíåøíèé îòêîñ
OuterSlope := nil;
// åñòü îêíî è íå ñìåæíàÿ ñòåíà, òî áðàòü âíåøíèå îòêîñû
if (OuterSlope <> nil) then
begin
//Tolik 25/08/2021 --
//hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDeltaSCS / 2;
//
hor_a2 := hor_a1;
//Tolik 25/08/2021 --
//ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDeltaSCS;
//depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDeltaSCS;
//
end
else
begin
ver_a := 0;
depth_a := 1;
end;
if InnerSlope <> nil then
begin
//Tolik 25/08/2021 --
//hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDeltaSCS / 2;
//
hor_b2 := hor_b1;
//
//ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDeltaSCS;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
//depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDeltaSCS;
//
end
else
begin
ver_b := 0;
depth_b := 1;
end;
end
else
// Äâåðü
if WallType = fwtDoorSlope then
begin
if InnerSlope <> nil then
begin
//Tolik 25/08/2021
//hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDeltaSCS / 2;
//
hor_a2 := hor_a1;
hor_b1 := hor_a1;
hor_b2 := hor_a1;
//ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDeltaSCS;
ver_b := ver_a;
depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
{depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDeltaSCS;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDeltaSCS;}
end
else
begin
ver_a := 0;
ver_b := 0;
depth_a := 1;
depth_b := 1;
end;
end
end;
GetWallPointsWithSlope(da1, da2, db1, db2, hor_a1, hor_a2, hor_b1, hor_b2);
//if PtInPolygon(FParent.FNetConture, FPlanObject.l1) then
//begin
// len1 := depth_a;
// depth_a := depth_b;
// depth_b := len1;
//end;
GetDoorPointsWithSlope(ca1, da1, depth_a);
GetDoorPointsWithSlope(ca2, da2, depth_a);
GetDoorPointsWithSlope(cb1, db1, depth_b);
GetDoorPointsWithSlope(cb2, db2, depth_b);
Points[0] := xl1;
Points[0].z := wall_h1;
Points[1] := da1;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
Points[3] := db1;
Points[3].z := wall_h1;
if IsConture then //13.06.2012
begin
// ïåðâûé áëîê - âçÿòü âûñîòó ñ ìîäïîèíòà
if j = 0 then
begin
Points[4] := xl1;
Points[4].z := corner_side1;
Points[5] := da1;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[6] := xr1;
Points[6].z := corner_side1;
Points[7] := db1;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
end
else
begin
Points[4] := xl1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, xl1, corner_side1, corner_side2);
Points[5] := da1;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[6] := xr1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, xr1, corner_side1, corner_side2);
Points[7] := db1;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
end;
WallViewType := WallViewType + [wvtNoUpper, wvtNoUnder];
WallSides := CollectInnerWall(aFaces, Points, WallViewType);
// ïîñòàâèòü òèï ñòåíû ïî ïðåäûäóùåìó îáüåêòó TNetDoor
if (j > 0) and (PrevDoor <> nil) then
begin
WallType := GetWallTypeByDoorType(PrevDoor);
if WallType in [fwtNiche, fwtArc] then
SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement);
end;
// ïîñòàâèòü òèï ñòåíû ïî ñëåäóþùåìó îáüåêòó TNetDoor
WallType := GetWallTypeByDoorType(aDoor);
if WallType in [fwtNiche, fwtArc] then
SetWallTypeToWallSide(WallSides, wstRightSide, WallType, xWallElement);
end;
//if PtInPolygon(FParent.FNetConture, da2) then
//begin
// xl1 := db2;
// xr1 := da2;
//end
//else
begin
//xl1 := da2;
//xr1 := db2;
xl1 := da2;
xr1 := db2;
end;
// Îáüåêò - Äâåðü
if aDoor.DoorObjType = dotDoor then
begin
//door_h1 := aDoor.WndPlacementHeight * FScaleDelta;
door_h1 := aDoor.WndPlacementHeight * FScaleDeltaSCS;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
//door_h2 := door_h1 + aDoor.Height * FScaleDelta; //door_h1 + GetDoorHeightfor3DModel * FScaleDelta;
door_h2 := door_h1 + aDoor.Height * FScaleDeltaSCS; //door_h1 + GetDoorHeightfor3DModel * FScaleDelta;
w := aDoor.Width * FScaleDelta / 2;
//w := aDoor.Width * FScaleDeltaSCS / 2;
OuterSlope := Nil;
InnerSlope := Nil;
// ïîñòðîèòü äâåðü
Points[0] := ca1;
Points[0].z := door_h1;
Points[1] := ca2;
Points[1].z := door_h1;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h1;
Points[4] := ca1;
Points[4].z := door_h2;
Points[5] := ca2;
Points[5].z := door_h2;
Points[6] := cb1;
Points[6].z := door_h2;
Points[7] := cb2;
Points[7].z := door_h2;
xWallElement.CollectDoor(aFaces, Points);
if IsConture then //13.06.2012
begin
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
SetWallTypeToWallSide(WallSides, wstUpper, fwtDoorSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2);
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
end;
{
// ïîñòðîèòü îòêîñû äëÿ äâåðè
if InnerSlope <> nil then
begin
xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement);
xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope);
xSlope.FSCSComponID := xSlope.FSCSCompon.ID;
xSlope.FName := xSlope.FSCSCompon.Name;
xWallElement.FSlopes.Add(xSlope);
// âíåøíèå
Points[0] := da1;
Points[0].z := door_h1;
Points[1] := da1;
Points[1].z := door_h2 + ver_a;
Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := ca1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := da2;
Points[0].z := door_h1;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := ca2;
Points[2].z := door_h1;
Points[3] := ca2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := ca1;
Points[0].z := door_h2;
Points[1] := ca2;
Points[1].z := door_h2;
Points[2] := da1;
Points[2].z := door_h2 + ver_a;
Points[3] := da2;
Points[3].z := door_h2 + ver_a;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
if OuterSlope <> nil then
begin
// âíóòðåííèå
Points[0] := db1;
Points[0].z := door_h1;
Points[1] := db1;
Points[1].z := door_h2 + ver_b;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := db2;
Points[0].z := door_h1;
Points[1] := db2;
Points[1].z := door_h2 + ver_b;
Points[2] := cb2;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := cb1;
Points[0].z := door_h2;
Points[1] := cb2;
Points[1].z := door_h2;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end; }
// ïîñòðîèòü îòêîñû äëÿ äâåðè
//if InnerSlope <> nil then
begin
xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement);
xWallElement.FSlopes.Add(xSlope);
// âíåøíèå
Points[0] := da1;
Points[0].z := door_h1;
Points[1] := da1;
Points[1].z := door_h2 + ver_a;
Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := ca1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := da2;
Points[0].z := door_h1;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := ca2;
Points[2].z := door_h1;
Points[3] := ca2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := ca1;
Points[0].z := door_h2;
Points[1] := ca2;
Points[1].z := door_h2;
Points[2] := da1;
Points[2].z := door_h2 + ver_a;
Points[3] := da2;
Points[3].z := door_h2 + ver_a;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
//if OuterSlope <> nil then
begin
// âíóòðåííèå
Points[0] := db1;
Points[0].z := door_h1;
Points[1] := db1;
Points[1].z := door_h2 + ver_b;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := db2;
Points[0].z := door_h1;
Points[1] := db2;
Points[1].z := door_h2 + ver_b;
Points[2] := cb2;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := cb1;
Points[0].z := door_h2;
Points[1] := cb2;
Points[1].z := door_h2;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
end;
// Îáüåêò - Îêíî
if aDoor.DoorObjType = dotWindow then
begin
//door_h1 := aDoor.WndPlacementHeight * FScaleDelta; //0.7 * FScaleDelta;
door_h1 := aDoor.WndPlacementHeight * FScaleDeltaSCS; //0.7 * FScaleDelta;door_h1 := aDoor.WndPlacementHeight * FScaleDelta; //0.7 * FScaleDelta;
{if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;}
//door_h2 := door_h1 + aDoor.Height * FScaleDelta;//GetWndHeightFor3DModel * FScaleDelta;
door_h2 := door_h1 + aDoor.Height * FScaleDeltaSCS;//GetWndHeightFor3DModel * FScaleDelta;
w := aDoor.Width * FScaleDelta / 2;
// ïîñòðîèòü îêíî
Points[0] := ca1;
Points[0].z := door_h1;
Points[1] := ca2;
Points[1].z := door_h1;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h1;
Points[4] := ca1;
Points[4].z := door_h2;
Points[5] := ca2;
Points[5].z := door_h2;
Points[6] := cb1;
Points[6].z := door_h2;
Points[7] := cb2;
Points[7].z := door_h2;
xWallElement.CollectWindow(aFaces, Points);
if IsConture then //13.06.2012
begin
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
SetWallTypeToWallSide(WallSides, wstUpper, fwtWindowSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2);
Points[5] := da2;
Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2);
Points[6] := db1;
Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2);
Points[7] := db2;
Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2);
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
end;
// ïîñòðîèòü îòêîñû äëÿ îêíà
// âíóòðåííèå
{TODO} // äëÿ âíåøíèõ ñäåëàòü àíàëîãè÷íî è äëÿ âñåõ îñòàëüíûõ îáúåêòîâ!!!
//if InnerSlope <> nil then
begin
xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement);
//xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope);
//xSlope.FSCSComponID := xSlope.FSCSCompon.ID;
//xSlope.FName := xSlope.FSCSCompon.Name;
xSlope.FSCSCompon := nil;
xSlope.FSCSComponID := 0;
xSlope.FName := 'xSlope';
xWallElement.FSlopes.Add(xSlope);
Points[0] := db1;
Points[0].z := door_h1;
Points[1] := db1;
Points[1].z := door_h2 + ver_b;
Points[2] := cb1;
Points[2].z := door_h1;
Points[3] := cb1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := db2;
Points[0].z := door_h1;
Points[1] := db2;
Points[1].z := door_h2 + ver_b;
Points[2] := cb2;
Points[2].z := door_h1;
Points[3] := cb2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := cb1;
Points[0].z := door_h2;
Points[1] := cb2;
Points[1].z := door_h2;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
// âíåøíèå
//if OuterSlope <> nil then
begin
xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement);
xSlope.FSCSCompon := nil;
xSlope.FSCSComponID := 0;
xSlope.FName := 'xSlope';
//xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhOuterSlope);
//xSlope.FSCSComponID := xSlope.FSCSCompon.ID;
//xSlope.FName := xSlope.FSCSCompon.Name;
xWallElement.FSlopes.Add(xSlope);
// end;
Points[0] := da1;
Points[0].z := door_h1;
Points[1] := da1;
Points[1].z := door_h2 + ver_a;
Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := ca1;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := da2;
Points[0].z := door_h1;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := ca2;
Points[2].z := door_h1;
Points[3] := ca2;
Points[3].z := door_h2;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
Points[0] := ca1;
Points[0].z := door_h2;
Points[1] := ca2;
Points[1].z := door_h2;
Points[2] := da1;
Points[2].z := door_h2 + ver_a;
Points[3] := da2;
Points[3].z := door_h2 + ver_a;
xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject);
xSide.CollectWallSide(aFaces, Points);
xSlope.FSides.Add(xSide);
end;
end;
PrevDoor := aDoor;
PrevDoorSCSCompon := DoorSCSCompon;
xPrevWallElement := xWallElement;
end;
WallViewType := [wvtNoLeftSide, wvtNoRightSide];
WallType := fwtNone;
if PrevDoor <> nil then
WallType := GetWallTypeByDoorType(PrevDoor);
if IsConture then //13.06.2012
begin
Points[0] := xl1;
Points[0].z := wall_h1;
Points[1] := xl2;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
Points[3] := xr2;
Points[3].z := wall_h1;
Points[4] := xl1;
//Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oxl1, oxl2, xl1, corner_side1, corner_side2);
Points[5] := xl2;
Points[5].z := corner_side2;
Points[6] := xr1;
//Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oxr1, oxr2, xr1, corner_side1, corner_side2);
Points[7] := xr2;
Points[7].z := corner_side2;
WallViewType := WallViewType + [wvtNoUpper, wvtNoUnder, wvtNoRightSide];
WallSides := CollectInnerWall(aFaces, Points, WallViewType);
// ïîñòàâèòü òèï ñòåíû ïî ñëåäóþùåìó îáüåêòó TNetDoor
if WallType in [fwtNiche, fwtArc] then
SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement);
end;
end
else
// åñëè âíóòðè íè÷åãî íåò (àëãîðèòì ïîñòðîåíèÿ ¹2)
begin
if IsConture then //13.06.2012
begin
if GArch3DInnerSidesFromVirtual then
begin
Points[0] := NetPath.op1^;
Points[1] := NetPath.op2^;
Points[4] := NetPath.op1^;
Points[5] := NetPath.op2^;
Points[2] := NetPath.ip1^;
Points[3] := NetPath.ip2^;
Points[6] := NetPath.ip1^;
Points[7] := NetPath.ip2^;
end
else
begin
Points[0] := NetPath.l1;
Points[1] := NetPath.l2;
Points[2] := NetPath.r1;
Points[3] := NetPath.r2;
Points[4] := NetPath.l1;
Points[5] := NetPath.l2;
Points[6] := NetPath.r1;
Points[7] := NetPath.r2;
end;
Points[0].z := wall_h1;
Points[1].z := wall_h1;
Points[2].z := wall_h1;
Points[3].z := wall_h1;
Points[4].z := corner_side1;
Points[5].z := corner_side2;
Points[6].z := corner_side1;
Points[7].z := corner_side2;
WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]);
end;
end;
{$ifEnd}
if WallSides <> nil then
FreeAndNil(WallSides);
except
on E: Exception do AddExceptionToLogEx('T3DWall.ParseWallForInner', E.Message);
end;
end;
procedure T3DWall.ParseWallForOuter(aFaces: TList; aVNetPath: TNetPath);
var
aDoor, PrevDoor: TNetDoor;
i, j, k: integer;
WallComponID: Integer;
l1, l2, r1, r2, p1, p2: TDoublePoint;
DoorSCSCompon, PrevDoorSCSCompon, BalconDoor, BalconWnd, InnerSlope, OuterSlope: TSCSComponent;
wall_h1, wall_h2, door_h1, door_h2, wnd_h1, wnd_h2, w, door_w, wnd_w, corner_side1, corner_side2: double;
Points, Points1, Points2: T3DPointArray;
oip1, oop1, oip2, oop2, xip2, xop2, xl2, xr2, xl1, xr1, da1, da2, db1, db2: TDoublePoint;
ba1, ba2, ba3, bb1, bb2, bb3: TDoublePoint;
ca1, ca2, cb1, cb2: TDoublePoint;
AllDoors, WallSides: TList;
len1, len2: double;
hor_a1, hor_a2, hor_b1, hor_b2, ver_a, ver_b, depth, depth_a, depth_b: double;
WallType: TFaceWallType;
WallViewType: TWallViewType;
xWallElement, xPrevWallElement: T3DWallElement;
xSlope: T3DSlope;
xSide: T3DSide;
Corners, Corners1: TSCSComponents;
knot1, knot2, KnotFlag, SideFlag: byte;
p1h, p2h: Double;
tmppoint: TDoublePoint;
lenminb: Double;
lenmina: Double;
aVNetPathP1, aVNetPathP2: TDoublePoint; //05.06.2012
NetPath: TNetPath;
PathIsNoConture: Boolean; //22.06.2012 - ÿâëÿåòñÿ ëè õîòü ñ îäíîé ñòîðîíû íå êîíòóðîì (ðàçîðâàíûì)
{ function checkisCrossPoint: Boolean;
begin
Result := not ((((CompareValue(FPlanObject.p1.x, aVNetPath.p1.x) = 0) and
(CompareValue(FPlanObject.p1.y, aVNetPath.p1.y) = 0)) and
((CompareValue(FPlanObject.p2.x, aVNetPath.p2.x) = 0) and
(CompareValue(FPlanObject.p2.y, aVNetPath.p2.y) = 0))) or
(((CompareValue(FPlanObject.p1.x, aVNetPath.p2.x) = 0) and
(CompareValue(FPlanObject.p1.y, aVNetPath.p2.y) = 0)) and
((CompareValue(FPlanObject.p2.x, aVNetPath.p1.x) = 0) and
(CompareValue(FPlanObject.p2.y, aVNetPath.p1.y) = 0))));
if Result then
Result := (((CompareValue(FPlanObject.p1.x, aVNetPath.p1.x) = 0) and
(CompareValue(FPlanObject.p1.y, aVNetPath.p1.y) = 0)) or
((CompareValue(FPlanObject.p1.x, aVNetPath.p2.x) = 0) and
(CompareValue(FPlanObject.p1.y, aVNetPath.p2.y) = 0)) or
((CompareValue(FPlanObject.p2.x, aVNetPath.p1.x) = 0) and
(CompareValue(FPlanObject.p2.y, aVNetPath.p1.y) = 0)) or
((CompareValue(FPlanObject.p2.x, aVNetPath.p2.x) = 0) and
(CompareValue(FPlanObject.p2.y, aVNetPath.p2.y) = 0)));
end; }
begin
try
//Tolik 23/12/2021 -- èñêëþ÷àåì ñàñ ñ ñîáîé è òå, ÷òî íå êàñàþòñÿ
{ if FPlanObject.id = aVNetPath.Id then
exit;
if not checkisCrossPoint then
exit;
}
//
WallComponID := FSCSComponID;
NetPath := FPlanObject;
if GArch3DInnerSidesFromVirtual then
NetPath := aVNetPath;
PathIsNoConture := Not NetPath.FIsConture;
if GArch3DInnerSidesFromVirtual then
begin
NetPath := aVNetPath;
for i := 0 to aVNetPath.FSrcPaths.Count - 1 do
begin
if Not TNetPath(aVNetPath.FSrcPaths[i]).FIsConture then
begin
PathIsNoConture := true;
Break; //// BREAK ////
end;
end;
end;
xWallElement := nil;
aVNetPathP1 := {Mpoint(aVNetPath.er1, aVNetPath.el1); //} aVNetPath.p1^;
aVNetPathP2 := {Mpoint(aVNetPath.er2, aVNetPath.el2); //} aVNetPath.p2^;
{$if Defined(ES_GRAPH_SC)}
wall_h1 := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
wall_h2 := wall_h1 + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
Corners := GetArchCornersForWall(FSCSCompon);
// Tolik -- 17/10/2016-- óãîëêîâ ìîæåò è íå áûòü ....
if Corners.Count > 0 then
begin
corner_side1 := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if corner_side1 = 0 then
corner_side1 := wall_h2;
corner_side2 := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if corner_side2 = 0 then
corner_side2 := wall_h2;
// correct ***
p1h := aVNetPath.p1H;
p2h := aVNetPath.p2H;
corner_side1 := p1h * FScaleDelta;
if corner_side1 = 0 then
corner_side1 := wall_h2;
corner_side2 := p2h * FScaleDelta;
if corner_side2 = 0 then
corner_side2 := wall_h2;
// correct ***
SetLength(Points, 12);
WallSides := nil;
// âñå äâåðè ñ ó÷åòîì ñìåæíûõ
AllDoors := aVNetPath.Doors; //GetFullDoors;
// åñëè âíóòðè åñòü äâåðè, îêíà ... (àëãîðèòì ïîñòðîåíèÿ ¹1)
if AllDoors.Count > 0 then
begin
// l - âíåøíèå
// r - âíóòðåííèå
// a - âíåøíèå
// b - âíóòðåííèå
// oop oip èçíà÷àëüíûå îðèãèíàëüíûå ïðàâèëüíî îïðåäåëåííûå!
// xop xip - â ñëó÷àå íåîáõîäèìîñòè ìîãóò âíóòðè öèêëà åùå ïåðåîïðåäåëÿòüñÿ!
if {NetPath.FIsConture} Not PathIsNoConture then
//if NetPath.FIsConture and Not GArch3DInnerSidesFromVirtual then
begin
//xl1 := aVNetPath.op1^;
//xr1 := aVNetPath.ip1^
if Not (PtInPolygon(FParent.FNetConture, aVNetPath.op1^)
{or IsPtInArray(aVNetPath.op1^, @FParent.FNetConture)}) then
begin
xl1 := aVNetPath.op1^;
xr1 := aVNetPath.ip1^;
end
else
begin
xl1 := aVNetPath.ip1^;
xr1 := aVNetPath.op1^
end;
//xl2 := aVNetPath.op2^;
//xr2 := aVNetPath.ip2^;
if Not (PtInPolygon(FParent.FNetConture, aVNetPath.op2^)
{or IsPtInArray(aVNetPath.op2^, @FParent.FNetConture)}) then
begin
xl2 := aVNetPath.op2^;
xr2 := aVNetPath.ip2^;
end
else
begin
xl2 := aVNetPath.ip2^;
xr2 := aVNetPath.op2^;
end;
end
else
begin
//xl1 := aVNetPath.ip1^;
//xl2 := aVNetPath.ip2^;
//xr1 := aVNetPath.op1^;
//xr2 := aVNetPath.op2^;
// Ñîîòâåòñòâèå òî÷êàì, åñëè áåç äâåðåé, îêîí, è ò.ä
// 0 xl1 op1
// 1 xop2 op2
// 2 xr1 ip1
// 3 xip2 ip2
// 4 xl1 op1
// 5 xop2 op2
// 6 xr1 ip1
// 7 xip2 ip2
//xl1 := aVNetPath.op1^;
//xr1 := aVNetPath.ip1^;
// Íà âñÿêèé ñëó÷àé
//xl2 := aVNetPath.op2^;
//xr2 := aVNetPath.ip2^;
//13.06.2012
//xl1 := aVNetPath.ip1^;
//xr1 := aVNetPath.op1^;
//// Íà âñÿêèé ñëó÷àé
//xl2 := aVNetPath.ip2^;
//xr2 := aVNetPath.op2^;
//13.06.2012 --------------------------------
xl1 := aVNetPath.op1^;
xr1 := aVNetPath.ip1^;
// Íà âñÿêèé ñëó÷àé
xl2 := aVNetPath.op2^;
xr2 := aVNetPath.ip2^;
end;
oop1 := xl1;
oop2 := xl2;
oip1 := xr1;
oip2 := xr2;
//if NetPath.FIsConture and Not GArch3DInnerSidesFromVirtual then
//if NetPath.FIsConture then
if Not PathIsNoConture then
begin
if PtInPolygon(FParent.FNetConture, xl1) {or IsPtInArray(xl1, @FParent.FNetConture)} then
begin
if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) {or IsPtInArray(aVNetPath.ip2^, @FParent.FNetConture)} then
xop2 := aVNetPath.ip2^
else
xop2 := aVNetPath.op2^;
end
else
begin
if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) then
xop2 := aVNetPath.op2^
else
//if PtInPolygon(FParent.FNetConture, aVNetPath.op2^) then //29.06.2012
xop2 := aVNetPath.ip2^;
end;
if PtInPolygon(FParent.FNetConture, xr1) {or IsPtInArray(xr1, @FParent.FNetConture)} then
begin
if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) {or IsPtInArray(aVNetPath.ip2^, @FParent.FNetConture)} then
xip2 := aVNetPath.ip2^
else
//if PtInPolygon(FParent.FNetConture, aVNetPath.op2^) then //29.06.2012
xip2 := aVNetPath.op2^;
end
else
begin
if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) then
xip2 := aVNetPath.op2^
else
xip2 := aVNetPath.ip2^;
end;
end
else
begin
//13.06.2012
//xip2 := aVNetPath.op2^;
//xop2 := aVNetPath.ip2^;
////xip2 := aVNetPath.ip2^;
////xop2 := aVNetPath.op2^;
//13.06.2012
xip2 := aVNetPath.ip2^;
xop2 := aVNetPath.op2^;
end;
p1 := aVNetPathP1; //aVNetPath.p1^;
p2 := aVNetPathP2; //aVNetPath.p2^;
PrevDoor := nil;
PrevDoorSCSCompon := nil;
xPrevWallElement := nil;
for j := 0 to AllDoors.Count - 1 do
begin
aDoor := TNetDoor(AllDoors[j]);
DoorSCSCompon := GetArchObjByCADObj(aDoor);
// îïðåäåëèòü ÷àñòü ñòåíû, îò íà÷àëà äî ñëåä. îáüåêòà
//if Not GArch3DInnerSidesFromVirtual then
begin
//if NetPath.FIsConture then
if Not PathIsNoConture then
begin
if PtInPolygon(FParent.FNetConture, aDoor.b1) then
//if (NetPath.FIsConture or (aDoor.DoorObjType = dotBalcony)) and PtInPolygon(FParent.FNetConture, aDoor.b1) then
//if PtInPolygon(FParent.FNetConture, aDoor.b1) then
begin
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.a2);
if len1 < len2 then
begin
da1 := aDoor.a1;
da2 := aDoor.a2;
db1 := aDoor.b1;
db2 := aDoor.b2;
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;
end
else
begin
da1 := aDoor.a2;
da2 := aDoor.a1;
db1 := aDoor.b2;
db2 := aDoor.b1;
ca1 := aDoor.ca2;
ca2 := aDoor.ca1;
cb1 := aDoor.cb2;
cb2 := aDoor.cb1;
end;
end
else
begin
len1 := GetLineLenght(xl1, aDoor.b1);
len2 := GetLineLenght(xl1, aDoor.b2);
if len1 < len2 then
begin
da1 := aDoor.b1;
da2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
ca1 := aDoor.cb1;
ca2 := aDoor.cb2;
cb1 := aDoor.ca1;
cb2 := aDoor.ca2;
end
else
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
ca1 := aDoor.cb2;
ca2 := aDoor.cb1;
cb1 := aDoor.ca2;
cb2 := aDoor.ca1;
end;
end;
end
else
begin
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.a2);
if len1 < len2 then
begin
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.b1);
if len1 < len2 then
begin
da1 := aDoor.a1;
da2 := aDoor.a2;
db1 := aDoor.b1;
db2 := aDoor.b2;
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;
end
else // Ïåðåâîðîò â ïîïåðåê
begin
da1 := aDoor.b1;
da2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
ca1 := aDoor.cb1;
ca2 := aDoor.cb2;
cb1 := aDoor.ca1;
cb2 := aDoor.ca2;
end;
end
else // Ïåðåâîðîò â äîëü
begin
len1 := GetLineLenght(xl1, aDoor.a2);
len2 := GetLineLenght(xl1, aDoor.b2);
if len1 < len2 then
begin
da1 := aDoor.a2;
da2 := aDoor.a1;
db1 := aDoor.b2;
db2 := aDoor.b1;
ca1 := aDoor.ca2;
ca2 := aDoor.ca1;
cb1 := aDoor.cb2;
cb2 := aDoor.cb1;
end
else // Ïåðåâîðîò â ïîïåðåê
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
ca1 := aDoor.cb2;
ca2 := aDoor.cb1;
cb1 := aDoor.ca2;
cb2 := aDoor.ca1;
end;
end;
{da1 := aDoor.a1;
da2 := aDoor.a2;
db1 := aDoor.b1;
db2 := aDoor.b2;
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;}
end;
end;
// else
// begin
// da1 := aDoor.a1;
// da2 := aDoor.a2;
// db1 := aDoor.b1;
// db2 := aDoor.b2;
//
// ca1 := aDoor.ca1;
// ca2 := aDoor.ca2;
// cb1 := aDoor.cb1;
// cb2 := aDoor.cb2;
// end;
(*
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.a2);
lenmina := min(len1, len2);
lenminb := min(GetLineLenght(xl1, aDoor.b1), GetLineLenght(xl1, aDoor.b2));
if lenmina > lenminb then
begin
len1 := GetLineLenght(xl1, aDoor.b1);
len2 := GetLineLenght(xl1, aDoor.b2);
if len1 < len2 then
begin
da1 := aDoor.b1;
da2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
end
else
begin
da1 := aDoor.a2;
da2 := aDoor.a1;
db1 := aDoor.b2;
db2 := aDoor.b1;
end;
end
else
begin
if len1 < len2 then
begin
da1 := aDoor.a1;
da2 := aDoor.a2;
db1 := aDoor.b1;
db2 := aDoor.b2;
end
else
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
end;
end;
len1 := GetLineLenght(xl1, aDoor.ca1);
len2 := GetLineLenght(xl1, aDoor.ca2);
lenmina := min(len1, len2);
lenminb := min(GetLineLenght(xl1, aDoor.cb1), GetLineLenght(xl1, aDoor.cb2));
//if lenmina > lenminb then
//begin
// ca1 := aDoor.cb1;
// ca2 := aDoor.cb2;
// cb1 := aDoor.ca1;
// cb2 := aDoor.ca2;
//end
//else
begin
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;
end;
//ca1 := aDoor.ca1;
//ca2 := aDoor.ca2;
//cb1 := aDoor.cb1;
//cb2 := aDoor.cb2;
*)
// ñêîððåêòèðîâàòü òî÷êè ñòåíû ñ ó÷åòîì îòêîñîâ
hor_a1 := 0;
hor_b1 := 0;
hor_a2 := 0;
hor_b2 := 0;
WallViewType := [];
WallType := GetWallTypeByDoorType(aDoor);
if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then
begin
InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Âíóòðåííèé îòêîñ
// Îêíî
if WallType = fwtWindowSlope then
begin
OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Âíåøíèé îòêîñ
// åñòü îêíî è íå ñìåæíàÿ ñòåíà, òî áðàòü âíåøíèå îòêîñû
if (OuterSlope <> nil) then
begin
hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a2 := hor_a1;
ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_a := 0;
depth_a := 0;
end;
if InnerSlope <> nil then
begin
hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_b2 := hor_b1;
ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_b := 0;
depth_b := 0;
end;
end
else
// Äâåðü
if WallType = fwtDoorSlope then
begin
if InnerSlope <> nil then
begin
hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a2 := hor_a1;
hor_b1 := hor_a1;
hor_b2 := hor_a1;
ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
ver_b := ver_a;
depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_a := 0;
ver_b := 0;
depth_a := 0;
depth_b := 0;
end;
end
else
// Áàëêîí
if WallType = fwtBalconSlope then
begin
if InnerSlope <> nil then
begin
BalconDoor := GetChildComponByIsLine(DoorSCSCompon, ctArhDoor); // Äâåðü áàëêîíà
hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a2 := hor_a1;
hor_b1 := hor_a1;
hor_b2 := hor_a1;
ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - BalconDoor.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
ver_b := ver_a;
depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_a := 0;
ver_b := 0;
depth_a := 0;
depth_b := 0;
end;
end;
end;
GetWallPointsWithSlope(da1, da2, db1, db2, hor_a1, hor_a2, hor_b1, hor_b2);
GetDoorPointsWithSlope(ca1, da1, depth_a);
GetDoorPointsWithSlope(ca2, da2, depth_a);
GetDoorPointsWithSlope(cb1, db1, depth_b);
GetDoorPointsWithSlope(cb2, db2, depth_b);
Points[0] := xl1;
Points[0].z := wall_h1;
Points[1] := da1;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
Points[3] := db1;
Points[3].z := wall_h1;
// ïåðâûé áëîê - âçÿòü âûñîòó ñ ìîäïîèíòà
if j = 0 then
begin
Points[4] := xl1;
Points[4].z := corner_side1;
Points[5] := da1;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[6] := xr1;
Points[6].z := corner_side1;
Points[7] := db1;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
Points[8] := p1;
Points[8].z := wall_h1;
Points[10] := p1;
Points[10].z := corner_side1;
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft];
knot1 := GetKnotsCount(aVNetPath, p1);
if knot1 >= 2 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 0)
else if knot1 >= 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0)
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1);
end
else
begin
Points[4] := xl1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, xl1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, xl1, corner_side1, corner_side2);
Points[5] := da1;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[6] := xr1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, xr1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, xr1, corner_side1, corner_side2);
Points[7] := db1;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
end;
xl1 := da2;
xr1 := db2;
// Îáüåêò - Äâåðü
if aDoor.DoorObjType = dotDoor then
begin
door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth);
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
if aVNetPath.FIsInner then
WallViewType := [wvtNoUpper, wvtNoLeft]
else
WallViewType := [wvtNoUpper];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstUpper, fwtDoorSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoUnder, wvtNoLeft]
else
WallViewType := [wvtNoUnder];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
end;
// Îáüåêò - Îêíî
if aDoor.DoorObjType = dotWindow then
begin
door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth);
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
if aVNetPath.FIsInner then
WallViewType := [wvtNoUpper, wvtNoLeft]
else
WallViewType := [wvtNoUpper];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstUpper, fwtWindowSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoUnder, wvtNoLeft]
else
WallViewType := [wvtNoUnder];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
end;
// Îáüåêò - Áàëêîí
if aDoor.DoorObjType = dotBalcony then
begin
BalconDoor := GetChildComponByIsLine(DoorSCSCompon, ctArhDoor); // Äâåðü áàëêîíà
BalconWnd := GetChildComponByIsLine(DoorSCSCompon, ctArhWindow); // Îêíî áàëêîíà
door_h1 := BalconDoor.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
door_h2 := door_h1 + BalconDoor.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
door_w := BalconDoor.GetPropertyValueAsFloat(pnWidth) * FScaleDelta;
wnd_h1 := door_h2 - BalconWnd.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if wnd_h1 < FStartDoorObject then
wnd_h1 := FStartDoorObject;
wnd_h2 := door_h2;
wnd_w := BalconWnd.GetPropertyValueAsFloat(pnWidth) * FScaleDelta;
// âû÷èñëèòü òî÷êè äëÿ äâåðè è îêíà
ba1 := ca1;
ba3 := ca2;
bb1 := cb1;
bb3 := cb2;
//GetParallelPoints(ba1, bb1, ba2, bb2, -door_w);
//if NetPath.FIsConture then
if Not PathIsNoConture then
begin
if PtInPolygon(FParent.FNetConture, aDoor.b1) then
GetParallelPoints(ba1, bb1, ba2, bb2, -door_w)
else
GetParallelPoints(ba1, bb1, ba2, bb2, door_w);
end
else
GetParallelPoints(ba1, bb1, ba2, bb2, -door_w);
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
if aVNetPath.FIsInner then
WallViewType := [wvtNoUpper, wvtNoLeft]
else
WallViewType := [wvtNoUpper];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstUpper, fwtBalconSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoUnder, wvtNoLeft]
else
WallViewType := [wvtNoUnder];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
// äîñòðîèòü áëîê ñòåíû â ïðîåì
ba1 := da1;
ba3 := da2;
bb1 := db1;
bb3 := db2;
//GetParallelPoints(ba1, bb1, ba2, bb2, -door_w);
//if NetPath.FIsConture then
if Not PathIsNoConture then
begin
if PtInPolygon(FParent.FNetConture, aDoor.b1) then
GetParallelPoints(ba1, bb1, ba2, bb2, -door_w)
else
GetParallelPoints(ba1, bb1, ba2, bb2, door_w);
end;
Points[0] := ba2;
Points[0].z := door_h1;
Points[1] := ba3;
Points[1].z := door_h1;
Points[2] := bb2;
Points[2].z := door_h1;
Points[3] := bb3;
Points[3].z := door_h1;
Points[4] := ba2;
Points[4].z := wnd_h1 - FDoorObjectDelta;
Points[5] := ba3;
Points[5].z := wnd_h1 - FDoorObjectDelta;
Points[6] := bb2;
Points[6].z := wnd_h1 - FDoorObjectDelta;
Points[7] := bb3;
Points[7].z := wnd_h1 - FDoorObjectDelta;
if aVNetPath.FIsInner then
WallViewType := [wvtNoUpper, wvtNoUnder, wvtNoLeft]
else
WallViewType := [wvtNoUpper, wvtNoUnder];
//WallSides := CollectOuterWall(aFaces, Points, WallViewType);
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1);
SetWallTypeToWallSide(WallSides, wstUpper, fwtBalconSlope, xWallElement);
SetWallTypeToWallSide(WallSides, wstLeftSide, fwtBalconSlope, xWallElement);
end;
// Îáüåêò - Àðêà
if aDoor.DoorObjType = dotArc then
begin
door_h1 := 0;
door_h2 := DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
//Points[0] := aDoor.a1;
Points[0] := da1;
Points[0].z := door_h2;
//Points[1] := aDoor.a2;
Points[1] := da2;
Points[1].z := door_h2;
//Points[2] := aDoor.b1;
Points[2] := db1;
Points[2].z := door_h2;
//Points[3] := aDoor.b2;
Points[3] := db2;
Points[3].z := door_h2;
//Points[4] := aDoor.a1;
Points[4] := da1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, aDoor.a1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
//Points[5] := aDoor.a2;
Points[5] := da2;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, aDoor.a2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2);
//Points[6] := aDoor.b1;
Points[6] := db1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, aDoor.b1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
//Points[7] := aDoor.b2;
Points[7] := db2;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, aDoor.b2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoUnder, wvtNoLeft]
else
WallViewType := [wvtNoUnder];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstUnder, fwtArc, xWallElement);
end;
// Îáüåêò - Íèøà
if aDoor.DoorObjType = dotNiche then
begin
door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth);
depth := DoorSCSCompon.GetPropertyValueAsFloat(pnDepth);
// äîñòðîèòü áëîê ñòåíû îò íèøû
Points[0] := aDoor.a1;
//Points[0] := da1;
Points[0].z := door_h1;
Points[1] := aDoor.a2;
//Points[1] := da2;
Points[1].z := door_h1;
Points[2] := aDoor.ca1;
//Points[2] := ca1;
Points[2].z := door_h1;
Points[3] := aDoor.ca2;
//Points[3] := ca2;
Points[3].z := door_h1;
Points[4] := aDoor.a1;
//Points[4] := da1;
Points[4].z := door_h2;
Points[5] := aDoor.a2;
//Points[5] := da2;
Points[5].z := door_h2;
Points[6] := aDoor.ca1;
//Points[6] := ca1;
Points[6].z := door_h2;
Points[7] := aDoor.ca2;
//Points[7] := ca2;
Points[7].z := door_h2;
//if aVNetPath.FIsInner then
// WallViewType := [wvtNoLeft]
//else
// WallViewType := [];
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft, wvtNoUpper, wvtNoUnder]
else
WallViewType := [wvtNoUpper, wvtNoUnder];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstRight, fwtNiche, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñíèçó
//Points[0] := aDoor.a1;
Points[0] := da1;
Points[0].z := wall_h1;
//Points[1] := aDoor.a2;
Points[1] := da2;
Points[1].z := wall_h1;
//Points[2] := aDoor.b1;
Points[2] := db1;
Points[2].z := wall_h1;
//Points[3] := aDoor.b2;
Points[3] := db2;
Points[3].z := wall_h1;
//Points[4] := aDoor.a1;
Points[4] := da1;
Points[4].z := door_h1;
//Points[5] := aDoor.a2;
Points[5] := da2;
Points[5].z := door_h1;
//Points[6] := aDoor.b1;
Points[6] := db1;
Points[6].z := door_h1;
//Points[7] := aDoor.b2;
Points[7] := db2;
Points[7].z := door_h1;
if aVNetPath.FIsInner then
WallViewType := [wvtNoUpper, wvtNoLeft]
else
WallViewType := [wvtNoUpper];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstUpper, fwtNiche, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
//Points[0] := aDoor.a1;
Points[0] := da1;
Points[0].z := door_h2;
//Points[1] := aDoor.a2;
Points[1] := da2;
Points[1].z := door_h2;
//Points[2] := aDoor.b1;
Points[2] := db1;
Points[2].z := door_h2;
//Points[3] := aDoor.b2;
Points[3] := db2;
Points[3].z := door_h2;
//Points[4] := aDoor.a1;
Points[4] := da1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, aDoor.a1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
//Points[5] := aDoor.a2;
Points[5] := da2;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, aDoor.a2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2);
//Points[6] := aDoor.b1;
Points[6] := db1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, aDoor.b1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
//Points[7] := aDoor.b2;
Points[7] := db2;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, aDoor.b2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoUnder, wvtNoLeft]
else
WallViewType := [wvtNoUnder];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstUnder, fwtNiche, xWallElement);
end;
PrevDoor := aDoor;
PrevDoorSCSCompon := DoorSCSCompon;
xPrevWallElement := xWallElement;
end;
WallType := fwtNone;
if PrevDoor <> nil then
WallType := GetWallTypeByDoorType(PrevDoor);
Points[0] := xl1;
Points[0].z := wall_h1;
//Points[1] := aVNetPath.op2^;
//if (GetLineLenght(xl1, aVNetPath.ip2^)) < (GetLineLenght(xl1, aVNetPath.op2^)) then
// Points[1] := aVNetPath.ip2^
//else
// Points[1] := aVNetPath.op2^;
Points[1] := xop2;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
//Points[3] := aVNetPath.ip2^;
//if (GetLineLenght(xr1, aVNetPath.ip2^)) < (GetLineLenght(xr1, aVNetPath.op2^)) then
// Points[3] := aVNetPath.ip2^
//else
// Points[3] := aVNetPath.op2^;
Points[3] := xip2;
Points[3].z := wall_h1;
Points[4] := xl1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, xl1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, xop2, xl1, corner_side1, corner_side2);
//Points[5] := aVNetPath.op2^;
Points[5] := xop2;
Points[5].z := corner_side2;
Points[6] := xr1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, xr1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, xip2, xr1, corner_side1, corner_side2);
//Points[7] := aVNetPath.ip2^;
Points[7] := xip2;
Points[7].z := corner_side2;
Points[9] := aVNetPathP2; //aVNetPath.p2^;
Points[9].z := wall_h1;
Points[11] := aVNetPathP2; //aVNetPath.p2^;
Points[11].z := corner_side2;
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft]
else
WallViewType := [];
knot2 := GetKnotsCount(aVNetPath, aVNetPathP2);
if knot2 >= 2 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 0)
else if knot2 >= 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0)
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2);
end
else
// åñëè âíóòðè íè÷åãî íåò (àëãîðèòì ïîñòðîåíèÿ ¹2)
begin
Points[0] := aVNetPath.op1^;
Points[0].z := wall_h1;
Points[1] := aVNetPath.op2^;
Points[1].z := wall_h1;
Points[2] := aVNetPath.ip1^;
Points[2].z := wall_h1;
Points[3] := aVNetPath.ip2^;
Points[3].z := wall_h1;
Points[4] := aVNetPath.op1^;
Points[4].z := corner_side1;
Points[5] := aVNetPath.op2^;
Points[5].z := corner_side2;
Points[6] := aVNetPath.ip1^;
Points[6].z := corner_side1;
Points[7] := aVNetPath.ip2^;
Points[7].z := corner_side2;
Points[8] := aVNetPathP1; //aVNetPath.p1^;
Points[8].z := wall_h1;
Points[9] := aVNetPathP2; //aVNetPath.p2^;
Points[9].z := wall_h1;
Points[10] := aVNetPathP1; //aVNetPath.p1^;
Points[10].z := corner_side1;
Points[11] := aVNetPathP2; //aVNetPath.p2^;
Points[11].z := corner_side2;
if aVNetPath.FComponID in [128,133,150,148] then
begin
EmptyProcedure;
end;
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft]
else
WallViewType := [];
knot1 := GetKnotsCount(aVNetPath, aVNetPathP1);
knot2 := GetKnotsCount(aVNetPath, aVNetPathP2);
if (knot1 >= 2) and (knot2 >= 2) then
begin
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 12, 0);
end
else if knot1 >= 2 then
begin
if knot2 = 0 then //29.05.2012 if knot2 = 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 2)
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 0);
end
else if knot2 >= 2 then
begin
if knot1 = 0 then //29.05.2012 if knot1 = 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 1)
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 0);
end
else
begin
if (knot1 = 1) and (knot2 >= 1) then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0)
else if knot1 = 0 then //29.05.2012 if knot1 = 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1) //08.06.2012 WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2)
else if knot2 = 0 then //29.05.2012 if knot2 = 1 then
begin
if knot1 = 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2)
else
// íà âñÿêèé ñëó÷àé - ïîõîäó ñþäà ïîïàñòü íå äîëæíû òàê êàê âûøå åñòü óñëîâèå if knot1 = 0 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1)
end
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 12);
end;
end;
//if WallSides <> nil then
// FreeAndNil(WallSides);
end;
{$else} // Tolik 22/08/2018 -- Ýòî ÷èñòî äëÿ ÑÊÑ !!!
wall_h1 := 0;
if ((aVNetPath.p1H < 0) or (aVNetPath.p2H < 0)) then
wall_h2 := 0
else
//wall_h2 := Max(aVNetPath.p1H, aVNetPath.p2H) * FScaleDelta;
wall_h2 := Max(aVNetPath.p1H, aVNetPath.p2H) * FScaleDeltaSCS;
//PathIsNoConture := (aVNetPath.Net.Paths.Count = 1);
begin
{corner_side1 := aVNetPath.p1.z * FScaleDelta;
corner_side2 := aVNetPath.p2.z * FScaleDelta;
if corner_side1 = 0 then
corner_side1 := wall_h2;
if corner_side2 = 0 then
corner_side2 := wall_h2;}
corner_side1 := -1;
corner_side2 := -1;
if aVNetPath.p1H >= 0 then
//corner_side1 := aVNetPath.p1H * FScaleDelta;
corner_side1 := aVNetPath.p1H * FScaleDeltaSCS;
if aVNetPath.p2H >= 0 then
corner_side2 := aVNetPath.p2H * FScaleDeltaSCS;
if Wall_h2 = 0 then
wall_h2 := Get3DWallHeight * FScaleDeltaSCS;
if corner_side1 = -1 then
corner_side1 := wall_h2;
if corner_side2 = -1 then
corner_side2 := wall_h2;
// correct ***
SetLength(Points, 12);
WallSides := nil;
// âñå äâåðè ñ ó÷åòîì ñìåæíûõ
AllDoors := aVNetPath.Doors; //GetFullDoors;
// åñëè âíóòðè åñòü äâåðè, îêíà ... (àëãîðèòì ïîñòðîåíèÿ ¹1)
if AllDoors.Count > 0 then
begin
// l - âíåøíèå
// r - âíóòðåííèå
// a - âíåøíèå
// b - âíóòðåííèå
// oop oip èçíà÷àëüíûå îðèãèíàëüíûå ïðàâèëüíî îïðåäåëåííûå!
// xop xip - â ñëó÷àå íåîáõîäèìîñòè ìîãóò âíóòðè öèêëà åùå ïåðåîïðåäåëÿòüñÿ!
if Not PathIsNoConture then
begin
if Not (PtInPolygon(FParent.FNetConture, aVNetPath.op1^)
{or IsPtInArray(aVNetPath.op1^, @FParent.FNetConture)}) then
begin
xl1 := aVNetPath.op1^;
xr1 := aVNetPath.ip1^;
end
else
begin
xl1 := aVNetPath.ip1^;
xr1 := aVNetPath.op1^
end;
if Not (PtInPolygon(FParent.FNetConture, aVNetPath.op2^)
{or IsPtInArray(aVNetPath.op2^, @FParent.FNetConture)}) then
begin
xl2 := aVNetPath.op2^;
xr2 := aVNetPath.ip2^;
end
else
begin
xl2 := aVNetPath.ip2^;
xr2 := aVNetPath.op2^;
end;
end
else
begin
xl1 := aVNetPath.op1^;
xr1 := aVNetPath.ip1^;
// Íà âñÿêèé ñëó÷àé
xl2 := aVNetPath.op2^;
xr2 := aVNetPath.ip2^;
end;
oop1 := xl1;
oop2 := xl2;
oip1 := xr1;
oip2 := xr2;
if Not PathIsNoConture then
begin
if PtInPolygon(FParent.FNetConture, xl1) {or IsPtInArray(xl1, @FParent.FNetConture)} then
begin
if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) {or IsPtInArray(aVNetPath.ip2^, @FParent.FNetConture)} then
xop2 := aVNetPath.ip2^
else
xop2 := aVNetPath.op2^;
end
else
begin
if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) then
xop2 := aVNetPath.op2^
else
//if PtInPolygon(FParent.FNetConture, aVNetPath.op2^) then //29.06.2012
xop2 := aVNetPath.ip2^;
end;
if PtInPolygon(FParent.FNetConture, xr1) {or IsPtInArray(xr1, @FParent.FNetConture)} then
begin
if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) {or IsPtInArray(aVNetPath.ip2^, @FParent.FNetConture)} then
xip2 := aVNetPath.ip2^
else
//if PtInPolygon(FParent.FNetConture, aVNetPath.op2^) then //29.06.2012
xip2 := aVNetPath.op2^;
end
else
begin
if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) then
xip2 := aVNetPath.op2^
else
xip2 := aVNetPath.ip2^;
end;
end
else
begin
xip2 := aVNetPath.ip2^;
xop2 := aVNetPath.op2^;
end;
p1 := aVNetPathP1; //aVNetPath.p1^;
p2 := aVNetPathP2; //aVNetPath.p2^;
PrevDoor := nil;
PrevDoorSCSCompon := nil;
xPrevWallElement := nil;
for j := 0 to AllDoors.Count - 1 do
begin
aDoor := TNetDoor(AllDoors[j]);
// îïðåäåëèòü ÷àñòü ñòåíû, îò íà÷àëà äî ñëåä. îáüåêòà
begin
if Not PathIsNoConture then
begin
if PtInPolygon(FParent.FNetConture, aDoor.b1) then
begin
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.a2);
if len1 < len2 then
begin
da1 := aDoor.a1;
da2 := aDoor.a2;
db1 := aDoor.b1;
db2 := aDoor.b2;
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;
end
else
begin
da1 := aDoor.a2;
da2 := aDoor.a1;
db1 := aDoor.b2;
db2 := aDoor.b1;
ca1 := aDoor.ca2;
ca2 := aDoor.ca1;
cb1 := aDoor.cb2;
cb2 := aDoor.cb1;
end;
end
else
begin
len1 := GetLineLenght(xl1, aDoor.b1);
len2 := GetLineLenght(xl1, aDoor.b2);
if len1 < len2 then
begin
da1 := aDoor.b1;
da2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
ca1 := aDoor.cb1;
ca2 := aDoor.cb2;
cb1 := aDoor.ca1;
cb2 := aDoor.ca2;
end
else
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
ca1 := aDoor.cb2;
ca2 := aDoor.cb1;
cb1 := aDoor.ca2;
cb2 := aDoor.ca1;
end;
end;
end
else
begin
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.a2);
if len1 < len2 then
begin
len1 := GetLineLenght(xl1, aDoor.a1);
len2 := GetLineLenght(xl1, aDoor.b1);
if len1 < len2 then
begin
da1 := aDoor.a1;
da2 := aDoor.a2;
db1 := aDoor.b1;
db2 := aDoor.b2;
ca1 := aDoor.ca1;
ca2 := aDoor.ca2;
cb1 := aDoor.cb1;
cb2 := aDoor.cb2;
end
else // Ïåðåâîðîò â ïîïåðåê
begin
da1 := aDoor.b1;
da2 := aDoor.b2;
db1 := aDoor.a1;
db2 := aDoor.a2;
ca1 := aDoor.cb1;
ca2 := aDoor.cb2;
cb1 := aDoor.ca1;
cb2 := aDoor.ca2;
end;
end
else // Ïåðåâîðîò â äîëü
begin
len1 := GetLineLenght(xl1, aDoor.a2);
len2 := GetLineLenght(xl1, aDoor.b2);
if len1 < len2 then
begin
da1 := aDoor.a2;
da2 := aDoor.a1;
db1 := aDoor.b2;
db2 := aDoor.b1;
ca1 := aDoor.ca2;
ca2 := aDoor.ca1;
cb1 := aDoor.cb2;
cb2 := aDoor.cb1;
end
else // Ïåðåâîðîò â ïîïåðåê
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
ca1 := aDoor.cb2;
ca2 := aDoor.cb1;
cb1 := aDoor.ca2;
cb2 := aDoor.ca1;
end;
end;
end;
end;
// ñêîððåêòèðîâàòü òî÷êè ñòåíû ñ ó÷åòîì îòêîñîâ
hor_a1 := 0;
hor_b1 := 0;
hor_a2 := 0;
hor_b2 := 0;
WallViewType := [];
WallType := GetWallTypeByDoorType(aDoor);
if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then
begin
//InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Âíóòðåííèé îòêîñ
InnerSlope := nil;
// Îêíî
if WallType = fwtWindowSlope then
begin
//OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Âíåøíèé îòêîñ
{ OuterSlope := nil;
// åñòü îêíî è íå ñìåæíàÿ ñòåíà, òî áðàòü âíåøíèå îòêîñû
if (OuterSlope <> nil) then
begin
hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a2 := hor_a1;
ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_a := 0;
depth_a := 0;
end;
if InnerSlope <> nil then
begin
hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_b2 := hor_b1;
ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
ver_b := 0;
depth_b := 0;
end;
}
hor_a1 := 0;
hor_a2 := 0;
//ver_a := 1;
ver_a := 0;
//depth_a := (aVNetPath.Width /2);// * FScaleDelta;
hor_b1 := 0;
hor_b2 := 0;
//ver_b := 1;//GetWndHeightFor3DModel * FScaleDelta;
ver_b := 0;
//depth_b := (aVNetPath.Width /2);// * FScaleDelta;
end
else
// Äâåðü
if WallType = fwtDoorSlope then
begin
if InnerSlope <> nil then
begin
hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2;
hor_a2 := hor_a1;
hor_b1 := hor_a1;
hor_b2 := hor_a1;
//ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta;
ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDeltaSCS;
ver_b := ver_a;
depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta;
end
else
begin
{ ver_a := 0;
ver_b := 0;
depth_a := 0;
depth_b := 0;}
hor_a1 := 0;
hor_a2 := 0;
ver_a := 0;
//depth_a := (aVNetPath.Width /4);// * FScaleDelta;
//depth_a := (aVNetPath.Width /2);// * FScaleDelta;
hor_b1 := 0;
hor_b2 := 0;
ver_b := 0;//GetWndHeightFor3DModel * FScaleDelta;
//depth_b := (aVNetPath.Width /4);// * FScaleDelta;
//depth_b := (aVNetPath.Width /2);// * FScaleDelta;
end;
end;
end;
GetWallPointsWithSlope(da1, da2, db1, db2, hor_a1, hor_a2, hor_b1, hor_b2);
GetDoorPointsWithSlope(ca1, da1, depth_a);
GetDoorPointsWithSlope(ca2, da2, depth_a);
GetDoorPointsWithSlope(cb1, db1, depth_b);
GetDoorPointsWithSlope(cb2, db2, depth_b);
Points[0] := xl1;
Points[0].z := wall_h1;
Points[1] := da1;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
Points[3] := db1;
Points[3].z := wall_h1;
// ïåðâûé áëîê - âçÿòü âûñîòó ñ ìîäïîèíòà
if j = 0 then
begin
Points[4] := xl1;
Points[4].z := corner_side1;
Points[5] := da1;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[6] := xr1;
Points[6].z := corner_side1;
Points[7] := db1;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
Points[8] := p1;
Points[8].z := wall_h1;
Points[10] := p1;
Points[10].z := corner_side1;
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft];
knot1 := GetKnotsCount(aVNetPath, p1);
if knot1 >= 2 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 0)
else if knot1 >= 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0)
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1);
end
else
begin
Points[4] := xl1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, xl1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, xl1, corner_side1, corner_side2);
Points[5] := da1;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[6] := xr1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, xr1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, xr1, corner_side1, corner_side2);
Points[7] := db1;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
end;
xl1 := da2;
xr1 := db2;
// Îáüåêò - Äâåðü
if aDoor.DoorObjType = dotDoor then
begin
//door_h1 := adoor.WndPlacementHeight * FScaleDelta;
door_h1 := adoor.WndPlacementHeight * FScaleDeltaSCS;
if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;
//door_h2 := door_h1 + aDoor.Height * FScaleDelta;//GetDoorHeightfor3DModel * FScaleDelta;
door_h2 := door_h1 + aDoor.Height * FScaleDeltaSCS;//GetDoorHeightfor3DModel * FScaleDelta;
w := aDoor.Width * FScaleDelta / 2;
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
if aVNetPath.FIsInner then
WallViewType := [wvtNoUpper, wvtNoLeft]
else
WallViewType := [wvtNoUpper];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstUpper, fwtDoorSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoUnder, wvtNoLeft]
else
WallViewType := [wvtNoUnder];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
end;
// Îáüåêò - Îêíî
if aDoor.DoorObjType = dotWindow then
begin
//door_h1 := aDoor.WndPlacementHeight * FScaleDelta;//0.7 * FScaleDelta;
door_h1 := aDoor.WndPlacementHeight * FScaleDeltaSCS;//0.7 * FScaleDelta;
{if door_h1 < FStartDoorObject then
door_h1 := FStartDoorObject;}
//door_h2 := door_h1 + aDoor.Height * FScaleDelta;//GetWndHeightFor3DModel * FScaleDelta;
door_h2 := door_h1 + aDoor.Height * FScaleDeltaSCS;//GetWndHeightFor3DModel * FScaleDelta;
w := aDoor.Width * FScaleDelta / 2;
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := da1;
Points[0].z := wall_h1;
Points[1] := da2;
Points[1].z := wall_h1;
Points[2] := db1;
Points[2].z := wall_h1;
Points[3] := db2;
Points[3].z := wall_h1;
Points[4] := da1;
Points[4].z := door_h1 - FDoorObjectDelta;
Points[5] := da2;
Points[5].z := door_h1 - FDoorObjectDelta;
Points[6] := db1;
Points[6].z := door_h1 - FDoorObjectDelta;
Points[7] := db2;
Points[7].z := door_h1 - FDoorObjectDelta;
if aVNetPath.FIsInner then
WallViewType := [wvtNoUpper, wvtNoLeft]
else
WallViewType := [wvtNoUpper];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
SetWallTypeToWallSide(WallSides, wstUpper, fwtWindowSlope, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := da1;
Points[0].z := door_h2 + ver_a;
Points[1] := da2;
Points[1].z := door_h2 + ver_a;
Points[2] := db1;
Points[2].z := door_h2 + ver_b;
Points[3] := db2;
Points[3].z := door_h2 + ver_b;
Points[4] := da1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2);
Points[5] := da2;
//Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2);
Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2);
Points[6] := db1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2);
Points[7] := db2;
//Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2);
Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2);
if aVNetPath.FIsInner then
WallViewType := [wvtNoUnder, wvtNoLeft]
else
WallViewType := [wvtNoUnder];
WallSides := CollectOuterWall(aFaces, Points, WallViewType);
end;
PrevDoor := aDoor;
xPrevWallElement := xWallElement;
end;
WallType := fwtNone;
if PrevDoor <> nil then
WallType := GetWallTypeByDoorType(PrevDoor);
Points[0] := xl1;
Points[0].z := wall_h1;
Points[1] := xop2;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
Points[3] := xip2;
Points[3].z := wall_h1;
Points[4] := xl1;
//Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, xl1, corner_side1, corner_side2);
Points[4].z := CalcPointHeight(oop1, xop2, xl1, corner_side1, corner_side2);
//Points[5] := aVNetPath.op2^;
Points[5] := xop2;
Points[5].z := corner_side2;
Points[6] := xr1;
//Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, xr1, corner_side1, corner_side2);
Points[6].z := CalcPointHeight(oip1, xip2, xr1, corner_side1, corner_side2);
//Points[7] := aVNetPath.ip2^;
Points[7] := xip2;
Points[7].z := corner_side2;
Points[9] := aVNetPathP2; //aVNetPath.p2^;
Points[9].z := wall_h1;
Points[11] := aVNetPathP2; //aVNetPath.p2^;
Points[11].z := corner_side2;
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft]
else
WallViewType := [];
knot2 := GetKnotsCount(aVNetPath, aVNetPathP2);
if knot2 >= 2 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 0)
else if knot2 >= 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0)
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2);
end
else
// åñëè âíóòðè íè÷åãî íåò (àëãîðèòì ïîñòðîåíèÿ ¹2)
begin
Points[0] := aVNetPath.op1^;
Points[0].z := wall_h1;
Points[1] := aVNetPath.op2^;
Points[1].z := wall_h1;
Points[2] := aVNetPath.ip1^;
Points[2].z := wall_h1;
Points[3] := aVNetPath.ip2^;
Points[3].z := wall_h1;
Points[4] := aVNetPath.op1^;
Points[4].z := corner_side1;
Points[5] := aVNetPath.op2^;
Points[5].z := corner_side2;
Points[6] := aVNetPath.ip1^;
Points[6].z := corner_side1;
Points[7] := aVNetPath.ip2^;
Points[7].z := corner_side2;
Points[8] := aVNetPathP1; //aVNetPath.p1^;
Points[8].z := wall_h1;
Points[9] := aVNetPathP2; //aVNetPath.p2^;
Points[9].z := wall_h1;
Points[10] := aVNetPathP1; //aVNetPath.p1^;
Points[10].z := corner_side1;
Points[11] := aVNetPathP2; //aVNetPath.p2^;
Points[11].z := corner_side2;
if aVNetPath.FComponID in [128,133,150,148] then
begin
EmptyProcedure;
end;
if aVNetPath.FIsInner then
WallViewType := [wvtNoLeft]
else
WallViewType := [];
knot1 := GetKnotsCount(aVNetPath, aVNetPathP1);
knot2 := GetKnotsCount(aVNetPath, aVNetPathP2);
//Tolik 29/08/2018 --
if ((knot2 = 0) and (knot1 = 0)) then
begin
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 12);
end
else
//
if (knot1 >= 2) and (knot2 >= 2) then
begin
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 12, 0);
end
else
if knot1 >= 2 then
begin
if knot2 = 0 then //29.05.2012 if knot2 = 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 2)
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 0);
end
else
if knot2 >= 2 then
begin
if knot1 = 0 then //29.05.2012 if knot1 = 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 1)
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 0);
end
else
begin
if (knot1 = 1) and (knot2 >= 1) then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0)
else
if knot1 = 0 then //29.05.2012 if knot1 = 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1) //08.06.2012 WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2)
else
if knot2 = 0 then //29.05.2012 if knot2 = 1 then
begin
if knot1 = 1 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2)
else
// íà âñÿêèé ñëó÷àé - ïîõîäó ñþäà ïîïàñòü íå äîëæíû òàê êàê âûøå åñòü óñëîâèå if knot1 = 0 then
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1)
end
else
WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 12);
end;
end;
end;
{$ifEnd}
if WallSides <> nil then
FreeAndNil(WallSides);
except
on E: Exception do AddExceptionToLogEx('T3DWall.ParseWallForOuter', E.Message);
end;
end;
procedure T3DWall.ParseWallForPerpendSides(aFaces: TList; aVNetPath: TNetPath);
var
Corners: TSCSComponents;
wall_h1, wall_h2: Double;
corner_side1, corner_side2: Double;
p1H, p2H: Double;
wall_h: TDoubleArray;
corner_side: TDoubleArray;
pH: TDoubleArray;
procedure AddPerpendSide(PathPt, OtherSidePt, PerpendPt: PDoublePoint; aSide: Integer);
var
a3DPointArr: T3DPointArray;
xSide: T3DSide;
//corner_side: Double;
//pH: Double;
FaceWallType: TFaceWallType;
//DirectionKoeff: Integer;
LinePt1, LinePt2: TDoublePoint;
begin
if PerpendPt <> nil then
begin
if Corners = nil then
begin
SetLength(wall_h, 2);
SetLength(corner_side, 2);
SetLength(pH, 2);
{$if Defined(ES_GRAPH_SC)}
wall_h[0] := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
wall_h[1] := wall_h[0] + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
Corners := GetArchCornersForWall(FSCSCompon);
corner_side[0] := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if corner_side[0] = 0 then
corner_side[0] := wall_h[1];
corner_side[1] := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
if corner_side[1] = 0 then
corner_side[1] := wall_h[1];
// correct ***
ph[0] := aVNetPath.p1H;
ph[1] := aVNetPath.p2H;
corner_side[0] := ph[0] * FScaleDelta;
if corner_side[0] = 0 then
corner_side[0] := wall_h[1];
corner_side[1] := ph[1] * FScaleDelta;
if corner_side[1] = 0 then
corner_side[1] := wall_h[1];
//
{$else}
wall_h[0] := 0;
//wall_h[1] := Get3DWallHeight * FScaleDelta;
wall_h[1] := Get3DWallHeight * FScaleDeltaSCS;
//corner_side[0] := Get3DWallHeight * FScaleDelta;
//corner_side[1] := Get3DWallHeight * FScaleDelta;
corner_side[0] := Get3DWallHeight * FScaleDeltaSCS;
corner_side[1] := Get3DWallHeight * FScaleDeltaSCS;
// correct ***
//Tolik 18/11/2019 --
if aVNetPath.p1H > 0 then
begin
ph[0] := aVNetPath.p1H;
//corner_side[0] := ph[0] * FScaleDelta;
corner_side[0] := ph[0] * FScaleDeltaSCS;
if corner_side[0] = 0 then
corner_side[0] := wall_h[1];
end;
if aVNetPath.p2H > 0 then
begin
ph[1] := aVNetPath.p2H;
//corner_side[1] := ph[1] * FScaleDelta;
corner_side[1] := ph[1] * FScaleDeltaSCS;
if corner_side[1] = 0 then
corner_side[1] := wall_h[1];
end;
{
ph[0] := aVNetPath.p1H;
ph[1] := aVNetPath.p2H;
corner_side[0] := ph[0] * FScaleDelta;
if corner_side[0] = 0 then
corner_side[0] := wall_h[1];
corner_side[1] := ph[1] * FScaleDelta;
if corner_side[1] = 0 then
corner_side[1] := wall_h[1];
}
{$ifEnd}
end;
LinePt1 := PathPt^;
LinePt2 := PerpendPt^;
FaceWallType := fwtNone;
if aVNetPath.FIsInner then
begin
FaceWallType := fwtInner;
//DirectionKoeff := GetParallelPointDirectionKoeff(PathPt^, PerpendPt^, OtherSidePt^);
//GetParallelPoints(PathPt^, PerpendPt^, LinePt1, LinePt2, 1 * DirectionKoeff);
end
else
begin
if aVNetPath.FIsConture then
begin
if (PathPt = aVNetPath.op1) or (PathPt = aVNetPath.op2) then
FaceWallType := fwtOuter
else
if (PathPt = aVNetPath.ip1) or (PathPt = aVNetPath.ip2) then
FaceWallType := fwtInner;
end
else
//08.06.2012 - çäåñü ñòàâèì ÷òî âíåøíèé, åñëè íåò çàìêíóòîãî êîíòóðà
FaceWallType := fwtOuter;
end;
SetLength(a3DPointArr, 4);
a3DPointArr[0] := LinePt1;
a3DPointArr[0].z := wall_h[0];
a3DPointArr[1] := LinePt2;
a3DPointArr[1].z := wall_h[0];
a3DPointArr[2] := LinePt1;
a3DPointArr[2].z := corner_side[aSide-1];
a3DPointArr[3] := LinePt2;
a3DPointArr[3].z := corner_side[aSide-1];
xSide := T3DSide.Create(ftNetPath, FaceWallType, wstUnder, self);
xSide.CollectWallSide(aFaces, a3DPointArr);
FSides.Add(xSide);
end;
end;
begin
Corners := nil;
AddPerpendSide(@aVNetPath.el1, @aVNetPath.el2, aVNetPath.epl1, 1);
AddPerpendSide(@aVNetPath.el2, @aVNetPath.el1, aVNetPath.epl2, 2);
AddPerpendSide(@aVNetPath.er1, @aVNetPath.er2, aVNetPath.epr1, 1);
AddPerpendSide(@aVNetPath.er2, @aVNetPath.er1, aVNetPath.epr2, 2);
end;
// Tolik 31/08/2018 --
Procedure T3DWall.ParseWallForJoint(aPathList: TList; aFaces: TList; aPoint: PDoublePoint); // ñòûêè ñòåí ñ ðàçíîé òîëùèíîé íà ïåðåñå÷åíèè 3-õ ñòåí
var UPoint1, UPoint2: PDoublePoint;
i, j, PathIndex: Integer;
currPath: TNetPath;
xSide: T3DSide;
a3DPointArr: T3DPointArray;
Wall_H: Double;
FaceWallType: TFaceWallType;
function isUniquePoint(aPoint: TDoublePoint; PathIndex: Integer): Boolean;
var i: Integer;
RelatedPath: TNetPath;
begin
Result := true;
for i := 0 to aPathList.Count - 1 do
begin
if i <> PathIndex then
begin
RelatedPath := TNetPath(aPathList[i]);
if ((CompareValue(aPoint.x, RelatedPath.r1.x) = 0) and (CompareValue(aPoint.y, RelatedPath.r1.y) = 0)) or
((CompareValue(aPoint.x, RelatedPath.r2.x) = 0) and (CompareValue(aPoint.y, RelatedPath.r2.y) = 0)) or
((CompareValue(aPoint.x, RelatedPath.l1.x) = 0) and (CompareValue(aPoint.y, RelatedPath.l1.y) = 0)) or
((CompareValue(aPoint.x, RelatedPath.l2.x) = 0) and (CompareValue(aPoint.y, RelatedPath.l2.y) = 0)) then
begin
Result := False;
break;
end;
end;
end;
end;
Procedure AddPoint(addPoint: TDoublePoint; zCoord: Double);
begin
if UPoint1 = nil then
begin
New(UPoint1);
UPoint1.x := AddPoint.x;
UPoint1.y := AddPoint.y;
UPoint1.z := zCoord;
end
else
begin
New(UPoint2);
UPoint2.x := AddPoint.x;
UPoint2.y := AddPoint.y;
UPoint2.z := zCoord;
end;
end;
begin
UPoint1 := nil;
UPoint2 := nil;
for i := 0 to aPathList.Count - 1 do
begin
currPath := TNetPath(aPathList[i]);
if ((CompareValue(aPoint.x, currPath.P1.x) = 0) and (CompareValue(aPoint.y, currPath.P1.y) = 0)) then
begin
if isUniquePoint(currPath.r1, i) then
AddPoint(currPath.r1, currPath.p1.z);
if UPoint2 <> nil then
break;
if isUniquePoint(currPath.l1, i) then
AddPoint(currPath.l1, currPath.p1.z);
if UPoint2 <> nil then
break;
end
else
if ((CompareValue(aPoint.x, currPath.P2.x) = 0) and (CompareValue(aPoint.y, currPath.P2.y) = 0)) then
begin
if isUniquePoint(currPath.r2, i) then
AddPoint(currPath.r2, currPath.p2.z);
if UPoint2 <> nil then
break;
if isUniquePoint(currPath.l2, i) then
AddPoint(currPath.l2, currPath.p2.z);
if UPoint2 <> nil then
break;
end;
end;
if UPoint2 <> nil then
begin
SetLength(a3DPointArr, 4);
//Wall_H := Max(UPoint1.z, UPoint2.z) * FScaleDelta;
Wall_H := Max(UPoint1.z, UPoint2.z) * FScaleDeltaSCS;
if Wall_H = 0 then
//Wall_H := Get3DWallHeight * FScaleDelta;
Wall_H := Get3DWallHeight * FScaleDeltaSCS;
a3DPointArr[0].x := UPoint1.x;
a3DPointArr[0].y := UPoint1.y;
a3DPointArr[0].z := 0;
a3DPointArr[1].x := UPoint2.x;
a3DPointArr[1].y := UPoint2.y;
a3DPointArr[1].z := 0;
a3DPointArr[2].x := UPoint1.x;
a3DPointArr[2].y := UPoint1.y;
a3DPointArr[2].z := Wall_H;
a3DPointArr[3].x := UPoint2.x;
a3DPointArr[3].y := UPoint2.y;
a3DPointArr[3].z := Wall_H;
FaceWallType := fwtOuter;
xSide := T3DSide.Create(ftNetPath, FaceWallType, wstUnder, self);
xSide.CollectWallSide(aFaces, a3DPointArr);
FSides.Add(xSide);
freeMem(UPoint1);
freeMem(UPoint2);
end
else
freeMem(UPoint1);
end;
procedure T3DWall.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
20: FParentIndex := IntVal;
21: FSCSComponID := intVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
case xCode of
90: begin
if byteVal = 0 then
FIsArc := False
else
FIsArc := True;
end;
end;
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DWall.ReadFromStream', E.Message);
end;
end;
procedure T3DWall.SetRelations;
begin
try
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DRoom(ModelObjectsList.Items[FParentIndex]);
T3DRoom(FParent).FWalls.Add(self);
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.SetRelations', E.Message);
end;
end;
procedure T3DWall.SetWallTypeToWallSide(aWallSides: TList; aWallSideType: TWallSideType;
aWallType: TFaceWallType; aWallElement: T3DWallElement);
var
i: integer;
WallSide: T3DSide;
begin
try
for i := 0 to aWallSides.Count - 1 do
begin
WallSide := T3DSide(aWallSides[i]);
if WallSide.FFace.FWallSideType = aWallSideType then
begin
WallSide.FFace.FFaceWallType := aWallType;
WallSide.FWallType := aWallType;
if (aWallType = fwtNiche) or (aWallType = fwtArc) then
begin
if aWallElement <> nil then
aWallElement.FSides.Add(WallSide);
FSides.Remove(WallSide);
end;
Break;
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.SetWallTypeToWallSide', E.Message);
end;
end;
procedure T3DWall.WriteToStream(Stream: TStream);
var
xInt: Integer;
xByte: Byte;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
if FIsArc then
xByte := 1
else
xByte := 0;
WriteField(90, Stream, xByte, sizeof(xByte));
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DWall.WriteToStream', E.Message);
end;
end;
{ T3DWallElement }
procedure T3DWallElement.CollectBalcon(aFaces: TList; ap1, ap2: T3DPointArray);
var
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
xBalconElement: T3DBalconElement;
begin
try
xBalconElement := T3DBalconElement.Create(aFaces, dotDoor, self);
xBalconElement.FSCSCompon := GetChildComponByIsLine(FSCSCompon, ctArhDoor);
xBalconElement.FSCSComponID := xBalconElement.FSCSCompon.ID;
xBalconElement.FName := xBalconElement.FSCSCompon.Name;
xBalconElement.CollectBalconDoor(aFaces, ap1);
FBalconElements.Add(xBalconElement);
xBalconElement := T3DBalconElement.Create(aFaces, dotWindow, self);
xBalconElement.FSCSCompon := GetChildComponByIsLine(FSCSCompon, ctArhWindow);
xBalconElement.FSCSComponID := xBalconElement.FSCSCompon.ID;
xBalconElement.FName := xBalconElement.FSCSCompon.Name;
xBalconElement.CollectBalconWindow(aFaces, ap2);
FBalconElements.Add(xBalconElement);
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.CollectBalcon', E.Message);
end;
end;
procedure T3DWallElement.CollectDoor(aFaces: TList; ap: T3DPointArray);
var
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
xSide: T3DSide;
begin
try
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[3];
a3DPointArr[3] := ap[2];
xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[4];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[7];
a3DPointArr[3] := ap[6];
xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[5];
a3DPointArr[3] := ap[4];
xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[2];
a3DPointArr[1] := ap[3];
a3DPointArr[2] := ap[7];
a3DPointArr[3] := ap[6];
xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[4];
a3DPointArr[2] := ap[6];
a3DPointArr[3] := ap[2];
xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[1];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[7];
a3DPointArr[3] := ap[3];
xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.CollectDoor', E.Message);
end;
end;
procedure T3DWallElement.CollectWindow(aFaces: TList; ap: T3DPointArray);
var
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
xSide: T3DSide;
begin
try
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[3];
a3DPointArr[3] := ap[2];
xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[4];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[7];
a3DPointArr[3] := ap[6];
xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[1];
a3DPointArr[2] := ap[5];
a3DPointArr[3] := ap[4];
xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self );
xSide.CollectWallElementSide(aFaces, a3DPointArr, True);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[2];
a3DPointArr[1] := ap[3];
a3DPointArr[2] := ap[7];
a3DPointArr[3] := ap[6];
xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr, True);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[4];
a3DPointArr[2] := ap[6];
a3DPointArr[3] := ap[2];
xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap[1];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[7];
a3DPointArr[3] := ap[3];
xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.CollectWindow', E.Message);
end;
end;
constructor T3DWallElement.Create(aFaces: TList; aNetDoor: TNetDoor; aElementType: TDoorObjType; aParent: T3DWall);
begin
try
inherited Create;
FClassName := 'T3DWallElement';
FPlanObject := aNetDoor;
if aNetDoor <> nil then
begin
{$if Defined(ES_GRAPH_SC)}
FSCSCompon := GetArchObjByCADObj(aNetDoor);
FSCSComponID := FSCSCompon.ID;
FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark;
{$else}
FName := 'WallElement';
{$ifEnd}
end;
FParent := aParent;
FElementType := aElementType;
FSlopes := TList.Create;
FSides := TList.Create;
FBalconElements := TList.Create;
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.Create', E.Message);
end;
end;
procedure T3DWallElement.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
20: FParentIndex := IntVal;
21: FSCSComponID := intVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.ReadFromStream', E.Message);
end;
end;
procedure T3DWallElement.SetRelations;
begin
try
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DWall(ModelObjectsList.Items[FParentIndex]);
T3DWall(FParent).FWallElements.Add(self);
end;
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.SetRelations', E.Message);
end;
end;
procedure T3DWallElement.WriteToStream(Stream: TStream);
var
xInt: Integer;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.WriteToStream', E.Message);
end;
end;
{ T3DSlope }
constructor T3DSlope.Create(aFaces: TList; aNetDoor: TNetDoor; aParent: T3DWallElement);
begin
try
inherited Create;
FClassName := 'T3DSlope';
{$if DEFINED (ES_GRAPH_SC)} // Tolik 28/08/2018 --
if aNetDoor <> nil then
begin
FSCSCompon := GetArchObjByCADObj(aNetDoor);
FSCSComponID := FSCSCompon.ID;
end;
{$else}
FSCSCompon := nil;
FSCSComponID := 0;
FName := _3DSlopeName;
{$ifEnd}
FParent := aParent;
FSides := TList.Create;
except
on E: Exception do AddExceptionToLogEx('T3DSlope.Create', E.Message);
end;
end;
procedure T3DSlope.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
20: FParentIndex := IntVal;
21: FSCSComponID := intVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DSlope.ReadFromStream', E.Message);
end;
end;
procedure T3DSlope.SetRelations;
begin
try
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DWallElement(ModelObjectsList.Items[FParentIndex]);
T3DWallElement(FParent).FSlopes.Add(self);
end;
except
on E: Exception do AddExceptionToLogEx('T3DSlope.SetRelations', E.Message);
end;
end;
procedure T3DSlope.WriteToStream(Stream: TStream);
var
xInt: Integer;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DSlope.WriteToStream', E.Message);
end;
end;
{ T3DBalconElement }
procedure T3DBalconElement.CollectBalconDoor(aFaces: TList; ap1: T3DPointArray);
var
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
xSide: T3DSide;
begin
try
// ñîáðàòü áàëêîííóþ äâåðü
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap1[0];
a3DPointArr[1] := ap1[1];
a3DPointArr[2] := ap1[3];
a3DPointArr[3] := ap1[2];
xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap1[4];
a3DPointArr[1] := ap1[5];
a3DPointArr[2] := ap1[7];
a3DPointArr[3] := ap1[6];
xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap1[0];
a3DPointArr[1] := ap1[1];
a3DPointArr[2] := ap1[5];
a3DPointArr[3] := ap1[4];
xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr, True);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap1[2];
a3DPointArr[1] := ap1[3];
a3DPointArr[2] := ap1[7];
a3DPointArr[3] := ap1[6];
xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr, True { Trans });
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap1[0];
a3DPointArr[1] := ap1[4];
a3DPointArr[2] := ap1[6];
a3DPointArr[3] := ap1[2];
xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap1[1];
a3DPointArr[1] := ap1[5];
a3DPointArr[2] := ap1[7];
a3DPointArr[3] := ap1[3];
xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
except
on E: Exception do AddExceptionToLogEx('T3DBalconElement.CollectBalconDoor', E.Message);
end;
end;
procedure T3DBalconElement.CollectBalconWindow(aFaces: TList; ap2: T3DPointArray);
var
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
xSide: T3DSide;
begin
try
// ñîáðàòü áàëêîííîå îêíî
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap2[0];
a3DPointArr[1] := ap2[1];
a3DPointArr[2] := ap2[3];
a3DPointArr[3] := ap2[2];
xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap2[4];
a3DPointArr[1] := ap2[5];
a3DPointArr[2] := ap2[7];
a3DPointArr[3] := ap2[6];
xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap2[0];
a3DPointArr[1] := ap2[1];
a3DPointArr[2] := ap2[5];
a3DPointArr[3] := ap2[4];
xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr, True);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap2[2];
a3DPointArr[1] := ap2[3];
a3DPointArr[2] := ap2[7];
a3DPointArr[3] := ap2[6];
xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr, True);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap2[0];
a3DPointArr[1] := ap2[4];
a3DPointArr[2] := ap2[6];
a3DPointArr[3] := ap2[2];
xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
SetLength(a3DPointArr, 4);
a3DPointArr[0] := ap2[1];
a3DPointArr[1] := ap2[5];
a3DPointArr[2] := ap2[7];
a3DPointArr[3] := ap2[3];
xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self);
xSide.CollectWallElementSide(aFaces, a3DPointArr);
FSides.Add(xSide);
except
on E: Exception do AddExceptionToLogEx('T3DBalconElement.CollectBalconWindow', E.Message);
end;
end;
constructor T3DBalconElement.Create(aFaces: TList; aElementType: TDoorObjType; aParent: T3DWallElement);
begin
try
inherited Create;
FClassName := 'T3DBalconElement';
FParent := aParent;
FElementType := aElementType;
FSides := TList.Create;
except
on E: Exception do AddExceptionToLogEx('T3DBalconElement.Create', E.Message);
end;
end;
procedure T3DBalconElement.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
20: FParentIndex := IntVal;
21: FSCSComponID := intVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DBalconElement.ReadFromStream', E.Message);
end;
end;
procedure T3DBalconElement.SetRelations;
begin
try
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DWallElement(ModelObjectsList.Items[FParentIndex]);
T3DWallElement(FParent).FBalconElements.Add(self);
end;
except
on E: Exception do AddExceptionToLogEx('T3DBalconElement.SetRelations', E.Message);
end;
end;
procedure T3DBalconElement.WriteToStream(Stream: TStream);
var
xInt: Integer;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DBalconElement.WriteToStream', E.Message);
end;
end;
{ T3DSObject }
constructor T3DSObject.Create(aParent: T3DRoom);
begin
try
inherited Create;
FClassName := 'T3DSObject';
FName := '';
FDescription := TStringList.Create;
FParent := aParent;
FGLObject := nil;
FFace := nil;
FScale.x := 1;
FScale.y := 1;
FScale.z := 1;
FPosition.x := 0;
FPosition.y := 0;
FPosition.z := 0;
FRotate.x := 0;
FRotate.y := 0;
FRotate.z := 0;
FObjectHash := '';
FTextureHash := '';
FTexture_ext := '';
//FFiles := TStringList.Create;
//FHashs := TStringList.Create;
except
on E: Exception do AddExceptionToLogEx('T3DSObject.Create', E.Message);
end;
end;
procedure T3DSObject.ReadFromStream(Stream: TStream);
var
i, j: integer;
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
xd, yd, zd: Double;
mStr: TMemoryStream;
fStr: TFileStream;
CanAdd: Boolean;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
20: FParentIndex := IntVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
Case xcode of
150: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPosition.x := xd;
FPosition.y := yd;
FPosition.z := zd;
end;
151: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FScale.x := xd;
FScale.y := yd;
FScale.z := zd;
end;
152: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FRotate.x := xd;
FRotate.y := yd;
FRotate.z := zd;
end;
// 153: begin
// mStr := TMemoryStream.Create;
// StreamToStream(Stream, mStr, xSize);
// mStr.Position := 0;
// mStr.SaveToFile('C:\govno_test.3ds');
// FreeAndNil(mStr);
// end;
end;
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
181: FDescription.Text := strVal;
182: FObjectHash := strVal;
183: FTextureHash := strVal;
184: FTexture_ext := strVal;
end;
{TODO} // ïåðåñìîòðåòü - õðåíü ïî õîäó çäåñü äåëàåòñ - îãðàíè÷åííûé íàáîð ôàéëîâ òîëüêî ïèøåòñÿ
// È ÍÅ ÒÀÌ - äîëæíû ðàç òîëüêî ïèñàòüñÿ ýòè äâà ñòðèìà!!!
//if (xCode >= 185) and (xCode <= 199) then
//begin
//CanAdd := True;
//for j := 0 to FFiles.Count - 1 do
//begin
// if FFiles[j] = StrVal then
// CanAdd := False;
//end;
//if CanAdd then
// FFiles.Add(strVal);
//end;
//if (xCode >= 200) and (xCode <= 219) then
//begin
//CanAdd := True;
//for j := 0 to FHashs.Count - 1 do
//begin
// if FHashs[j] = StrVal then
// CanAdd := False;
//end;
//if CanAdd then
// FHashs.Add(strVal);
//end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DSObject.ReadFromStream', E.Message);
end;
end;
procedure T3DSObject.SetRelations;
begin
try
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DRoom(ModelObjectsList.Items[FParentIndex]);
T3DRoom(FParent).F3DSObjects.Add(self);
end;
except
on E: Exception do AddExceptionToLogEx('T3DSObject.SetRelations', E.Message);
end;
end;
// Tolik 04/04/2019 - -
procedure T3DSObject.WriteToStream(Stream: TStream);
var
xInt: Integer;
aPoint: pInt;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FPosition.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FPosition.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FPosition.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FScale.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FScale.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FScale.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FRotate.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FRotate.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FRotate.z;
WriteBinField(152, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
// Write 3DS File
// if FPath <> '' then
// begin
// xStream := TFileStream.Create(FPath, fmOpenRead);
// WriteStreamField(153, Stream, xStream);
// FreeAndNil(xStream);
// end;
{TODO} // ïåðåñìîòðåòü - õðåíü ïî õîäó çäåñü äåëàåòñ - îãðàíè÷åííûé íàáîð ôàéëîâ òîëüêî ïèøåòñÿ
// È ÂÎÇÌÎÆÍÎ ÍÅ ÒÀÌ - äîëæíû ðàç òîëüêî ïèñàòüñÿ ýòè äâà ñòðèìà!!!
// Êîðî÷å ïåðåñìîòðåòü âñþ îðãàíèçàöèþ ýòîé õðåíè!
//for i := 0 to FFiles.Count - 1 do
//begin
// xStr := FFiles[i];
// if ((185 + i) <= 199) then
// WriteStrField(185 + i, Stream, xStr);
//end;
//for i := 0 to FHashs.Count - 1 do
//begin
// xStr := FHashs[i];
// if ((200 + i) <= 219) then
// WriteStrField(200 + i, Stream, xStr);
//end;
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(182, Stream, FObjectHash);
WriteStrField(183, Stream, FTextureHash);
WriteStrField(184, Stream, FTexture_ext);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DSObject.WriteToStream', E.Message);
end;
end;
(*
procedure T3DSObject.WriteToStream(Stream: TStream);
var
i, xCount, xInt: Integer;
xByte: Byte;
xStr: string;
xDouble: Double;
aPoint: pInt;
xStream: TFileStream;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := ModelObjectsList.IndexOf(FParent);
WriteField(20, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FPosition.x;
pDouble(pChar(aPoint) + 8)^ := FPosition.y;
pDouble(pChar(aPoint) + 16)^ := FPosition.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FScale.x;
pDouble(pChar(aPoint) + 8)^ := FScale.y;
pDouble(pChar(aPoint) + 16)^ := FScale.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FRotate.x;
pDouble(pChar(aPoint) + 8)^ := FRotate.y;
pDouble(pChar(aPoint) + 16)^ := FRotate.z;
WriteBinField(152, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
// Write 3DS File
// if FPath <> '' then
// begin
// xStream := TFileStream.Create(FPath, fmOpenRead);
// WriteStreamField(153, Stream, xStream);
// FreeAndNil(xStream);
// end;
{TODO} // ïåðåñìîòðåòü - õðåíü ïî õîäó çäåñü äåëàåòñ - îãðàíè÷åííûé íàáîð ôàéëîâ òîëüêî ïèøåòñÿ
// È ÂÎÇÌÎÆÍÎ ÍÅ ÒÀÌ - äîëæíû ðàç òîëüêî ïèñàòüñÿ ýòè äâà ñòðèìà!!!
// Êîðî÷å ïåðåñìîòðåòü âñþ îðãàíèçàöèþ ýòîé õðåíè!
//for i := 0 to FFiles.Count - 1 do
//begin
// xStr := FFiles[i];
// if ((185 + i) <= 199) then
// WriteStrField(185 + i, Stream, xStr);
//end;
//for i := 0 to FHashs.Count - 1 do
//begin
// xStr := FHashs[i];
// if ((200 + i) <= 219) then
// WriteStrField(200 + i, Stream, xStr);
//end;
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(182, Stream, FObjectHash);
WriteStrField(183, Stream, FTextureHash);
WriteStrField(184, Stream, FTexture_ext);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DSObject.WriteToStream', E.Message);
end;
end;
*)
{ T3DConnector }
procedure T3DConnector.CollectConnector(aFaces: TList; ap: T3DPointArray);
var
aFace: TFaceRecord;
i: Integer;
begin
try
//Tolik 08/04/2025
//FPoint := ap[0];
if Self.FisPipeElement then
begin
if Length(ap) = 3 then
FPoint := ap[1]
else
FPoint := ap[0];
end
else
FPoint := ap[0];
//
{TODO ZCoord}
//ap[0].z := ap[0].z * FScaleDelta;
for i := 0 to (Length(ap) - 1) do
ap[i].z := ap[i].z * FScaleDeltaSCS; // NEWNEW
if not Self.FisPipeElement then
aFace := TFaceRecord.Create(ap, clRed, ftPipe, 0.1, False, FSCSObject)
else
aFace := TFaceRecord.Create(ap, clGreen, ftPipe, 0.1, False, FSCSObject);
aFaces.Add(aFace);
FFace := aFace;
except
on E: Exception do AddExceptionToLogEx('T3DConnector.CollectConnector', E.Message);
end;
end;
// Tolik 24/09/1218
//constructor T3DConnector.Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel);
constructor T3DConnector.Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel; aIsPipe: Boolean = False);
//
var
i: integer;
begin
try
inherited Create;
// Tolik 12/10/20108 --
//if aSCSObject.ConnectorType = ct_NB then
// T3DModelFile := Get3DModelFileName(aSCSObject)
//else
T3DModelFile :='';
FUse3DSize := False;
//
FisPipeElement := aIsPipe;
FClassName := 'T3DConnector';
FSCSObject := aSCSObject;
FListID := GCadForm.FCADListID;
FDescription := TStringList.Create;
FCaptions := TStringList.Create;
FNotes := TStringList.Create;
FConnType := ct_Empty;
FParent := aParent;
// Tolik 26/09/2018 --
SetLength(FPipeRadiusArray, 0);
F3dModelFileName := '';
HasPipeElements := False;
//
if aSCSObject <> nil then
begin
if aSCSObject.ConnectorType <> ct_Clear then
begin
if not aSCSObject.FIsApproach then // Tolik 14/02/2020 -- åñëè ïîïàäåòñÿ äîì íà Êàäå ...
// êîìïîíåíòà íå áóäåò
begin
FSCSCompon := GetSCSComponByCADObj(aSCSObject);
FSCSComponID := FSCSCompon.ID;
end
else
FSCSComponID := -1;
end
else
begin
FSCSCompon := nil;
//Tolik 18/4/2025 --
//FSCSComponID := -1;
FSCSComponID := aSCSObject.ID;
//
end;
FName := FSCSObject.Name;
FIndex := FSCSObject.FIndex;
//for i := 0 to FSCSObject.OutTextCaptions.Count - 1 do
// FDescription.Add(FSCSObject.OutTextCaptions.Strings[i]);
for i := 0 to FSCSObject.OutTextCaptions.Count - 1 do
FCaptions.Add(FSCSObject.OutTextCaptions.Strings[i]);
for i := 0 to FSCSObject.OutTextNotes.Count - 1 do
FNotes.Add(FSCSObject.OutTextNotes.Strings[i]);
if FSCSObject.ConnectorType <> ct_Clear then
FConnType := ct_Full;
end;
FGLObject := nil;
FGLObject1 := nil;
FGLCaption := nil;
FFace := nil;
FPoint.x := 0;
FPoint.y := 0;
FPoint.z := 0;
FGLPoint.x := 0;
FGLPoint.y := 0;
FGLPoint.z := 0;
FOffset.x := 0;
FOffset.y := 0;
FOffset.z := 0;
FScale.x := 1;
FScale.y := 1;
FScale.z := 1;
FRotate.x := 0;
FRotate.y := 0;
FRotate.z := 0;
FObjectHash := '';
FTextureHash := '';
FTexture_ext := '';
//FFiles := TStringList.Create;
//FHashs := TStringList.Create;
FColor := clrBlack;
FJoinedConnectorsList := TList.Create;
FJoinedLinesList := TList.Create;
FRelatedLines := TList.Create; // -- Tolik 03/4/2025 ñïèñîê òðàññ, ïî êîòîðûì ïðîõîèò ñîåäèíåíèå
FLength := 0; // Tolik 03/04/05 -- äëèíà ñîåäèíåíèÿ
except
on E: Exception do AddExceptionToLogEx('T3DConnector.Create', E.Message);
end;
end;
procedure T3DConnector.ReadFromStream(Stream: TStream);
var
i, j: integer;
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
xd, yd, zd: Double;
mStr: TMemoryStream;
fStr: TFileStream;
CanAdd: Boolean;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
F3dModelFileName := ReadStringFromStream(Stream); // Tolik 03/10/2018 - -
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
21: FSCSComponID := intVal;
22: FListID := intVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
Case xcode of
150: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPoint.x := xd;
FPoint.y := yd;
FPoint.z := zd;
end;
151: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FScale.x := xd;
FScale.y := yd;
FScale.z := zd;
end;
152: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FRotate.x := xd;
FRotate.y := yd;
FRotate.z := zd;
end;
153: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FOffset.x := xd;
FOffset.y := yd;
FOffset.z := zd;
end;
end;
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
181: FDescription.Text := strVal;
182: FObjectHash := strVal;
183: FTextureHash := strVal;
184: FTexture_ext := strVal;
end;
{TODO} // ïåðåñìîòðåòü - õðåíü ïî õîäó çäåñü äåëàåòñ - îãðàíè÷åííûé íàáîð ôàéëîâ òîëüêî ïèøåòñÿ
// È ÍÅ ÒÀÌ - äîëæíû ðàç òîëüêî ïèñàòüñÿ ýòè äâà ñòðèìà!!!
//if (xCode >= 185) and (xCode <= 199) then
//begin
//CanAdd := True;
//for j := 0 to FFiles.Count - 1 do
//begin
// if FFiles[j] = StrVal then
// CanAdd := False;
//end;
//if CanAdd then
// FFiles.Add(strVal);
//end;
//if (xCode >= 200) and (xCode <= 219) then
//begin
//CanAdd := True;
//for j := 0 to FHashs.Count - 1 do
//begin
// if FHashs[j] = StrVal then
// CanAdd := False;
//end;
//if CanAdd then
// FHashs.Add(strVal);
//end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DConnector.ReadFromStream', E.Message);
end;
end;
procedure T3DConnector.SetRelations;
begin
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DModel(ModelObjectsList.Items[FParentIndex]);
T3DModel(FParent).FScsObjects.Add(self);
end;
end;
Function T3DConnector.Get3DModelFileName(aSCSObject: TConnectorObject): String;
var i, j: Integer;
SCSCatalog: TSCSCatalog;
SCSCompon: TSCSComponent;
A_Cad: TF_CaD;
currList: TSCSList;
begin
Result := '';
A_Cad := Nil;
if TPowerCad(ASCSObject.Owner) <> nil then
if TF_Cad(TPowerCad(ASCSObject.Owner).Owner) <> nil then
A_Cad := TF_Cad(TPowerCad(ASCSObject.Owner).Owner);
if A_Cad <> nil then
begin
currList := F_ProjMan.GSCSBase.CurrProject.GetListByID(A_Cad.FCADListID);
if CurrList <> nil then
begin
SCSCatalog := CurrList.GetCatalogFromReferencesBySCSID(aSCSObject.ID);
if SCSCatalog <> nil then
begin
for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
SCSCompon := SCSCatalog.ComponentReferences[i];
for j := 0 to SCSCompon.Properties.Count - 1 do
begin
if UpperCase(PProperty(SCSCompon.Properties).SysName) = '3DS_MODEL' then
begin
Result := PProperty(SCSCompon.Properties).Value;
break;
end;
end;
if Result <> '' then
break;
end;
end;
end;
end;
end;
// Tolik 04/04/2019 --
procedure T3DConnector.WriteToStream(Stream: TStream);
var
xInt: Integer;
aPoint: pInt;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
WriteString(Stream, F3dModelFileName); // Tolik 03/10/2018 --
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FPoint.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FPoint.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FPoint.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FScale.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FScale.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FScale.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FRotate.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FRotate.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FRotate.z;
WriteBinField(152, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FOffset.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FOffset.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FOffset.z;
WriteBinField(153, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
{TODO} // ïåðåñìîòðåòü - õðåíü ïî õîäó çäåñü äåëàåòñÿ - îãðàíè÷åííûé íàáîð ôàéëîâ òîëüêî ïèøåòñÿ
// È ÍÅ ÒÀÌ - äîëæíû ðàç òîëüêî ïèñàòüñÿ ýòè äâà ñòðèìà!!!
//for i := 0 to FFiles.Count - 1 do
//begin
// xStr := FFiles[i];
// if ((185 + i) <= 199) then
// WriteStrField(185 + i, Stream, xStr);
//end;
//for i := 0 to FHashs.Count - 1 do
//begin
// xStr := FHashs[i];
// if ((200 + i) <= 219) then
// WriteStrField(200 + i, Stream, xStr);
//end;
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(182, Stream, FObjectHash);
WriteStrField(183, Stream, FTextureHash);
WriteStrField(184, Stream, FTexture_ext);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message);
end;
end;
(*
procedure T3DConnector.WriteToStream(Stream: TStream);
var
i, xCount, xInt: Integer;
xByte: Byte;
xStr: string;
xDouble: Double;
aPoint: pInt;
xStream: TFileStream;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
WriteString(Stream, F3dModelFileName); // Tolik 03/10/2018 --
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FPoint.x;
pDouble(pChar(aPoint) + 8)^ := FPoint.y;
pDouble(pChar(aPoint) + 16)^ := FPoint.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FScale.x;
pDouble(pChar(aPoint) + 8)^ := FScale.y;
pDouble(pChar(aPoint) + 16)^ := FScale.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FRotate.x;
pDouble(pChar(aPoint) + 8)^ := FRotate.y;
pDouble(pChar(aPoint) + 16)^ := FRotate.z;
WriteBinField(152, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FOffset.x;
pDouble(pChar(aPoint) + 8)^ := FOffset.y;
pDouble(pChar(aPoint) + 16)^ := FOffset.z;
WriteBinField(153, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
{TODO} // ïåðåñìîòðåòü - õðåíü ïî õîäó çäåñü äåëàåòñÿ - îãðàíè÷åííûé íàáîð ôàéëîâ òîëüêî ïèøåòñÿ
// È ÍÅ ÒÀÌ - äîëæíû ðàç òîëüêî ïèñàòüñÿ ýòè äâà ñòðèìà!!!
//for i := 0 to FFiles.Count - 1 do
//begin
// xStr := FFiles[i];
// if ((185 + i) <= 199) then
// WriteStrField(185 + i, Stream, xStr);
//end;
//for i := 0 to FHashs.Count - 1 do
//begin
// xStr := FHashs[i];
// if ((200 + i) <= 219) then
// WriteStrField(200 + i, Stream, xStr);
//end;
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(182, Stream, FObjectHash);
WriteStrField(183, Stream, FTextureHash);
WriteStrField(184, Stream, FTexture_ext);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message);
end;
end;
*)
{ T3DComponent } // -- Tolik 17/10/2018 --
constructor T3DComponent.Create;
begin
inherited;
FClassName := 'T3DComponent';
isGroupedFigure := False;
end;
{}
{ T3DLine }
procedure T3DLine.CollectLine(aFaces: TList; ap: T3DPointArray);
var
aFace: TFaceRecord;
k: integer;
GetConn: TConnectorObject;
// Tolik 26/04/2018 --
TrunkConn: TConnectorObject;
TrunkZ: double;
Procedure CollectComponDiams;
var i: Integer;
SCSCatalog: TSCSCatalog;
LineCadList: TSCSList;
SCSLine: TOrthoLine;
MaxCableDiam, MaxPipeDiam, MaxCableChannelDiam: String;
SCSCompon: TSCSComponent;
ComponDiam: Double;
begin
if Self.FSCSObject <> nil then
begin
MaxCableDiam := '-1';
MaxPipeDiam := '-1';
MaxCableChannelDiam := '-1';
SCSCatalog := Nil;
SCSLine := Self.FSCSObject;
LineCadList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID);
if LineCadList <> nil then
SCSCatalog := LineCadList.GetCatalogFromReferencesBySCSID(SCSLine.ID);
if SCSCatalog <> nil then
begin
for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
SCSCompon := SCSCatalog.ComponentReferences[i];
//Tolik 10/04/2025 --
//if SCSCompon.ComponentType.SysName <> ctsnCableChannelAccessory then
if ((SCSCompon.ComponentType.SysName <> ctsnCableChannelAccessory) and (SCSCompon.ComponentType.SysName <> ctsnWireTray)) then
begin
ComponDiam := getLineComponOutRadius(SCSCompon);
if isCableComponent(SCSCompon) then //êàáåëü
begin
if CompareValue(ComponDiam, StrToFloat_My(ComponDiameterList[0])) = 1 then
ComponDiameterList[0] := FloatToStr(ComponDiam);
end
else //òðóáà èëè ãîôðà
if (SCSCompon.ComponentType.SysName = ctsnTube) or (SCSCompon.Componenttype.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}') then // òðóáà
begin
if (CompareValue(ComponDiam, StrToFloat_My(ComponDiameterList[1])) = 1) then
ComponDiameterList[1] := FloatToStr(ComponDiam);
end
else // êàáåëüíûé êàíàë
if SCSCompon.ComponentType.SysName = ctsnCableChannel then // êàáåëüíûé êàíàë èëè ãîôðà
begin
if (CompareValue(ComponDiam, StrToFloat_My(ComponDiameterList[2])) = 1) then
ComponDiameterList[2] := FloatToStr(ComponDiam);
end;
end;
end;
end;
end;
end;
//
begin
try
FPoint1 := ap[0];
FPoint2 := ap[1];
{TODO ZCoord}
//ap[0].z := ap[0].z * FScaleDelta;
//ap[1].z := ap[1].z * FScaleDelta;
ap[0].z := ap[0].z * FScaleDeltaSCS; // NEWNEW
ap[1].z := ap[1].z * FScaleDeltaSCS; // NEWNEW
// Tolik 26/04/2018 --
if TOrthoLine(FSCSObject).FisRaiseUpDown then
if ((HListOfCadsFor3DModel <> nil) or (LListOfCadsFor3DModel <> nil)) then
begin
TrunkConn := Nil;
if TConnectorObject(TOrthoLine(FSCSObject).JoinConnector1).FConnRaiseType = crt_TrunkUP then
begin
TrunkConn := TConnectorObject(TOrthoLine(FSCSObject).JoinConnector1);
TrunkZ := Ap[0].z;
end
else
if TConnectorObject(TOrthoLine(FSCSObject).JoinConnector2).FConnRaiseType = crt_TrunkUP then
begin
TrunkConn := TConnectorObject(TOrthoLine(FSCSObject).JoinConnector2);
TrunkZ := Ap[1].z;
end
end;
//
// ïåðåíàçíà÷èòü ïåðâóþ ñòîðîíó
if FSCSObject.JoinConnector1 <> nil then
begin
if TConnectorObject(FSCSObject.JoinConnector1).JoinedConnectorsList.Count = 0 then
GetConn := TConnectorObject(FSCSObject.JoinConnector1)
else
GetConn := TConnectorObject(TConnectorObject(FSCSObject.JoinConnector1).JoinedConnectorsList[0]);
if GetConn <> nil then
begin
ap[0].x := GetConn.ActualPoints[1].x;
ap[0].y := GetConn.ActualPoints[1].y;
end;
end;
// ïåðåíàçíà÷èòü âòîðóþ ñòîðîíó
if FSCSObject.JoinConnector2 <> nil then
begin
if TConnectorObject(FSCSObject.JoinConnector2).JoinedConnectorsList.Count = 0 then
GetConn := TConnectorObject(FSCSObject.JoinConnector2)
else
GetConn := TConnectorObject(TConnectorObject(FSCSObject.JoinConnector2).JoinedConnectorsList[0]);
if GetConn <> nil then
begin
ap[1].x := GetConn.ActualPoints[1].x;
ap[1].y := GetConn.ActualPoints[1].y;
end;
end;
// Tolik -- 26/04/2018 --
if TrunkConn <> nil then
begin
TrunkZ := GetTrunkZ(TrunkConn, TrunkZ);
if TOrthoLine(FSCSObject).JoinConnector1.Id = TrunkConn.Id then
AP[0].z := TrunkZ
else
if TOrthoLine(FSCSObject).JoinConnector2.Id = TrunkConn.Id then
AP[1].z := TrunkZ;
end;
//
CollectComponDiams;
aFace := TFaceRecord.Create(ap, clBlack, ftLine, 0.1, False, FSCSObject);
aFaces.Add(aFace);
FFace := aFace;
except
on E: Exception do AddExceptionToLogEx('T3DLine.CollectLine', E.Message);
end;
end;
constructor T3DLine.Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel);
var
i: integer;
begin
try
inherited Create;
FClassName := 'T3DLine';
FSCSObject := aSCSObject;
FListID := GCadForm.FCADListID;
FDescription := TStringList.Create;
FCaptions := TStringList.Create;
FNotes := TStringList.Create;
FLineType := lt_Line;
FParent := aParent;
FLength := 0;
// Tolik 08/11/2018 --
ComponDiameterList := TStringList.Create;
ComponDiameterList.Add('-1'); // cable
ComponDiameterList.Add('-1'); // tube
ComponDiameterList.Add('-1'); // CableChannel
//
if aSCSObject <> nil then
begin
FSCSCompon := GetSCSComponByCADObj(aSCSObject);
if FSCSCompon <> nil then
FSCSComponID := FSCSCompon.ID
else
FSCSComponID := -1;
FName := FSCSObject.Name;
FIndex := FSCSObject.FIndex;
//for i := 0 to FSCSObject.OutTextCaptions.Count - 1 do
// FDescription.Add(FSCSObject.OutTextCaptions.Strings[i]);
for i := 0 to FSCSObject.OutTextCaptions.Count - 1 do
FCaptions.Add(FSCSObject.OutTextCaptions.Strings[i]);
for i := 0 to FSCSObject.OutTextNotes.Count - 1 do
FNotes.Add(FSCSObject.OutTextNotes.Strings[i]);
if FScsObject.Name = cCadClasses_Mes25 then
FLineType := lt_Raise;
if FScsObject.Name = cCadClasses_Mes27 then
FLineType := lt_FloorRaise;
FLength := FSCSObject.LineLength;
end;
FGLObject := nil;
FGLCaption := nil;
FFace := nil;
FPoint1.x := 0;
FPoint1.y := 0;
FPoint1.z := 0;
FPoint2.x := 0;
FPoint2.y := 0;
FPoint2.z := 0;
FGLPoint1.x := 0;
FGLPoint1.y := 0;
FGLPoint1.z := 0;
FGLPoint2.x := 0;
FGLPoint2.y := 0;
FGLPoint2.z := 0;
FColor := clBlack;
FJoinConnector1 := nil;
FJoinConnector2 := nil;
except
on E: Exception do AddExceptionToLogEx('T3DLine.Create', E.Message);
end;
end;
// Tolik 24/07/2018 --
destructor T3DLine.destroy;
begin
FDescription.Free;
FCaptions.Free;
FNotes.Free;
ComponDiameterList.Free; // Tolik 08/11/2018 --
inherited;
end;
//
procedure T3DLine.ReadFromStream(Stream: TStream);
var
i, j: integer;
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
xd, yd, zd: Double;
mStr: TMemoryStream;
fStr: TFileStream;
CanAdd: Boolean;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
21: FSCSComponID := intVal;
22: FListID := intVal;
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
Case xcode of
150: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPoint1.x := xd;
FPoint1.y := yd;
FPoint1.z := zd;
end;
151: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPoint2.x := xd;
FPoint2.y := yd;
FPoint2.z := zd;
end;
end;
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
181: FDescription.Text := strVal;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DLine.ReadFromStream', E.Message);
end;
end;
procedure T3DLine.SetRelations;
begin
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DModel(ModelObjectsList.Items[FParentIndex]);
T3DModel(FParent).FScsObjects.Add(self);
end;
end;
// Tolik 04/04/2019 --
procedure T3DLine.WriteToStream(Stream: TStream);
var
xInt: Integer;
aPoint: pInt;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FPoint1.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FPoint1.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FPoint1.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FPoint2.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FPoint2.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FPoint2.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message);
end;
end;
{
procedure T3DLine.WriteToStream(Stream: TStream);
var
i, xCount, xInt: Integer;
xByte: Byte;
xStr: string;
xDouble: Double;
aPoint: pInt;
xStream: TFileStream;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FPoint1.x;
pDouble(pChar(aPoint) + 8)^ := FPoint1.y;
pDouble(pChar(aPoint) + 16)^ := FPoint1.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FPoint2.x;
pDouble(pChar(aPoint) + 8)^ := FPoint2.y;
pDouble(pChar(aPoint) + 16)^ := FPoint2.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message);
end;
end;
}
// Tolik 18/10/2018 --
Constructor T3DLineComponent.Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel);
begin
inherited;
FClassName := 'T3DLineComponent';
end;
//
{Tolik 18/09/2018 -- T3DTube -- òðóáà...}
constructor T3DTube.Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel; aSCSCompon: TSCSComponent; aTubeDiameter: Double; aTailTubeList: TList = nil);
var
i: integer;
begin
try
inherited Create;
FClassName := 'T3DTube';
FSCSObject := aSCSObject;
FListID := GCadForm.FCADListID;
FDescription := TStringList.Create;
FCaptions := TStringList.Create;
FNotes := TStringList.Create;
FLineType := lt_Line;
FParent := aParent;
FLength := 0;
FColor := clBlue;
FTopDiameter := 0.5;
FBottomDiameter := 0.5;
if aSCSCompon <> nil then
if not aSCSCompon.ServToDelete then
begin
FSCSCompon := aSCSCompon;
FSCSComponID := FSCSCompon.ID;
FName := ASCSCompon.GetNameForVisible;
FIndex := FSCSObject.FIndex;
if aSCSCompon.IsLine = biTrue then
FLength := aSCSCompon.GetPartLength;
FTopDiameter := aTubeDiameter;
FBottomDiameter := aTubeDiameter;
for i := 0 to aSCSCompon.Properties.Count - 1 do
begin
if UPPERCASE(PProperty(aSCSCompon.Properties[i]).SysName) = 'COLOR' then
begin
try
FColor := TColor(strtoInt(PProperty(aSCSCompon.Properties[i]).Value));
except
end;
end;
{else
if UPPERCASE(PProperty(aSCSCompon.Properties[i]).SysName) = pnOutDiametr then
begin
try
FTopDiameter := StrToFloat_My(PProperty(aSCSCompon.Properties[i]).Value);
FBottomDiameter := StrToFloat_My(PProperty(aSCSCompon.Properties[i]).Value);
except
end;
end;}
end;
end;
FGLObject := nil;
FGLCaption := nil;
FFace := nil;
FPoint1.x := 0;
FPoint1.y := 0;
FPoint1.z := 0;
FPoint2.x := 0;
FPoint2.y := 0;
FPoint2.z := 0;
FGLPoint1.x := 0;
FGLPoint1.y := 0;
FGLPoint1.z := 0;
FGLPoint2.x := 0;
FGLPoint2.y := 0;
FGLPoint2.z := 0;
//FColor := clBlack;
FJoinConnector1 := nil;
FJoinConnector2 := nil;
except
on E: Exception do AddExceptionToLogEx('T3DLine.Create', E.Message);
end;
end;
procedure T3DTube.CollectCylinder(aFaces: TList; ap: T3DPointArray);
var
aFace: TFaceRecord;
k: integer;
GetConn: TConnectorObject;
// Tolik 26/04/2018 --
TrunkConn: TConnectorObject;
TrunkZ: double;
//
begin
TrunkConn := Nil;
try
FPoint1 := ap[0];
FPoint2 := ap[1];
{TODO ZCoord}
//ap[0].z := ap[0].z * FScaleDelta;
//ap[1].z := ap[1].z * FScaleDelta;
ap[0].z := ap[0].z * FScaleDeltaSCS; // NEWNEW
ap[1].z := ap[1].z * FScaleDeltaSCS; // NEWNEW
// Tolik 26/04/2018 --
if TOrthoLine(FSCSObject).FisRaiseUpDown then
if ((HListOfCadsFor3DModel <> nil) or (LListOfCadsFor3DModel <> nil)) then
begin
TrunkConn := Nil;
if TConnectorObject(TOrthoLine(FSCSObject).JoinConnector1).FConnRaiseType = crt_TrunkUP then
begin
TrunkConn := TConnectorObject(TOrthoLine(FSCSObject).JoinConnector1);
TrunkZ := Ap[0].z;
end
else
if TConnectorObject(TOrthoLine(FSCSObject).JoinConnector2).FConnRaiseType = crt_TrunkUP then
begin
TrunkConn := TConnectorObject(TOrthoLine(FSCSObject).JoinConnector2);
TrunkZ := Ap[1].z;
end
end;
//
{
// ïåðåíàçíà÷èòü ïåðâóþ ñòîðîíó
if FSCSObject.JoinConnector1 <> nil then
begin
if TConnectorObject(FSCSObject.JoinConnector1).JoinedConnectorsList.Count = 0 then
GetConn := TConnectorObject(FSCSObject.JoinConnector1)
else
GetConn := TConnectorObject(TConnectorObject(FSCSObject.JoinConnector1).JoinedConnectorsList[0]);
if GetConn <> nil then
begin
//ap[0].x := GetConn.ActualPoints[1].x;
//ap[0].y := GetConn.ActualPoints[1].y;
end;
end;
// ïåðåíàçíà÷èòü âòîðóþ ñòîðîíó
if FSCSObject.JoinConnector2 <> nil then
begin
if TConnectorObject(FSCSObject.JoinConnector2).JoinedConnectorsList.Count = 0 then
GetConn := TConnectorObject(FSCSObject.JoinConnector2)
else
GetConn := TConnectorObject(TConnectorObject(FSCSObject.JoinConnector2).JoinedConnectorsList[0]);
if GetConn <> nil then
begin
ap[1].x := GetConn.ActualPoints[1].x;
ap[1].y := GetConn.ActualPoints[1].y;
end;
end;
}
// Tolik -- 26/04/2018 --
if TrunkConn <> nil then
begin
TrunkZ := GetTrunkZ(TrunkConn, TrunkZ);
if TOrthoLine(FSCSObject).JoinConnector1.Id = TrunkConn.Id then
AP[0].z := TrunkZ
else
if TOrthoLine(FSCSObject).JoinConnector2.Id = TrunkConn.Id then
AP[1].z := TrunkZ;
end;
//
aFace := TFaceRecord.Create(ap, FColor, ftCylinder, 0.1, False, FSCSObject);
aFaces.Add(aFace);
FFace := aFace;
except
on E: Exception do AddExceptionToLogEx('T3DLine.CollectLine', E.Message);
end;
end;
// Tolik 04/04/2019 --
procedure T3DTube.WriteToStream(Stream: TStream);
var
xInt: Integer;
aPoint: pInt;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FPoint1.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FPoint1.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FPoint1.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FPoint2.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FPoint2.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FPoint2.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
WriteStrField(181, Stream, FDescription.Text);
xInt := Integer(FColor);
WriteField(23, Stream, xInt, sizeof(xInt)); // Color
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message);
end;
end;
{
procedure T3DTube.WriteToStream(Stream: TStream);
var
i, xCount, xInt: Integer;
xByte: Byte;
xStr: string;
xDouble: Double;
aPoint: pInt;
xStream: TFileStream;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FPoint1.x;
pDouble(pChar(aPoint) + 8)^ := FPoint1.y;
pDouble(pChar(aPoint) + 16)^ := FPoint1.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FPoint2.x;
pDouble(pChar(aPoint) + 8)^ := FPoint2.y;
pDouble(pChar(aPoint) + 16)^ := FPoint2.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
WriteStrField(181, Stream, FDescription.Text);
xInt := Integer(FColor);
WriteField(23, Stream, xInt, sizeof(xInt)); // Color
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message);
end;
end;
}
procedure T3DTube.ReadFromStream(Stream: TStream);
var
i, j: integer;
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
xd, yd, zd: Double;
mStr: TMemoryStream;
fStr: TFileStream;
CanAdd: Boolean;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
21: FSCSComponID := intVal;
22: FListID := intVal;
23: FColor := TColor(intVal);
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
Case xcode of
150: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPoint1.x := xd;
FPoint1.y := yd;
FPoint1.z := zd;
end;
151: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPoint2.x := xd;
FPoint2.y := yd;
FPoint2.z := zd;
end;
end;
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
181: FDescription.Text := strVal;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DLine.ReadFromStream', E.Message);
end;
end;
procedure T3DTube.SetRelations;
begin
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DModel(ModelObjectsList.Items[FParentIndex]);
T3DModel(FParent).FScsObjects.Add(self);
end;
end;
destructor T3DTube.destroy;
begin
FDescription.Free;
FCaptions.Free;
FNotes.Free;
inherited;
end;
///// T3DBooblick -- Tolik 20/09/2018 --
constructor T3DBooblick.Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel);
var
i: integer;
begin
try
inherited Create;
FClassName := 'T3DBooblick';
FSCSObject := aSCSObject;
FListID := GCadForm.FCADListID;
FDescription := TStringList.Create;
FCaptions := TStringList.Create;
FNotes := TStringList.Create;
FLineType := lt_Line;
FParent := aParent;
FLength := 0;
FColor := clBlue;
FTopDiameter := 0.5;
FBottomDiameter := 0.5;
FGLObject := nil;
FGLCaption := nil;
FFace := nil;
FPoint1.x := 0;
FPoint1.y := 0;
FPoint1.z := 0;
FPoint2.x := 0;
FPoint2.y := 0;
FPoint2.z := 0;
FGLPoint1.x := 0;
FGLPoint1.y := 0;
FGLPoint1.z := 0;
FGLPoint2.x := 0;
FGLPoint2.y := 0;
FGLPoint2.z := 0;
//FColor := clBlack;
FJoinConnector1 := nil;
FJoinConnector2 := nil;
except
on E: Exception do AddExceptionToLogEx('T3DLine.Create', E.Message);
end;
end;
procedure T3DBooblick.CollectBooblick(aFaces: TList; ap: T3DPointArray);
var
aFace: TFaceRecord;
k: integer;
GetConn: TConnectorObject;
// Tolik 26/04/2018 --
TrunkConn: TConnectorObject;
TrunkZ: double;
//
begin
TrunkConn := Nil;
try
FPoint1 := ap[0];
FPoint2 := ap[1];
aFace := TFaceRecord.Create(ap, FColor, ftBooblick, 0.1, False, FSCSObject);
aFaces.Add(aFace);
FFace := aFace;
except
on E: Exception do AddExceptionToLogEx('T3DLine.CollectLine', E.Message);
end;
end;
// Tolik 04/04/2019 --
procedure T3DBooblick.WriteToStream(Stream: TStream);
var
xInt: Integer;
aPoint: pInt;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FPoint1.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FPoint1.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FPoint1.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(PAnsiChar(aPoint) + 0)^ := FPoint2.x;
pDouble(PAnsiChar(aPoint) + 8)^ := FPoint2.y;
pDouble(PAnsiChar(aPoint) + 16)^ := FPoint2.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
WriteStrField(181, Stream, FDescription.Text);
xInt := Integer(FColor);
WriteField(23, Stream, xInt, sizeof(xInt)); // Color
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message);
end;
end;
{
procedure T3DBooblick.WriteToStream(Stream: TStream);
var
i, xCount, xInt: Integer;
xByte: Byte;
xStr: string;
xDouble: Double;
aPoint: pInt;
xStream: TFileStream;
begin
try
WriteString(Stream, FClassName);
WriteString(Stream, FName);
xInt := FSCSComponID;
WriteField(21, Stream, xInt, sizeof(xInt));
xInt := FListID;
WriteField(22, Stream, xInt, sizeof(xInt));
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FPoint1.x;
pDouble(pChar(aPoint) + 8)^ := FPoint1.y;
pDouble(pChar(aPoint) + 16)^ := FPoint1.z;
WriteBinField(150, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
GetMem(aPoint, 24);
pDouble(pChar(aPoint) + 0)^ := FPoint2.x;
pDouble(pChar(aPoint) + 8)^ := FPoint2.y;
pDouble(pChar(aPoint) + 16)^ := FPoint2.z;
WriteBinField(151, Stream, pByte(aPoint), 24);
FreeMem(aPoint, 24);
WriteStrField(181, Stream, FDescription.Text);
xInt := Integer(FColor);
WriteField(23, Stream, xInt, sizeof(xInt)); // Color
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message);
end;
end;
}
procedure T3DBooblick.ReadFromStream(Stream: TStream);
var
i, j: integer;
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
xd, yd, zd: Double;
mStr: TMemoryStream;
fStr: TFileStream;
CanAdd: Boolean;
begin
try
isOk := False;
FName := ReadStringFromStream(Stream);
repeat
xCode := 0;
Stream.Read(xCode, 1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal, 4);
Case xcode of
21: FSCSComponID := intVal;
22: FListID := intVal;
23: FColor := TColor(intVal);
end;
end
else
if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal, 1);
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize, 4);
Case xcode of
150: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPoint1.x := xd;
FPoint1.y := yd;
FPoint1.z := zd;
end;
151: begin
Stream.read(xd, 8);
Stream.read(yd, 8);
Stream.read(zd, 8);
FPoint2.x := xd;
FPoint2.y := yd;
FPoint2.z := zd;
end;
end;
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
case xCode of
180: isOk := true;
181: FDescription.Text := strVal;
end;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
end;
until isOk;
except
on E: Exception do AddExceptionToLogEx('T3DLine.ReadFromStream', E.Message);
end;
end;
procedure T3DBooblick.SetRelations;
begin
if FParentIndex = - 1 then
begin
FParent := nil;
end
else
begin
FParent := T3DModel(ModelObjectsList.Items[FParentIndex]);
T3DModel(FParent).FScsObjects.Add(self);
end;
end;
destructor T3DBooblick.destroy;
begin
FDescription.Free;
FCaptions.Free;
FNotes.Free;
inherited;
end;
////
/////////////////////////////////////////////////////////
///////////////////////Äîáàâëåíî 10.12.2013 Ìèòÿé Ä.Â.//////////////////////////
//*************** -ROOF- **************************
constructor T3DCorner.Create(AParent: T3DRoom; AName: string);
begin
inherited Create;
FClassName := 'T3DCorner';
FName := AName;
FParent := AParent;
FZOrder := 0;
FGLObject := nil;
FFaceType := ftLine;
JoinedWalls := TList.Create;
FSCSCompon := nil;
end;
// Tolik 24/07/2018 --
destructor T3DCorner.destroy;
begin
SetLength(FGLPOints, 0);
JoinedWalls.Free;
inherited;
end;
destructor T3DWallElement.destroy;
var i: Integer;
begin
for i := 0 to FSlopes.Count - 1 do
begin
T3DSlope(FSlopes[i]).free;
end;
FSlopes.free;
for i := 0 to FSides.Count - 1 do
begin
T3DSide(FSides[i]).Free;
end;
FSides.Free;
for i := 0 to FBalconElements.Count - 1 do
begin
T3DBalconElement(FBalconElements[i]).Free;
end;
FBalconElements.Free;
inherited;
end;
Destructor T3DBalconElement.destroy;
var i: Integer;
begin
for i := 0 to FSides.Count - 1 do
begin
T3DSide(FSides[i]).Free;
end;
FSides.Free;
inherited;
end;
Destructor T3DSlope.destroy;
var i: Integer;
begin
for i := 0 to FSides.Count - 1 do
begin
T3DSide(FSides[i]).Free;
end;
FSides.Free;
inherited;
end;
Destructor T3DSObject.destroy;
begin
FDescription.free;
inherited;
end;
Destructor T3DConnector.destroy;
begin
FDescription.Free;
FCaptions.Free;
FNotes.Free;
FJoinedConnectorsList.Free;
FJoinedLinesList.Free;
FRelatedLines.Free;
inherited;
end;
//*************** -\ROOF- **************************
end.