admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 17:25:39 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/SRC/ARCH/U_Arch3D.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

4184 lines
128 KiB
ObjectPascal
Raw Permalink Blame History

unit U_Arch3D;
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_SCSComponent, VectorTypes, rrEllipses;
type
// ìîäåëü
T3DModel = class;
// êîìíàòà
T3DRoom = class;
// ñòåíà
T3DWall = class;
// ýëåìåíò ñòåíû (îêíî, äâåðü, áàëêîí, íèøà, àðêà)
T3DWallElement = class;
// ýëåìåíò áàëêîíà (áàëêîííîå îêíî, áàëêîííàÿ äâåðü)
T3DBalconElement = class;
// îòêîñ (äâåðíîé, îêîíîííûé, áàëêîííûé)
T3DSlope = class;
// ãðàíü (ñòåíû, îêíà, äâåðè, îòêîñà è ò.ä) - ýòî òå îáüåêòû ïîëèãîíîâ è ìýøåé,
// êîòîðûå äîáàâëÿþòñÿ â Faces è îòðèñîâûâàþòñÿ
T3DSide = class;
// îáúåêòû ñ 3ds
T3DSObject = class;
T3DModel = class(TMyObject)
FClassName: string;
FName: string;
FRooms: TList;
FHashs: TStringList;
constructor Create;
function GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject;
// 2011-05-10
procedure CollectModel(aFaces: TList; aNets: TList);
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
T3DRoom = class(TMyObject)
private
FParentIndex: Integer;
public
FClassName: string;
FName: string;
FPlanObject: TNet;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DModel;
FNetConture: TDoublePointArr;
FFloorConture: TDoublePointArr;
FCeilingConture: TDoublePointArr;
FWalls: TList;
F3DSObjects: TList;
FFloor: T3DSide;
FCeiling: T3DSide;
FVisible: Boolean;
constructor Create(aFaces: TList; aNet: TNet; aParent: T3DModel);
procedure CollectRoom(aFaces: TList);
procedure CollectFloor(aFaces: TList);
procedure CollectCeiling(aFaces: TList);
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;
FSCSCompon: TSCSComponent;
FSCSComponID: Integer;
FParent: T3DRoom;
FWallElements: TList;
FSides: TList;
FIsArc: Boolean;
constructor Create(aFaces: TList; aNetPath: TNetPath; aParent: T3DRoom);
procedure ParseWall(aFaces: TList);
function CollectWall(aFaces: TList; ap: T3DPointArray; aAdjoiningList: TList; aWallViewType: TWallViewType): TList;
procedure CollectWallWithAdjoining(aFaces: TList; ap: T3DPointArray; aAdjoiningList: TList; aWallSideType: TWallSideType);
function GetFullDoors: TList;
function GetAdjoiningWalls: TList;
function CheckAdjoiningWallSide(l1, l2: TDoublePoint; isAdjoin: boolean = False): Boolean;
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;
procedure WriteToStream(Stream: TStream);
procedure ReadFromStream(Stream: TStream);
procedure SetRelations;
end;
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);
procedure CollectDoor(aFaces: TList; ap: T3DPointArray);
procedure CollectWindow(aFaces: TList; ap: T3DPointArray);
procedure CollectBalcon(aFaces: TList; ap1, ap2: T3DPointArray);
procedure ReplaceArcSides;
procedure ReplaceNicheSides;
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);
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);
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;
FRotate: Integer;
FMirror: Boolean;
FAsArc: Boolean;
FTextureHash: string;
FTexture_ext: string;
FSubSides: TList;
constructor Create(aFaceType: TFaceType; aWallType: TFaceWallType; aSideType: TWallSideType; aParent: TObject);
procedure CollectWallSide(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;
FPath: string;
constructor Create(aParent: T3DRoom);
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;
// ïîëó÷èòü òèï ñòåíû ïî òèïó îáüåêòà 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 GetArcWallPointsAll(aPoints: T3DPointArray; FPlanObject: TNetPath; isWall: boolean = False): T3DPointArray;
const
{TODO}
FDeltaZ: Double = 0.03;
FDeltaZFloor: Double = 0.045;
FDeltaZPlane: Double = 0.032;
FDeltaZSlope: Double = 0.025;
// îòñòóï îò ïîëà
FFloorDelta: Double = 0.00; //.01
// îòñòóï äî ïîòîëêà îò âåðõíèõ ãðàíåé ñòåíû
FFCeilingDelta: Double = 0.00; //.01
// íà÷àëî ïîñòðîåíèå îáüåêòîâ îêíî, äâåðü, íèøà, áàëêîí
FStartDoorObject: Double = 0.0; // 0.03
// îòñòóï îò íèæíåé ãðàíè îáüåêòà äî âåðõíåé ãðàíè ñòåíû
// íàïðèìåð íàðèñîâàòü êóñîê ñòåíû ïîä îêíîì, ÷òîáû íèæíÿÿ ãðàíü îêíà íå ñëèâàëàñü ñ âåðõíåé ãðàíüþ ñòåíû
FDoorObjectDelta: Double = 0.0; //.01
// íàèìåíîâàíèÿ îáüåêòîâ ìîäåëè
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, tex_innerwall, tex_outerwall, tex_floor, tex_ceiling,
tex_doorslope, tex_windowslope, tex_arc, tex_balconslope, tex_niche: string;
FScaleDelta: Double;
FSingleRoom: Boolean;
implementation
uses U_BaseCommon, U_ArchCommon, U_Common, U_Protection, U_ProtectionCommon, Form3d;
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 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 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);
hor_a1 := hor_a1 / outer_len;
hor_a2 := hor_a2 / outer_len;
hor_b1 := hor_b1 / inner_len;
hor_b2 := hor_b2 / inner_len;
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);
depth := depth / d_len;
c.x := d.x - (d.x - c.x) * depth;
c.y := d.y - (d.y - c.y) * depth;
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.GetDoorPointsWithSlope', E.Message);
end;
end;
function GetImageHash(aFName: string): string;
var
Buffer: PByte;
Size: Integer;
ImageStream: TFileStream;
begin
ImageStream := TFileStream.Create(aFName, fmOpenRead);
try
size := ImageStream.Size;
GetMem(Buffer, Size + 1);
ImageStream.Position := 0;
ImageStream.Read(Buffer^, Size);
Result := BuildBuffHash(Buffer, Size);
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.GetImageHash', E.Message);
end;
FreeMem(Buffer, size);
FreeAndNil(ImageStream);
end;
{ T3DModel }
// 2011-05-10
procedure T3DModel.CollectModel(aFaces: TList; aNets: TList);
var
i: integer;
xNet: TNet;
xRoom: T3DRoom;
begin
try
for i := 0 to aNets.Count - 1 do
begin
xNet := TNet(aNets[i]);
xRoom := T3DRoom.Create(aFaces, xNet, self);
FRooms.Add(xRoom);
end;
except
on E: Exception do AddExceptionToLogEx('T3DModel.CollectModel', E.Message);
end;
end;
constructor T3DModel.Create;
var
HashStr, tmpdir, tex_from, tex_to: string;
begin
try
inherited Create;
FClassName := 'T3DModel';
FScaleDelta := UOMToMetre(1000 / GCadForm.PCad.MapScale);
FRooms := TList.Create;
FName := cModel;
FHashs := TStringList.Create;
tmpdir := ExtractDirByCategoryType(dctPictures);
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\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\balcon_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\niche.bmp';
HashStr := GetImageHash(tex_from);
tex_to := tmpdir + '\' + HashStr + '.bmp';
CopyFile(PChar(tex_from), PChar(tex_to), True);
FHashs.Add(HashStr);
except
on E: Exception do AddExceptionToLogEx('T3DModel.Create', 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;
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;
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;
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;
procedure T3DModel.WriteToStream(Stream: TStream);
var
i: integer;
xStr: string;
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;
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DModel.WriteToStream', E.Message);
end;
end;
{ T3DRoom }
procedure T3DRoom.CollectCeiling(aFaces: TList);
var
i, j: integer;
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
Cnt: Integer;
xSide: T3DSide;
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);
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);
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);
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;
}
// MARK
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;
{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;
}
// MARK
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;
FVisible := True;
if aFaces <> nil then
begin
if GCurrentRoom3DView = nil then
begin
FSingleRoom := False;
CollectRoom(aFaces);
end
else
begin
FSingleRoom := True;
if FSCSComponID = GCurrentRoom3DView.ID then
CollectRoom(aFaces)
else
FVisible := False;
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DRoom.Create', 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;
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));
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.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);
begin
try
inherited Create;
FClassName := 'T3DSide';
FColor := clGray;
FFaceType := aFaceType;
FWallType := aWallType;
FSideType := aSideType;
FParent := aParent;
FGLObject := nil;
FFace := nil;
FDescription := TStringList.Create;
FRotate := 0;
FMirror := False;
FAsArc := False;
FTextureHash := '';
FTexture_ext := '';
FSubSides := TList.Create;
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;
except
on E: Exception do AddExceptionToLogEx('T3DSide.Create', E.Message);
end;
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;
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: FRotate := 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;
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 := FRotate;
WriteField(25, 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;
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 := FRotate;
WriteField(25, 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);
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.CheckAdjoiningWallSide(l1, l2: TDoublePoint; isAdjoin: boolean = False): Boolean;
var
i, j: integer;
CAD: TF_CAD;
Nets: TList;
Net: TNet;
NetInnerConture, NetOuterConture: TDoublePointArr;
mp: TDoublePoint;
len, len_a, len_b: double;
xl1, xl2: TDoublePoint;
begin
try
Result := False;
CAD := TF_CAD(TPowerCad(FPlanObject.Net.Owner).Owner);
Nets := GetAllOtherNetsFromCAD(CAD, FPlanObject.Net);
mp.x := (l1.x + l2.x) / 2;
mp.y := (l1.y + l2.y) / 2;
len_a := 1;
len_b := GetLineLenght(l1, l2);
len := len_a / len_b;
xl1.x := l2.x - (l2.x - l1.x) * len;
xl1.y := l2.y - (l2.y - l1.y) * len;
xl2.x := l1.x - (l1.x - l2.x) * len;
xl2.y := l1.y - (l1.y - l2.y) * len;
// Ïåðåáèðàåì âñå äðóãèå êîìíàòû è ñìîòðèì ïîïàäàþò ëè îáå òî÷êè âî âíåøíèé êîíòóð êîìíàòû
// åñëè äà, òî îíà ÷àñòü ñòåíû ñìåæíàÿ è åé ñòàòóñ - âíóòðåííÿ
for i := 0 to Nets.Count - 1 do
begin
Net := TNet(Nets[i]);
// çàäàåì êîíòóð ñòåíû
NetInnerConture := Net.GetRoomInnerConture;
NetOuterConture := Net.GetRoomOuterConture;
NetInnerConture := Net.GetRoomConture;
if {(PtInPolygon(NetOuterConture, mp)) or }
(PtInPolygon(NetInnerConture, mp)) then
begin
Result := True;
exit;
end;
(*
if (PtInPolygon(NetOuterConture, xl1) and PtInPolygon(NetOuterConture, xl2)) or
(PtInPolygon(NetInnerConture, xl1) and PtInPolygon(NetInnerConture, xl2)) then
begin
Result := True;
exit;
end;
*)
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.CheckAdjoiningWallSide', E.Message);
end;
end;
function T3DWall.CollectWall(aFaces: TList; ap: T3DPointArray; aAdjoiningList: TList; aWallViewType: TWallViewType): TList;
var
i: integer;
a3DPointArr, a3DPointArrArc: T3DPointArray;
aFace: TFaceRecord;
WallSideConture: TDoublePointArr;
AdjoiningList: TList;
pp: PDoublePoint;
p: TDoublePoint;
l1, l2: TDoublePoint;
xSide: T3DSide;
{
j: integer;
a3DPointArrCeil: T3DPointArray;
aFaceCeil: TFaceRecord;
Cnt: Integer;
xSideCeil: T3DSide;
}
begin
try
// ïåðåôîìèðîâàòü aAdjoiningList, âûÿâèòü òîëüêî òå òî÷êè êîòîðûå âõîäÿò â ýòîò áëîê ñòåíû
AdjoiningList := TList.Create;
for i := 0 to aAdjoiningList.Count - 1 do
begin
pp := PDoublePoint(aAdjoiningList[i]);
p := pp^;
SetLength(WallSideConture, 4);
WallSideConture[0] := ap[0];
WallSideConture[1] := ap[1];
WallSideConture[2] := ap[3];
WallSideConture[3] := ap[2];
if PtInPolygon(WallSideConture, p) then
AdjoiningList.Add(pp);
end;
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)
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUnder, self);
// 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)
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUpper, self);
// new ***
if FIsArc then
begin
a3DPointArrArc := GetArcWallPoints(a3DPointArr);
xSide.CollectArcWallSide(aFaces, a3DPointArrArc);
(*
try
xSideCeil := T3DSide.Create(ftNetCeiling, fwtNone, wstNone, self);
Cnt := Length(a3DPointArrArc) div 2;
SetLength(xSideCeil.FPoints, Cnt{ * 2});
SetLength(xSideCeil.FGLPoints, Cnt{ * 2});
for j := 0 to Cnt - 1 do
begin
xSideCeil.FPoints[j] := a3DPointArrArc[j];
end;
aFaceCeil := TFaceRecord.Create(xSideCeil.FPoints, xSideCeil.FColor, ftNetCeiling, 1, False, nil);
aFaces.Add(aFaceCeil);
xSideCeil.FFace := aFaceCeil;
xSideCeil.FName := cCeiling;
//FCeiling := xSideCeil;
except
on E: Exception do AddExceptionToLogEx('U_Arch3D.CollectWall_Ceiling', E.Message);
end;
*)
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);
// 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 (AdjoiningList <> nil) and (AdjoiningList.Count > 0) then
begin
CollectWallWithAdjoining(aFaces, a3DPointArr, AdjoiningList, wstLeft);
end
else
begin
l1 := ap[0];
l2 := ap[1];
if CheckAdjoiningWallSide(l1, l2) then
begin
xSide := T3DSide.Create(ftNetPath, fwtInner, wstLeft, self);
if Not FIsArc then
xSide.FDescription.Text := 'empty';
end
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstLeft, self);
// 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;
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);
// 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 (AdjoiningList <> nil) and (AdjoiningList.Count > 0) then
begin
CollectWallWithAdjoining(aFaces, a3DPointArr, AdjoiningList, wstRight);
end
else
begin
l1 := ap[2];
l2 := ap[3];
if CheckAdjoiningWallSide(l1, l2) then
begin
xSide := T3DSide.Create(ftNetPath, fwtInner, wstRight, self);
if Not FIsArc then
xSide.FDescription.Text := 'empty';
end
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstRight, self);
// 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;
end;
// Ëåâàÿ Áîêîâàÿ ãðàíü
if not (wvtNoLeftSide in aWallViewType) then
begin
a3DPointArr[0] := ap[0];
a3DPointArr[1] := ap[4];
a3DPointArr[2] := ap[2];
a3DPointArr[3] := ap[6];
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, wstLeftSide, self)
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstLeftSide, self);
xSide.CollectWallSide(aFaces, a3DPointArr);
FSides.Add(xSide);
Result.Add(xSide);
end;
// Ïðàâàÿ Áîêîâàÿ ãðàíü
if not (wvtNoRightSide in aWallViewType) then
begin
a3DPointArr[0] := ap[1];
a3DPointArr[1] := ap[5];
a3DPointArr[2] := ap[3];
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, wstRightSide, self)
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, wstRightSide, self);
xSide.CollectWallSide(aFaces, a3DPointArr);
FSides.Add(xSide);
Result.Add(xSide);
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.CollectWall', E.Message);
end;
end;
procedure T3DWall.CollectWallWithAdjoining(aFaces: TList; ap: T3DPointArray; aAdjoiningList: TList; aWallSideType: TWallSideType);
var
pp1, pp2: PDoublePoint;
p1, p2, l1, l2, h1, h2, xl, xh, xl1, xh1: TDoublePoint;
i, j: integer;
koef, len1, len2: double;
WallPoints: TList;
Inserted: Boolean;
a3DPointArr: T3DPointArray;
aFace: TFaceRecord;
WallSideConture: TDoublePointArr;
xSide: T3DSide;
begin
try
l1 := ap[0];
l2 := ap[1];
h1 := ap[2];
h2 := ap[3];
WallPoints := TList.create;
SetLength(a3DPointArr, 4);
for i := 0 to aAdjoiningList.Count - 1 do
begin
pp1 := PDoublePoint(aAdjoiningList[i]);
p1 := pp1^;
// Ïðîâåðèòü, ÷òî òî÷êà âõîäèò èìåííî â ýòó ãðàíü ñòåíû!!!
begin
len1 := GetLineLenght(l1, p1);
Inserted := False;
// îòñîðòèðîâàòü, ÷òîáû øëè ïî ïîðÿäêó
for j := 0 to WallPoints.Count - 1 do
begin
pp2 := PDoublePoint(WallPoints[j]);
p2 := pp2^;
len2 := GetLineLenght(l1, p2);
if len1 < len2 then
begin
WallPoints.Insert(j, pp1);
Inserted := True;
break;
end;
end;
if not Inserted then
WallPoints.Add(pp1);
end;
end;
// ïåðåáèðàåì òî÷êè è ñòðîèì îòðåçêè ñòåíû
xl1 := l1;
xh1 := h1;
for i := 0 to WallPoints.Count - 1 do
begin
p1 := PDoublePoint(WallPoints[i])^;
len1 := GetLineLenght(l1, p1);
len2 := GetLineLenght(l2, p1);
koef := len1 / (len1 + len2);
xl.x := l1.x - (l1.x - l2.x) * koef;
xl.y := l1.y - (l1.y - l2.y) * koef;
xl.z := l1.z;
xh := xl;
xh.z := h1.z;
a3DPointArr[0] := xl1;
a3DPointArr[1] := xl;
a3DPointArr[2] := xh1;
a3DPointArr[3] := xh;
if CheckAdjoiningWallSide(xl1, xl, True) then
begin
xSide := T3DSide.Create(ftNetPath, fwtInner, aWallSideType, self);
if Not( (PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2])) or
(PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3])) ) then
if Not FIsArc then
xSide.FDescription.Text := 'empty';
end
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, aWallSideType, self);
xSide.CollectWallSide(aFaces, a3DPointArr);
FSides.Add(xSide);
xl1 := xl;
xh1 := xh;
end;
a3DPointArr[0] := xl1;
a3DPointArr[1] := l2;
a3DPointArr[2] := xh1;
a3DPointArr[3] := h2;
if CheckAdjoiningWallSide(xl1, l2, True) then
begin
xSide := T3DSide.Create(ftNetPath, fwtInner, aWallSideType, self);
if Not( (PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2])) or
(PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3])) ) then
if Not FIsArc then
xSide.FDescription.Text := 'empty';
end
else
xSide := T3DSide.Create(ftNetPath, fwtOuter, aWallSideType, self);
xSide.CollectWallSide(aFaces, a3DPointArr);
FSides.Add(xSide);
except
on E: Exception do AddExceptionToLogEx('T3DWall.CollectWallWithAdjoining', E.Message);
end;
end;
constructor T3DWall.Create(aFaces: TList; aNetPath: TNetPath; aParent: T3DRoom);
begin
try
inherited Create;
FClassName := 'T3DWall';
FPlanObject := aNetPath;
if aNetPath <> nil then
begin
FIsArc := FPlanObject.isArc;
FSCSCompon := GetArchObjByCADObj(aNetPath);
FSCSComponID := FSCSCompon.ID;
FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark;
end;
FWallElements := TList.Create;
FSides := TList.Create;
FParent := aParent;
if aFaces <> nil then
ParseWall(aFaces);
except
on E: Exception do AddExceptionToLogEx('T3DWall.Create', E.Message);
end;
end;
function T3DWall.GetAdjoiningWalls: TList;
var
i, j: integer;
CAD: TF_CAD;
CADWalls: TList;
WallConture: TDoublePointArr;
Wall: TNetPath;
NetPathConture, NetInnerConture, NetOuterConture: TDoublePointArr;
rad1, rad2: Double;
begin
try
Result := TList.Create;
WallConture := FPlanObject.GetConturePolygon;
NetInnerConture := FPlanObject.Net.GetRoomInnerConture;
NetOuterConture := FPlanObject.Net.GetRoomOuterConture;
CAD := TF_CAD(TPowerCad(FPlanObject.Net.Owner).Owner);
CADWalls := GetAllOtherNetWallsFromCAD(CAD, FPlanObject.Net);
if CADWalls.Count > 0 then
begin
// çàäàåì êîíòóð ñòåíû
SetLength(NetPathConture, 4);
NetPathConture[0] := FPlanObject.l1;
NetPathConture[1] := FPlanObject.l2;
NetPathConture[2] := FPlanObject.r2;
NetPathConture[3] := FPlanObject.r1;
rad1 := GetRadOfLine(FPlanObject.p1^, FPlanObject.p2^);
// Ïåðåáèðàåì âñå ñòåíû è ñìîòðèì ïîïàäàþò ëè îíè â äàííóþ ñòåíó ïî êîîðäèíàòàì
for i := 0 to CADWalls.Count - 1 do
begin
Wall := TNetPath(CADWalls[i]);
rad2 := GetRadOfLine(Wall.p1^, Wall.p2^);
if (PtInPolygon(NetInnerConture, Wall.p1^) and AnglesCMP(rad1, rad2) and PointDistCMP(Wall.p1^, FPlanObject)) or
(PtInPolygon(NetOuterConture, Wall.p1^) and AnglesCMP(rad1, rad2) and PointDistCMP(Wall.p1^, FPlanObject))then
Result.Add(Wall.p1);
if (PtInPolygon(NetInnerConture, Wall.p2^) and AnglesCMP(rad1, rad2) and PointDistCMP(Wall.p2^, FPlanObject)) or
(PtInPolygon(NetOuterConture, Wall.p2^) and AnglesCMP(rad1, rad2) and PointDistCMP(Wall.p2^, FPlanObject)) then
Result.Add(Wall.p2);
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.GetAdjoiningWalls', E.Message);
end;
end;
function GetArcWallPointsAll(aPoints: T3DPointArray; FPlanObject: TNetPath; isWall: boolean = False): T3DPointArray;
var
Fpoints: T2DPointArray;
Radius: Double;
a1,a2: Double;
Cnt: Integer;
i, idx: Integer;
p1, p2: TDoublePoint;
FPointsInOrder: Boolean; // Íîâûå òî÷êè äîáàâëÿòü â ïîðÿäêå êîòîðîì ïðèøëè, èëè îáðàòíîì
OldDxfMode: Boolean;
procedure AddPointToArray(APoint: TDoublePoint; var AArray: T3DPointArray);
begin
SetLength(AArray, Length(AArray)+1);
AArray[Length(AArray)-1] := APoint;
end;
begin
try
SetLength(Result, 0);
// 1-st ARC
p1 := aPoints[0];
p2 := aPoints[1];
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);
AddPointToArray(p1, Result);
if Cnt > 2 then
begin
FPointsInOrder := EQDP(p1, DoublePoint(FPoints[0].x, FPoints[0].y));
for i := 1 to cnt - 2 do
begin
if FPointsInOrder then
idx := i
else
idx := cnt - i - 1;
if (i mod 10) = 0 then
AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p1.z), Result);
end;
end;
AddPointToArray(p2, Result);
if length(aPoints) > 3 then
begin
// 2-nd ARC
p1 := aPoints[2];
p2 := aPoints[3];
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
AddPointToArray(p1, Result);
if Cnt > 2 then
begin
FPointsInOrder := EQDP(p1, DoublePoint(FPoints[0].x, FPoints[0].y));
for i := 1 to cnt - 2 do
begin
if FPointsInOrder then
idx := i
else
idx := cnt - i - 1;
if (i mod 10) = 0 then
AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p2.z), Result);
end;
end;
AddPointToArray(p2, Result);
end
else
begin
AddPointToArray(p2, Result);
if Cnt > 2 then
begin
FPointsInOrder := EQDP(p2, DoublePoint(FPoints[0].x, FPoints[0].y));
for i := 1 to cnt - 2 do
begin
if FPointsInOrder then
idx := i
else
idx := cnt - i - 1;
if (i mod 10) = 0 then
AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p2.z), Result);
end;
end;
AddPointToArray(p1, Result);
end;
end;
except
on E: Exception do AddExceptionToLogEx('T3DWall.GetArcWallPoints', E.Message);
end;
end;
function T3DWall.GetArcWallPoints(aPoints: T3DPointArray; isWall: boolean = False): T3DPointArray;
begin
result := GetArcWallPointsAll(aPoints, FPlanObject, 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;
procedure T3DWall.ParseWall(aFaces: TList);
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;
xl1, xr1, da1, da2, db1, db2: TDoublePoint;
ba1, ba2, ba3, bb1, bb2, bb3: TDoublePoint;
ca1, ca2, cb1, cb2: TDoublePoint;
AllDoors, AdjoiningList, WallSides: TList;
len1, len2: double;
hor_a1, hor_a2, hor_b1, hor_b2, ver_a, ver_b, depth_a, depth_b: double;
WallType: TFaceWallType;
WallViewType: TWallViewType;
xWallElement, xPrevWallElement: T3DWallElement;
xSlope: T3DSlope;
xSide: T3DSide;
Corners: TSCSComponents;
begin
try
WallComponID := FSCSComponID;
wall_h1 := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta;
wall_h2 := wall_h1 + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta;
// MARK
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;
//
SetLength(Points, 8);
WallSides := nil;
// âñå äâåðè ñ ó÷åòîì ñìåæíûõ
AllDoors := GetFullDoors;
// åñòü ëè ñìåæíûå ñòåíû ñ ýòîé
// åñëè 3Ä ïî îòäåëüíîé êîìíàòå òî èñêàòü íåò ñìûñëà
if FSingleRoom then
AdjoiningList := TList.Create
else
AdjoiningList := GetAdjoiningWalls;
// åñëè âíóòðè åñòü äâåðè, îêíà ... (àëãîðèòì ïîñòðîåíèÿ ¹1)
if AllDoors.Count > 0 then
begin
xl1 := FPlanObject.l1;
xr1 := FPlanObject.r1;
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);
// îïðåäåëèòü ÷àñòü ñòåíû, îò íà÷àëà äî ñëåä. îáüåêòà
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;
end
else
begin
da1 := aDoor.b2;
da2 := aDoor.b1;
db1 := aDoor.a2;
db2 := aDoor.a1;
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 := [];
if PrevDoor <> nil then
begin
WallType := GetWallTypeByDoorType(PrevDoor);
if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then
WallViewType := WallViewType + [wvtNoLeftSide];
end;
WallType := GetWallTypeByDoorType(aDoor);
if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then
begin
WallViewType := WallViewType + [wvtNoRightSide];
InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Âíóòðåííèé îòêîñ
// Îêíî
if WallType = fwtWindowSlope then
begin
OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Âíåøíèé îòêîñ
// åñòü îêíî è íå ñìåæíàÿ ñòåíà, òî áðàòü âíåøíèå îòêîñû
if (AdjoiningList.Count = 0) and (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;
{
Points[4] := xl1;
Points[4].z := wall_h2;
Points[5] := da1;
Points[5].z := wall_h2;
Points[6] := xr1;
Points[6].z := wall_h2;
Points[7] := db1;
Points[7].z := wall_h2;
}
// MARK
// ïåðâûé áëîê - âçÿòü âûñîòó ñ ìîäïîèíòà
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[6] := xr1;
Points[6].z := corner_side1;
Points[7] := db1;
Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, 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[5] := da1;
Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[6] := xr1;
Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2);
Points[7] := db1;
Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
end;
WallSides := CollectWall(aFaces, Points, AdjoiningList, 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);
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] := 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);
// ïîñòðîèòü áëîê ñòåíû ñíèçó
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 := CollectWall(aFaces, Points, AdjoiningList, []);
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 := wall_h2;
Points[5] := da2;
Points[5].z := wall_h2;
Points[6] := db1;
Points[6].z := wall_h2;
Points[7] := db2;
Points[7].z := wall_h2;
}
// MARK
Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[5] := da2;
Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2);
Points[6] := db1;
Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[7] := db2;
Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2);
WallSides := CollectWall(aFaces, Points, AdjoiningList, [wvtNoUnder]);
// ïîñòðîèòü îòêîñû äëÿ äâåðè
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);
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);
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);
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);
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);
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);
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);
// ïîñòðîèòü áëîê ñòåíû ñíèçó
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 := CollectWall(aFaces, Points, AdjoiningList, []);
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 := wall_h2;
Points[5] := da2;
Points[5].z := wall_h2;
Points[6] := db1;
Points[6].z := wall_h2;
Points[7] := db2;
Points[7].z := wall_h2;
}
// MARK
Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[5] := da2;
Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2);
Points[6] := db1;
Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[7] := db2;
Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2);
WallSides := CollectWall(aFaces, Points, AdjoiningList, [wvtNoUnder]);
// ïîñòðîèòü îòêîñû äëÿ îêíà
// âíóòðåííèå
{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);
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);
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);
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);
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);
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);
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);
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);
// ïîñòðîèòü áëîê ñòåíû ñíèçó
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 := CollectWall(aFaces, Points, AdjoiningList, []);
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 := wall_h2;
Points[5] := da2;
Points[5].z := wall_h2;
Points[6] := db1;
Points[6].z := wall_h2;
Points[7] := db2;
Points[7].z := wall_h2;
}
// MARK
Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2);
Points[5] := da2;
Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2);
Points[6] := db1;
Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2);
Points[7] := db2;
Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2);
WallSides := CollectWall(aFaces, Points, AdjoiningList, [wvtNoUnder]);
// äîñòðîèòü áëîê ñòåíû â ïðîåì
ba1 := da1;
ba3 := da2;
bb1 := db1;
bb3 := db2;
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 := CollectWall(aFaces, Points, AdjoiningList, []);
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);
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);
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);
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);
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);
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);
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].z := door_h2;
Points[1] := aDoor.a2;
Points[1].z := door_h2;
Points[2] := aDoor.b1;
Points[2].z := door_h2;
Points[3] := aDoor.b2;
Points[3].z := door_h2;
Points[4] := aDoor.a1;
{
Points[4].z := wall_h2;
Points[5] := aDoor.a2;
Points[5].z := wall_h2;
Points[6] := aDoor.b1;
Points[6].z := wall_h2;
Points[7] := aDoor.b2;
Points[7].z := wall_h2;
}
// MARK
Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a1, corner_side1, corner_side2);
Points[5] := aDoor.a2;
Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a2, corner_side1, corner_side2);
Points[6] := aDoor.b1;
Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b1, corner_side1, corner_side2);
Points[7] := aDoor.b2;
Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b2, corner_side1, corner_side2);
WallSides := CollectWall(aFaces, Points, AdjoiningList, []);
SetWallTypeToWallSide(WallSides, wstUnder, fwtArc, xWallElement);
//xWallElement.ReplaceArcSides;
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);
// äîñòðîèòü áëîê ñòåíû îò íèøû
Points[0] := aDoor.a1;
Points[0].z := door_h1;
Points[1] := aDoor.a2;
Points[1].z := door_h1;
Points[2] := aDoor.ca1;
Points[2].z := door_h1;
Points[3] := aDoor.ca2;
Points[3].z := door_h1;
Points[4] := aDoor.a1;
Points[4].z := door_h2;
Points[5] := aDoor.a2;
Points[5].z := door_h2;
Points[6] := aDoor.ca1;
Points[6].z := door_h2;
Points[7] := aDoor.ca2;
Points[7].z := door_h2;
WallSides := CollectWall(aFaces, Points, AdjoiningList, []);
SetWallTypeToWallSide(WallSides, wstRight, fwtNiche, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñíèçó
Points[0] := aDoor.a1;
Points[0].z := wall_h1;
Points[1] := aDoor.a2;
Points[1].z := wall_h1;
Points[2] := aDoor.b1;
Points[2].z := wall_h1;
Points[3] := aDoor.b2;
Points[3].z := wall_h1;
Points[4] := aDoor.a1;
Points[4].z := door_h1;
Points[5] := aDoor.a2;
Points[5].z := door_h1;
Points[6] := aDoor.b1;
Points[6].z := door_h1;
Points[7] := aDoor.b2;
Points[7].z := door_h1;
WallSides := CollectWall(aFaces, Points, AdjoiningList, []);
SetWallTypeToWallSide(WallSides, wstUpper, fwtNiche, xWallElement);
// ïîñòðîèòü áëîê ñòåíû ñâåðõó
Points[0] := aDoor.a1;
Points[0].z := door_h2;
Points[1] := aDoor.a2;
Points[1].z := door_h2;
Points[2] := aDoor.b1;
Points[2].z := door_h2;
Points[3] := aDoor.b2;
Points[3].z := door_h2;
Points[4] := aDoor.a1;
{
Points[4].z := wall_h2;
Points[5] := aDoor.a2;
Points[5].z := wall_h2;
Points[6] := aDoor.b1;
Points[6].z := wall_h2;
Points[7] := aDoor.b2;
Points[7].z := wall_h2;
}
// MARK
Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a1, corner_side1, corner_side2);
Points[5] := aDoor.a2;
Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a2, corner_side1, corner_side2);
Points[6] := aDoor.b1;
Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b1, corner_side1, corner_side2);
Points[7] := aDoor.b2;
Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b2, corner_side1, corner_side2);
WallSides := CollectWall(aFaces, Points, AdjoiningList, []);
SetWallTypeToWallSide(WallSides, wstUnder, fwtNiche, xWallElement);
//xWallElement.ReplaceNicheSides;
end;
PrevDoor := aDoor;
PrevDoorSCSCompon := DoorSCSCompon;
xPrevWallElement := xWallElement;
end;
WallViewType := [];
WallType := fwtNone;
if PrevDoor <> nil then
WallType := GetWallTypeByDoorType(PrevDoor);
if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then
WallViewType := WallViewType + [wvtNoLeftSide];
Points[0] := xl1;
Points[0].z := wall_h1;
Points[1] := FPlanObject.l2;
Points[1].z := wall_h1;
Points[2] := xr1;
Points[2].z := wall_h1;
Points[3] := FPlanObject.r2;
Points[3].z := wall_h1;
Points[4] := xl1;
{
Points[4].z := wall_h2;
Points[5] := FPlanObject.l2;
Points[5].z := wall_h2;
Points[6] := xr1;
Points[6].z := wall_h2;
Points[7] := FPlanObject.r2;
Points[7].z := wall_h2;
}
// MARK
Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2);
Points[5] := FPlanObject.l2;
Points[5].z := corner_side2;
Points[6] := xr1;
Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2);
Points[7] := FPlanObject.r2;
Points[7].z := corner_side2;
WallSides := CollectWall(aFaces, Points, AdjoiningList, WallViewType);
// ïîñòàâèòü òèï ñòåíû ïî ñëåäóþùåìó îáüåêòó TNetDoor
if WallType in [fwtNiche, fwtArc] then
SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement);
end
else
// åñëè âíóòðè íè÷åãî íåò (àëãîðèòì ïîñòðîåíèÿ ¹2)
begin
Points[0] := FPlanObject.l1;
Points[0].z := wall_h1;
Points[1] := FPlanObject.l2;
Points[1].z := wall_h1;
Points[2] := FPlanObject.r1;
Points[2].z := wall_h1;
Points[3] := FPlanObject.r2;
Points[3].z := wall_h1;
Points[4] := FPlanObject.l1;
{
Points[4].z := wall_h2;
Points[5] := FPlanObject.l2;
Points[5].z := wall_h2;
Points[6] := FPlanObject.r1;
Points[6].z := wall_h2;
Points[7] := FPlanObject.r2;
Points[7].z := wall_h2;
}
// MARK
Points[4].z := corner_side1;
Points[5] := FPlanObject.l2;
Points[5].z := corner_side2;
Points[6] := FPlanObject.r1;
Points[6].z := corner_side1;
Points[7] := FPlanObject.r2;
Points[7].z := corner_side2;
WallSides := CollectWall(aFaces, Points, AdjoiningList, []);
end;
if WallSides <> nil then
FreeAndNil(WallSides);
except
on E: Exception do AddExceptionToLogEx('T3DWall.ParseWall', E.Message);
end;
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
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
FSCSCompon := GetArchObjByCADObj(aNetDoor);
FSCSComponID := FSCSCompon.ID;
FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark;
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.ReplaceArcSides;
var
i, j: integer;
xSide: T3DSide;
begin
try
for i := 0 to FParent.FSides.Count - 1 do
begin
xSide := T3DSide(FParent.FSides[i]);
if xSide.FWallType = fwtArc then
begin
FSides.Add(xSide);
end;
end;
for i := 0 to FSides.Count - 1 do
begin
xSide := T3DSide(FSides[i]);
FParent.FSides.Remove(xSide);
end;
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.ReplaceArcSides', E.Message);
end;
end;
procedure T3DWallElement.ReplaceNicheSides;
var
i, j: integer;
xSide: T3DSide;
begin
try
for i := 0 to FParent.FSides.Count - 1 do
begin
xSide := T3DSide(FParent.FSides[i]);
if xSide.FWallType = fwtNiche then
begin
FSides.Add(xSide);
end;
end;
for i := 0 to FSides.Count - 1 do
begin
xSide := T3DSide(FSides[i]);
FParent.FSides.Remove(xSide);
end;
except
on E: Exception do AddExceptionToLogEx('T3DWallElement.ReplaceNicheSides', 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 aNetDoor <> nil then
begin
FSCSCompon := GetArchObjByCADObj(aNetDoor);
FSCSComponID := FSCSCompon.ID;
end;
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;
FPath := '';
except
on E: Exception do AddExceptionToLogEx('T3DSObject.Create', E.Message);
end;
end;
procedure T3DSObject.ReadFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize: Integer;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
xByte: pByte;
xd, yd, zd: Double;
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;
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: FPath := 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);
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(182, Stream, FPath);
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;
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);
WriteStrField(181, Stream, FDescription.Text);
WriteStrField(182, Stream, FPath);
WriteStrField(180, Stream, 'BaseEnd');
except
on E: Exception do AddExceptionToLogEx('T3DSObject.WriteToStream', E.Message);
end;
end;
}
end.
Reference in New Issue View Git Blame Copy Permalink