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; 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): 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 } 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; 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): 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; 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 xSide := T3DSide.Create(ftNetPath, fwtInner, wstLeft, self) 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 xSide := T3DSide.Create(ftNetPath, fwtInner, wstRight, self) 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) then xSide := T3DSide.Create(ftNetPath, fwtInner, aWallSideType, self) 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) then xSide := T3DSide.Create(ftNetPath, fwtInner, aWallSideType, self) 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; 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.