unit U_Arch3DNew; interface uses Windows, Forms, StdCtrls, Classes, ComCtrls, Controls, DrawEngine, PCTypesUtils, SysUtils, Dialogs, Math, Contnrs, DrawObjects, PCDrawBox, PCDrawing, PowerCad, Graphics, U_Cad, U_ESCadClasess, fplan, U_Common_Classes, U_BaseConstants, U_SCSComponent, VectorTypes, rrEllipses, GlColor; const myDelta = 0.05; type // модель T3DModel = class; // комната T3DRoom = class; // стена T3DWall = class; // элемент стены (окно, дверь, балкон, ниша, арка) T3DWallElement = class; // элемент балкона (балконное окно, балконная дверь) T3DBalconElement = class; // откос (дверной, окононный, балконный) T3DSlope = class; // грань (стены, окна, двери, откоса и т.д) - это те обьекты полигонов и мэшей, // которые добавляются в Faces и отрисовываются T3DSide = class; // объекты с 3ds T3DSObject = class; T3DLineType = (lt_Line, lt_Raise, lt_FloorRaise); T3DConnType = (ct_Empty, ct_Full); TWallPoints = record WallPoint1: double; Wallpoint2: double; end; //Tolik -- 09/07/2018 -- TNetEntryInfo = record NetPath: TNetPath; P1EntryCount: integer; P2EntryCount: integer; end; PNetEntryInfo = ^TNetEntryInfo; // T3DModel = class(TObject) private function FindRealWallByVirtualNetPath(aNetPath: TNetPath): T3DWall; function FindWallByNetPath(aNetPath: TNetPath): T3DWall; public FClassName: string; FName: string; FRooms: TList; FScsObjects: TList; FHashs: TStringList; F3DSHashs: TStringList; isUserTransparency: Boolean; // Tolik 28/11/2018 -- FFiles: TStringList; FFilesHashs: TStringList; constructor Create; //Tolik 23/07/0218 -- Destructor destroy;override; // function GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject; procedure CollectModel(aFaces: TList; aNets: TList); procedure CollectScsModel(aFaces: TList; aScsObjects: TList); procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; T3DRoom = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FListID: Integer; FPlanObject: TNet; FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DModel; FNetConture: TDoublePointArr; FFloorConture: TDoublePointArr; FCeilingConture: TDoublePointArr; FFloorContureForNormal: TDoublePointArr; // Tolik 14/01/2020 // Tolik --20/06/2018 -- FCeilingContureList: Array of TDoublePointArr; // контуры полов для СКС -- засунуть все в одну комнату, так как в СКС ТОЛЬКО ОДИН TNET .... // соответственно и комнату строить будем, в отличие от ГрафМодуля, ТОЛЬКО ОДНУ... // FWalls: TList; F3DSObjects: TList; FFloor: T3DSide; FCeiling: T3DSide; FVisible: Boolean; FZOrder: double; FCorner: TList; constructor Create(aFaces: TList; aNet: TNet; aParent: T3DModel); //Tolik 23/07/2018-- Destructor destroy; override; // //Tolik 17/07/2018 -- //procedure CollectRoom(aFaces: TList); procedure CollectRoom(aFaces: TList; aSCSPathList: TList = nil); // // Tolik 13/01/2020 //procedure CollectFloor(aFaces: TList); //procedure CollectCeiling(aFaces: TList); procedure CollectFloor(aFaces: TList; aPathContureList: TList = nil); procedure CollectCeiling(aFaces: TList; aPathContureList: TList = nil); // function GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject; procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; T3DWall = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FPlanObject: TNetPath; FVPath: TNetPath; //12.06.2012 FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DRoom; FWallElements: TList; FSides: TList; FIsArc: Boolean; FZOrder: Double; FGLObject: TObject; FFaceType: TFaceType; FPoints: TDoublePointArr; FGLPOints: T3DPointArray; constructor Create(aFaces: TList; aNetPath: TNetPath; aParent: T3DRoom); // Tolik Destructor Destroy; override; // procedure ParseWallForInner(aFaces: TList; aVNetPath: TNetPath); procedure ParseWallForOuter(aFaces: TList; aVNetPath: TNetPath); procedure ParseWallForPerpendSides(aFaces: TList; aVNetPath: TNetPath); //23.05.2012 - Внести перпендикулярные грани //Tolik 31/08/2018 -- Procedure ParseWallForJoint(aPathList: TList; aFaces: TList; aPoint: PDoublePoint); // стыки стен с разной толщиной на пересечении 3-х стен // function CollectInnerWall(aFaces: TList; ap: T3DPointArray; aWallViewType: TWallViewType; isRightInner: Boolean = False): TList; function CollectOuterWall(aFaces: TList; ap: T3DPointArray; aWallViewType: TWallViewType; aKnotFlag: Byte=0; aSideFlag: Byte=0): TList; function GetFullDoors: TList; procedure SetWallTypeToWallSide(aWallSides: TList; aWallSideType: TWallSideType; aWallType: TFaceWallType; aWallElement: T3DWallElement); function CalcPointHeight(p1, p2, Point: TDoublePoint; p1h, p2h: Double): Double; function GetArcWallPoints(aPoints: T3DPointArray; isWall: boolean = False): T3DPointArray; function GetKnotsCount(aNetPath: TNetPath; p: TDoublePoint): Byte; procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; //*************** ROOF ****************** T3DCorner = class(TMyObject) public FClassName: string; FName: string; FParent: T3DRoom; FZOrder: Double; FGLObject: TObject; FFaceType: TFaceType; JoinedWalls: TList; FPoints: TDoublePoint; FGLPOints: T3DPointArray; FSCSCompon: TSCSComponent; constructor Create(AParent: T3DRoom; AName: string); destructor destroy; override; end; //*************** \ROOF ***************** T3DWallElement = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FPlanObject: TNetDoor; FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DWall; FElementType: TDoorObjType; FSlopes: TList; FBalconElements: TList; FSides: TList; constructor Create(aFaces: TList; aNetDoor: TNetDoor; aElementType: TDoorObjType; aParent: T3DWall); // Tolik 24/07/2018 -- destructor destroy; override; // procedure CollectDoor(aFaces: TList; ap: T3DPointArray); procedure CollectWindow(aFaces: TList; ap: T3DPointArray); procedure CollectBalcon(aFaces: TList; ap1, ap2: T3DPointArray); procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; T3DBalconElement = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DWallElement; FElementType: TDoorObjType; FSides: TList; constructor Create(aFaces: TList; aElementType: TDoorObjType; aParent: T3DWallElement); // Tolik 24/07/2018 -- Destructor destroy; override; // procedure CollectBalconDoor(aFaces: TList; ap1: T3DPointArray); procedure CollectBalconWindow(aFaces: TList; ap2: T3DPointArray); procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; T3DSlope = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DWallElement; FSides: TList; constructor Create(aFaces: TList; aNetDoor: TNetDoor; aParent: T3DWallElement); // Tolik 24/07/2018 - - Destructor destroy; override; // procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; T3DSide = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FDescription: TStringList; FParent: TObject; FGLObject: TObject; FFace: TFaceRecord; FFaceType: TFaceType; FWallType: TFaceWallType; FSideType: TWallSideType; FPoints: T3DPointArray; FGLPoints: T3DPointArray; FColor: TColor; FTextureRotate: Integer; FTextureScale: Integer; FMirror: Boolean; FAsArc: Boolean; FTextureHash: string; FTexture_ext: string; FSubSides: TList; FZOrder: double; FNetPath: TNetPath; //29.05.2012 constructor Create(aFaceType: TFaceType; aWallType: TFaceWallType; aSideType: TWallSideType; aParent: TObject; aNetPath: TNetPath=nil); // Tolik 24/07/2018 -- destructor destroy; override; // procedure CollectWallSide(aFaces: TList; ap: T3DPointArray); procedure CollectWallSideEx(aFaces: TList; ap: T3DPointArray); procedure CollectArcWallSide(aFaces: TList; ap: T3DPointArray); procedure CollectWallElementSide(aFaces: TList; ap: T3DPointArray; fTrans: boolean = False); procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; function GetArea: Double; end; T3DSObject = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FDescription: TStringList; FParent: T3DRoom; FGLObject: TObject; FFace: TFaceRecord; FPosition: T3DPoint; FScale: T3DPoint; FRotate: T3DPoint; FObjectHash: string; FTextureHash: string; FTexture_ext: string; FZOrder: double; //FFiles: TStringList; //FHashs: TStringList; constructor Create(aParent: T3DRoom); // Tolik 24/07/218 -- destructor destroy; override; // procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; T3DConnector = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FIndex: Integer; FDescription: TStringList; FCaptions: TStringList; FNotes: TStringList; FListID: Integer; FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DModel; FGLObject: TObject; FGLObject1: TObject; FGLCaption: TObject; FSCSObject: TConnectorObject; FFace: TFaceRecord; FPoint: T3DPoint; FGLPoint: T3DPoint; FOffset: T3DPoint; FScale: T3DPoint; FRotate: T3DPoint; FObjectHash: string; FTextureHash: string; FTexture_ext: string; FZOrder: double; //FFiles: TStringList; //FHashs: TStringList; FColor: TVector4f; FConnType: T3DConnType; FJoinedConnectorsList: TList; FJoinedLinesList: TList; FPipeRadiusArray: array of Double; // Tolik 26/09/2018 -- T3DModelFile: String; FisPipeElement: Boolean; // Tolik 24/09/2018 -- // Tolik 13/10/2018 -- F3dModelFileName: String; FPipeRadius: Double; F3D_Height: Double; F3D_Width: Double; F3D_Length: Double; FUse3DSize: Boolean; HasPipeElements: Boolean; // для пустого коннектора, если на нем будут рисоваться повороты труб, гофры и т.п FRelatedLines: TList; // Tolik 03/04/2025 -- трассы, по которым рисуется часть трубного соединения FLength: Double; // Tolik 03/04/2025 длина соединения // //Tolik -- 24//09/2018 -- //constructor Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel); constructor Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel; aIsPipe: Boolean = False); virtual; // // Tolik 24/07/2018 -- destructor destroy; override; // procedure CollectConnector(aFaces: TList; ap: T3DPointArray); procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; Function Get3DModelFileName(aSCSObject: TConnectorObject): String; end; //Tolik 17/10/2018 -- T3DComponent = Class(T3DConnector) Public AbsVector, AbsUpVector: TVector4F; absMatrix: TMatrix4F; isGroupedFigure: Boolean; constructor Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel; aIsPipe: Boolean = False); override; //Destructor Destroy; end; // T3DLine = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FIndex: Integer; FDescription: TStringList; FCaptions: TStringList; FLength: Double; FNotes: TStringList; FListID: Integer; FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DModel; FGLObject: TObject; FGLCaption: TObject; FSCSObject: TOrthoLine; FFace: TFaceRecord; FPoint1: T3DPoint; FPoint2: T3DPoint; FGLPoint1: T3DPoint; FGLPoint2: T3DPoint; FZOrder: double; FColor: TColor; FLineType: T3DLineType; FJoinConnector1: T3DConnector; // соединитель 1 FJoinConnector2: T3DConnector; // соединитель 2 // Tolik 08/11/2018 - - ComponDiameterList: TStringList; // список макс. диаметров компонент на трассе (если они есть) //[0] -- кабель //[1] -- гофра //[2] -- каб канал constructor Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel); virtual; // Tolik 24/07/2018 -- destructor destroy; override; // procedure CollectLine(aFaces: TList; ap: T3DPointArray); procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; // Tolik 18/10/2018 -- T3DLineComponent = class(T3DLine) public constructor Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel);override; end; // // Tolik 18/09/20108 -- T3DTube = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FIndex: Integer; FDescription: TStringList; FCaptions: TStringList; FLength: Double; FTopDiameter: Double; FBottomDiameter: Double; FNotes: TStringList; FListID: Integer; FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DModel; FGLObject: TObject; FGLCaption: TObject; FSCSObject: TOrthoLine; FFace: TFaceRecord; FPoint1: T3DPoint; FPoint2: T3DPoint; FGLPoint1: T3DPoint; FGLPoint2: T3DPoint; FZOrder: double; FColor: TColor; FLineType: T3DLineType; FJoinConnector1: T3DConnector; // соединитель 1 FJoinConnector2: T3DConnector; // соединитель 2 constructor Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel; aSCSCompon: TSCSComponent; aTubeDiameter: Double; aTailTubeList: TList = nil); destructor destroy; override; procedure CollectCylinder(aFaces: TList; ap: T3DPointArray); procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; T3DBooblick = class(TMyObject) private FParentIndex: Integer; public FClassName: string; FName: string; FIndex: Integer; FDescription: TStringList; FCaptions: TStringList; FLength: Double; FTopDiameter: Double; FBottomDiameter: Double; FNotes: TStringList; FListID: Integer; FSCSCompon: TSCSComponent; FSCSComponID: Integer; FParent: T3DModel; FGLObject: TObject; FGLCaption: TObject; FSCSObject: TConnectorObject; FFace: TFaceRecord; FPoint1: T3DPoint; FPoint2: T3DPoint; FGLPoint1: T3DPoint; FGLPoint2: T3DPoint; FZOrder: double; FColor: TColor; FLineType: T3DLineType; FJoinConnector1: T3DConnector; // соединитель 1 FJoinConnector2: T3DConnector; // соединитель 2 constructor Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel); destructor destroy; override; procedure CollectBooblick(aFaces: TList; ap: T3DPointArray); procedure WriteToStream(Stream: TStream); procedure ReadFromStream(Stream: TStream); procedure SetRelations; end; // сравнение координат function CoordsCMP(p1, p2: TDoublePoint): Boolean; // сравнение углов function AnglesCMP(a1, a2: Double): Boolean; // сравнение дистанции между точками function PointDistCMP(p: TDoublePoint; aNetPath: TNetPath): Boolean; function FindVirtualNetPathByReal(aGrpNet: TNet; aNetPath: TNetPath; aExtCheck: Boolean=false): TNetPath; // получить тип стены по типу обьекта TNetDoor function GetWallTypeByDoorType(aDoor: TNetDoor): TFaceWallType; // получить точки стены с учетом откосов окна/двери/балкона procedure GetWallPointsWithSlope(var da1, da2, db1, db2: TDoublePoint; hor_a1, hor_a2, hor_b1, hor_b2: double); // получить точки двери/окна/балкона с учетом откосов окна/двери/балкона procedure GetDoorPointsWithSlope(var c: TDoublePoint; d: TDoublePoint; depth: double); // получить строку Hash для файла текстуры function GetImageHash(aFName: string): string; function GetObjectHash(aFName: string): string; function GetArcWallPointsAll(aPoints: T3DPointArray; FPlanObject: TNetPath; isWall: boolean = False): T3DPointArray; function GetAllNets(aCad: TF_CAD): TList; function GetVirtualNetPathsByRealNet(aNet, aGrpNet: TNet): TList; function GetWorkDir: string; Procedure GetCeilingConture(aNet: TNet; aPaths: Tlist; var aCeilingConture: TDoublePointArr); function ConverResultToUom(aResult: Double; aIzm: String): Double; // Tolik 18/10/2018 -- Function GetPoint(aLine: TOrthoLine; PointNum: Integer; dist: Double): PDoublePoint; // Tolik 18/10/2018 -- Function GetPointA(apoint1, aPoint2: TDoublePoint; dist: Double): PDoublePoint; // Tolik 12/10/2025 -- const {TODO} FDeltaZ: Double = 0.030; FDeltaZFloor: Double = 0.025; // 0.045 FDeltaZPlane: Double = 0.015; FDeltaZSlope: Double = 0.035; // 0.025 // отступ от пола FFloorDelta: Double = 0.00; //.01 // отступ до потолка от верхних граней стены FFCeilingDelta: Double = 0.00; //.01 // начало построение обьектов окно, дверь, ниша, балкон FStartDoorObject: Double = 0.0; // 0.03 // отступ от нижней грани обьекта до верхней грани стены // например нарисовать кусок стены под окном, чтобы нижняя грань окна не сливалась с верхней гранью стены FDoorObjectDelta: Double = 0.0; //.01 // наименования обьектов модели {//15.08.2012 cModel = '3D Модель'; cRoom = 'Комната '; cWall = 'Стена '; cDoor = 'Дверной проем '; cWindow = 'Оконный проем '; cBalcon = 'Балконный проем '; cNiche = 'Ниша '; cArc = 'Арка '; cInnerSlope = 'Откос'; cOuterSlope = 'Внешний откос'; cSide = 'Грань '; cFloor = 'Пол'; cCeiling = 'Потолок'; cSubSide = 'Подгрань ';} var InnerwallStream: TMemoryStream; OuterwallStream: TMemoryStream; FloorStream: TMemoryStream; CeilingStream: TMemoryStream; DoorStream: TMemoryStream; WindowStream: TMemoryStream; ArcStream: TMemoryStream; BalconStream: TMemoryStream; NicheStream: TMemoryStream; tmpdir_a, tex_innerwall, tex_outerwall, tex_floor, tex_ceiling, tex_doorslope, tex_windowslope, tex_arc, tex_balconslope, tex_niche: string; FScaleDelta: Double; FScaleDeltaSCS: Double; FGroupNet: TNet; //FSingleRoom: Boolean; //06.06.2012 GArch3DInnerSidesFromVirtual: Boolean = true; GArch3DAllowAlignPoint: Boolean = false; implementation uses U_BaseCommon, U_ArchCommon, U_Common, U_Protection, U_ProtectionCommon, Form3d, U_Constants, GLTexture, U_MAIN; // Tolik 25/12/2019 -- //function comparePoint(aCPoint1, ACPoint2: TDoublePoint): Boolean; function comparePoint(aCPoint1, ACPoint2: TDoublePoint; aDelta: Double): Boolean; var currDelta: Double; begin try currDelta := ABS(aCPoint1.x - aCPoint2.x); if CompareValue(currDelta, aDelta) = -1 then begin currDelta := ABS(aCPoint1.y - aCPoint2.y); if CompareValue(currDelta, aDelta) = -1 then Result := True else result := False; end else result := False; except on e: Exception do result := False; end; { if CompareValue(aCPoint1.x, aCPoint2.x) = 0 then begin if CompareValue(aCPoint1.y, aCPoint2.y) = 0 then Result := true else Result := False; end else Result := False;} end; // //Tolik 18/10/2018 -- function ConverResultToUom(aResult: Double; aIzm: String): Double; var div_koeff: integer; ProjUOM: Integer; UomIzm, CadUomIzm: Double; begin Result := aResult; UomIzm := -1; if (aIzm = 'm') then UomIzm := 1 else if (aIzm = 'm.') then UomIzm := 1 else if (aIzm = 'м') then UomIzm := 1 else if (aIzm = 'м.') then UomIzm := 1 else if (aIzm = 'sm') then UomIzm := 100 else if (aIzm = 'sm.') then UomIzm := 100 else if (aIzm = 'см') then UomIzm := 100 else if (aIzm = 'см.') then UomIzm := 100 else if (aIzm = 'mm') then UomIzm := 1000 else if (aIzm = 'mm.') then UomIzm := 1000 else if (aIzm = 'мм') then UomIzm := 1000 else if (aIzm = 'мм.') then UomIzm := 1000 else if (aIzm = 'ft') then UomIzm := 0.3 else if (aIzm = 'ft.') then UomIzm := 0.3 else if (aIzm = 'фт') then UomIzm := 0.3 else if (aIzm = 'фт.') then UomIzm := 0.3 else if (aIzm = 'dm') then UomIzm := 0.025 else if (aIzm = 'dm.') then UomIzm := 0.025 else if (aIzm = 'дм') then UomIzm := 0.025 else if (aIzm = 'дм.') then UomIzm := 0.025; if UomIzm <> -1 then begin ProjUOM := F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure; Case ProjUom of umSantimetr : CadUomIzm := 100; umMetr : CadUomIzm := 1; umInch : CadUomIzm := 0.025; umFoot : CadUomIzm := 0.3; end; Result := aResult * (CadUomIzm/UomIzm); //Result := aResult * (UomIzm/CadUomIzm); end; end; Function GetPoint(aLine: TOrthoLine; PointNum: Integer; dist: Double): PDoublePoint; var p1, p2: TDoublePoint; i: Integer; TubeCompon: TSCSComponent; distx, disty, distz, koefx, koefy, koefz, LineLen: Double; LineCatalog: TSCSCatalog; CirclePoint: PDoublePoint; RealRadius: Double; PointsAngle: Double; Conn1,Conn2: TConnectorObject; MaxX, MaxY, MinX, MinY, DistToPoint: Double; begin Result := Nil; New(Result); DistToPoint := Dist; Conn1 := TConnectorObject(aLine.JoinConnector1); Conn2 := TConnectorObject(aLine.JoinConnector2); if Conn1.JoinedConnectorsList.Count > 0 then begin Conn1 := TConnectorObject(Conn1.JoinedConnectorsList[0]); if PointNum = 1 then begin Conn1.GetBounds(MaxX, MaxY, MinX, MinY); DistTopoint := DistToPoint + ((Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))) / (UOMToMetre(1000 / GCadForm.PCad.MapScale)))/4; end; end; if Conn2.JoinedConnectorsList.Count > 0 then begin Conn2 := TConnectorObject(Conn2.JoinedConnectorsList[0]); if PointNum = 2 then begin Conn2.GetBounds(MaxX, MaxY, MinX, MinY); DistTopoint := DistToPoint + ((Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))) / (UOMToMetre(1000 / GCadForm.PCad.MapScale)))/4; end; end; if PointNum = 1 then begin p1.x := Conn1.ap1.x; p1.y := Conn1.ap1.y; p1.z := UomToMetre(Conn1.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)); //p1.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]; p2.x := Conn2.ap1.x; p2.y := Conn2.ap1.y; p2.z := UomToMetre(Conn2.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)); //p2.z := TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]; end else if PointNum = 2 then begin p2.x := Conn1.ap1.x; p2.y := Conn1.ap1.y; p2.z := UomToMetre(Conn1.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)); //p2.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]; p1.x := Conn2.ap1.x; p1.y := Conn2.ap1.y; p1.z := (UomToMetre(Conn2.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale))); //p1.z := TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]; end else begin Dispose(Result); Result := Nil; exit; end; LineLen := SQRT(SQR(p1.x - p2.x) + SQR(p1.y - p2.y) + SQR(p1.z - p2.z)); koefx := (p2.x - p1.x)/LineLen; koefy := (p2.y - p1.y)/LineLen; koefz := (p2.z - p1.z)/LineLen; Result.x := p1.x + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx); Result.y := p1.y + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy); Result.z := MetreToUom(p1.z + DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz)/(UOMToMetre(1000 / GCadForm.PCad.MapScale)); //Result.x := p1.x + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx); //Result.y := p1.y + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy); //Result.z := MetreToUom((p1.z + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz))/(UOMToMetre(1000 / GCadForm.PCad.MapScale))); end; // Для расчета точек поперечной отрисовки сетки (если это, например, проволочный лоток) Function GetPointA(aPoint1, aPoint2: TDoublePoint; dist: Double): PDoublePoint; // Tolik 12/10/2025 -- var p1, p2: TDoublePoint; distx, disty, distz, koefx, koefy, koefz, LineLen: Double; DistToPoint: Double; begin Result := Nil; New(Result); DistToPoint := Dist; p1.x := aPoint1.x; p1.y := aPoint1.y; p1.z := UomToMetre(aPoint1.z) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)); //p1.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]; p2.x := aPoint2.x; p2.y := aPoint2.y; p2.z := UomToMetre(aPoint2.z) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)); LineLen := SQRT(SQR(P1.x - P2.x) + SQR(P1.y - P2.y) + SQR(P1.z - P2.z)); koefx := (P2.x - P1.x)/LineLen; koefy := (P2.y - P1.y)/LineLen; koefz := (P2.z - P1.z)/LineLen; Result.x := P1.x + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx); Result.y := P1.y + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy); Result.z := MetreToUom(P1.z + DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz)/(UOMToMetre(1000 / GCadForm.PCad.MapScale)); //Result.x := p1.x + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx); end; function GetTubeRadius(aSCSCompon: TSCSComponent): Double; var i : Integer; NBProp: TNBProperty; PipeDiameter_edIzm: String; currProp: PProperty; begin Result := -1; for i := 0 to aSCScompon.Properties.Count - 1 do begin if UPPERCASE(PProperty(aSCSCompon.Properties[i]).SysName) = pnOutDiametr then begin try currProp := PProperty(aSCSCompon.Properties[i]); Result := StrToFloat_My(PProperty(aSCSCompon.Properties[i]).Value)/2; //PropValueInUOM(Result, UPPERCASE(PProperty(aSCSCompon.Properties[i]).SysName), ProjUOM, ProjUOM); NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(currProp.GuidProperty); if NbProp <> nil then begin PipeDiameter_edIzm := NbProp.PropertyData.Izm; Result := ConverResultToUom(Result, PipeDiameter_edIzm); end; except end; if Result <> -1 then break; end; end; end; Function getLineComponOutRadius(aLineComponent: TSCSComponent): double; var LineComponProp: PProperty; NBProp: TNBProperty; OutDiam: Double; LineComponCatalog: TSCSCatalog; SideString, SideString1: String; Side1, Side2: Double; CharPos: integer; ED_Izm: string; begin Result := -1; ED_Izm := 'mm'; if (aLineComponent.ComponentType.SysName <> ctsnCableChannel) or (aLineComponent.ComponentType.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}') then begin LineComponProp := aLineComponent.GetPropertyBySysName(pnOutDiametr); if LineComponProp <> nil then begin OutDiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty); if NbProp <> nil then //Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm) ED_Izm := NbProp.PropertyData.Izm else begin OutDiam := 0; LineComponProp := Nil; end; end; end else //if isCableComponent(aLineComponent) then // if Cable begin LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); if LineComponProp <> nil then begin OutDiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty); if NbProp <> nil then //Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm); ED_Izm := NbProp.PropertyData.Izm else begin OutDiam := 0; LineComponProp := Nil; end; end; end end; if LineComponProp = nil then // try to find in_section or inside diameter begin LineComponProp := aLineComponent.GetPropertyBySysName(pnInDiametr); if LineComponProp <> nil then begin Outdiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty); if NbProp <> nil then //Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm); ED_Izm := NbProp.PropertyData.Izm else begin OutDiam := 0; LineComponProp := Nil; end; end; end; end; if LineComponProp = nil then begin LineComponProp := aLineComponent.GetPropertyBySysName(pnInSection); if LineComponProp <> nil then begin Outdiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(LineComponProp.GuidProperty); if NbProp <> nil then //Result := ConverResultToUom(OutDiam/2, NbProp.PropertyData.Izm); ED_Izm := NbProp.PropertyData.Izm else begin OutDiam := 0; LineComponProp := Nil; end; end; end; end; end else begin LineComponProp := aLineComponent.GetPropertyBySysName(pnCableChannelSideSection);// размер стороны каб канала //LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); // наружное сечение if LineComponProp <> nil then begin SideString := UpperCase(LineComponProp.Value); if SideString <> '' then begin SideString := StringReplace(SideString,'Х','X',[rfReplaceAll]); CharPos := Pos('X', SideString); if CharPos > 1 then begin SideString1 := copy(SideString, 1, CharPos - 1); Delete(SideString,1,CharPos); Try Side1 := StrToFloat_My(SideString); Side2 := StrToFloat_My(SideString1); except on E: Exception do LineComponProp := Nil; end; if LineComponProp <> nil then begin OutDiam := SQRT(Side1 * Side2); Result := ConverResultToUom(OutDiam/2, 'mm'); end; end else LineComponProp := Nil; end; end else begin LineComponProp := aLineComponent.GetPropertyBySysName(pnOutSection); // наружное сечение if LineComponprop <> nil then begin OutDiam := StrToFloat_My(LineComponProp.Value); if OutDiam > 0 then begin OutDiam := SQRT(OutDiam); Result := ConverResultToUom(OutDiam/2, 'mm'); end else LineComponProp := nil; end; end; end; if LineComponProp = nil then begin LineComponCatalog := aLineComponent.GetfirstParentCatalog; if LineComponCatalog <> nil then AddExceptionToLogEx('Tfrm3D: ', _3DNotSetSideSection + LineComponCatalog.GetNameForVisible(False) +'\'+ aLineComponent.GetNameForVisible(False)); end; Result := ConverResultToUom(OutDiam/2, 'mm'); end; // //Tolik 09/07/2018 -- Function CollectSCSWallEntries(aPathList: TList): TList; // var i, j: Integer; PathInfo: PNetEntryInfo; currPath: TNetPath; //f: TextFile; //PathList: TList; begin Result := TList.Create; //PathList := TList.Create; {for i := 0 to aPathList.Count - 1 do begin currPath := TNetPath(aPathList[i]); if (CompareValue(currPath.p1.x, currPath.p2.x) <> 0) or (CompareValue(currPath.p1.y, currPath.p2.y) <> 0) then if PathList.IndexOf(currPath) = -1 then PathList.Add(currPath); end;} // AssignFile(f, 'd:\PathPoints.txt'); // rewrite(f); //for i := 0 to PathList.Count - 1 do for i := 0 to aPathList.Count - 1 do begin //if not currPath.ISClosed then begin currPath := TNetPath(aPathList[i]); //23/12/2019 -- проверка и отсеивание путей, у которых начало и конец в одной точке (для старых проектов) if comparePoint(currPath.p1^, currPath.p2^, myDelta) then Continue; { writeln(f, 'Path ' + inttostr(i) + ': P1.x = ' + FloatTostr(currPath.p1.x) + ' P1.y = ' + FloatTostr(currPath.p1.y)); writeln(f, 'Path ' + inttostr(i) + ': P2.x = ' + FloatTostr(currPath.p2.x) + ' P2.y = ' + FloatTostr(currPath.p2.y)); writeln(f,' ');} New(PathInfo); PathInfo.NetPath := currPath; PathInfo.P1EntryCount := 1; PathInfo.P2EntryCount := 1; for j := 0 to aPathList.Count - 1 do begin if TNetPath(aPathList[j]) <> currPath then begin if comparePoint(TNetPath(aPathList[j]).p1^, currPath.p1^, myDelta) then Inc(PathInfo.P1EntryCount); if comparePoint(TNetPath(aPathList[j]).p2^, currPath.p2^, myDelta) then Inc(PathInfo.P2EntryCount); if comparePoint(TNetPath(aPathList[j]).p2^, currPath.p1^, myDelta) then Inc(PathInfo.P1EntryCount); if comparePoint(TNetPath(aPathList[j]).p1^, currPath.p2^, myDelta) then Inc(PathInfo.P2EntryCount); end; end; end; Result.Add(PathInfo); end; // CloseFile(f); // PathList.Free; end; Function GetContureListFromNet(aNets: TNet; var aFloorsConturesList, aNormalList: TList): TList; // вернет список из отдельных стен и контуров(список списков) var i, j: Integer; CanProceed: Boolean; NetList: TList; CurrNet: TNet; PathList: TList; Path1, Path2, currPath, StartPath: TNetPath; RemovedPathList: TList; NetContureL, NetContureR, LeftNormalConture, RightNormalConture: TList; LeftContureLen, RightContureLen, LeftLen, RightLen: Double; LeftFloorConture, RightFloorConture: TList; cp: PDoublePoint; currPointOrder: Integer; // Tolik 25/12/2019 -- покакой точке идем // 1 - r1 // 2 - r2 // 3 - l1 // 4 - l2 PassedList: TList; // 24/12/2019 -- PathPoint: PDoublePoint; PrevPoint: TDoublePoint; LastArcPathLen: Double; PathToDel: TNetPath; f: TextFile; s: string; Procedure RemovepathFromList(aPath: TNetPath; aRemovePath: Boolean = true); var i: Integer; currEntryInfo: PNetEntryInfo; begin currEntryInfo := Nil; for i := 0 to PathList.Count - 1 do begin if PNetEntryInfo(PathList[i]).NetPath <> aPath then begin if comparePoint(PNetEntryInfo(PathList[i]).NetPath.p1^, aPath.p1^,myDelta) then Dec(PNetEntryInfo(PathList[i]).P1EntryCount); if comparePoint(PNetEntryInfo(PathList[i]).NetPath.p2^, aPath.p2^, myDelta) then Dec(PNetEntryInfo(PathList[i]).P2EntryCount); if comparePoint(PNetEntryInfo(PathList[i]).NetPath.p1^, aPath.p2^, myDelta) then Dec(PNetEntryInfo(PathList[i]).P1EntryCount); if comparePoint(PNetEntryInfo(PathList[i]).NetPath.p2^, aPath.p1^, myDelta) then Dec(PNetEntryInfo(PathList[i]).P2EntryCount); end else currEntryInfo := PNetEntryInfo(PathList[i]); end; if currEntryInfo <> nil then begin if aRemovePath then begin // удалить из списка for i := 0 to PathList.Count - 1 do begin if PNetEntryInfo(PathList[i]).NetPath = aPath then begin PathList.Delete(i); break; end; end; Dispose(currEntryInfo); end; end; end; Function HasRelatedPoint(aPath1, aPath2: TNetPath): Boolean; begin if comparePoint(aPath1.p1^, aPath2.p1^, myDelta) then begin Result := True; exit; end; if comparePoint(aPath1.p1^, aPath2.p2^, myDelta) then begin Result := True; exit; end; if comparePoint(aPath1.p2^, aPath2.p1^, myDelta) then begin Result := True; exit; end; if comparePoint(aPath1.p2^, aPath2.p2^, myDelta) then begin Result := True; exit; end; end; Procedure RemovePassedPaths; var i: Integer; canRemove: Boolean; currPathInfo: PNetEntryInfo; begin CanRemove := True; while canRemove do begin canRemove := False; for i := PathList.Count - 1 downto 0 do begin if ((PNetEntryInfo(PathList[i]).P1EntryCount <= 1) or (PNetEntryInfo(PathList[i]).P2EntryCount <= 1)) then begin CanRemove := True; currPathInfo := PNetEntryInfo(PathList[i]); PathList.Delete(i); Dispose(currPathInfo); end; end; end; end; Procedure RemoveEntry(aPath: TNetPath); var i: Integer; currEntryInfo: PNetEntryInfo; begin currEntryInfo := Nil; for i := 0 to PathList.Count - 1 do begin if PNetEntryInfo(PathList[i]).NetPath = aPath then begin currEntryInfo := PNetEntryInfo(PathList[i]); PathList.Delete(i); Dispose(currEntryInfo); break; end end; end; function GetClosedConture(aPath: TNetPath; var aFlContList, aNormalList: TList; aLeft: Boolean = false): TList; var i, BreakCounter, PathConnPoint: Integer; ConnectedPathList: TList; StartPoint, NextPoint: TDoublePoint; NextPath, PrevPath: TNetPath; ConturePoint: PDoublePoint; function CheckInListById(aList: TList; aPath: TNetPath): Boolean; var i: integer; begin Result := False; for i := 0 to aList.Count - 1 do begin if TNetPath(aList[i]).Id = aPath.Id then begin Result := True; break; end; end; end; Function GetConnPathsBySide(aConPath: TNetPath; aSide: integer): TList; var i: Integer; cp: TDoublePoint; cpp: TNetPath; begin Result := TList.Create; if aSide = 1 then begin cp.x := aConPath.p1.x; cp.y := aConPath.p1.y; end else begin cp.x := aConPath.p2.x; cp.y := aConPath.p2.y; end; for i := 0 to aPath.Net.Paths.Count - 1 do begin cpp := TNetPath(aPath.Net.Paths[i]); if cpp <> aConPath then begin if comparePoint(cpp.p1^, cp, myDelta) or comparePoint(cpp.p2^, cp, myDelta) then if Result.IndexOf(cpp) = -1 then Result.Add(cpp); end; end; end; Procedure AddPointToFloorConture(aPoint: TDoublePoint; addNormal: Boolean = False); begin New(ConturePoint); ConturePoint.z := 0; ConturePoint.x := APoint.x; ConturePoint.y := APoint.y; aFlContList.Add(ConturePoint); if addNormal then begin New(ConturePoint); ConturePoint.z := 0; ConturePoint.x := APoint.x; ConturePoint.y := APoint.y; aNormalList.Add(ConturePoint); end; end; //Function isUniquePoint(aPoint: TDoublePoint; aPath: TNetPath): Boolean; Function isUniquePoint(aPoint: TDoublePoint; aPath: TNetPath; aSide: integer = 1): Boolean; var i: Integer; cPath: TNetPath; PathList: TList; begin Result := True; PathList := nil; PathList := GetConnPathsBySide(aPath, aSide); //for i := 0 to aNets.Paths.Count - 1 do for i := 0 to PathList.Count - 1 do begin cPath := TNetPath(PathList[i]); if cPath <> aPath then begin if ( ((CompareValue(aPoint.x, cPath.r1.x) = 0) and (CompareValue(aPoint.y, cPath.r1.y) = 0)) or ((CompareValue(aPoint.x, cPath.l1.x) = 0) and (CompareValue(aPoint.y, cPath.l1.y) = 0)) or ((CompareValue(aPoint.x, cPath.r2.x) = 0) and (CompareValue(aPoint.y, cPath.r2.y) = 0)) or ((CompareValue(aPoint.x, cPath.l2.x) = 0) and (CompareValue(aPoint.y, cPath.l2.y) = 0)) ) then begin Result := False; break; end; end; end; freeAndnil(PathList); end; (* Function isUniquePoint(aPoint: TDoublePoint; aPath: TNetPath): Boolean; var i: Integer; cPath: TNetPath; begin Result := True; { for i := 0 to ConnectedPathList.Count - 1 do begin cPath := TNetPath(ConnectedPathList[i]); if cPath <> aPath then begin cPath := TNetPath(ConnectedPathList[i]); if ( ((CompareValue(aPoint.x, cPath.r1.x) = 0) and (CompareValue(aPoint.y, cPath.r1.y) = 0)) or ((CompareValue(aPoint.x, cPath.r2.x) = 0) and (CompareValue(aPoint.y, cPath.r2.y) = 0)) or ((CompareValue(aPoint.x, cPath.l1.x) = 0) and (CompareValue(aPoint.y, cPath.l1.y) = 0)) or ((CompareValue(aPoint.x, cPath.l2.x) = 0) and (CompareValue(aPoint.y, cPath.l2.y) = 0)) ) then begin Result := False; break; end; end; end; } for i := 0 to aNets.Paths.Count - 1 do begin cPath := TNetPath(aNets.Paths[i]); if cPath <> aPath then begin if ( ((CompareValue(aPoint.x, cPath.r1.x) = 0) and (CompareValue(aPoint.y, cPath.r1.y) = 0)) or ((CompareValue(aPoint.x, cPath.r2.x) = 0) and (CompareValue(aPoint.y, cPath.r2.y) = 0)) or ((CompareValue(aPoint.x, cPath.l1.x) = 0) and (CompareValue(aPoint.y, cPath.l1.y) = 0)) or ((CompareValue(aPoint.x, cPath.l2.x) = 0) and (CompareValue(aPoint.y, cPath.l2.y) = 0)) ) then begin Result := False; break; end; end; end; end; *) Procedure AddArcToFloorConture(aPath: TNetPath; var aLen: Double; aDirection: Integer; aStartP: TDoublePoint); var i, range: Integer; Point1, Point2: TDoublePoint; arcPoints: T2DPointArray; CCPoint: PDoublePoint; Rad, ang1, ang2: Double; invertarray: Boolean; dxfModeFlag: Boolean; LineLen1, LineLen2: double; begin if not aPath.isArc then exit; case aDirection of 1: begin if aPath.Inverted then begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.l1); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.l2); end else begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.l2); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.l1); end; Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.l1.x) + sqr(aPath.ArcCenter.y - aPath.l1.y)); end; 2: begin if aPath.Inverted then begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.l1); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.l2); end else begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.l2); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.l1); end; Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.l1.x) + sqr(aPath.ArcCenter.y - aPath.l1.y)); end; 3: begin if aPath.Inverted then begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.r1); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.r2); end else begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.r2); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.r1); end; Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.r1.x) + sqr(aPath.ArcCenter.y - aPath.r1.y)); end; 4: begin if aPath.Inverted then begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.r1); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.r2); end else begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.r2); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.r1); end; Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.r1.x) + sqr(aPath.ArcCenter.y - aPath.r1.y)); end; end; // end case if ang2 = 0 then ang2 := 2 * pi; dxfModeFlag := dxfMode32; dxfMode32 := true; BezierArcPoints(arcPoints, aPath.ArcCenter.x, aPath.ArcCenter.y, Rad, ang1, ang2); dxfMode32 := dxfModeFlag; range := Length(arcPoints) - 2; LineLen1 := SQRT(sqr(aStartP.x - t2DPoint(arcPoints[0]).x) + sqr(aStartP.y - t2dPoint(arcPoints[0]).y)); LineLen2 := SQRT(sqr(aStartP.x - t2DPoint(arcPoints[range + 1]).x) + sqr(aStartP.y - t2dPoint(arcPoints[range + 1]).y)); if compareValue(LineLen1, LineLen2) = 1 then invertarray := True else invertarray := False; for i := 0 to range do begin aLen := aLen + SQRT(sqr(t2dPoint(arcPoints[i]).x - t2DPoint(arcPoints[i + 1]).x) + sqr(t2dPoint(arcPoints[i]).y - t2dPoint(arcPoints[i + 1]).y)); end; inc(Range); if invertarray then begin for i := 0 to range do begin New(CCPoint); CCPoint.x := t2dPoint(ArcPoints[i]).x; CCPoint.y := t2dPoint(ArcPoints[i]).y; CCPoint.z := 0; aFlContList.Add(CCPoint); end; end else begin for i := range downto 0 do begin New(CCPoint); CCPoint.x := t2dPoint(ArcPoints[i]).x; CCPoint.y := t2dPoint(ArcPoints[i]).y; CCPoint.z := 0; aFlContList.Add(CCPoint); end; end; New(CCPoint); CCPoint.x := aStartP.x; CCPoint.y := aStartP.y; CCPoint.z := 0; aNormalList.Add(CCPoint); SetLength(arcPoints,0); if aPath.Inverted then begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.p1^); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.p2^); end else begin ang1 := GetRadOfLine(aPath.ArcCenter, aPath.p2^); ang2 := GetRadOfLine(aPath.ArcCenter, aPath.p1^); end; Rad := Sqrt(sqr(APath.ArcCenter.x - aPath.p1.x) + sqr(aPath.ArcCenter.y - aPath.p1.y)); dxfModeFlag := dxfMode32; dxfMode32 := true; BezierArcPoints(arcPoints, aPath.ArcCenter.x, aPath.ArcCenter.y, Rad, ang1, ang2); dxfMode32 := dxfModeFlag; range := Length(arcPoints) - 2; for i := 0 to range do begin LastArcPathLen := LastArcPathLen + SQRT(sqr(t2dPoint(arcPoints[i]).x - t2DPoint(arcPoints[i + 1]).x) + sqr(t2dPoint(arcPoints[i]).y - t2dPoint(arcPoints[i + 1]).y)); end; SetLength(arcPoints,0); { SetLength(arcPoints, 2); arcPoints[0] := FromPoint; arcPoints[1] := ToPoint; resArcPoints := GetArcWallPointsAll(arcPoints, aPath); range := Length(resArcPoints) - 2; for i := 0 to range do //контур пола begin New(CCPoint); CCPoint^ := resArcPoints[i]; CCPoint.z := 0; aFlContList.Add(CCPoint); end; inc(Range); Point1 := resArcPoints[0]; // здесь посчитать длину пройденной дуги к общей пройденной длине for i := 1 to range do //контур пола begin Point2 := resArcPoints[i]; aLen := aLen + SQRT(sqr(Point1.x - Point2.x) + sqr(Point1.y - Point2.y)); Point1 := Point2; end; SetLength(arcPoints, 0); SetLength(resArcPoints, 0); } end; Function GetPathWithUniquePoint(var aLen: Double): TNetPath; var i, j, pct: Integer; currPath, AddedPath: TNetPath; PathFound: Boolean; PathPoint: TDoublePoint; p1Connection: Boolean; PointList: TList; Dist, mindist: Double; AddPoint: TDoublePoint; f: TextFile; s: String; ff: TStringList; begin {ff := TStringList.Create; //AssignFile(f,'c:\users\Tolik\Documents\netpaths.txt'); //rewrite(f); for i := 0 to aNets.Paths.Count - 1 do begin currPath := TNetPath(aNets.Paths[i]); s := 'P1.X = '+ ';' + FloatTostr(currPath.p1.x) + ';' + 'P1.Y = ' + ';' + FloatTostr(currPath.p1.y); ff.add(s); s := 'P2.X = ' + ';'+ FloatTostr(currPath.p2.x) + ';' + 'P2.Y = ' + ';'+ FloatTostr(currPath.p2.y); ff.add(s); //writeln(f,s); s := 'R1.Y = ' + ';'+ FloatTostr(currPath.r1.x) + ';' + 'R1.Y = ' + ';'+ FloatTostr(currPath.r1.y); ff.add(s); //writeln(f,s); s := 'R2.X = ' + ';'+ FloatTostr(currPath.r2.x) + ';' + 'R2.Y = ' + ';'+ FloatTostr(currPath.r2.y); ff.add(s); //writeln(f,s); s := 'L1.Y = ' + ';'+ FloatTostr(currPath.l1.x) + ';' + 'L1.Y = '+ ';' + FloatTostr(currPath.l1.y); ff.add(s); //writeln(f,s); s := 'L2.X = ' + ';'+ FloatTostr(currPath.l2.x) + ';' + 'L2.Y = ' + ';'+ FloatTostr(currPath.l2.y); ff.add(s); //writeln(f,s); ff.add(' '); //writeln(f, ''); end; //CloseFile(f); } Result := Nil; mindist := -1; AddedPath := nil; pct := 0; for i := 0 to ConnectedPathList.Count - 1 do begin if TNetPath(ConnectedPathList[i]) <> PrevPath then begin CurrPath := TNetPath(ConnectedPathList[i]); p1Connection := ( ((CompareValue(currPath.p1.x, PrevPath.p1.x) = 0) and (CompareValue(currPath.p1.y, PrevPath.p1.y) = 0)) or ((CompareValue(currPath.p1.x, PrevPath.p2.x) = 0) and (CompareValue(currPath.p1.y, PrevPath.p2.y) = 0)) ); if p1Connection then begin if isUniquePoint(currPath.r1, currPath, 1) then begin dist := sqrt(sqr(NextPoint.x - currPath.r1.x)+ sqr(NextPoint.y - currPath.r1.y)); if ((CompareValue(dist, mindist) = -1) or (minDist = -1)) then begin //Result := currPath; //if RemovedPathList.IndexOf(NextPath) = -1 then //begin pct := 1; AddedPath := currPath; mindist := dist; //AddPointToFloorConture(currPath.r1); { NextPoint.x := currPath.r2.x; NextPoint.y := currPath.r2.y; } end; //end end else if isUniquePoint(currPath.l1, currPath, 1) then begin dist := sqrt(sqr(NextPoint.x - currPath.l1.x)+ sqr(NextPoint.y - currPath.l1.y)); if ((CompareValue(dist, mindist) = -1) or (minDist = -1)) then begin pct := 2; //AddPointToFloorConture(currPath.l1); AddedPath := currPath; mindist := dist; { Result := currPath; NextPoint.x := currPath.l2.x; NextPoint.y := currPath.l2.y; } end; end; end else begin if isUniquePoint(currPath.r2, currPath, 2) then begin dist := sqrt(sqr(NextPoint.x - currPath.r2.x)+ sqr(NextPoint.y - currPath.r2.y)); if ((CompareValue(dist, mindist) = -1) or (minDist = -1)) then begin mindist := dist; pct := 3; //AddPointToFloorConture(currPath.r2); AddedPath := currPath; { Result := currPath; NextPoint.x := currPath.r1.x; NextPoint.y := currPath.r1.y; } end; end else if isUniquePoint(currPath.l2, currPath, 2) then begin dist := sqrt(sqr(NextPoint.x - currPath.l2.x)+ sqr(NextPoint.y - currPath.l2.y)); if ((CompareValue(dist, mindist) = -1) or (minDist = -1)) then begin //AddPointToFloorConture(currPath.l2); AddedPath := currPath; mindist := dist; pct := 4; { Result := currPath; NextPoint.x := currPath.l1.x; NextPoint.y := currPath.l1.y; } end; end; end; end; {if Result <> nil then exit;} end; if AddedPath <> nil then begin case pct of 1: begin AddPointToFloorConture(AddedPath.r1); NextPoint := AddedPath.r2; aLen := aLen + Sqrt(sqr(AddedPath.r1.x - AddedPath.r2.x) + sqr(AddedPath.r1.y - AddedPath.r2.y) );//minDist; end; 2: begin AddPointToFloorConture(AddedPath.l1); NextPoint := AddedPath.l2; aLen := aLen + Sqrt(sqr(AddedPath.l1.x - AddedPath.l2.x) + sqr(AddedPath.l1.y - AddedPath.l2.y) ); //minDist; end; 3: begin AddPointToFloorConture(AddedPath.r2); NextPoint := AddedPath.r1; aLen := aLen + Sqrt(sqr(AddedPath.r1.x - AddedPath.r2.x) + sqr(AddedPath.r1.y - AddedPath.r2.y) );//+ minDist; end; 4: begin AddPointToFloorConture(AddedPath.l2); NextPoint := AddedPath.l1; aLen := aLen + Sqrt(sqr(AddedPath.l1.x - AddedPath.l2.x) + sqr(AddedPath.l1.y - AddedPath.l2.y) );//+ minDist; end; end; Result := AddedPath; end; end; { Function GetPathWithUniquePoint: TNetPath; var i, j: Integer; currPath: TNetPath; PathFound: Boolean; PathPoint: TDoublePoint; p1Connection: Boolean; PointList: TList; begin Result := Nil; for i := 0 to ConnectedPathList.Count - 1 do begin if TNetPath(ConnectedPathList[i]) <> PrevPath then begin CurrPath := TNetPath(ConnectedPathList[i]); p1Connection := ( ((CompareValue(currPath.p1.x, PrevPath.p1.x) = 0) and (CompareValue(currPath.p1.y, PrevPath.p1.y) = 0)) or ((CompareValue(currPath.p1.x, PrevPath.p2.x) = 0) and (CompareValue(currPath.p2.y, PrevPath.p2.y) = 0)) ); if p1Connection then begin if isUniquePoint(currPath.r1, currPath, 1) then begin Result := currPath; //if RemovedPathList.IndexOf(NextPath) = -1 then //begin AddPointToFloorConture(currPath.r1); NextPoint.x := currPath.r2.x; NextPoint.y := currPath.r2.y; //end end else if isUniquePoint(currPath.l1, currPath, 1) then begin AddPointToFloorConture(currPath.l1); Result := currPath; NextPoint.x := currPath.l2.x; NextPoint.y := currPath.l2.y; end; end else begin if isUniquePoint(currPath.r2, currPath, 2) then begin AddPointToFloorConture(currPath.r2); Result := currPath; NextPoint.x := currPath.r1.x; NextPoint.y := currPath.r1.y; end else if isUniquePoint(currPath.l2, currPath, 2) then begin AddPointToFloorConture(currPath.l2); Result := currPath; NextPoint.x := currPath.l1.x; NextPoint.y := currPath.l1.y; end; end; end; if Result <> nil then exit; end; end; } function GetNextPathByPoint(var aStartPoint: TDoublePoint; var aLen, aPathLen: double): TNetPath; var i: Integer; currPath: TNetPath; seekPath: Boolean; SeekPoint: TDoublePoint; PointList: TList; UPoint: PDoublePoint; SavedPathList: TList; Procedure FillConnectedbyPoint(aPoint: TDoublePoint); var i: Integer; NPath: TNetPath; begin ConnectedPathList.Clear; for i := 0 to NextPath.Net.Paths.Count - 1 do begin NPath := TNetPath(NextPath.Net.Paths[i]); if NPath.ID <> NextPath.Id then begin if comparePoint(NPath.P1^, aPoint, myDelta) or comparePoint(NPath.P2^, aPoint, myDelta) then if ConnectedPathList.IndexOf(NPath) = -1 then ConnectedPathList.Add(NPath); end; end; end; Function GetNextUniquePoint: TNetPath; var i: Integer; Len1, Len2: Double; ConnPath: TNetPath; LastPoint: TDoublePoint; begin Result := Nil; {Len1 := 1000000000; for i := 0 to ConnectedPathList.Count - 1 do begin ConnPath := TNetPath(ConnectedPathList[i]); if isUniquePoint(ConnPath.r1, ConnPath) then begin Len2 := Sqrt(sqr(ConnPath.r1.x - NextPoint.x) + sqr(ConnPath.r1.y - NextPoint.y)); if CompareValue(Len1,Len2) = 1 then begin Len1 := Len2; Result := ConnPath; LastPoint.x := ConnPath.r1.x; LastPoint.y := ConnPath.r1.y; end; end; if isUniquePoint(ConnPath.r2, ConnPath) then begin Len2 := (Sqrt(sqr(ConnPath.r2.x - NextPoint.x) + sqr(ConnPath.r2.y - NextPoint.y))); if CompareValue(Len1,Len2) = 1 then begin Len1 := Len2; Result := ConnPath; LastPoint.x := ConnPath.r2.x; LastPoint.y := ConnPath.r2.y; end; end; if isUniquePoint(ConnPath.l1, ConnPath) then begin Len2 := (Sqrt(sqr(ConnPath.l1.x - NextPoint.x) + sqr(ConnPath.l1.y - NextPoint.y))); if CompareValue(Len1,Len2) = 1 then begin Len1 := Len2; Result := ConnPath; LastPoint.x := ConnPath.l1.x; LastPoint.y := ConnPath.l1.y; end; end; if isUniquePoint(ConnPath.l2, ConnPath) then begin Len2 := (Sqrt(sqr(ConnPath.l2.x - NextPoint.x) + sqr(ConnPath.l2.y - NextPoint.y))); if CompareValue(Len1,Len2) = 1 then begin Len1 := Len2; Result := ConnPath; LastPoint.x := ConnPath.l2.x; LastPoint.y := ConnPath.l2.y; end; end; end;} if Result <> nil then begin aLen := aLen + Len1; NextPoint.x := LastPoint.x; NextPoint.y := LastPoint.y; if (((CompareValue(NextPoint.x, NextPath.r1.x) = 0) and (CompareValue(NextPoint.y, NextPath.r1.y) = 0)) or ((CompareValue(NextPoint.x, NextPath.l1.x) = 0) and (CompareValue(NextPoint.y, NextPath.l1.y) = 0))) then ConnectedPathList := GetConnPathsBySide(NextPath, 1) else ConnectedPathList := GetConnPathsBySide(NextPath, 2); end; end; function GoAroundPath: TNetpath; var NextPathPoint, p1,p2,p3: TDoublePoint; oldOrder, Side: integer; PassedPathLen, PathLen: double; PointOrder: integer; begin Result := Nil; if comparePoint(aStartPoint, NextPath.r1, myDelta) then PointOrder := 1 else if comparePoint(aStartPoint, NextPath.r2, myDelta) then PointOrder := 2 else if comparePoint(aStartPoint, NextPath.l1, myDelta) then PointOrder := 3 else if comparePoint(aStartPoint, NextPath.l2, myDelta) then PointOrder := 4; PathLen := Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + Sqr(NextPath.p1.y - NextPath.p2.y)); case PointOrder of 1: // r1 begin PassedPathLen := Sqrt(sqr(NextPath.l1.x - NextPath.l2.x) + Sqr(NextPath.l1.y - NextPath.l2.y)); NextPathPoint := NextPath.p1^; currPointOrder := 4; Side := 2; AddPointToFloorConture(aStartPoint); AddPointToFloorConture(NextPath.l1); aStartPoint := NextPath.l2; end; 2: // r2 begin NextPathPoint := NextPath.p2^; PassedPathLen := Sqrt(sqr(NextPath.l1.x - NextPath.l2.x) + Sqr(NextPath.l1.y - NextPath.l2.y)); currPointOrder := 3; Side := 1; AddPointToFloorConture(aStartPoint); AddPointToFloorConture(NextPath.l2); aStartPoint := NextPath.l1; end; 3: // l1 begin NextPathPoint := NextPath.p1^; PassedPathLen := Sqrt(sqr(NextPath.r1.x - NextPath.r2.x) + Sqr(NextPath.r1.y - NextPath.r2.y)); currPointOrder := 2; Side := 2; AddPointToFloorConture(aStartPoint); AddPointToFloorConture(NextPath.r1); aStartPoint := NextPath.r2; end; 4: // l2 begin NextPathPoint := NextPath.p2^; PassedPathLen := Sqrt(sqr(NextPath.r1.x - NextPath.r2.x) + Sqr(NextPath.r1.y - NextPath.r2.y)); currPointOrder := 1; Side := 1; AddPointToFloorConture(aStartPoint); AddPointToFloorConture(NextPath.r2); aStartPoint := NextPath.r1; end; end; //ConnectedPathList.Clear; FreeAndNil(ConnectedPathList); //FillConnectedbyPoint(p1); ConnectedPathList := GetConnPathsBySide(NextPath, Side); aLen := aLen + PassedPathLen; //aPathLen := aPathLen + PathLen; if ConnectedPathList.Count > 0 then PAssedList.remove(NextPath); //Result := GetNextPathByPoint(NextPoint, aLen, aPathLen); Result := NextPath; end; Procedure GetNearestRelatedPathAndPoint; var i: integer; dist, d1, d2, MinDist: Double; rp1, rp2: TDoublePoint; relPath, currPath: TNetPath; isFirstPoint: Boolean; PointOrder: integer; relPoint, CurrPoint: PDoublePoint; sPoint, kPoint: TDoublePoint; StartSide, CurrSide: Integer; begin relPoint := nil; currPath := nil; Dist := 10000000; MinDist := -1; sPoint.x := -100; sPoint.y := -100; PointOrder := -1; if comparePoint(aStartPoint, NextPath.r1, myDelta) then PointOrder := 1 else if comparePoint(aStartPoint, NextPath.r2, myDelta) then PointOrder := 2 else if comparePoint(aStartPoint, NextPath.l1, myDelta) then PointOrder := 1 else if comparePoint(aStartPoint, NextPath.l2, myDelta) then PointOrder := 2; case PointOrder of 1: relPoint := NextPath.p1; 2: relPoint := NextPath.p2; end; if PointOrder <> -1 then begin for i := 0 to ConnectedPathList.Count - 1 do begin relPath := TNetPath(ConnectedPathList[i]); { case PointOrder of 1: relPoint := NextPath.p1; 2: relPoint := NextPath.p2; end;} //r1, l1 if ((CompareValue(relPoint.x, relPath.p1.x, myDelta) = 0) and (CompareValue(relPoint.y, relPath.p1.y, myDelta) = 0 )) then begin d1 := sqrt(sqr(aStartPoint.x - relPath.r1.x) + sqr(aStartPoint.y - relPath.r1.y)); d2 := sqrt(sqr(aStartPoint.x - relPath.l1.x) + sqr(aStartPoint.y - relPath.l1.y)); MinDist := min(d1, d2); if mindist < Dist then begin Dist := MinDist; currPath := relPath; if CompareValue(d1, d2) = 1 then begin sPoint.x := relPath.l2.x; sPoint.y := relPath.l2.y; kPoint.x := relPath.l1.x; kPoint.y := relPath.l1.y; end else begin sPoint.x := relPath.r2.x; sPoint.y := relPath.r2.y; kPoint.x := relPath.r1.x; kPoint.y := relPath.r1.y; end; end; end else //r2, l2 if ((CompareValue(relPoint.x, relPath.p2.x, myDelta) = 0) and (CompareValue(relPoint.y, relPath.p2.y, myDelta) = 0 )) then begin d1 := sqrt(sqr(aStartPoint.x - relPath.r2.x) + sqr(aStartPoint.y - relPath.r2.y)); d2 := sqrt(sqr(aStartPoint.x - relPath.l2.x) + sqr(aStartPoint.y - relPath.l2.y)); MinDist := min(d1, d2); if mindist < Dist then begin dist := MinDist; currPath := relPath; if CompareValue(d1, d2) = 1 then begin sPoint.x := relPath.l1.x; sPoint.y := relPath.l1.y; kPoint.x := relPath.l2.x; kPoint.y := relPath.l2.y; end else begin sPoint.x := relPath.r1.x; sPoint.y := relPath.r1.y; kPoint.x := relPath.r2.x; kPoint.y := relPath.r2.y; end; end; end else continue; end; if Dist <> 10000000 then begin aLen := aLen + Dist;// + sqrt(sqr(currPath.p1.x - currPath.p2.x) + sqr(currPath.p1.y - currPath.p2.y)); aStartPoint := sPoint; AddPointToFloorConture(kPoint); Result := currPath; end; end; end; begin Result := Nil; SeekPath := True; CurrPath := Nil; inc(BreakCounter); if BreakCounter > 2000 then exit; //if (ConnectedPathList.Count > 0){ and isUniquePoint(NextPoint, NextPath))} then // no connections (wall break) {begin Result := GetNextUniquePoint; end else} begin if ConnectedPathList.Count > 0 then begin for i := 0 to ConnectedPathList.Count - 1 do begin currPath := TNetPath(ConnectedPathList[i]); //if PassedList.IndexOf(currPath) = -1 then begin if comparePoint(currPath.r1, aStartPoint, myDelta) then begin if currPath.isArc then //AddArcToFloorConture(currPath, aStartPoint, currPath.r2, currPath.p1^, currPAth.p2^, aLen) AddArcToFloorConture(currPath, aLen, 3, currPath.r2) else aLen := aLen + SQRT(sqr(currPath.r1.x - currPath.r2.x) + sqr(currPath.r1.y - currPath.r2.y)); currPointOrder := 2; aStartPoint.x := currPath.r2.x; aStartPoint.y := currPath.r2.y; Result := currPath; SeekPath := False; end else if comparePoint(currPath.r2, aStartPoint, myDelta) then begin if currPath.isArc then //AddArcToFloorConture(currPath, aStartPoint, currPath.r1, currPath.p2^, currPAth.p1^, aLen) AddArcToFloorConture(currPath, aLen, 4, currPath.r1) else aLen := aLen + SQRT(sqr(currPath.r1.x - currPath.r2.x) + sqr(currPath.r1.y - currPath.r2.y)); aStartPoint.x := currPath.r1.x; aStartPoint.y := currPath.r1.y; currPointOrder := 1; Result := currPath; SeekPath := False; end else if comparePoint(currPath.l2, aStartPoint, myDelta) then begin if currPath.isArc then //AddArcToFloorConture(currPath, aStartPoint, currPath.l1, currPath.p2^, currPAth.p1^, aLen) AddArcToFloorConture(currPath, aLen, 2, currPath.l1) else aLen := aLen + SQRT(sqr(currPath.l1.x - currPath.l2.x) + sqr(currPath.l1.y - currPath.l2.y)); aStartPoint.x := currPath.l1.x; aStartPoint.y := currPath.l1.y; currPointOrder := 3; Result := currPath; SeekPath := False; end else if comparePoint(currPath.l1, aStartPoint, myDelta) then begin if currPath.isArc then //AddArcToFloorConture(currPath, aStartPoint, currPath.l2, currPath.p1^, currPAth.p2^, aLen) AddArcToFloorConture(currPath, aLen, 1, currPath.l2) else aLen := aLen + SQRT(sqr(currPath.l1.x - currPath.l2.x) + sqr(currPath.l1.y - currPath.l2.y)); aStartPoint.x := currPath.l2.x; aStartPoint.y := currPath.l2.y; currPointOrder := 4; Result := currPath; SeekPath := False; end; if result <> nil then break else begin SavedPathList := TList.Create; SavedPathList.Assign(ConnectedPathList); //if NextPath.Width <> currPath.Width then if (ABS(NextPath.Width - currPath.Width) > 0.01) then begin UPoint := Nil; case currPointOrder of 1: UPoint := NextPath.epr1; 2: UPoint := NextPath.epr2; 3: UPoint := NextPath.epl1; 4: UPoint := NextPath.epl2; end; if UPoint <> nil then begin aLen := aLen + SQRT(sqr(UPoint.x - aStartPoint.x) + sqr(UPoint.y - aStartPoint.y)); AddPointToFloorConture(aStartPoint); //NextPoint := UPoint^; aStartPoint := UPoint^; Result := GetNextPathByPoint(aStartPoint, aLen, aPathLen); if Result <> nil then break else begin ConnectedPathList.Clear; ConnectedPathList.Assign(SavedPAthList); SavedPathList.free; end; end else begin case currPointOrder of 1: UPoint := currPath.epr1; 2: UPoint := currPath.epr2; 3: UPoint := currPath.epl1; 4: UPoint := currPath.epl2; end; end; if UPoint <> nil then begin aLen := aLen + SQRT(sqr(UPoint.x - NextPoint.x) + sqr(UPoint.y - NextPoint.y)); AddPointToFloorConture(NextPoint); //NextPoint := UPoint^; aStartPoint := UPoint^; end; end; SavedPathList.free; end; end; end; //Tolik 08/12/2021 -- разрыв контура вследствие разной толщины стен ... if Result = nil then begin //GetNearestRelatedPathAndPoint; end; end else begin if Result = nil then // дошли до несвязанного краЯ стены, припиздяченной к контуру begin // край стены или перегородки внутри комнаты Result := GoAroundPath; if Result <> nil then exit; {else begin ConnectedPathList.Clear; ConnectedPathList.Assign(SavedPAthList); SavedPathList.free; end;} if RemovedPathList.IndexOf(NextPath) <> -1 then // край стены begin if CompareValue(NextPath.r1.x, aStartPoint.x) = 0 then if CompareValue(NextPath.r1.y, aStartPoint.y) = 0 then begin if Not NextPath.isArc then begin AddPointToFloorConture(NextPath.r1); AddPointToFloorConture(NextPath.r2); //aLen := aLen + SQRT(sqr(NextPath.r1.x - NextPath.r2.x) + sqr(NextPath.r1.y - NextPath.r2.y)); end; NextPoint.x := NextPath.l2.x; NextPoint.y := NextPath.l2.y; //aLen := aLen + SQRT(sqr(NextPath.r2.x - NextPath.l2.x) + sqr(NextPath.r2.y - NextPath.l2.y)); SeekPoint.x := NextPath.p2.x; SeekPoint.y := NextPath.p2.y; FillConnectedbyPoint(SeekPoint); { if ConnectedPathList.Count = 0 then begin AddPointToFloorConture(NextPath.l2); aLen := aLen + SQRT(sqr(NextPath.l1.x - NextPath.l2.x) + sqr(NextPath.l1.y - NextPath.l2.y)); NextPoint.x := NextPath.l1.x; NextPoint.y := NextPath.l1.y; SeekPoint.x := NextPath.p1.x; SeekPoint.y := NextPath.p1.y; FillConnectedbyPoint(SeekPoint); end;} Result := GetNextPathByPoint(NextPoint, aLen, aPathLen); SeekPath := False; end; if SeekPath then if CompareValue(NextPath.r2.x, aStartPoint.x) = 0 then if CompareValue(NextPath.r2.y, aStartPoint.y) = 0 then begin if Not NextPath.isArc then begin AddPointToFloorConture(NextPath.r2); AddPointToFloorConture(NextPath.r1); //aLen := aLen + SQRT(sqr(NextPath.r1.x - NextPath.r2.x) + sqr(NextPath.r1.y - NextPath.r2.y)); end; NextPoint.x := NextPath.l1.x; NextPoint.y := NextPath.l1.y; SeekPoint.x := NextPath.p1.x; SeekPoint.y := NextPath.p1.y; FillConnectedbyPoint(SeekPoint); { if ConnectedPathList.Count = 0 then begin AddPointToFloorConture(NextPath.l1); aLen := aLen + SQRT(sqr(NextPath.l1.x - NextPath.l2.x) + sqr(NextPath.l1.y - NextPath.l2.y)); NextPoint.x := NextPath.l2.x; NextPoint.y := NextPath.l2.y; SeekPoint.x := NextPath.p2.x; SeekPoint.y := NextPath.p2.y; FillConnectedbyPoint(SeekPoint); end; } Result := GetNextPathByPoint(NextPoint, aLen, aPathLen); SeekPath := False; end; if SeekPath then if CompareValue(NextPath.l2.x, aStartPoint.x) = 0 then if CompareValue(NextPath.l2.y, aStartPoint.y) = 0 then begin if Not NextPath.isArc then begin AddPointToFloorConture(NextPath.l2); AddPointToFloorConture(NextPath.l1); //aLen := aLen + SQRT(sqr(NextPath.l1.x - NextPath.l2.x) + sqr(NextPath.l1.y - NextPath.l2.y)); end; NextPoint.x := NextPath.r1.x; NextPoint.y := NextPath.r1.y; SeekPoint.x := NextPath.p1.x; SeekPoint.y := NextPath.p1.y; FillConnectedbyPoint(SeekPoint); { if ConnectedPathList.Count = 0 then begin AddPointToFloorConture(NextPath.r1); aLen := aLen + SQRT(sqr(NextPath.r1.x - NextPath.r2.x) + sqr(NextPath.r1.y - NextPath.r2.y)); NextPoint.x := NextPath.r2.x; NextPoint.y := NextPath.r2.y; SeekPoint.x := NextPath.p2.x; SeekPoint.y := NextPath.p2.y; FillConnectedbyPoint(SeekPoint); end; } Result := GetNextPathByPoint(NextPoint, aLen, aPathLen); SeekPath := False; end; if SeekPath then if CompareValue(NextPath.l1.x, aStartPoint.x) = 0 then if CompareValue(NextPath.l1.y, aStartPoint.y) = 0 then begin if Not NextPath.isArc then begin AddPointToFloorConture(NextPath.l1); AddPointToFloorConture(NextPath.l2); //aLen := aLen + SQRT(sqr(NextPath.l1.x - NextPath.l2.x) + sqr(NextPath.l1.y - NextPath.l2.y)); end; NextPoint.x := NextPath.r2.x; NextPoint.y := NextPath.r2.y; SeekPoint.x := NextPath.p2.x; SeekPoint.y := NextPath.p2.y; FillConnectedbyPoint(SeekPoint); { if ConnectedPathList.Count = 0 then begin AddPointToFloorConture(NextPath.r2); aLen := aLen + SQRT(sqr(NextPath.r1.x - NextPath.r2.x) + sqr(NextPath.r1.y - NextPath.r2.y)); NextPoint.x := NextPath.r1.x; NextPoint.y := NextPath.r1.y; SeekPoint.x := NextPath.p1.x; SeekPoint.y := NextPath.p1.y; FillConnectedbyPoint(SeekPoint); end; } Result := GetNextPathByPoint(NextPoint, aLen, aPathLen); SeekPath := False; end; end; end; end; end; end; (* Procedure AddArcToFloorConture(aPoint: TDoublePoint; aPath: TNetPath); var ArcPoints, Points: T3DPointArray; DirectOrder: Boolean; i, ArrayLen: Integer; SecondPoint: TDoublePoint; BeginIndex, EndIndex: Integer; function GetArcPoints: T3DPointArray; var i, ModVal, Cnt: Integer; Radius, a1, a2: Double; OldDxfMode: Boolean; Fpoints: T2DPointArray; currPoint: PDoublePoint; begin //SecondPoint if ((CompareValue(aPath.r1.x, aPoint.x) = 0) and (CompareValue(aPath.r1.y, aPoint.y) = 0)) then begin SecondPoint.x := aPath.r2.x; SecondPoint.y := aPath.r2.y; end else if ((CompareValue(aPath.r2.x, aPoint.x) = 0) and (CompareValue(aPath.r2.y, aPoint.y) = 0)) then begin SecondPoint.x := aPath.r1.x; SecondPoint.y := aPath.r1.y; end else if ((CompareValue(aPath.l1.x, aPoint.x) = 0) and (CompareValue(aPath.l1.y, aPoint.y) = 0)) then begin SecondPoint.x := aPath.l2.x; SecondPoint.y := aPath.l2.y; end else if ((CompareValue(aPath.l2.x, aPoint.x) = 0) and (CompareValue(aPath.l2.y, aPoint.y) = 0)) then begin SecondPoint.x := aPath.l1.x; SecondPoint.y := aPath.l1.y; end; ModVal := 12; //10; Radius := GetLineLenght(aPoint, APath.ArcCenter); a1 := GetRadOfLine(APath.ArcCenter, APoint); a2 := GetRadOfLine(APath.ArcCenter, SecondPoint); if Not APath.Inverted then ExchangeDouble(a1, a2); OldDxfMode := DxfMode; // повышаем точность - количество точек для дуги DxfMode := True; try BezierArcPoints(FPoints, APath.ArcCenter.x, APath.ArcCenter.y, Radius, a1, a2); finally DxfMode := OldDxfMode; end; Cnt := Length(FPoints) - 1; if Cnt > 2 then begin if ((CompareValue(FPoints[0].x, APoint.x) = 0) and (CompareValue(FPoints[0].y, APoint.y) = 0)) then begin for i := 0 to Cnt do begin if i mod 10 = 0 then Begin SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1].x := FPoints[i].x; Result[Length(Result) - 1].y := FPoints[i].y; end; end; end else begin for i := Cnt downto 0 do begin if i mod 10 = 0 then Begin SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1].x := FPoints[i].x; Result[Length(Result) - 1].y := FPoints[i].y; end; end; end; end; SetLength(FPoints, 0); end; Function getDirectOrder(aArcPoints: T3DPointArray): Boolean; var DistToFirstArcPoint, DistToLastArcPoint: Double; begin //Result := True; Result := False; if Length(ArcPoints) > 0 then begin DistToFirstArcPoint := SQRT( SQR(aArcPoints[BeginIndex].x - aPoint.x) + SQR(aArcPoints[BeginIndex].y - aPoint.y) ); DistToLastArcPoint := SQRT( SQR(aArcPoints[EndIndex].x - aPoint.x) + SQR(aArcPoints[EndIndex].y - aPoint.y) ); if CompareValue(DistToLastArcPoint, DistToFirstArcPoint) = 1 then //result := False; Result := True; end; end; begin SetLength(Points, 2); // r path side if (((CompareValue(aPath.r1.x, aPoint.x) = 0) and (CompareValue(aPath.r1.y, aPoint.y) = 0)) or ((CompareValue(aPath.r2.x, aPoint.x) = 0) and (CompareValue(aPath.r2.y, aPoint.y) = 0))) then begin Points[0].x := aPath.r1.x; Points[0].y := aPath.r1.y; Points[1].x := aPath.r2.x; Points[1].y := aPath.r2.y; end else if (((CompareValue(aPath.l1.x, aPoint.x) = 0) and (CompareValue(aPath.l1.y, aPoint.y) = 0)) or ((CompareValue(aPath.l2.x, aPoint.x) = 0) and (CompareValue(aPath.l2.y, aPoint.y) = 0))) then begin Points[0].x := aPath.l1.x; Points[0].y := aPath.l1.y; Points[1].x := aPath.l2.x; Points[1].y := aPath.l2.y; end; ArcPoints := GetArcPoints;//(Points, aPath, True); if Length(ArcPoints) > 2 then begin BeginIndex := 0; EndIndex := Length(ArcPoints) - 1; if (((CompareValue(ArcPoints[0].x, aPoint.x) = 0) and (CompareValue(ArcPoints[0].y, aPoint.y) = 0)) or ((CompareValue(ArcPoints[0].x, SecondPoint.x) = 0) and (CompareValue(ArcPoints[0].y, SecondPoint.y) = 0))) then inc(BeginIndex); if (((CompareValue(ArcPoints[EndIndex].x, aPoint.x) = 0) and (CompareValue(ArcPoints[EndIndex].y, aPoint.y) = 0)) or ((CompareValue(ArcPoints[EndIndex].x, SecondPoint.x) = 0) and (CompareValue(ArcPoints[EndIndex].y, SecondPoint.y) = 0))) then Dec(EndIndex); DirectOrder := getDirectOrder(ArcPoints);//((CompareValue(ArcPoints[0].x, aPoint.x) = 0) and (CompareValue(ArcPoints[0].y, aPoint.y) = 0)); if DirectOrder then for i := EndIndex downto BeginIndex do AddPointToFloorConture(TDoublePoint(ArcPoints[i])) else for i := BeginIndex to EndIndex do AddPointToFloorConture(TDoublePoint(ArcPoints[i])); AddPointToFloorConture(aPoint); end; end; *) function CalcArcLen(aPath: TNetPath): Double; var i, range: Integer; Point1, Point2: TDoublePoint; arcPoints, resArcPoints: T3DPointArray; begin Result := 0; if aPath = nil then exit; if not aPath.isArc then exit; SetLength(arcPoints, 2); arcPoints[0] := aPath.p1^; arcPoints[1] := aPath.p2^; resArcPoints := GetArcWallPointsAll(arcPoints, aPath); range := Length(resArcPoints) - 1; Point1 := resArcPoints[0]; for i := 1 to range do begin Point2 := resArcPoints[i]; Result := Result + SQRT(sqr(Point1.x - Point2.x) + sqr(Point1.y - Point2.y)); Point1 := Point2; end; SetLength(arcPoints, 0); SetLength(resArcPoints, 0); end; Procedure AddPrevPathLen; begin if aLeft then begin if NextPath.isArc then begin //LeftLen := LeftLen + CalcArcLen(NextPath) //LeftLen := LeftLen + LastArcPathLen; LeftContureLen := LeftContureLen + LastArcPathLen; LastArcPathLen := 0; end else begin LeftContureLen := LeftContureLen + Sqrt(sqr(PrevPath.l1.x - PrevPath.l2.x) + sqr(PrevPath.l1.y - PrevPath.l2.y)); //LeftLen := LeftLen + Sqrt(sqr(PrevPath.p1.x - PrevPath.p2.x) + sqr(PrevPath.p1.y - PrevPath.p2.y)); end; end else begin if NextPath.isArc then begin //RightLen := RightLen + CalcArcLen(NextPath) //RightLen := RightLen + LastArcPathLen; RightContureLen := RightContureLen + LastArcPathLen; LastArcPathLen := 0; end else begin RightContureLen := RightContureLen + Sqrt(sqr(PrevPath.r1.x - PrevPath.r2.x) + sqr(PrevPath.r1.y - PrevPath.r2.y)); //RightLen := RightLen + Sqrt(sqr(PrevPath.p1.x - PrevPath.p2.x) + sqr(PrevPath.p1.y - PrevPath.p2.y)); end; end; end; begin Result := TList.Create; PassedList := TList.Create; StartPoint.z := 0; NextPoint.z := 0; PathConnPoint := 1; PathPoint := aPath.p1; if aLeft then begin StartPoint.x := aPath.l1.x; StartPoint.y := aPath.l1.y; currPointOrder := 3; end else begin StartPoint.x := aPath.r1.x; StartPoint.y := aPath.r1.y; currPointOrder := 1; end; //AddPointToFloorConture(StartPoint); BreakCounter := 0; //FreeAndNil(ConnectedPathList); ConnectedPathList := GetConnPathsBySide(aPath, 1); if ConnectedPathList.Count > 0 then begin for i := ConnectedPathList.Count - 1 downto 0 do begin if ComparePoint(TNetPath(ConnectedPathList[i]).p1^, TNetPath(ConnectedPathList[i]).p2^, myDelta) then ConnectedPathList.Delete(i); end; end; {for i := 0 to aPath.Net.Paths.Count - 1 do begin currPath := TNetPath(aPath.Net.Paths[i]); if currPath <> aPath then if aPath.Connected(currPath) then ConnectedPathList.Add(currPath); end;} NextPath := aPath; NextPoint.x := StartPoint.x; NextPoint.y := StartPoint.y; if NextPath <> nil then begin CanProceed := True; PrevPath := NextPAth; //AddPrevPathLen; end; while CanProceed do begin PrevPath := NextPath; if not NextPath.isArc then AddPointToFloorConture(NextPoint, true); {else AddArcToFloorConture(NextPoint, NextPath);} // прерывание цикла (на всякий) inc(BreakCounter); if BreakCounter > 2000 then begin //ConnectedPathList.Free; FreeAndNil(ConnectedPathList); FreeAndNil(Result); break; end; //Tolik 14/12/2021 -- if aLeft then NextPath := GetNextPathByPoint(NextPoint, LeftContureLen, LeftLen) else NextPath := GetNextPathByPoint(NextPoint, RightContureLen, RightLen); { if aLeft then NextPath := GetNextPathByPoint(NextPoint, LeftLen, LeftContureLen) else NextPath := GetNextPathByPoint(NextPoint, RightLen, RightContureLen); } // if NextPath = nil then begin //Tolik 16/12/2021 -- //NextPath := GetPathWithUniquePoint; if aLeft then NextPath := GetPathWithUniquePoint(LeftContureLen) else NextPath := GetPathWithUniquePoint(RightContureLen); // if NextPath = nil then begin //ConnectedPathList.Free; FreeAndNil(ConnectedPathList); FreeAndNil(Result); break; end else begin // PrevPath := NextPath; // addPrevPathLen; end; end; //Tolik 14/12/2021 - - //else if NextPath <> nil then // begin if aLeft then begin if NextPath.isArc then begin //LeftLen := LeftLen + CalcArcLen(NextPath) LeftLen := LeftLen + LastArcPathLen; //LeftContureLen := LeftContureLen + LastArcPathLen; LastArcPathLen := 0; end else LeftLen := LeftLen + Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + sqr(NextPath.p1.y - NextPath.p2.y)); //LeftContureLen := LeftContureLen + Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + sqr(NextPath.p1.y - NextPath.p2.y)); end else begin if NextPath.isArc then begin //RightLen := RightLen + CalcArcLen(NextPath) RightLen := RightLen + LastArcPathLen; //RightContureLen := RightContureLen + LastArcPathLen; LastArcPathLen := 0; end else RightLen := RightLen + Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + sqr(NextPath.p1.y - NextPath.p2.y)); //RightContureLen := RightContureLen + Sqrt(sqr(NextPath.p1.x - NextPath.p2.x) + sqr(NextPath.p1.y - NextPath.p2.y)); end; //ConnectedPathList.free; FreeAndNil(ConnectedPathList); if (((CompareValue(NextPoint.x, NextPath.r1.x) = 0) and (CompareValue(NextPoint.y, NextPath.r1.y) = 0)) or ((CompareValue(NextPoint.x, NextPath.l1.x) = 0) and (CompareValue(NextPoint.y, NextPath.l1.y) = 0))) then ConnectedPathList := GetConnPathsBySide(NextPath, 1) else ConnectedPathList := GetConnPathsBySide(NextPath, 2); if ConnectedPathList.Count > 0 then begin for i := ConnectedPathList.Count - 1 downto 0 do begin if ComparePoint(TNetPath(ConnectedPathList[i]).p1^, TNetPath(ConnectedPathList[i]).p2^, myDelta) then ConnectedPathList.Delete(i); end; end; {for i := 0 to NextPath.Net.Paths.Count - 1 do begin currPath := TNetPath(NextPath.Net.Paths[i]); if currPath <> NextPath then if NextPath.Connected(currPath) then ConnectedPathList.Add(currPath); end;} if RemovedPathList.IndexOf(NextPath) = -1 then begin if not CheckInListById(Result, NextPath) then begin Result.Add(NextPath); PassedList.Assign(Result, laOR); end; end; if CompareValue(StartPoint.x, NextPoint.x) = 0 then if CompareValue(StartPoint.y, NextPoint.y) = 0 then CanProceed := False; end; end; end; //function CheckNoContureInList(aResList, aList: TList): Boolean; function CheckNoContureInList(aResList, aList, aContureList: TList): Boolean; var i, j, k: integer; resList: TList; resPath, currPath: TNetPath; SamePaths: Boolean; function CheckNoPointinList(aList: TList; aPoint: PDoublePoint) : boolean; var i: Integer; begin Result := False; for i := 0 to aList.Count - 1 do begin if ((Comparevalue(PdoublePoint(aList[i]).x, aPoint.x) = 0) and (Comparevalue(PdoublePoint(aList[i]).y, aPoint.y) = 0)) then begin Result := True; break; end; end; end; begin Result := True; for i := 0 to aResList.Count - 1 do begin SamePaths := True; resList := TList(aResList[i]); if resList.Count = aList.Count then begin for j := 0 to aList.Count - 1 do begin currPath := TNetPath(aList[j]); SamePaths := (ResList.IndexOf(currPath) <> -1); if not SamePaths then break; end; if SamePaths then begin Result := False; break; end; end; end; if not Result then begin Result := True; for i := 0 to aFloorsConturesList.Count - 1 do begin ResList := TList(aFloorsConturesList[i]); if ResList.Count = aContureList.Count then begin for j := 0 to ResList.Count - 1 do begin if ChecknoPointinList(ResList, PDoublePoint(aContureList[j])) then begin Result := False; break; end; end; end; if not Result then break; end; end; end; Procedure AddNoAddedPaths(aList: TList); var i, j: Integer; currPath: TNetPath; PathList, PathsToAdd: TList; PathExists: Boolean; begin PathsToAdd := TList.Create; for i := 0 to aNets.Paths.Count - 1 do begin currPath := TNetPath(aNets.Paths[i]); if (CompareValue(currPath.p1.x, CurrPath.p2.x) = 0) and (CompareValue(currPath.p1.y, CurrPath.p2.y) = 0) then Continue; PathExists := false; for j := 0 to aList.Count - 1 do begin PathList := TList(aList[j]); if PathList.IndexOf(currPath) <> -1 then begin PathExists := True; break; end; end; if not PathExists then if PathsToAdd.IndexOf(currPath) = -1 then PathsToAdd.Add(currPath); end; for i := 0 to PathsToAdd.Count - 1 do begin currPath := TNetPath(PathsToAdd[i]); LeftFloorConture := TList.Create; new(cp); cp.x := currPath.r1.x; cp.y := currPath.r1.y; LeftFloorConture.Add(cp); new(cp); cp.x := currPath.r2.x; cp.y := currPath.r2.y; LeftFloorConture.Add(cp); new(cp); cp.x := currPath.l2.x; cp.y := currPath.l2.y; LeftFloorConture.Add(cp); new(cp); cp.x := currPath.l1.x; cp.y := currPath.l1.y; LeftFloorConture.Add(cp); aFloorsConturesList.Add(LeftFloorConture); PathList := TList.Create; PathList.Add(currPath); aList.Add(PathList); aNormalList.Add(nil); end; end; function GetEntryCount(aList: TList; aPath: TNetPath): integer; var i, j: integer; currList: TList; begin Result := 0; for i := 0 to aList.Count - 1 do begin currList := TList(aList[i]); for j := 0 to currList.Count - 1 do begin if TNetPath(currList[j]).id = aPath.Id then begin inc(Result); if Result > 1 then break; end; end; if Result > 1 then break; end; end; function CheckIsConture(aList: TList): boolean; var FirstPath, LastPath: TNetPath; begin Result := False; if aList.Count > 2 then begin FirstPath := TNetPath(aList[0]); LastPath := tNetPath(aList[aList.count - 1 ]); if ((CompareValue(FirstPath.p1.x, LastPath.p1.x) = 0) and (CompareValue(FirstPath.p1.y, LastPath.p1.y) = 0)) or ((CompareValue(FirstPath.p1.x, LastPath.p2.x) = 0) and (CompareValue(FirstPath.p1.y, LastPath.p2.y) = 0)) or ((CompareValue(FirstPath.p2.x, LastPath.p1.x) = 0) and (CompareValue(FirstPath.p2.y, LastPath.p1.y) = 0)) or ((CompareValue(FirstPath.p2.x, LastPath.p2.x) = 0) and (CompareValue(FirstPath.p2.y, LastPath.p2.y) = 0)) then Result := True; end; end; begin Result := TList.Create; if aNets.Paths = nil then exit; if aNets.Paths.Count = 0 then exit; // assignFile(f, 'd:\Tolik\PathPoints.txt'); // rewrite(f); //Tolik 16/12/2021 -- for i := aNets.Paths.Count - 1 downto 0 do begin PAthToDel := aNets.Paths[i]; { s := 'Path ' + inttostr(i) + ' ID = ' + inttostr(PAthToDel.ID); writeln(f,s); s := 'P1 = '+ FloatToStr(PathTodel.P1.x) + ' ' + FloatToStr(PathTodel.P1.y) + ' ' + FloatToStr(PathTodel.P1.z); writeln(f,s); s := 'P2 = '+ FloatToStr(PathTodel.P2.x) + ' ' + FloatToStr(PathTodel.P2.y) + ' ' + FloatToStr(PathTodel.P2.z); writeln(f,s); s := 'L1 = '+ FloatToStr(PathTodel.l1.x) + ' ' + FloatToStr(PathTodel.l1.y) + ' ' + FloatToStr(PathTodel.l1.z); writeln(f,s); s := 'R1 = '+ FloatToStr(PathTodel.r1.x) + ' ' + FloatToStr(PathTodel.r1.y) + ' ' + FloatToStr(PathTodel.r1.z); writeln(f,s); s := 'L2 = '+ FloatToStr(PathTodel.l2.x) + ' ' + FloatToStr(PathTodel.l2.y) + ' ' + FloatToStr(PathTodel.l2.z); writeln(f,s); s := 'R2 = '+ FloatToStr(PathTodel.r2.x) + ' ' + FloatToStr(PathTodel.r2.y) + ' ' + FloatToStr(PathTodel.r2.z); writeln(f,s); s := '----------------------------------------------------------------------------'; writeln(f,s); } if comparePoint(PAthTodel.p1^, PathTodel.p2^, 0.0001) then aNets.DeletePath(PathTodel); end; //closeFile(f); // RemovedPathList := TList.Create; PathList := CollectSCSWallEntries(aNets.Paths); CanProceed := True; LastArcPathLen := 0; // просто стены (в незамкнутых контурах) по идее, все незамкнутые контура роазобьются на отдельные стены { while CanProceed do begin CanProceed := False; for i := PathList.Count - 1 downto 0 do begin if PNetEntryInfo(PathList[i]).P1EntryCount = 1 then // порог исключенния - одно соединение на точке begin CanProceed := True; NetList := TList.Create; NetList.Add(PNetEntryInfo(PathList[i]).NetPath); Result.Add(NetList); RemovedPathList.Add(PNetEntryInfo(PathList[i]).NetPath); LeftFloorConture := TList.Create; new(cp); cp.x := PNetEntryInfo(PathList[i]).NetPath.r1.x; cp.y := PNetEntryInfo(PathList[i]).NetPath.r1.y; LeftFloorConture.Add(cp); new(cp); cp.x := PNetEntryInfo(PathList[i]).NetPath.r2.x; cp.y := PNetEntryInfo(PathList[i]).NetPath.r2.y; LeftFloorConture.Add(cp); new(cp); cp.x := PNetEntryInfo(PathList[i]).NetPath.l2.x; cp.y := PNetEntryInfo(PathList[i]).NetPath.l2.y; LeftFloorConture.Add(cp); new(cp); cp.x := PNetEntryInfo(PathList[i]).NetPath.l1.x; cp.y := PNetEntryInfo(PathList[i]).NetPath.l1.y; LeftFloorConture.Add(cp); aFloorsConturesList.Add(LeftFloorConture); //aFloorsConturesList.Add(nil); RemovepathFromList(PNetEntryInfo(PathList[i]).NetPath); end else if PNetEntryInfo(PathList[i]).P2EntryCount = 1 then begin CanProceed := True; NetList := TList.Create; NetList.Add(PNetEntryInfo(PathList[i]).NetPath); Result.Add(NetList); RemovedPathList.Add(PNetEntryInfo(PathList[i]).NetPath); // добавить в список удаленных LeftFloorConture := TList.Create; new(cp); cp.x := PNetEntryInfo(PathList[i]).NetPath.r1.x; cp.y := PNetEntryInfo(PathList[i]).NetPath.r1.y; LeftFloorConture.Add(cp); new(cp); cp.x := PNetEntryInfo(PathList[i]).NetPath.r2.x; cp.y := PNetEntryInfo(PathList[i]).NetPath.r2.y; LeftFloorConture.Add(cp); new(cp); cp.x := PNetEntryInfo(PathList[i]).NetPath.l2.x; cp.y := PNetEntryInfo(PathList[i]).NetPath.l2.y; LeftFloorConture.Add(cp); new(cp); cp.x := PNetEntryInfo(PathList[i]).NetPath.l1.x; cp.y := PNetEntryInfo(PathList[i]).NetPath.l1.y; LeftFloorConture.Add(cp); aFloorsConturesList.Add(LeftFloorConture); //aFloorsConturesList.Add(nil); RemovepathFromList(PNetEntryInfo(PathList[i]).NetPath); end; end; end;} // здесь - поиск замкнутых контуров if PathList.Count > 0 then begin for i := 0 to PathList.Count - 1 do begin StartPath := PNetEntryInfo(PathList[i]).NetPath; if GetEntryCount(Result, StartPath) < 2 then begin LeftContureLen := 0; RightContureLen := 0; //LeftContureLen := Sqrt(sqr(StartPath.l1.x - StartPath.l2.x) + sqr(StartPath.l1.y - StartPath.l2.y)); //RightContureLen := Sqrt(sqr(StartPath.r1.x - StartPath.r2.x) + sqr(StartPath.r1.y - StartPath.r2.y)); //LeftLen := Sqrt(sqr(StartPath.p1.x - StartPath.p2.x) + sqr(StartPath.p1.y - StartPath.p2.y)); //RightLen := LeftLen; LeftLen := 0; RightLen := 0; LeftFloorConture := TList.Create; RightFloorConture:= TList.Create; LeftNormalConture := TList.Create; RightNormalConture := TList.Create; NetContureL := GetClosedConture(StartPath, LeftFloorConture, LeftNormalConture, true); NetContureR := GetClosedConture(StartPath, RightFloorConture, RightNormalConture); if NetContureL <> nil then begin if CheckIsConture(NetContureL) then begin if compareValue(LeftLen, LeftContureLen) > 0 then begin if CheckNoContureInList(Result, NetContureL, LeftFloorConture) then begin Result.Add(NetContureL); aFloorsConturesList.Add(LeftFloorConture); aNormalList.Add(LeftNormalConture); end else begin FreeAndNil(NetContureL); //FreeList(LeftFloorConture); FreeAndDisposeList(LeftFloorConture); FreeAndDisposeList(LeftNormalConture); end; end; end else begin FreeAndNil(NetContureL); //FreeList(LeftFloorConture); FreeAndDisposeList(LeftFloorConture); FreeAndDisposeList(LeftNormalConture); end; end; if NetContureR <> nil then begin if CheckIsConture(NetContureR) then begin if compareValue(RightLen, RightContureLen) > 0 then begin if CheckNoContureInList(Result, NetContureR, RightFloorConture) then begin Result.Add(NetContureR); aFloorsConturesList.Add(RightFloorConture); aNormalList.Add(RightNormalConture); end else begin FreeAndNil(NetContureR); //FreeList(RightFloorConture); FreeAndDisposeList(RightFloorConture); FreeAndDisposeList(RightNormalConture); end; end; end else begin FreeAndNil(NetContureR); FreeAndDisposeList(RightFloorConture); FreeAndDisposeList(RightNormalConture); end; end; end; end; end; AddNoAddedPaths(Result); // добавить те сегменты, что не попали ... if PathList.Count > 0 then for i := 0 to PathList.Count - 1 do begin PNetEntryInfo(PathList[i]).NetPath := nil; Dispose(PNetEntryInfo(PathList[i])); end; PathList.Free; RemovedPathList.Free; end; // function CoordsCMP(p1, p2: TDoublePoint): Boolean; begin try result := (abs(p1.x - p2.x) < 0.1) and (abs(p1.y - p2.y) < 0.1); except on E: Exception do AddExceptionToLogEx('U_Arch3D.CoordsCMP', E.Message); end; end; function GetAllNets(aCad: TF_CAD): TList; var i: integer; xFigure: TFigure; begin try Result := TList.create; for i := 0 to aCad.PCad.Figures.Count - 1 do begin xFigure := TFigure(aCad.PCad.Figures[i]); if xFigure is TNet then if TNet(xFigure).Paths.Count > 0 then Result.Add(xFigure); end; except on E: Exception do AddExceptionToLogEx('GetAllNets', E.Message); end; end; function GetVirtualNetPathsByRealNet(aNet, aGrpNet: TNet): TList; var i, j: Integer; SrcPath: TNetPath; vPath: TNetPath; NetBndRect: TDoubleRect; begin Result := TList.Create; {//26.06.2012} if aGrpNet <> nil then begin NetBndRect := aNet.GetBoundRect; NetBndRect.Left := NetBndRect.Left - aNet.WallThick; NetBndRect.Top := NetBndRect.Top - aNet.WallThick; NetBndRect.Right := NetBndRect.Right + aNet.WallThick; NetBndRect.Bottom := NetBndRect.Bottom + aNet.WallThick; for i := 0 to aGrpNet.Paths.Count - 1 do begin vPath := TNetPath(aGrpNet.Paths[i]); for j := 0 to vPath.FSrcPaths.Count - 1 do begin SrcPath := TNetPath(vPath.FSrcPaths[j]); if (SrcPath.Net = aNet) and (vPath.p1 <> vPath.p2) and Not EQDP(vPath.p1^, vPath.p2^) then if PointInRect(vPath.p1^, NetBndRect) and PointInRect(vPath.p2^, NetBndRect) then begin Result.Add(vPath); Break; //// BREAK //// end; end; end; end; {if aNet <> nil then begin for i := 0 to aNet.Paths.Count - 1 do begin vPath := FindVirtualNetPathByReal(aGrpNet, TNetPath(aNet.Paths[i]), false); if vPath <> nil then Result.Add(vPath); end; end;} end; function AnglesCMP(a1, a2: Double): Boolean; var a: double; begin try result := false; a := abs(a1 - a2); a := StrToFloat_My(FormatFloat('0.00', a)); while a >= 3.14 do begin a := a - pi; end; if a < 0.1 then Result := True; except on E: Exception do AddExceptionToLogEx('U_Arch3D.AnglesCMP', E.Message); end; end; function PointDistCMP(p: TDoublePoint; aNetPath: TNetPath): Boolean; begin try Result := True; if GetLineLenght(p, aNetPath.p1^) < 1 then Result := false; if GetLineLenght(p, aNetPath.p2^) < 1 then Result := false; except on E: Exception do AddExceptionToLogEx('U_Arch3D.PointDistCMP', E.Message); end; end; function FindVirtualNetPathByReal(aGrpNet: TNet; aNetPath: TNetPath; aExtCheck: Boolean=false): TNetPath; var TmpPath: TNetPath; i, j: Integer; MinDLen: Double; NetPathLen, PathLen: Double; begin Result := nil; if aGrpNet <> nil then begin MinDLen := -1; NetPathLen := GetLineLenght(aNetPath.p1^, aNetPath.p2^); for i := 0 to aGrpNet.Paths.Count - 1 do begin TmpPath := TNetPath(aGrpNet.Paths[i]); if TmpPath.FSrcPaths.Count > 0 then for j := 0 to TmpPath.FSrcPaths.Count - 1 do begin if TmpPath.FSrcPaths[j] = aNetPath then begin if Not aExtCheck or ((TmpPath.p1 <> TmpPath.p2) and Not PointNear(TmpPath.p1^, TmpPath.p2^)) then begin PathLen := GetLineLenght(TmpPath.p1^, TmpPath.p2^); if (MinDLen = -1) or (Abs(NetPathLen - PathLen) < MinDLen) then begin MinDLen := Abs(NetPathLen - PathLen); Result := TmpPath; //Break; //// BREAK //// end; end; end; end; end; end; end; function GetWallTypeByDoorType(aDoor: TNetDoor): TFaceWallType; begin try Result := fwtNone; if aDoor.DoorObjType = dotDoor then Result := fwtDoorSlope; if aDoor.DoorObjType = dotWindow then Result := fwtWindowSlope; if aDoor.DoorObjType = dotArc then Result := fwtArc; if aDoor.DoorObjType = dotBalcony then Result := fwtBalconSlope; if aDoor.DoorObjType = dotNiche then Result := fwtNiche; except on E: Exception do AddExceptionToLogEx('U_Arch3D.GetWallTypeByDoorType', E.Message); end; end; procedure GetWallPointsWithSlope(var da1, da2, db1, db2: TDoublePoint; hor_a1, hor_a2, hor_b1, hor_b2: double); var inner_len, outer_len: double; begin try outer_len := GetLineLenght(da1, da2); inner_len := GetLineLenght(db1, db2); // Tolik 03/01/2020 - - if outer_len <> 0 then begin hor_a1 := hor_a1 / outer_len; hor_a2 := hor_a2 / outer_len; end; if inner_len <> 0 then begin hor_b1 := hor_b1 / inner_len; hor_b2 := hor_b2 / inner_len; end; da1.x := da1.x + (da1.x - da2.x) * hor_a1; da1.y := da1.y + (da1.y - da2.y) * hor_a1; da2.x := da2.x + (da2.x - da1.x) * hor_a2; da2.y := da2.y + (da2.y - da1.y) * hor_a2; db1.x := db1.x + (db1.x - db2.x) * hor_b1; db1.y := db1.y + (db1.y - db2.y) * hor_b1; db2.x := db2.x + (db2.x - db1.x) * hor_b2; db2.y := db2.y + (db2.y - db1.y) * hor_b2; except on E: Exception do AddExceptionToLogEx('U_Arch3D.GetWallPointsWithSlope', E.Message); end; end; procedure GetDoorPointsWithSlope(var c: TDoublePoint; d: TDoublePoint; depth: double); var d_len: double; begin try d_len := GetLineLenght(c, d); if (d_len <> 0) and (depth <> 0) then begin depth := depth / d_len; c.x := d.x - (d.x - c.x) * depth; c.y := d.y - (d.y - c.y) * depth; end; except on E: Exception do AddExceptionToLogEx('U_Arch3D.GetDoorPointsWithSlope', E.Message); end; end; function GetImageHash(aFName: string): string; var Buffer: PByte; Size: Integer; xStream: TFileStream; begin // xStream := TFileStream.Create(aFName, fmOpenRead); try // size := xStream.Size; // GetMem(Buffer, Size + 1); // xStream.Position := 0; // xStream.Read(Buffer^, Size); //Result := BuildBuffHash(Buffer, Size); Result := BuildFileHash(aFName); except on E: Exception do AddExceptionToLogEx('U_Arch3D.GetImageHash', E.Message); end; // FreeMem(Buffer, size); // FreeAndNil(xStream); end; function GetObjectHash(aFName: string): string; var Buffer: PByte; Size: Integer; xStream: TFileStream; begin // xStream := TFileStream.Create(aFName, fmOpenRead); try // size := xStream.Size; // GetMem(Buffer, Size + 1); // xStream.Position := 0; // xStream.Read(Buffer^, Size); //Result := BuildBuffHash(Buffer, Size); Result := BuildFileHash(aFName); except on E: Exception do AddExceptionToLogEx('U_Arch3D.GetImageHash', E.Message); end; // FreeMem(Buffer, size); // FreeAndNil(xStream); end; { T3DModel } procedure T3DModel.CollectModel(aFaces: TList; aNets: TList); var i, j, k, l: integer; xNets: TList; xNet, FullNet: TNet; xNetPath: TNetPath; xRoom, NextRoom: T3DRoom; xWall, xSecondWall: T3DWall; isRoof: boolean; // Tolik -- 17/07/2018 -- NetList, RoomList, PathList, FloorsConturesList, FloorConture, NormalsContureList: TList; // Tolik 20/06/2018 -- список замкнутых контуров, полученных с TNet'a, если используем не Графмодуль а СКС FloorContureLen: Integer; AllPathsNet: TNet; xCorner: T3DCorner; ip: TDoublePoint; CornerName: String; refreshFlag: Boolean; PassedList: TList; IsPathListConture: Boolean; TmpPath: TNetPath; Procedure AddPointsToNet(aNet: TNet); var i: Integer; currPath, NextPath: TNetPath; cp: PDoublePoint; begin if aNet.Paths.Count > 0 then begin currPath := TNetPath(aNet.Paths[0]); if aNet.Paths.Count = 1 then begin New(cp); cp.x := currPath.p1.x; cp.y := currPath.p1.y; cp.z := 0; aNet.Points.Add(cp); New(cp); cp.x := currPath.p2.x; cp.y := currPath.p2.y; cp.z := 0; aNet.Points.Add(cp); exit; end; NextPath := TNetPath(aNet.Paths[1]); New(cp); cp.x := currPath.p1.x; cp.y := currPath.p1.y; cp.z := 0; if (((CompareValue(cp.x, NextPath.p1.x) = 0) and (CompareValue(cp.y, NextPath.p1.y) = 0)) or ((CompareValue(cp.x, NextPath.p2.x) = 0) and (CompareValue(cp.y, NextPath.p2.y) = 0))) then begin cp.x := currPath.p2.x; cp.y := currPath.p2.y; aNet.Points.Add(cp); New(cp); cp.x := currPath.p1.x; cp.y := currPath.p1.y; cp.z := 0; aNet.Points.Add(cp); end else begin aNet.Points.Add(cp); New(cp); cp.x := currPath.p2.x; cp.y := currPath.p2.y; cp.z := 0; aNet.Points.Add(cp); end; for i := 1 to aNet.Paths.Count - 1 do begin NextPath := TNetPath(aNet.Paths[i]); if (((CompareValue(NextPath.p1.x, currPath.p1.x) = 0) and (CompareValue(NextPath.p1.y, currPath.p1.y) = 0)) or ((CompareValue(NextPath.p1.x, currPath.p2.x) = 0) and (CompareValue(NextPath.p1.y, currPath.p2.y) = 0))) then begin New(cp); cp.x := NextPath.p2.x; cp.y := NextPath.p2.y; cp.z := 0; aNet.Points.Add(cp); end else begin if (((CompareValue(NextPath.p2.x, currPath.p1.x) = 0) and (CompareValue(NextPath.p2.y, currPath.p1.y) = 0)) or ((CompareValue(NextPath.p2.x, currPath.p2.x) = 0) and (CompareValue(NextPath.p2.y, currPath.p2.y) = 0))) then begin New(cp); cp.x := NextPath.p1.x; cp.y := NextPath.p1.y; cp.z := 0; aNet.Points.Add(cp); end else break; end; currPath := NextPath; end; end; end; // Procedure CalcWithRelatedPoints(aNet: TNet); var cTNet: tNet; currPath, netPath: TNetPath; AddedPathList: TList; i, j, k: Integer; CanAddPAth: Boolean; begin cTNet := TNet(aNets[0]); AddedPathList := TList.Create; for i := 0 to aNet.Paths.Count - 1 do begin netPath := TNetPath(aNet.Paths[i]); for j := 0 to cTNet.Paths.Count - 1 do begin currPath := TNetPath(cTNet.Paths[j]); if currPath.Connected(netPath) then begin if AddedPathList.IndexOf(currPath) = -1 then begin CanAddPath := True; for k := 0 to aNet.Paths.Count - 1 do begin if TNetPath(aNet.Paths[k]).AreYou(currPath.p1, currPath.p2) then begin CanAddPath := False; break; end; end; if CanAddPAth then AddedPathList.Add(currPAth); end; end; end; end; for i := 0 to AddedPathList.Count - 1 do aNet.Paths.Add(TNetPath(AddedPathList[i])); aNet.RefreshPaths(True); for i := aNet.Paths.Count - 1 downto 0 do begin currPath := TNetPath(aNet.Paths[i]); if AddedPathList.IndexOf(currPath) <> -1 then aNet.Paths.delete(i); end; AddedPathList.free; end; Function CheckIsPathListConture(aPathList: tList): Boolean; begin Result := False; if aPathList.Count > 2 then begin if TNetPath(aPathList[0]).Connected(TNetPath(aPathList[aPathList.Count - 1])) then Result := True; end; end; // Tolik 30/10/2019 -- для смежных комнат -- кз -- для стен типа перегородок внутри комнат - сойдет Procedure DefineInsidePaths; var i, j, k, l: Integer; currRoom, CheckRoom: T3DRoom; currWall: T3DWall; begin for i := 0 to fRooms.Count - 1 do begin CurrRoom := T3DRoom(FRooms[i]); for j := 0 to FRooms.Count - 1 do begin if j <> i then begin CheckRoom := T3DRoom(FRooms[j]); if Length(CheckRoom.FNetConture) > 0 then begin for k := 0 to CurrRoom.FWalls.Count - 1 do begin currWall := T3DWall(CurrRoom.FWalls[k]); if currWall.FPlanObject <> nil then begin l := 0; {if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.p1^) and PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.p2^)) then currWall.FPlanObject.FIsInner := True;} if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.r1)) then inc(l); if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.l1)) then inc(l); if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.r2)) then inc(l); if (PtInPolygon(CheckRoom.FNetConture, currWall.FPlanObject.l2)) then inc(l); if l > 2 then currWall.FPlanObject.FIsInner := True; end; end; end; end; end; end; end; Procedure DefineInnerPaths(aNetList: TList); var i, j, k, l: Integer; currNet, NextNet : TNet; CurrPath, NextPath: TNetPath; begin for i := 0 to aNetList.Count - 1 do begin currNet := TNet(aNetList[i]); for j := 0 to currNet.Paths.Count - 1 do begin currPath := TNetPath(currNet.Paths[j]); currPath.op1 := @currPath.el1; currPath.op2 := @currPath.el2; currPath.ip1 := @currPath.er1; currPath.ip2 := @currPath.er2; if not currPath.FIsInner then if i < (aNetList.Count - 1) then begin for k := (i+1) to aNetList.Count - 1 do begin NextNet := TNet(aNetList[k]); for l := 0 to NextNet.Paths.Count - 1 do begin NextPath := TNetpath(NextNet.Paths[l]); //if currPath = NextPath then if ((CompareValue(currPath.p1.x, NextPath.p1.x) = 0) and (CompareValue(currPath.p1.y, NextPath.p1.y) = 0) and (CompareValue(currPath.p2.x, NextPath.p2.x) = 0) and (CompareValue(currPath.p2.y, NextPath.p2.y) = 0)) or ((CompareValue(currPath.p2.x, NextPath.p1.x) = 0) and (CompareValue(currPath.p2.y, NextPath.p1.y) = 0) and (CompareValue(currPath.p1.x, NextPath.p2.x) = 0) and (CompareValue(currPath.p1.y, NextPath.p2.y) = 0)) then begin currPath.FIsInner := True; break; end; end; if currPath.FIsInner then break; end; end; end; end; end; function GetSCSRoomConture(aNet: tNet): TDoublePointArr; var startPoint, NextPoint, LastPoint: PDoublePoint; Side, ResultLength, i, j, range, currResLength: Integer; currPath, NextPath: TNetPath; Rad, ang1, ang2: Double; invertarray: Boolean; dxfModeFlag: Boolean; LineLen1, LineLen2: double; arcPoints: T2DPointArray; function GetConnSide(aPoint: PDoublePoint; aPath: TNetPath): Integer; begin Result := 0; if ((CompareValue(aPoint.x, aPath.p1.x) = 0) and (CompareValue(aPoint.y, aPath.p1.y) = 0)) then Result := 1 else if ((CompareValue(aPoint.x, aPath.p2.x) = 0) and (CompareValue(aPoint.y, aPath.p2.y) = 0)) then Result := 2; end; begin SetLength(Result, 0); ResultLength := 0; if aNet.Paths.Count = 0 then exit; if aNet.Paths.Count = 1 then begin { SetLength(Result, 2); Result[0].x := TNetPath(aNet.Paths[0]).p1.x; Result[0].y := TNetPath(aNet.Paths[0]).p1.y; Result[0].z := 0; Result[1].x := TNetPath(aNet.Paths[0]).p2.x; Result[1].y := TNetPath(aNet.Paths[0]).p2.y; Result[1].z := 0; exit; } SetLength(Result, 4); Result[0].x := TNetPath(aNet.Paths[0]).l1.x; Result[0].y := TNetPath(aNet.Paths[0]).l1.y; Result[0].z := 0; Result[1].x := TNetPath(aNet.Paths[0]).l2.x; Result[1].y := TNetPath(aNet.Paths[0]).l2.y; Result[1].z := 0; Result[2].x := TNetPath(aNet.Paths[0]).r2.x; Result[2].y := TNetPath(aNet.Paths[0]).r2.y; Result[2].z := 0; Result[3].x := TNetPath(aNet.Paths[0]).r1.x; Result[3].y := TNetPath(aNet.Paths[0]).r1.y; Result[3].z := 0; exit; end; currPath := TNetPath(aNet.Paths[0]); StartPoint := currPath.p1; Side := 1; LastPoint := currPath.p2; NextPath := TNetPath(aNet.Paths[1]); Side := 0; Side := GetConnSide(StartPoint, NextPath); if Side = 0 then begin StartPoint := currPath.p2; LastPoint := currPath.p1; Side := GetConnSide(StartPoint, NextPath); end; if Side = 0 then exit; // -- не сложилось ... // Tolik 10/01/2020 -- не учтены стены в виде дуги... if currPath.isArc then begin if currPath.Inverted then begin ang1 := GetRadOfLine(currPath.ArcCenter, currPath.p1^); ang2 := GetRadOfLine(currPath.ArcCenter, currPath.p2^); end else begin ang1 := GetRadOfLine(currPath.ArcCenter, currPath.p2^); ang2 := GetRadOfLine(currPath.ArcCenter, currPath.p1^); end; Rad := Sqrt(sqr(currPath.ArcCenter.x - currPath.p1.x) + sqr(currPath.ArcCenter.y - currPath.p1.y)); if ang2 = 0 then ang2 := 2 * pi; dxfModeFlag := dxfMode32; dxfMode32 := true; BezierArcPoints(arcPoints, currPath.ArcCenter.x, currPath.ArcCenter.y, Rad, ang1, ang2); dxfMode32 := dxfModeFlag; range := Length(arcPoints) - 1; LineLen1 := SQRT(sqr(StartPoint.x - t2DPoint(arcPoints[0]).x) + sqr(StartPoint.y - t2dPoint(arcPoints[0]).y)); LineLen2 := SQRT(sqr(StartPoint.x - t2DPoint(arcPoints[range]).x) + sqr(StartPoint.y - t2dPoint(arcPoints[range]).y)); if compareValue(LineLen1, LineLen2) = 1 then invertarray := True else invertarray := False; currResLength := Length(Result); SetLength(Result, Length(Result) + range + 1); if invertArray then begin for i := range downto 0 do begin Result[currResLength + i].x := t2DPoint(arcPoints[i]).x; Result[currResLength + i].y := t2DPoint(arcPoints[i]).y; Result[currResLength + i].z := 0; end; end else begin for i := 0 to range do begin Result[currResLength + i].x := t2DPoint(arcPoints[i]).x; Result[currResLength + i].y := t2DPoint(arcPoints[i]).y; Result[currResLength + i].z := 0; end; end; end else begin // ResultLength := Length(Result); // Tolik 10/01/2020 INC(ResultLength); SetLength(Result, ResultLength); Result[ResultLength - 1].x := StartPoint.x; Result[ResultLength - 1].y := StartPoint.y; Result[ResultLength - 1].z := 0; end; for i := 1 to aNet.Paths.Count - 1 do begin NextPath := TNetPath(aNet.Paths[i]); if ((CompareValue(NextPath.p1.x, StartPoint.x) <> 0) or (CompareValue(NextPath.p1.y, StartPoint.y) <> 0)) then StartPoint := NextPath.p1 else if ((CompareValue(NextPath.p2.x, StartPoint.x) <> 0) or (CompareValue(NextPath.p2.y, StartPoint.y) <> 0)) then StartPoint := NextPath.p2 else StartPoint := Nil; if StartPoint = nil then exit; //Tolik 10/01/2020 -- не учтены стены в виде дуги... if NextPath.isArc then begin if NextPath.Inverted then begin ang1 := GetRadOfLine(NextPath.ArcCenter, NextPath.p1^); ang2 := GetRadOfLine(NextPath.ArcCenter, NextPath.p2^); end else begin ang1 := GetRadOfLine(NextPath.ArcCenter, NextPath.p2^); ang2 := GetRadOfLine(NextPath.ArcCenter, NextPath.p1^); end; Rad := Sqrt(sqr(NextPath.ArcCenter.x - NextPath.p1.x) + sqr(NextPath.ArcCenter.y - NextPath.p1.y)); if ang2 = 0 then ang2 := 2 * pi; dxfModeFlag := dxfMode32; dxfMode32 := true; BezierArcPoints(arcPoints, NextPath.ArcCenter.x, NextPath.ArcCenter.y, Rad, ang1, ang2); dxfMode32 := dxfModeFlag; range := Length(arcPoints) - 1; LineLen1 := SQRT(sqr(StartPoint.x - t2DPoint(arcPoints[0]).x) + sqr(StartPoint.y - t2dPoint(arcPoints[0]).y)); LineLen2 := SQRT(sqr(StartPoint.x - t2DPoint(arcPoints[range]).x) + sqr(StartPoint.y - t2dPoint(arcPoints[range]).y)); if compareValue(LineLen1, LineLen2) = 1 then invertarray := True else invertarray := False; currResLength := Length(Result); SetLength(Result, Length(Result) + range + 1); if invertArray then begin for j := range downto 0 do begin Result[currResLength + j].x := t2DPoint(arcPoints[j]).x; Result[currResLength + j].y := t2DPoint(arcPoints[j]).y; Result[currResLength + j].z := 0; end; end else begin for j := 0 to range do begin Result[currResLength + j].x := t2DPoint(arcPoints[j]).x; Result[currResLength + j].y := t2DPoint(arcPoints[j]).y; Result[currResLength + j].z := 0; end; end; end else begin ResultLength := Length(Result); // Tolik 10/01/2020 INC(ResultLength); SetLength(Result, ResultLength); Result[ResultLength - 1].x := StartPoint.x; Result[ResultLength - 1].y := StartPoint.y; Result[ResultLength - 1].z := 0; end; end; end; function GetRelatedPaths(aNet: TNet; aPoint: PDoublePoint): TList; var i: Integer; currPath: TNetPath; begin Result := TList.Create; for i := 0 to aNet.Paths.Count - 1 do begin currPath := TNetPath(aNet.Paths[i]); if ((CompareValue(aPoint.x, currPath.p1.x) = 0) and (CompareValue(aPoint.y, currPath.p1.y) = 0)) or ((CompareValue(aPoint.x, currPath.p2.x) = 0) and (CompareValue(aPoint.y, currPath.p2.y) = 0)) then if Result.IndexOf(currPath)= -1 then Result.Add(currPath); end; if Result.Count < 2 then FreeAndNil(Result); end; // Tolik 31/10/2019 -- Procedure DropInnerPaths; var i: Integer; currNet: TNet; begin currNet := TNet(aNets[0]); for i := 0 to currNet.Paths.Count - 1 do TNetPath(currNet.Paths[i]).FIsInner := False; end; // begin refreshFlag := GCanRefreshCaD; GCanRefreshCad := False; try FGroupNet := nil; RoomList := Nil; FloorsConturesList := Nil; NormalsContureList := nil; FloorConture := Nil; NetList := nil; isRoof := False; if aNets.Count > 0 then if IfFiguraIsRoof(aNets[0]) then isRoof := True; //31.05.2012 - групповой строим вначале, дабы сразу все модификации определились if IsRoof then begin // GCurrentRoom3DView := F_ProjMan.GetActualSelectedComponent; GArch3DInnerSidesFromVirtual := False; for i := 0 to aNets.Count - 1 do begin xNet := TNet(aNets[i]); xRoom := T3DRoom.Create(aFaces, xNet, self); FRooms.Add(xRoom); end; GArch3DInnerSidesFromVirtual := True; //GCurrentRoom3DView := nil; end else begin {$if Defined(ES_GRAPH_SC)} if GCurrentRoom3DView = nil then FGroupNet := GroupRoomNets(GCadForm); for i := 0 to aNets.Count - 1 do begin xNet := TNet(aNets[i]); xRoom := T3DRoom.Create(aFaces, xNet, self); FRooms.Add(xRoom); end; //Exit; ///// EXIT ///// {$else} // Tolik if aNets.Count > 0 then begin DropInnerPaths; // Tolik 31/10/2019 -- чтобы переопределились на парсинге и не пропали нужные стены в процессе ... FloorsConturesList := TList.Create; // список контуров полов для комнат NormalsContureList := TList.Create; TNet(aNets[0]).CalculatePathPoints; TNet(aNets[0]).IntersectPaths(False); TNet(aNets[0]).RefreshPaths(); TNet(aNets[0]).RefreshPoints; //RoomList := GetContureListFromNet(TNet(aNets[0]), FloorsConturesList); // построит список стен/комнат и заодно контуры полов для каждой комнаты RoomList := GetContureListFromNet(TNet(aNets[0]), FloorsConturesList, NormalsContureList); // построит список стен/комнат и заодно контуры полов для каждой комнаты NetList := TList.Create; if RoomList.Count > 0 then begin for i := 0 to RoomList.Count - 1 do begin PathList := RoomList[i]; IsPathListConture := CheckIsPathListConture(PathList); xNet := TNet.create(8, mydsNormal, GCadForm.PCad); xNet.FAllowAddPathWithSamePoints := True; for j := 0 to PathList.Count - 1 do begin xNetPath := TNetPath(PathList[j]); xNet.Paths.Add(xNetPath); xNetPath.FIsConture := IsPathListConture; end; AddPointsToNet(xNet); NetList.Add(xNet); end; end; DefineInnerPaths(NetList); // определить пути между контурами (смежные) FGroupNet := GroupRoomNets(GCadForm, NetList); FGroupNet.RefreshPaths(True);// GArch3DInnerSidesFromVirtual := False; for i := 0 to NetList.Count - 1 do begin xNet := TNet(NetList[i]); xRoom := T3DRoom.Create(aFaces, xNet, self); if FloorsConturesList[i] <> nil then begin FloorConture := TList(FloorsConturesList[i]); SetLength(xRoom.FCeilingConture, FloorConture.Count); SetLength(xRoom.FFloorConture, FloorConture.Count); for j := 0 to FloorConture.Count - 1 do begin xRoom.FCeilingConture[j].x := PDoublePoint(FloorConture[j]).x; xRoom.FCeilingConture[j].y := PDoublePoint(FloorConture[j]).y; //Tolik 25/08/2021 -- FScaleDeltaSCS //xRoom.FCeilingConture[j].z := Get3DWallHeight * FScaleDelta; xRoom.FCeilingConture[j].z := Get3DWallHeight * FScaleDeltaSCS; // xRoom.FFloorConture[j].x := PDoublePoint(FloorConture[j]).x; xRoom.FFloorConture[j].y := PDoublePoint(FloorConture[j]).y; xRoom.FFloorConture[j].z := 0; end; xRoom.FNetConture := GetSCSRoomConture(xNet); end; if NormalsContureList <> nil then if NormalsContureList.Count > 0 then if (NormalsContureList.Count - 1) >= i then if NormalsContureList[i] <> nil then begin FloorConture := TList(NormalsContureList[i]); SetLength(xRoom.FFloorContureForNormal, FloorConture.Count); for j := 0 to FloorConture.Count - 1 do begin xRoom.FFloorContureForNormal[j] := PDoublePoint(FloorConture[j])^; end; FreeAndDisposeList(TList(NormalsContureList[i])); NormalsContureList[i] := nil; end; if aFaces <> nil then xRoom.CollectRoom(aFaces, xNet.Paths); // xRoom.FVisible := False; FRooms.Add(xRoom); end; GArch3DInnerSidesFromVirtual := True; end; {$ifEnd} {$if Defined(ES_GRAPH_SC)} //25.06.2012 - Насыпаем внутренние грани по групповому TNet if GArch3DInnerSidesFromVirtual and Assigned(FGroupNet) then begin // for i := 0 to FGroupNet.Paths.Count - 1 do begin xNetPath := TNetPath(FGroupNet.Paths[i]); for j := 0 to FRooms.Count - 1 do begin xRoom := T3DRoom(FRooms[j]); for k := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[k]); if xNetPath.FSrcPaths.IndexOf(xWall.FPlanObject) <> -1 then //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForInner(aFaces, xNetPath); end; end; //xWall := FindRealWallByVirtualNetPath(xNetPath); //if xWall <> nil then // xWall.ParseWallForInner(aFaces, xNetPath) //else // EmptyProcedure; end; //GArch3DInnerSidesFromVirtual := True; end; if GCurrentRoom3DView = nil then begin //31.05.2012 FGroupNet := GroupRoomNets(GCadForm); for i := 0 to FGroupNet.Paths.Count - 1 do begin xNetPath := TNetPath(FGroupNet.Paths[i]); xWall := FindRealWallByVirtualNetPath(xNetPath); if xWall <> nil then begin //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForOuter(aFaces, xNetPath); //xWall.ParseWallForOuter(aFaces, xWall.FPlanObject) end else EmptyProcedure; end; //FreeAndNil(FGroupNet); end else begin xNet := GetNetByComponID(GCurrentRoom3DView.ID, GCadForm); for i := 0 to xNet.Paths.Count - 1 do begin xNetPath := TNetPath(xNet.Paths[i]); xWall := FindWallByNetPath(xNetPath); if xWall <> nil then begin //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForOuter(aFaces, xNetPath) //xWall.ParseWallForOuter(aFaces, xWall.FPlanObject) end else EmptyProcedure; end; end; // ParseWallForPerpendSides if GCurrentRoom3DView = nil then begin for i := 0 to FGroupNet.Paths.Count - 1 do begin xNetPath := TNetPath(FGroupNet.Paths[i]); xWall := FindRealWallByVirtualNetPath(xNetPath); if xWall <> nil then //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForPerpendSides(aFaces, xNetPath) else EmptyProcedure; end; //FreeAndNil(FGroupNet); end else begin xNet := GetNetByComponID(GCurrentRoom3DView.ID, GCadForm); for i := 0 to xNet.Paths.Count - 1 do begin xNetPath := TNetPath(xNet.Paths[i]); xWall := FindWallByNetPath(xNetPath); if xWall <> nil then //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForPerpendSides(aFaces, xNetPath) else EmptyProcedure; end; end; {$else} if aNets.Count > 0 then begin //if GArch3DInnerSidesFromVirtual and Assigned(FGroupNet) then begin // PassedList := TList.Create; //GArch3DInnerSidesFromVirtual := False; for i := 0 to FGroupNet.Paths.Count - 1 do begin xNetPath := TNetPath(FGroupNet.Paths[i]); //if PassedList.IndexOf(xNetPath) = -1 then begin for j := 0 to FRooms.Count - 1 do begin xRoom := T3DRoom(FRooms[j]); for k := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[k]); if xNetPath.FSrcPaths.IndexOf(xWall.FPlanObject) <> -1 then //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForInner(aFaces, xNetPath); end; end; PassedList.Add(xNetPath); end; end; //GArch3DInnerSidesFromVirtual := True; end; PassedList.Clear; // GArch3DInnerSidesFromVirtual := False; if GCurrentRoom3DView = nil then begin //31.05.2012 FGroupNet := GroupRoomNets(GCadForm); for i := 0 to FGroupNet.Paths.Count - 1 do begin xNetPath := TNetPath(FGroupNet.Paths[i]); //if PassedList.IndexOf(xNetPath) = -1 then begin xWall := FindRealWallByVirtualNetPath(xNetPath); if xWall <> nil then begin xWall.ParseWallForOuter(aFaces, xNetPath); //xWall.ParseWallForOuter(aFaces, xWall.FPlanObject) end else EmptyProcedure; PassedList.Add(xNetPath); end; end; //FreeAndNil(FGroupNet); end else begin xNet := GetNetByComponID(GCurrentRoom3DView.ID, GCadForm); for i := 0 to xNet.Paths.Count - 1 do begin xNetPath := TNetPath(xNet.Paths[i]); //if PassedList.IndexOf(xNetPath) = -1 then begin xWall := FindWallByNetPath(xNetPath); if xWall <> nil then begin //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForOuter(aFaces, xNetPath) //xWall.ParseWallForOuter(aFaces, xWall.FPlanObject) end else EmptyProcedure; PassedList.Add(xNetPath); end; end; end; PassedList.Clear; // ParseWallForPerpendSides if GCurrentRoom3DView = nil then begin for i := 0 to FGroupNet.Paths.Count - 1 do begin xNetPath := TNetPath(FGroupNet.Paths[i]); //if PassedList.IndexOf(xNetPath) = -1 then begin xWall := FindRealWallByVirtualNetPath(xNetPath); if xWall <> nil then //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForPerpendSides(aFaces, xNetPath) else EmptyProcedure; PassedList.Add(xNetPath); end; end; //FreeAndNil(FGroupNet); end else begin xNet := GetNetByComponID(GCurrentRoom3DView.ID, GCadForm); for i := 0 to xNet.Paths.Count - 1 do begin xNetPath := TNetPath(xNet.Paths[i]); //if PassedList.IndexOf(xNetPath) = -1 then begin xWall := FindWallByNetPath(xNetPath); if xWall <> nil then //Если в контексте не имеется что-либо,связанное с крышей,тогда только добавляем xWall.ParseWallForPerpendSides(aFaces, xNetPath) else EmptyProcedure; PassedList.Add(xNetPath); end; end; end; PassedList.Free; // Tolik -- 31/08/2018 -- боковушка на стыке стен разной толщины (в стену с наибольшей толщиной) for i := 0 to FGroupNet.Points.Count - 1 do begin PassedList := GetRelatedPaths(FGroupNet, PDoublePoint(FGroupNet.Points[i])); if PassedList <> nil then begin { for j := 0 to PassedList.Count - 1 do begin xNetPath := TNetPath(PassedList[j]); xWall := FindRealWallByVirtualNetPath(xNetPath); if xWall <> nil then begin xWall.ParseWallForJoint(PassedList, aFaces, PDoublePoint(FGroupNet.Points[i])); break; end; end; } xNetPath := nil; for j := 0 to PassedList.Count - 1 do begin if xNetPath = nil then xNetPath := TNetPath(PassedList[j]) else if CompareValue(xNetPath.Width, TNetPath(PassedList[j]).Width) = -1 then xNetPath := TNetPath(PassedList[j]); end; xWall := FindRealWallByVirtualNetPath(xNetPath); if xWall <> nil then begin xWall.ParseWallForJoint(PassedList, aFaces, PDoublePoint(FGroupNet.Points[i])); end; end; PassedList.Free; end; end; {$ifEnd} end; if FGroupNet <> nil then FreeAndNil(FGroupNet); // Tolik 30/10/2019 -- DefineInsidePaths; for i := 0 to FRooms.Count - 1 do begin for k := 0 to T3DRoom(FRooms[i]).FWalls.Count - 1 do begin if T3DWall(T3DRoom(FRooms[i]).FWalls[k]).FPlanObject.FIsInner then begin for j := 0 to T3DWall(T3DRoom(FRooms[i]).FWalls[k]).FSides.Count - 1 do begin if (T3DSide(T3DWall(T3DRoom(FRooms[i]).FWalls[k]).FSides[j]).FFace <> nil) then TFaceRecord(T3DSide(T3DWall(T3DRoom(FRooms[i]).FWalls[k]).FSides[j]).FFace).FFaceWallType := fwtInner; end; end; end; end; // if RoomList <> nil then begin for i := 0 to RoomList.Count - 1 do TList(RoomList[i]).Free; RoomList.Free; end; if FloorsConturesList <> nil then begin FloorsConturesList.Pack; for i := 0 to FloorsConturesList.Count - 1 do begin FreeAndDisposeList(TList(FloorsConturesList[i])); end; FloorsConturesList.Free; end; if NormalsContureList <> nil then begin NormalsContureList.Pack; for i := 0 to NormalsContureList.Count - 1 do begin FreeAndDisposeList(TList(NormalsContureList[i])); end; NormalsContureList.Free; end; if NetList <> nil then begin for i := 0 to NetList.Count - 1 do begin xNet := TNet(NetList[i]); xNet.Paths.Clear; xNet.Free; end; NetList.Free; end; except on E: Exception do AddExceptionToLogEx('T3DModel.CollectModel', E.Message); end; GCanRefreshCad := refreshFlag; end; procedure T3DModel.CollectScsModel(aFaces, aScsObjects: TList); var i, j, k: integer; aFace: TFaceRecord; a3DPointArr: T3DPointArray; x3DConnector: T3DConnector; x3DLine: T3DLine; xLine: TOrthoLine; xConn, GetConn: TConnectorObject; xFigure, InFigure: TFigure; xFigureGrp: TSCSFigureGrp; //Tolik 17/09/2018 -- TubeList: TList; x3DTube: T3dTube; x3DBooblick: T3DBooblick; TailTubeList: TList; TubePoint: PDoublePoint; TubeRadius: Double; PipeList, PassedLineList: TList; ComponOffset: Double; Function GetPoint(aLine: TOrthoLine; PointNum: Integer; dist: Double): PDoublePoint; var p1, p2: TDoublePoint; i: Integer; TubeCompon: TSCSComponent; distx, disty, distz, koefx, koefy, koefz, LineLen: Double; LineCatalog: TSCSCatalog; CirclePoint: PDoublePoint; RealRadius: Double; PointsAngle: Double; Conn1,Conn2: TConnectorObject; MaxX, MaxY, MinX, MinY, DistToPoint: Double; begin Result := Nil; New(Result); DistToPoint := Dist; Conn1 := TConnectorObject(aLine.JoinConnector1); Conn2 := TConnectorObject(aLine.JoinConnector2); if Conn1.JoinedConnectorsList.Count > 0 then begin Conn1 := TConnectorObject(Conn1.JoinedConnectorsList[0]); if PointNum = 1 then begin Conn1.GetBounds(MaxX, MaxY, MinX, MinY); DistTopoint := DistToPoint + ((Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))) / (UOMToMetre(1000 / GCadForm.PCad.MapScale)))/4; end; end; if Conn2.JoinedConnectorsList.Count > 0 then begin Conn2 := TConnectorObject(Conn2.JoinedConnectorsList[0]); if PointNum = 2 then begin Conn2.GetBounds(MaxX, MaxY, MinX, MinY); DistTopoint := DistToPoint + ((Sqrt(Sqr(MaxX - MinX) + Sqr(MaxY - MinY))) / (UOMToMetre(1000 / GCadForm.PCad.MapScale)))/4; end; end; if PointNum = 1 then begin p1.x := Conn1.ap1.x; p1.y := Conn1.ap1.y; p1.z := UomToMetre(Conn1.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)); //p1.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]; p2.x := Conn2.ap1.x; p2.y := Conn2.ap1.y; p2.z := UomToMetre(Conn2.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)); //p2.z := TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]; end else if PointNum = 2 then begin p2.x := Conn1.ap1.x; p2.y := Conn1.ap1.y; p2.z := UomToMetre(Conn1.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)); //p2.z := TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]; p1.x := Conn2.ap1.x; p1.y := Conn2.ap1.y; p1.z := (UomToMetre(Conn2.ActualZOrder[1]) * (UOMToMetre(1000 / GCadForm.PCad.MapScale))); //p1.z := TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]; end else begin Dispose(Result); Result := Nil; exit; end; LineLen := SQRT(SQR(p1.x - p2.x) + SQR(p1.y - p2.y) + SQR(p1.z - p2.z)); koefx := (p2.x - p1.x)/LineLen; koefy := (p2.y - p1.y)/LineLen; koefz := (p2.z - p1.z)/LineLen; Result.x := p1.x + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx); Result.y := p1.y + (DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy); Result.z := MetreToUom(p1.z + DistTopoint * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz)/(UOMToMetre(1000 / GCadForm.PCad.MapScale)); //Result.x := p1.x + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefx); //Result.y := p1.y + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefy); //Result.z := MetreToUom((p1.z + ((Dist) * (UOMToMetre(1000 / GCadForm.PCad.MapScale)) * koefz))/(UOMToMetre(1000 / GCadForm.PCad.MapScale))); end; Function GetTubeList(aLine: TOrthoLine): TList; var i: integer; LineCatalog: TSCSCatalog; begin Result := TList.Create; if aLine <> nil then if not aLine.Deleted then begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aLine.ID); if LineCatalog <> nil then begin for i := 0 to LineCatalog.ComponentReferences.Count - 1 do begin if LineCatalog.ComponentReferences[i].ComponentType.SysName = ctsnTube then if Result.IndexOf(LineCatalog.ComponentReferences[i]) = -1 then begin Result.Add(LineCatalog.ComponentReferences[i]); //break; end; end; end; end; end; Function CheckisPipeElement(AConn: TConnectorObject): Boolean; var i, j, TubeCount: Integer; LineCatalog: TSCSCatalog; LineSCSComponent: TSCSComponent; begin Result := False; TubeCount := 0; for i := 0 to AConn.JoinedOrtholinesList.Count - 1 do begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrthoLine(aConn.JoinedOrthoLinesList[i]).ID); if LineCatalog <> nil then begin for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineSCSComponent := LineCatalog.ComponentReferences[j]; if LineSCSComponent.ComponentType.SysName = ctsnTube then begin inc(TubeCount); break; end; end; end; end; Result := (TubeCount > 0); end; Procedure CreatePipeElement(aConn: TConnectorObject); // Cable var i, j, k : Integer; MaxPipeRadius, PrevPipeRadius, PipeRadius: Double; LineCatalog: TSCSCatalog; LineComponent, LineComponent1: TSCSComponent; LineList, TubeList: TList; PipePoint, PrevPipePoint, addPoint: PDoublePoint; apArray: T3DPointArray; TubeLine, TubeLine1: TOrthoLine; JoinedConn: TConnectorObject; CableList: TList; CableOffset: Double; ConnSide: integer; exVals: Boolean; //Tolik 12/11/2021 -- проверка на наличие в точечном объекте элемента трубного соединения function CheckisPipeElement(aConnector: TConnectorObject): Boolean; var i: integer; SCSCatalog: TSCSCatalog; Cad: TF_Cad; SCSList: TSCSList; begin Result := False; if aConnector.ConnectorType = ct_Nb then begin SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(aConnector.Owner.Owner).FCADListID); if SCSList <> nil then begin SCSCatalog := SCSList.GetCatalogFromReferencesBySCSID(aConnector.ID); if SCSCatalog <> nil then begin for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin if SCSCatalog.ComponentReferences[i].ComponentType.SysName = ctsnTubeElement then begin Result := True; break; end; end; end; end; end; end; begin LineList := TList.Create; TubeList := TList.Create; PipeList := TList.Create; CableList:= TList.Create; PipePoint := nil; PrevPipePoint := nil; //Collect Lines //Tolik 12/11/2021 -- //if aConn.ConnectorType = ct_Clear then if (aConn.ConnectorType = ct_Clear) or (not CheckisPipeElement(aConn)) then // begin if aConn.ConnectorType = ct_Clear then // Tolik 12/11/2021 - - begin for i := 0 to aConn.JoinedOrthoLineslist.Count - 1 do begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrthoLine(aConn.JoinedOrthoLineslist[i]).ID); if LineCatalog <> nil then if PassedLineList.IndexOf(LineCatalog) = -1 then begin for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineComponent := LineCatalog.ComponentReferences[j]; if LineComponent.ComponentType.SysName = ctsnTube then begin LineList.Add(TOrthoLine(aConn.JoinedOrthoLineslist[i])); TubeList.Add(LineComponent); // if isCableComponent(LineComponent) then if CableList.IndexOf(LineComponent) = - 1 then CableList.Add(LineComponent); break; end; if isCableComponent(LineComponent) then if CableList.IndexOf(LineComponent) = - 1 then CableList.Add(LineComponent); end; end; end; end; end else begin for j := 0 to aConn.JoinedconnectorsList.count - 1 do begin Joinedconn := TconnectorObject(aConn.JoinedconnectorsList[j]); for i := 0 to Joinedconn.JoinedOrthoLinesList.Count - 1 do begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TOrthoLine(Joinedconn.JoinedOrthoLineslist[i]).ID); if LineCatalog <> nil then if PassedLineList.IndexOf(LineCatalog) = -1 then begin for k := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineComponent := LineCatalog.ComponentReferences[k]; if LineComponent.ComponentType.SysName = ctsnTube then begin LineList.Add(TOrthoLine(JoinedConn.JoinedOrthoLineslist[i])); TubeList.Add(LineComponent); break; end else begin if isCableComponent(LineComponent) then if CableList.IndexOf(LineComponent) = - 1 then CableList.Add(LineComponent); end; end; end; end; end; end; (* for i := 0 to CableList.Count - 1 do begin SetLength(apArray, 3); TubeLine := TOrthoLine(LineList[0]); LineComponent := TSCSComponent(TubeList[0]); PipeRadius := GetTubeRadius(LineComponent); if PipeRadius = -1 then //Tolik 28/03/2025 -- если на задан радиус трубы - выходим Exit; PipeRadius := PipeRadius + PipeRadius /10; PipePoint := nil; if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TubeLine, 1, PipeRadius) else PipePoint := GetPoint(TubeLine, 2, PipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then PipePoint := GetPoint(TubeLine, 1, PipeRadius) else PipePoint := GetPoint(TubeLine, 2, PipeRadius) end; apArray[0].x := PipePoint.x; apArray[0].y := PipePoint.y; apArray[0].z := PipePoint.z; DisPose(PipePoint); // 21/12/2019 -- Tolik PipePoint := nil; apArray[1].x := aConn.ap1.x; apArray[1].y := aConn.ap1.y; apArray[1].z := aConn.ActualZOrder[1]; if LineList.Count > 1 then begin for j := 1 to LineList.Count - 1 do begin PrevPipePoint := nil; AddPoint := nil; TubeLine := TOrthoLine(LineList[0]); LineComponent := TSCSComponent(TubeList[0]); PrevPipeRadius := GetTubeRadius(LineComponent); PrevPipeRadius := PrevPipeRadius + PrevPipeRadius /10; if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then PrevPipePoint := GetPoint(TubeLine, 1, PrevPipeRadius) else PrevPipePoint := GetPoint(TubeLine, 2, PrevPipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then PrevPipePoint := GetPoint(TubeLine, 1, PrevPipeRadius) else PrevPipePoint := GetPoint(TubeLine, 2, PrevPipeRadius) end; TubeLine := TOrthoLine(LineList[i]); LineComponent := TSCSComponent(TubeList[j]); PipeRadius := GetTubeRadius(LineComponent); PipeRadius := PipeRadius + PipeRadius /10; if PipeRadius <> -1 then // !!!! begin SetLength(apArray, 2); if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TubeLine, 1, PipeRadius) else PipePoint := GetPoint(TubeLine, 2, PipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then PipePoint := GetPoint(TubeLine, 1, PipeRadius) else PipePoint := GetPoint(TubeLine, 2, PipeRadius) end; apArray[0].x := PrevPipePoint.x; apArray[0].y := PrevPipePoint.y; apArray[0].z := PrevPipePoint.z; apArray[1].x := aConn.ap1.x; apArray[1].y := aConn.ap1.y; apArray[1].z := aConn.ActualZOrder[1]; if CompareValue(PipeRadius, PrevPipeRadius) = 0 then begin SetLength(apArray, 3); apArray[2].x := PipePoint.x; apArray[2].y := PipePoint.y; apArray[2].z := PipePoint.z; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := PipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); end else begin // SetLength(apArray, 2); if CompareValue(PrevPipeRadius, PipeRadius) = -1 then begin TubeLine := TOrthoLine(LineList[0]); if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then addPoint := GetPoint(TubeLine, 1, PrevPipeRadius + PipeRadius) else addPoint := GetPoint(TubeLine, 2, PrevPipeRadius + PipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then addPoint := GetPoint(TubeLine, 1, PrevPipeRadius + PipeRadius) else addPoint := GetPoint(TubeLine, 2, PrevPipeRadius + PipeRadius); end; apArray[0].x := PipePoint.x; apArray[0].y := PipePoint.y; apArray[0].z := PipePoint.z; end else begin TubeLine := TOrthoLine(LineList[i]); if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then addPoint := GetPoint(TubeLine, 1, PrevPipeRadius + PipeRadius) else addPoint := GetPoint(TubeLine, 2, PrevPipeRadius + PipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then addPoint := GetPoint(TubeLine, 1, PrevPipeRadius + PipeRadius) else addPoint := GetPoint(TubeLine, 2, PrevPipeRadius + PipeRadius); end; end; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := Max(PipeRadius, PrevPipeRadius); FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); SetLength(apArray, 3); apArray[0].x := PipePoint.x; apArray[0].y := PipePoint.y; apArray[0].z := PipePoint.z; apArray[1].x := aConn.ap1.x; apArray[1].y := aConn.ap1.y; apArray[1].z := aConn.ActualZOrder[1]; apArray[2].x := PrevPipePoint.x; apArray[2].y := PrevPipePoint.y; apArray[2].z := PrevPipePoint.z; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := Min(PipeRadius, PrevPipeRadius) + MetreToUom(0.001); FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); SetLength(apArray, 2); apArray[0].x := addPoint.x; apArray[0].y := addPoint.y; apArray[0].z := addPoint.z; if CompareValue(PrevPipeRadius, PipeRadius) = -1 then begin apArray[1].x := PrevPipePoint.x; apArray[1].y := PrevPipePoint.y; apArray[1].z := PrevPipePoint.z; end else begin apArray[1].x := PipePoint.x; apArray[1].y := PipePoint.y; apArray[1].z := PipePoint.z; end; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := Min(PipeRadius, PrevPipeRadius) + MetreToUom(0.001); FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); end; end; if PipePoint <> nil then begin Dispose(PipePoint); PipePoint := nil; end; if AddPoint <> nil then begin Dispose(AddPoint); AddPoint := nil; end; if PrevPipePoint <> nil then begin Dispose(PrevPipePoint); PrevPipePoint := nil; end; end; SetLength(apArray, 0); end else begin SetLength(apArray, 2); x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := PipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); SetLength(apArray, 0); end; end; *) //Сбросить трассы с трубами, где не указан диаметр самой трубы for i := LineList.Count - 1 downto 0 do begin LineComponent := TSCSComponent(TubeList[i]); PipeRadius := GetTubeRadius(LineComponent); if PipeRadius = -1 then begin LineList.Delete(i); TubeList.Delete(i); CableList.Delete(i); end; end; if LineList.Count > 0 then begin if LineList.Count = 1 then //заглушка begin SetLength(apArray, 2); TubeLine := TOrthoLine(LineList[0]); LineComponent := TSCSComponent(TubeList[0]); PipeRadius := GetTubeRadius(LineComponent); PipeRadius := PipeRadius + PipeRadius /10; PipePoint := nil; if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TubeLine, 1, PipeRadius) else PipePoint := GetPoint(TubeLine, 2, PipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TubeLine.JoinConnector1)) <> -1 then PipePoint := GetPoint(TubeLine, 1, PipeRadius) else PipePoint := GetPoint(TubeLine, 2, PipeRadius) end; apArray[1].x := PipePoint.x; apArray[1].y := PipePoint.y; apArray[1].z := PipePoint.z; DisPose(PipePoint); // 21/12/2019 -- Tolik PipePoint := nil; apArray[0].x := aConn.ap1.x; apArray[0].y := aConn.ap1.y; apArray[0].z := aConn.ActualZOrder[1]; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := PipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); x3DConnector.FRelatedLines.Add(TubeLine); x3DConnector.FLength := PipeRadius; end else // стык двух труб или колено if LineList.Count = 2 then begin PipeRadius := GetTubeRadius(TSCSComponent(TubeList[0])); PipeRadius := PipeRadius + PipeRadius /10; PipePoint := nil; PrevPipeRadius := GetTubeRadius(TSCSComponent(TubeList[1])); PrevPipeRadius := PrevPipeRadius + PrevPipeRadius /10; if CompareValue(PipeRadius, PrevPipeRadius) = 0 then // две трассы, труба одинакового диаметра begin SetLength(apArray, 3 ); if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TOrthoLine(LineList[0]).JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TOrthoLine(LineList[0]), 1, PipeRadius) else PipePoint := GetPoint(TOrthoLine(LineList[0]), 2, PipeRadius); if TConnectorObject(TOrthoLine(LineList[1]).JoinConnector1).Id = aConn.ID then PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 1, PipeRadius) else PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 2, PipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[0]).JoinConnector1)) <> -1 then PipePoint := GetPoint(TOrthoLine(LineList[0]), 1, PipeRadius) else PipePoint := GetPoint(TOrthoLine(LineList[0]), 2, PipeRadius); if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[1]).JoinConnector1)) <> -1 then PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 1, PipeRadius) else PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 2, PipeRadius); end; SetLength(apArray, 3); apArray[0].x := PipePoint.x; apArray[0].y := PipePoint.y; apArray[0].z := PipePoint.z; DisPose(PipePoint); PipePoint := nil; apArray[1].x := aConn.ap1.x; apArray[1].y := aConn.ap1.y; apArray[1].z := aConn.ActualZOrder[1]; apArray[2].x := PrevPipePoint.x; apArray[2].y := PrevPipePoint.y; apArray[2].z := PrevPipePoint.z; Dispose(PrevPipePoint); PrevPipePoint := nil; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := PipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); x3DConnector.FRelatedLines.Add(TOrthoLine(LineList[0])); x3DConnector.FRelatedLines.Add(TOrthoLine(LineList[1])); x3DConnector.FLength := PipeRadius; end else begin exVals := False; if CompareValue(PipeRadius, PrevPiperadius) = -1 then begin ExchangeDouble(PipeRadius, PrevPipeRadius); // выбрать больший радиус как основу exVals := True; end; SetLength(apArray, 3); if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TOrthoLine(LineList[0]).JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TOrthoLine(LineList[0]), 1, PipeRadius) else PipePoint := GetPoint(TOrthoLine(LineList[0]), 2, PipeRadius); if TConnectorObject(TOrthoLine(LineList[1]).JoinConnector1).Id = aConn.ID then PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 1, PipeRadius) else PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 2, PipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[0]).JoinConnector1)) <> -1 then PipePoint := GetPoint(TOrthoLine(LineList[0]), 1, PipeRadius) else PipePoint := GetPoint(TOrthoLine(LineList[0]), 2, PipeRadius); if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[1]).JoinConnector1)) <> -1 then PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 1, PipeRadius) else PrevPipePoint := GetPoint(TOrthoLine(LineList[1]), 2, PipeRadius); end; SetLength(apArray, 3); apArray[0].x := PipePoint.x; apArray[0].y := PipePoint.y; apArray[0].z := PipePoint.z; DisPose(PipePoint); PipePoint := nil; apArray[1].x := aConn.ap1.x; apArray[1].y := aConn.ap1.y; apArray[1].z := aConn.ActualZOrder[1]; apArray[2].x := PrevPipePoint.x; apArray[2].y := PrevPipePoint.y; apArray[2].z := PrevPipePoint.z; Dispose(PrevPipePoint); PrevPipePoint := nil; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := PipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); x3DConnector.FRelatedLines.Add(TOrthoLine(LineList[0])); x3DConnector.FRelatedLines.Add(TOrthoLine(LineList[1])); x3DConnector.FLength := PipeRadius; if exVals then TubeLine := LineList[0] else TubeLine := LineList[1]; if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TubeLine.JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TubeLine, 1, PipeRadius + PrevPipeRadius) else PipePoint := GetPoint(TubeLine, 2, PipeRadius + PrevPipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TubeLine.JoinConnector1) <> -1 then PipePoint := GetPoint(TubeLine, 1, PipeRadius + PrevPipeRadius) else PipePoint := GetPoint(TubeLine, 2, PipeRadius + PrevPipeRadius); end; SetLength(apArray, 2); apArray[0].x := aConn.ap1.x; apArray[0].y := aConn.ap1.y; apArray[0].z := aConn.ActualZOrder[1]; apArray[1].x := PipePoint.x; apArray[1].y := PipePoint.y; apArray[1].z := PipePoint.z; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := PrevPipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); x3DConnector.FRelatedLines.Add(TubeLine); x3DConnector.FLength := PipeRadius + PrevPipeRadius; end; end else if LineList.Count > 2 then begin MaxPipeRadius := -1; TubeLine1 := nil; TubeLine := nil; for i := 0 to TubeList.Count - 1 do //get Max tube Radius begin PipeRadius := GetTubeRadius(TSCSComponent(TubeList[i])); if CompareValue(MaxPipeRadius, PipeRadius) = -1 then begin MaxPipeRadius := PipeRadius; TubeLine := TOrthoLine(LineList[i]); LineComponent := TSCSComponent(TubeList[i]); j := i; end; end; Tubelist.Delete(j); // удаляем выбранную трассу и трубу из списка LineList.Delete(j); CableList.Delete(j); for i := 0 to TubeList.Count - 1 do //get next tube with Max Radius begin PipeRadius := GetTubeRadius(TSCSComponent(TubeList[i])); if CompareValue(MaxPipeRadius, PipeRadius) = 0 then begin TubeLine1 := TOrthoLine(LineList[i]); LineComponent1 := TSCSComponent(Tubelist[i]); j := i; break; end; end; MaxPipeRadius := MaxPipeRadius + MaxPipeRadius/10; if TubeLine1 = nil then //если нет труб больше с макс радиусом, берем трубу с макс радиусом из тех, что остались begin PipeRadius := -1; for i := 0 to LineList.Count - 1 do begin PrevPipeRadius := GetTubeRadius(TSCSComponent(TubeList[i])); if CompareValue(PipeRadius, PrevPipeRadius) = -1 then begin PipeRadius := PrevPipeRadius; TubeLine1 := TOrthoLine(LineList[i]); LineComponent1 := TSCSComponent(TubeList[i]); j := i; end; end; end; PipeRadius := PipeRadius + PipeRadius/10; Tubelist.Delete(j); // удаляем вторую выбранную трассу и трубу из списка LineList.Delete(j); CableList.Delete(j); //первое колено макс радиусом if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TOrthoLine(TubeLine).JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TOrthoLine(TubeLine), 1, MaxPipeRadius) else PipePoint := GetPoint(TOrthoLine(TubeLine), 2, MaxPipeRadius); if TConnectorObject(TOrthoLine(TubeLine1).JoinConnector1).Id = aConn.ID then PrevPipePoint := GetPoint(TOrthoLine(TubeLine1), 1, MaxPipeRadius) else PrevPipePoint := GetPoint(TOrthoLine(TubeLine1), 2, MaxPipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(TubeLine).JoinConnector1)) <> -1 then PipePoint := GetPoint(TOrthoLine(TubeLine), 1, MaxPipeRadius) else PipePoint := GetPoint(TOrthoLine(TubeLine), 2, MaxPipeRadius); if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(TubeLine1).JoinConnector1)) <> -1 then PrevPipePoint := GetPoint(TOrthoLine(TubeLine1), 1, MaxPipeRadius) else PrevPipePoint := GetPoint(TOrthoLine(TubeLine1), 2, MaxPipeRadius); end; SetLength(apArray, 3); apArray[0].x := PipePoint.x; apArray[0].y := PipePoint.y; apArray[0].z := PipePoint.z; DisPose(PipePoint); PipePoint := nil; apArray[1].x := aConn.ap1.x; apArray[1].y := aConn.ap1.y; apArray[1].z := aConn.ActualZOrder[1]; apArray[2].x := PrevPipePoint.x; apArray[2].y := PrevPipePoint.y; apArray[2].z := PrevPipePoint.z; Dispose(PrevPipePoint); PrevPipePoint := nil; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := MaxPipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); x3DConnector.FRelatedLines.Add(TubeLine); x3DConnector.FRelatedLines.Add(TubeLine1); x3DConnector.FLength := MaxPipeRadius; //если первые две трубы разного радиуса - докинуть хвостовик соединения для тоньшей трубы if CompareValue(MaxPipeRadius, PipeRadius) <> 0 then begin if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TOrthoLine(TubeLine1).JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TOrthoLine(TubeLine1), 1, PipeRadius + MaxPipeRadius) else PipePoint := GetPoint(TOrthoLine(TubeLine1), 2, PipeRadius + MaxPipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(TubeLine1).JoinConnector1)) <> -1 then PipePoint := GetPoint(TOrthoLine(TubeLine1), 1, PipeRadius + MaxPipeRadius) else PipePoint := GetPoint(TOrthoLine(TubeLine1), 2, PipeRadius + MaxPipeRadius); end; SetLength(apArray, 2); apArray[0].x := aConn.ap1.x; apArray[0].y := aConn.ap1.y; apArray[0].z := aConn.ActualZOrder[1]; apArray[1].x := PipePoint.x; apArray[1].y := PipePoint.y; apArray[1].z := PipePoint.z; Dispose(PipePoint); PipePoint := nil; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := PipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); x3DConnector.FRelatedLines.Add(TubeLine1); x3DConnector.FLength := PipeRadius + MaxPipeRadius; end; //дорисовать остальные for i := 0 to TubeList.Count - 1 do begin PipeRadius := GetTubeRadius(TSCSComponent(TubeList[i])); PipeRadius := PipeRadius + PipeRadius/10; if aConn.ConnectorType = ct_Clear then begin if TConnectorObject(TOrthoLine(LineList[i]).JoinConnector1).Id = aConn.ID then PipePoint := GetPoint(TOrthoLine(LineList[i]), 1, PipeRadius + MaxPipeRadius) else PipePoint := GetPoint(TOrthoLine(LineList[i]), 2, PipeRadius + MaxPipeRadius); end else begin if aConn.JoinedConnectorsList.IndexOf(TConnectorObject(TOrthoLine(LineList[i]).JoinConnector1)) <> -1 then PipePoint := GetPoint(TOrthoLine(LineList[i]), 1, PipeRadius + MaxPipeRadius) else PipePoint := GetPoint(TOrthoLine(LineList[i]), 2, PipeRadius + MaxPipeRadius); end; SetLength(apArray, 2); apArray[0].x := aConn.ap1.x; apArray[0].y := aConn.ap1.y; apArray[0].z := aConn.ActualZOrder[1]; apArray[1].x := PipePoint.x; apArray[1].y := PipePoint.y; apArray[1].z := PipePoint.z; Dispose(PipePoint); PipePoint := nil; x3DConnector := T3DConnector.Create(aFaces, xConn, Self, True); x3DConnector.CollectConnector(aFaces, apArray); x3DConnector.FPipeRadius := PipeRadius; FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; x3DConnector.FColor := ConvertWinColor(clGreen); x3DConnector.FRelatedLines.Add(LineList[i]); x3DConnector.FLength := PipeRadius + MaxPipeRadius; end; end; LineList.Free; TubeList.Free; PipeList.Free; CableList.Free; end; end; // Function Get3dModelFileName(aConn: TConnectorObject): String; var i, j: Integer; ConnDir: TSCSCatalog; currCompon: TSCSComponent; componProp: pProperty; begin Result := ''; if aConn.ConnectorType = ct_Nb then begin ConnDir := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aConn.ID); if ConnDir <> nil then begin For i := 0 to ConnDir.ComponentReferences.Count - 1 do begin currCompon := ConnDir.ComponentReferences[i]; if currCompon.IsTop then begin for j := 0 to currCompon.Properties.Count - 1 do begin if UpperCase(PProperty(currCompon.Properties[j]).SysName) = '3DS_MODEL' then begin Result := PProperty(currCompon.Properties[j]).Value; break; end; end; end; if Result <> '' then break; end; end; end; end; Procedure DefineConnProperties(aConn: TConnectorObject; var a3DConn: T3DConnector); var i: Integer; SCSCompon: TSCSComponent; CadList: TF_Cad; SCSList: TSCSList; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; Length3D, Width3D, Height3D: Double; NbProp: TNBProperty; begin CadList := nil; if aConn.Owner <> nil then if TPowerCad(aConn.Owner).Owner <> nil then CadList := TF_Cad(TPowerCad(aConn.Owner).Owner); if CadList <> nil then begin SCSComponent := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(CadList.FCADListID); if SCSList <> nil then begin SCSCatalog := SCSList.GetCatalogFromReferencesBySCSID(aConn.ID); if SCSCatalog <> nil then begin for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin if SCSCatalog.ComponentReferences[i].IsTop then begin SCSComponent := SCSCatalog.ComponentReferences[i]; break; end; end; end; end; end else exit; if SCSComponent <> nil then begin Length3D := -1; Width3D := -1; Height3D := -1; for i := 0 to SCSComponent.Properties.Count - 1 do begin if PProperty(SCSComponent.Properties[i]).SysName = '3DS_MODEL' then a3DConn.F3dModelFileName := PProperty(SCSComponent.Properties[i]).Value else if PProperty(SCSComponent.Properties[i]).SysName = '3D_WIDTH' then begin NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(PProperty(SCSComponent.Properties[i]).GUIDProperty); if NbProp <> nil then begin Width3D := StrToFloat_My(PProperty(SCSComponent.Properties[i]).Value); Width3D := ConverResultToUom(Width3D, NbProp.PropertyData.Izm); end; end else if PProperty(SCSComponent.Properties[i]).SysName = '3D_HEIGHT' then begin NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(PProperty(SCSComponent.Properties[i]).GUIDProperty); if NbProp <> nil then begin Height3D := StrToFloat_My(PProperty(SCSComponent.Properties[i]).Value); Height3D := ConverResultToUom(Height3D, NbProp.PropertyData.Izm); end; end else if PProperty(SCSComponent.Properties[i]).SysName = '3D_LENGTH' then begin NbProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyByGUID(PProperty(SCSComponent.Properties[i]).GUIDProperty); if NbProp <> nil then begin Length3D := StrToFloat_My(PProperty(SCSComponent.Properties[i]).Value); Length3D := ConverResultToUom(Length3D, NbProp.PropertyData.Izm); end; end end; end; if a3DConn.F3dModelFileName <> '' then if Length3D <> -1 then if Width3D <> -1 then if Height3D <> -1 then begin a3DConn.F3D_Height := Height3D; a3DConn.F3D_Length := Length3D; a3DConn.F3D_Width := Width3D; a3DConn.FUse3DSize := True; end; end; // Tolik -- зоны камер наблюдения (проба) Procedure CheckAddZones(aConn: TConnectorObject); var i: Integer; TPieFigure: TPie; begin for i := 0 to aConn.DrawFigure.InFigures.Count - 1 do begin if TFigure(aConn.DrawFigure.InFigures[i]).isAutoCreatedFigure = biTrue then if TFigure(aConn.DrawFigure.InFigures[i]).ClassName = 'TPie' then begin TPieFigure := TPie(aConn.DrawFigure.InFigures[i]); end; end; end; begin PassedLineList := TList.Create; ComponOffset := 0; try for i := 0 to aScsObjects.Count - 1 do begin xFigure := TFigure(aScsObjects[i]); if xFigure.ClassName = 'TConnectorObject' then begin // Tolik -- 14/02/2020 -- отсеять подъезды домов (если попадутся), т.к. на 3Д там показывать нечего (пока что...) if TConnectorObject(xFigure).FisApproach then continue; // xConn := TConnectorObject(xFigure); SetLength(a3DPointArr, 1); a3DPointArr[0].x := xConn.ActualPoints[1].x; a3DPointArr[0].y := xConn.ActualPoints[1].y; {TODO ZCoord} a3DPointArr[0].z := xConn.ActualZOrder[1]; //a3DPointArr[0].z := MetreToUOM(xConn.ActualZOrder[1]); // NEW if (xConn.Name <> 'Anchor') then begin if xConn.ConnectorType <> ct_Clear then begin x3DConnector := T3DConnector.Create(aFaces, xConn, Self); x3DConnector.CollectConnector(aFaces, a3DPointArr); FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; DefineConnProperties(xConn, x3DConnector); //x3DConnector.F3dModelFileName := Get3dModelFileName(xConn); //Tolik 04/11/2019 -- if xConn.DrawFigure <> nil then CheckAddZones(xConn); // end //Tolik 08/04/2025 -- //else if xConn.JoinedConnectorsList.Count >= 0 then else if ((xConn.JoinedConnectorsList.Count >= 0) and (not CheckisPipeElement(xConn))) then // begin x3DConnector := T3DConnector.Create(aFaces, xConn, Self); x3DConnector.CollectConnector(aFaces, a3DPointArr); FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; // Tolik 13/10/2018 -*- {if xConn.JoinedConnectorsList.Count > 0 then DefineConnProperties(TConnectorObject(xConn.JoinedConnectorsList[0]), x3DConnector);} // end; end; // Tolik 24/09/2018 -- if (xConn.Name <> 'Anchor') then if xConn.ConnectorType = ct_Clear then if CheckisPipeElement(xConn) then begin if xConn.JoinedConnectorsList.Count > 0 then CreatePipeElement(TConnectorObject(xConn.JoinedConnectorsList[0])) else CreatePipeElement(xConn); end; // Tolik 20/09/2018 -- { if xConn.ConnectorType = ct_Clear then begin x3DBooblick := T3dBooblick.Create(aFaces, xConn, Self); x3DBooblick.CollectBooblick(aFaces, a3DPointArr); FScsObjects.Add(x3DConnector); x3DBooblick.FSCSObject.F3DObject := x3DBooblick; end; } // // Tolik 21/09/2018 -- // end; if xFigure.ClassName = 'TOrthoLine' then begin xLine := TOrthoLine(xFigure); SetLength(a3DPointArr, 2); a3DPointArr[0].x := xLine.ActualPoints[1].x; a3DPointArr[0].y := xLine.ActualPoints[1].y; {TODO ZCoord} a3DPointArr[0].z := xLine.ActualZOrder[1]; //a3DPointArr[0].z := MetreToUOM(xLine.ActualZOrder[1]); // new a3DPointArr[1].x := xLine.ActualPoints[2].x; a3DPointArr[1].y := xLine.ActualPoints[2].y; {TODO ZCoord} a3DPointArr[1].z := xLine.ActualZOrder[2]; //a3DPointArr[1].z := MetreToUOM(xLine.ActualZOrder[2]); // new x3DLine := T3DLine.Create(aFaces, xLine, Self); x3dLine.CollectLine(aFaces, a3DPointArr); FScsObjects.Add(x3DLine); x3DLine.FSCSObject.F3DObject := x3DLine; // Tolik 17/09/2018 -- трубы на трассе TubeList := GetTubeList(xLine); //15/09/2021 -- //TubeList := nil; ComponOffset := 0; if TubeList <> nil then begin TailTubeList := Nil; for j := 0 to TubeList.Count - 1 do begin TubeRadius := GetTubeRadius(TSCSComponent(TubeList[j])); (* if TubeRadius <> -1 then begin x3DTube := T3DTube.create(aFaces, xLine, Self, TSCSComponent(TubeList[j]), TubeRadius*2, TailTubeList); TubePoint := GetPoint(TOrthoLine(xFigure), 1, TubeRadius); if TubePoint <> nil then begin a3DPointArr[0].x := TubePoint.x + ComponOffset; a3DPointArr[0].y := TubePoint.y; a3DPointArr[0].z := TubePoint.z; DisPose(TubePoint); end; TubePoint := GetPoint(TOrthoLine(xFigure), 2, TubeRadius); if TubePoint <> nil then begin a3DPointArr[1].x := TubePoint.x + ComponOffset; a3DPointArr[1].y := TubePoint.y; a3DPointArr[1].z := TubePoint.z; DisPose(TubePoint); end; x3DTube.CollectCylinder(aFaces, a3DPointArr); FScsObjects.Add(x3DTube); x3DTube.FSCSObject.F3DObject := x3DTube; end; ComponOffset := ComponOffset + TubeRadius * 2; *) { if TailTubeList <> nil then // это, типа, если будут торцы, отрисованные цилиндрами, в зависимости от свойств компонента "труба" begin for k := 0 to TailTubeList.count - 1 do begin x3DTube := T3DTube(TailTubeList[k]); FScsObjects.Add(x3DTube); x3DTube.FSCSObject.F3DObject := x3DTube; end; end; } end; TubeList.Free; end; // end; if xFigure.ClassName = 'TSCSFigureGrp' then begin xFigureGrp := TSCSFigureGrp(xFigure); for j := 0 to xFigureGrp.InFigures.Count - 1 do begin InFigure := Tfigure(xFigureGrp.InFigures[j]); if InFigure.ClassName = 'TConnectorObject' then begin xConn := TConnectorObject(InFigure); SetLength(a3DPointArr, 1); a3DPointArr[0].x := xConn.ActualPoints[0].x; a3DPointArr[0].y := xConn.ActualPoints[0].y; {TODO ZCoord} a3DPointArr[0].z := xConn.ActualZOrder[0]; //a3DPointArr[0].z := MetreToUOM(xConn.ActualZOrder[0]); // new if (xConn.Name <> 'Anchor') then begin if xConn.ConnectorType <> ct_Clear then begin x3DConnector := T3DConnector.Create(aFaces, xConn, Self); x3DConnector.CollectConnector(aFaces, a3DPointArr); FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; end else if xConn.JoinedConnectorsList.Count >= 0 then begin x3DConnector := T3DConnector.Create(aFaces, xConn, Self); x3DConnector.CollectConnector(aFaces, a3DPointArr); FScsObjects.Add(x3DConnector); x3DConnector.FSCSObject.F3DObject := x3DConnector; end; end; end; (* if InFigure.ClassName = 'TOrthoLine' then begin xLine := TOrthoLine(InFigure); SetLength(a3DPointArr, 2); a3DPointArr[0].x := xLine.ActualPoints[0].x; a3DPointArr[0].y := xLine.ActualPoints[0].y; {TODO ZCoord} a3DPointArr[0].z := xLine.ActualZOrder[0]; //a3DPointArr[0].z := MetreToUOM(xLine.ActualZOrder[0]); // new a3DPointArr[1].x := xLine.ActualPoints[1].x; a3DPointArr[1].y := xLine.ActualPoints[1].y; {TODO ZCoord} a3DPointArr[1].z := xLine.ActualZOrder[1]; //a3DPointArr[1].z := MetreToUOM(xLine.ActualZOrder[1]); // new x3DLine := T3DLine.Create(aFaces, xLine, Self); x3dLine.CollectLine(aFaces, a3DPointArr); FScsObjects.Add(x3DLine); x3DLine.FSCSObject.F3DObject := x3DLine; end; *) end; end; end; // *** Set Joined Objects ************************************************** for i := 0 to FScsObjects.Count - 1 do begin //Tolik 15/09/2021 -- //if TObject(FScsObjects[i]) is T3DConnector then if TObject(FScsObjects[i]).ClassName = 'T3DConnector' then begin x3DConnector := T3DConnector(FScsObjects[i]); xConn := x3DConnector.FSCSObject; for j := 0 to xConn.JoinedConnectorsList.Count - 1 do begin GetConn := TConnectorObject(xConn.JoinedConnectorsList[j]); x3DConnector.FJoinedConnectorsList.Add(T3DConnector(GetConn.F3DObject)); end; for j := 0 to xConn.JoinedOrtholinesList.Count - 1 do begin xLine := TOrthoLine(xConn.JoinedOrtholinesList[j]); // Tolik 27/014/2018 -- if x3DConnector.FJoinedLinesList.IndexOf(T3DLine(xLine.F3DObject)) = -1 then // x3DConnector.FJoinedLinesList.Add(T3DLine(xLine.F3DObject)); end; end; // Tolik 19/11/2018 --- //if TObject(FScsObjects[i]) is T3DLine then if TObject(FScsObjects[i]).ClassName = 'T3DLine' then begin x3DLine := T3DLine(FScsObjects[i]); xLine := x3DLine.FSCSObject; GetConn := TConnectorObject(xLine.JoinConnector1); x3DLine.FJoinConnector1 := T3DConnector(GetConn.F3dObject); GetConn := TConnectorObject(xLine.JoinConnector2); x3DLine.FJoinConnector2 := T3DConnector(GetConn.F3dObject); end; end; except on E: Exception do AddExceptionToLogEx('T3DModel.CollectScsModel', E.Message); end; PassedLineList.Free; end; function GetWorkDir: string; var aDir: string; begin Result := ''; aDir := AddCreateDirToPath(ExtractFileDir(Application.ExeName), dnSave); aDir := AddCreateDirToPath(aDir, sdPictures); Result := aDir; end; constructor T3DModel.Create; var HashStr, tmpdir, tex_from, tex_to: string; begin try inherited Create; FClassName := 'T3DModel'; //Tolik 28/01/2024 -- //FScaleDelta := UOMToMetre(1000 / GCadForm.PCad.MapScale); //FScaleDeltaSCS := 1000 / GCadForm.PCad.MapScale; FScaleDelta := ABS(UOMToMetre(1000 / GCadForm.PCad.MapScale)); FScaleDeltaSCS := ABS(1000 / GCadForm.PCad.MapScale); // FRooms := TList.Create; FScsObjects := TList.Create; FName := cModel; FGroupNet := nil; FHashs := TStringList.Create; F3DSHashs := TStringList.Create; FFiles := TStringList.Create; FFilesHashs := TStringList.Create; tmpdir := GetWorkDir; //ExtractDirByCategoryType(20{dctPictures}); {$IF DEFINED(SCS_PE)} //Tolik 25/08/2021 -- для РЕ немножко поменяем цвета стен, потолка, пола.... tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp'; HashStr := GetImageHash(tex_from); //Отделяем имя картинки tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\floor_PE.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\ceiling_PE.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\inner_wall_PE.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); {$ELSE} //Tolik 25/08/2021 -- для РУС/УКР - пока что - как было. tex_from := ExeDir + '\3DTextures\inner_wall.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\outer_wall.bmp'; HashStr := GetImageHash(tex_from); //Отделяем имя картинки tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\floor.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\ceiling.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\door_slope.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\window_slope.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\balcon_slope.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); {$IFEND} tex_from := ExeDir + '\3DTextures\arc.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\niche.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); tex_from := ExeDir + '\3DTextures\empty.bmp'; HashStr := GetImageHash(tex_from); tex_to := tmpdir + '\' + HashStr + '.bmp'; CopyFile(PChar(tex_from), PChar(tex_to), True); FHashs.Add(HashStr); isUserTransparency := False; // Tolik 28/11/2018 -- except on E: Exception do AddExceptionToLogEx('T3DModel.Create', E.Message); end; end; // Tolik --23/07/2018 -- Destructor T3DModel.destroy; var i: Integer; begin // FreeList(FRooms); for i := 0 to FRooms.Count - 1 do begin T3DRoom(FRooms[i]).free; end; FRooms.Free; //20/09/2021 -- for i := 0 to FScsObjects.Count - 1 do TObject(FScsObjects[i]).Free; FScsObjects.free; // FGroupNet := nil; FHashs.free; F3DSHashs.free; FFiles.free; FFilesHashs.free; inherited; end; // function T3DModel.FindRealWallByVirtualNetPath(aNetPath: TNetPath): T3DWall; var i, j: integer; rNetPath: TNetPath; xRoom: T3DRoom; xWall: T3DWall; begin try Result := nil; if aNetPath.FSrcPaths.Count > 0 then begin rNetPath := TNetPath(aNetPath.FSrcPaths[0]); for i := 0 to FRooms.Count - 1 do begin xRoom := T3DRoom(FRooms[i]); for j := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[j]); if rNetPath = xWall.FPlanObject then begin Result := xWall; exit; end; end; end; end; except on E: Exception do AddExceptionToLogEx('T3DModel.FindRealWallByVirtualNetPath', E.Message); end; end; function T3DModel.FindWallByNetPath(aNetPath: TNetPath): T3DWall; var i, j: integer; rNetPath: TNetPath; xRoom: T3DRoom; xWall: T3DWall; begin try Result := nil; for i := 0 to FRooms.Count - 1 do begin xRoom := T3DRoom(FRooms[i]); for j := 0 to xRoom.FWalls.Count - 1 do begin xWall := T3DWall(xRoom.FWalls[j]); if xWall.FPlanObject = aNetPath then begin Result := xWall; exit; end; end; end; except on E: Exception do AddExceptionToLogEx('T3DModel.FindWallByNetPath', E.Message); end; end; function T3DModel.GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject; var i: Integer; begin Result := nil; for i := 0 to FRooms.Count - 1 do begin Result := T3DRoom(FRooms[i]).GetObjectBySCSCompon(ASCSCompon); if Result <> nil then Break; //// BREAK //// end; end; // Tolik 04/04/2019 -- старая закомменчена ниже procedure T3DModel.ReadFromStream(Stream: TStream); var isOk: Boolean; xCode, xSize: Integer; j, intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; CanAdd: Boolean; xStr: AnsiString; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; end; if (xCode >= 181) and (xCode <= 219) then begin CanAdd := True; for j := 0 to FHashs.Count - 1 do begin if FHashs[j] = StrVal then CanAdd := False; end; if CanAdd then FHashs.Add(strVal); end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end else if (xCode = 241) then begin Stream.Read(intVal, sizeof(intVal)); if intVal > 0 then begin SetLength(xStr, intVal); Stream.Read(PAnsiChar(xStr)^, intVal); FHashs.Text := String(xStr); end else FHashs.Text := ''; end else if (xCode = 242) then begin Stream.Read(intVal, sizeof(intVal)); if intVal > 0 then begin SetLength(xStr, intVal); Stream.Read(PAnsiChar(xStr)^, intVal); F3DSHashs.Text := String(xStr); end else F3DSHashs.Text := ''; end else if (xCode = 243) then begin Stream.Read(intVal, sizeof(intVal)); if intVal > 0 then begin SetLength(xStr, intVal); Stream.Read(PAnsiChar(xStr)^, intVal); FFiles.Text := String(xStr); end else FFiles.Text := ''; end else if (xCode = 244) then begin Stream.Read(intVal, sizeof(intVal)); if intVal > 0 then begin SetLength(xStr, intVal); Stream.Read(PAnsiChar(xStr)^, intVal); FFilesHashs.Text := String(xStr); end else FFilesHashs.Text := ''; end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DModel.ReadFromStream', E.Message); end; end; { procedure T3DModel.ReadFromStream(Stream: TStream); var isOk: Boolean; xCode, xSize: Integer; i, j, intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; CanAdd: Boolean; xStr: string; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; end; if (xCode >= 181) and (xCode <= 219) then begin CanAdd := True; for j := 0 to FHashs.Count - 1 do begin if FHashs[j] = StrVal then CanAdd := False; end; if CanAdd then FHashs.Add(strVal); end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end else if (xCode = 241) then begin Stream.Read(intVal, sizeof(intVal)); if intVal > 0 then begin SetLength(xStr, intVal); Stream.Read(pchar(xStr)^, intVal); FHashs.Text := xStr; end else FHashs.Text := ''; end else if (xCode = 242) then begin Stream.Read(intVal, sizeof(intVal)); if intVal > 0 then begin SetLength(xStr, intVal); Stream.Read(pchar(xStr)^, intVal); F3DSHashs.Text := xStr; end else F3DSHashs.Text := ''; end else if (xCode = 243) then begin Stream.Read(intVal, sizeof(intVal)); if intVal > 0 then begin SetLength(xStr, intVal); Stream.Read(pchar(xStr)^, intVal); FFiles.Text := xStr; end else FFiles.Text := ''; end else if (xCode = 244) then begin Stream.Read(intVal, sizeof(intVal)); if intVal > 0 then begin SetLength(xStr, intVal); Stream.Read(pchar(xStr)^, intVal); FFilesHashs.Text := xStr; end else FFilesHashs.Text := ''; end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DModel.ReadFromStream', E.Message); end; end; } procedure T3DModel.SetRelations; begin try except on E: Exception do AddExceptionToLogEx('T3DModel.SetRelations', E.Message); end; end; // Tolik 04/04/2019 -- procedure T3DModel.WriteToStream(Stream: TStream); var xStr: AnsiString; xInt: integer; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); //for i := 0 to FHashs.Count - 1 do //begin // xStr := FHashs[i]; // if ((181 + i) <= 219) then // WriteStrField(181 + i, Stream, xStr); //end; xStr := AnsiString(FHashs.Text); xInt := Length(xStr); WriteField(241, Stream, xInt, sizeof(xInt)); if xInt > 0 then Stream.Write(PAnsiChar(xStr)^,length(xStr)); xStr := AnsiString(F3DSHashs.Text); xInt := Length(xStr); WriteField(242, Stream, xInt, sizeof(xInt)); if xInt > 0 then Stream.Write(PAnsiChar(xStr)^,length(xStr)); xStr := AnsiString(FFiles.Text); xInt := Length(xStr); WriteField(243, Stream, xInt, sizeof(xInt)); if xInt > 0 then Stream.Write(PAnsiChar(xStr)^,length(xStr)); xStr := AnsiString(FFilesHashs.Text); xInt := Length(xStr); WriteField(244, Stream, xInt, sizeof(xInt)); if xInt > 0 then Stream.Write(PAnsiChar(xStr)^,length(xStr)); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DModel.WriteToStream', E.Message); end; end; { procedure T3DModel.WriteToStream(Stream: TStream); var i: integer; xStr: string; xInt: integer; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); //for i := 0 to FHashs.Count - 1 do //begin // xStr := FHashs[i]; // if ((181 + i) <= 219) then // WriteStrField(181 + i, Stream, xStr); //end; xStr := FHashs.Text; xInt := Length(xStr); WriteField(241, Stream, xInt, sizeof(xInt)); if xInt > 0 then Stream.Write(pchar(xStr)^,length(xStr)); xStr := F3DSHashs.Text; xInt := Length(xStr); WriteField(242, Stream, xInt, sizeof(xInt)); if xInt > 0 then Stream.Write(pchar(xStr)^,length(xStr)); xStr := FFiles.Text; xInt := Length(xStr); WriteField(243, Stream, xInt, sizeof(xInt)); if xInt > 0 then Stream.Write(pchar(xStr)^,length(xStr)); xStr := FFilesHashs.Text; xInt := Length(xStr); WriteField(244, Stream, xInt, sizeof(xInt)); if xInt > 0 then Stream.Write(pchar(xStr)^,length(xStr)); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DModel.WriteToStream', E.Message); end; end; } { T3DRoom } procedure T3DRoom.CollectCeiling(aFaces: TList; aPathContureList: TList = nil); var i, j: integer; a3DPointArr: T3DPointArray; aFace: TFaceRecord; Cnt: Integer; xSide: T3DSide; CeilingHeight: Double; begin try xSide := T3DSide.Create(ftNetCeiling, fwtNone, wstNone, self); Cnt := Length(FCeilingConture); SetLength(xSide.FPoints, Cnt{ * 2}); SetLength(xSide.FGLPoints, Cnt{ * 2}); for i := 0 to Cnt - 1 do begin xSide.FPoints[i] := FCeilingConture[i]; end; aFace := TFaceRecord.Create(xSide.FPoints, xSide.FColor, ftNetCeiling, 1, False, nil); // Tolik 13/01/2020 j := Length(FFloorContureForNormal); if j > 0 then begin if cnt > 0 then begin CeilingHeight := FCeilingConture[0].z; SetLength(aFace.PointsForNormal, j); for i := 0 to j - 1 do begin aFace.PointsForNormal[i] := FFloorContureForNormal[i]; aFace.PointsForNormal[i].z := CeilingHeight; end; end; end; {if aPathContureList <> nil then begin if cnt > 0 then begin CeilingHeight := FCeilingConture[0].y; SetLength(aFace.PointsForNormal, aPathContureList.Count); for i := 0 to aPathContureList.Count - 1 do begin aFace.PointsForNormal[i] := PDoublePoint(aPathContureList[i])^; aFace.PointsForNormal[i].y := CeilingHeight; end; end; end;} // aFaces.Add(aFace); xSide.FFace := aFace; xSide.FName := cCeiling; FCeiling := xSide; except on E: Exception do AddExceptionToLogEx('U_Arch3D.CollectCeiling', E.Message); end; end; function T3DRoom.GetObjectBySCSCompon(ASCSCompon: TSCSComponent): TObject; var i: Integer; begin Result := nil; if ASCSCompon = FSCSCompon then Result := self; //else //for i := 0 to FWalls.Count - 1 do //begin // Result := T3DWall(FRooms[i]).GetObjectBySCSCompon(ASCSCompon); // if Result <> nil then // Break; //// BREAK //// //end; end; procedure T3DRoom.CollectFloor(aFaces: TList; aPathContureList: TList = nil); var i, j: integer; a3DPointArr: T3DPointArray; aFace: TFaceRecord; Cnt: Integer; xSide: T3DSide; begin try xSide := T3DSide.Create(ftNetFloor, fwtNone, wstNone, Self); Cnt := Length(FFloorConture); SetLength(xSide.FPoints, Cnt{ * 2}); SetLength(xSide.FGLPoints, Cnt{ * 2}); for i := 0 to Cnt - 1 do begin xSide.FPoints[i] := FFloorConture[i]; end; aFace := TFaceRecord.Create(xSide.FPoints, xSide.FColor, ftNetFloor, 1, False, nil); // Tolik 13/01/2020 j := Length(FFloorContureForNormal); if j > 0 then begin SetLength(aFace.PointsForNormal, j); for i := 0 to j - 1 do begin aFace.PointsForNormal[i] := FFloorContureForNormal[i]; end; end; {if aPathContureList <> nil then begin SetLength(aFace.PointsForNormal, aPathContureList.Count); for i := 0 to aPathContureList.Count - 1 do begin aFace.PointsForNormal[i] := PDoublePoint(aPathContureList[i])^; end; end;} aFaces.Add(aFace); xSide.FFace := aFace; xSide.FName := cFloor; FFloor := xSide; except on E: Exception do AddExceptionToLogEx('T3DRoom.CollectFloor', E.Message); end; end; {TODO} { procedure T3DRoom.CollectRoom(aFaces: TList); var xNetPath: TNetPath; i, j, k: integer; WallComponID: Integer; Room: TSCSComponent; SCSCompon: TSCSComponent; xWall: T3DWall; begin try Room := GCurrentRoom3DView; if Room = nil then begin FSingleRoom := False; for i := 0 to FPlanObject.Paths.Count - 1 do begin xNetPath := TNetPath(FPlanObject.Paths[i]); xWall := T3DWall.Create(aFaces, xNetPath, Self); FWalls.Add(xWall); end; CollectFloor(aFaces); CollectCeiling(aFaces); end else begin if Room.ID = FSCSComponID then begin FSingleRoom := True; for i := 0 to FPlanObject.Paths.Count - 1 do begin xNetPath := TNetPath(FPlanObject.Paths[i]); xWall := T3DWall.Create(aFaces, xNetPath, Self); FWalls.Add(xWall); end; CollectFloor(aFaces); CollectCeiling(aFaces); end; end; except on E: Exception do AddExceptionToLogEx('T3DRoom.CollectRoom', E.Message); end; end; } Function IfStackedPoints(aNet: TNet): boolean; var i,j: integer; P: PDoublepoint; RelPoints: TList; xPath: TNetPath; begin Result := false; RelPoints := Tlist.Create; for i := 0 to aNet.Points.Count - 1 do begin P := aNet.Points[i]; RelPoints.Clear; for j := 0 to aNet.Paths.Count - 1 do begin xPath := TNetPath(aNet.Paths[j]); if (EQDP(P^,xPath.p1^))then RelPoints.Add(xPath.p1); if (EQDP(P^,xPath.p2^))then RelPoints.Add(xPath.p2); end; if RelPoints.Count > 2 then begin Result := true; Break; end; end; FreeAndNil(RelPoints); end; // MARK //procedure T3DRoom.CollectRoom(aFaces: TList); procedure T3DRoom.CollectRoom(aFaces: TList; aSCSPathList: TList = nil); var xNetPath: TNetPath; i, j, k: integer; WallComponID: Integer; Room: TSCSComponent; SCSCompon: TSCSComponent; xWall,xSecondWall: T3DWall; ItSRoof: Boolean; CornerName: string; xCorner: T3DCorner; xRoom: T3DRoom; ip: TDoublePoint; p: PDoublePoint; xFigure: TFigure; ID: Integer; ArchObj: TSCSComponent; Node: TTreeNode; HeightWall1,HeightWall2: Double; HeightWallPoints1,HeightWallpoints2: TWallPoints; begin try ItSRoof := False; xSecondWall := nil; {$if Defined(ES_GRAPH_SC)} // Tolik 15/06/2018 -- отвязать от компонента, если не графмодуль if FPlanObject.Paths.Count > 0 then begin xNetPath := TNetPath(FPlanObject.Paths[0]); xWall := T3DWall.Create(aFaces, xNetPath, Self); //26.11.2013 - добавлено Митяй Дмитрий for j := 0 to xWall.FParent.FSCSCompon.Properties.Count - 1 do begin if PProperty(xWall.FParent.FSCSCompon.Properties[j]).SysName = 'MATERIAL_TYPE' then begin ItSRoof := True; Break; end; if PProperty(xWall.FParent.FSCSCompon.Properties[j]).SysName = 'RESIDUE' then begin ItSRoof := true; Break; end; end; if ItsRoof then begin SetLength(xWall.FPoints,2); SetLength(xWall.FGLPoints,2); xWall.FPoints[0] := xWall.FPlanObject.el1; xWall.FPoints[1] := xWall.FPlanObject.el2; end; end; for i := 0 to FPlanObject.Paths.Count - 1 do begin xNetPath := TNetPath(FPlanObject.Paths[i]); if i > 0 then begin xWall := T3DWall.Create(aFaces, xNetPath, Self); if ItsRoof then begin SetLength(xWall.FPoints,2); SetLength(xWall.FGLPoints,2); xWall.FPoints[0] := xWall.FPlanObject.el1; xWall.FPoints[1] := xWall.FPlanObject.el2; end; end; FWalls.Add(xWall); end; {$Else} {Tolik 17/07/2018 -- -- если СКС} { if aSCSPathList <> nil then begin for i := 0 to aSCSPathList.Count - 1 do begin xNetPath := TNetPath(aSCSPathList[i]); xWall := T3DWall.Create(aFaces, xNetPath, Self); if ItsRoof then begin SetLength(xWall.FPoints,2); SetLength(xWall.FGLPoints,2); xWall.FPoints[0].x := xNetPath.p1.x; xWall.FPoints[0].y := xNetPath.p1.y; xWall.FPoints[1].x := xNetPath.p2.x; xWall.FPoints[1].y := xNetPath.p2.y; end; FWalls.Add(xWall); end; end;} for i := 0 to FPlanObject.Paths.Count - 1 do begin xNetPath := TNetPath(FPlanObject.Paths[i]); xWall := T3DWall.Create(aFaces, xNetPath, Self); FWalls.Add(xWall); end; {$ifend} //*****************ROOF*********************** if ItSRoof then begin ArchObj := GetArchObjByCADObj(FPlanObject); for i := 0 to FWalls.Count - 1 do begin xWall := T3DWall(FWalls[i]); for j := i+1 to FWalls.Count - 1 do begin xSecondWall := T3DWall(FWalls[j]); // if LinesCross(xSecondWall.FPlanObject.p1^, xSecondWall.FPlanObject.p2^, xWall.FPlanObject.p1^, xWall.FPlanObject.p2^) then // if IfStackedPoints(FPlanObject) then begin //находим точку пересечения // if GetInterSectionPoint(xSecondWall.FPlanObject.p1^, xSecondWall.FPlanObject.p2^, xWall.FPlanObject.p1^, xWall.FPlanObject.p2^, ip) then begin if xWall.FPlanObject.Connected(xSecondWall.FPlanObject) then begin CornerName := _3DCornerName + xSecondWall.FName + '/' + xWall.FName; xRoom := T3DRoom(xWall.FParent); xCorner := T3DCorner.Create(xRoom,CornerName); xCorner.JoinedWalls.Add(xWall); xCorner.JoinedWalls.Add(xSecondWall); HeightWallPoints1.WallPoint1 := GetZPoint(FPlanObject,xWall.FPlanObject.p1); HeightWallPoints1.WallPoint2 := GetZPoint(FPlanObject,xWall.FPlanObject.p2); HeightWallPoints2.WallPoint1 := GetZPoint(FPlanObject,xSecondWall.FPlanObject.p1); HeightWallPoints2.WallPoint2 := GetZPoint(FPlanObject,xSecondWall.FPlanObject.p2); if (HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint1)and (HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint2)and (HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint1)and (HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint2)and (HeightWallPoints2.WallPoint1 = HeightWallPoints1.WallPoint1)and (HeightWallPoints2.WallPoint1 = HeightWallPoints1.WallPoint2)and (HeightWallPoints2.WallPoint2 = HeightWallPoints1.WallPoint1)and (HeightWallPoints2.WallPoint2 = HeightWallPoints1.WallPoint2)then begin if GetInterSectionPoint(xSecondWall.FPlanObject.p1^, xSecondWall.FPlanObject.p2^, xWall.FPlanObject.p1^, xWall.FPlanObject.p2^, ip) then if EQDP(ip,xWall.FPlanObject.p1^) then begin ip := xWall.FPlanObject.p1^; ID := FPlanObject.GetPointID(xWall.FPlanObject.p1); end else begin ip := xWall.FPlanObject.p2^; ID := FPlanObject.GetPointID(xWall.FPlanObject.p2); end; end else if (HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint1)and (HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint2) then begin ip := xWall.FPlanObject.p1^; ID := FPlanObject.GetPointID(xWall.FPlanObject.p1); end else if (HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint1)and (HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint2) then begin ip := xWall.FPlanObject.p2^; ID := FPlanObject.GetPointID(xWall.FPlanObject.p2); end else if (HeightWallPoints2.WallPoint1 = HeightWallPoints1.WallPoint1)and (HeightWallPoints2.WallPoint1 = HeightWallPoints1.WallPoint2) then begin ip := xSecondWall.FPlanObject.p1^; ID := FPlanObject.GetPointID(xSecondWall.FPlanObject.p1); end else if (HeightWallPoints2.WallPoint2 = HeightWallPoints1.WallPoint1)and (HeightWallPoints2.WallPoint2 = HeightWallPoints1.WallPoint2) then begin ip := xSecondWall.FPlanObject.p2^; ID := FPlanObject.GetPointID(xSecondWall.FPlanObject.p2); end else begin if (EQDP(xWall.FPlanObject.p1^,xSecondWall.FPlanObject.p1^))and (HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint1)then begin ip := xWall.FPlanObject.p1^; ID := FPlanObject.GetPointID(xWall.FPlanObject.p1); end else if (EQDP(xWall.FPlanObject.p1^,xSecondWall.FPlanObject.p2^))and (HeightWallPoints1.WallPoint1 = HeightWallPoints2.WallPoint2)then begin ip := xWall.FPlanObject.p1^; ID := FPlanObject.GetPointID(xWall.FPlanObject.p1); end else if (EQDP(xWall.FPlanObject.p2^,xSecondWall.FPlanObject.p1^))and (HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint1)then begin ip := xWall.FPlanObject.p2^; ID := FPlanObject.GetPointID(xWall.FPlanObject.p2); end else if (EQDP(xWall.FPlanObject.p2^,xSecondWall.FPlanObject.p2^))and (HeightWallPoints1.WallPoint2 = HeightWallPoints2.WallPoint2)then begin ip := xWall.FPlanObject.p2^; ID := FPlanObject.GetPointID(xWall.FPlanObject.p2); end; end; //Узнаем ноуд Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true); //узнаем СКС компонент if Node <> nil then xCorner.FSCSCompon := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node); xCorner.FPoints := ip; if xCorner.FSCSCompon <> nil then HeightWall1 := xCorner.FSCSCompon.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(FPlanObject.Owner).MapScale); //устанавливаем углу точку Z xCorner.FPoints.z := HeightWall1; FCorner.add(xCorner); end; end; { end else if LinesCross(xSecondWall.FPlanObject.el1, xSecondWall.FPlanObject.el2, xWall.FPlanObject.el1, xWall.FPlanObject.el2) then begin //находим точку пересечения if GetInterSectionPoint(xSecondWall.FPlanObject.el1, xSecondWall.FPlanObject.el2, xWall.FPlanObject.el1, xWall.FPlanObject.el2, ip) then begin CornerName := 'Угол для: ' + xSecondWall.FName + '/' + xWall.FName; xRoom := T3DRoom(xWall.FParent); xCorner := T3DCorner.Create(xRoom,CornerName); xCorner.JoinedWalls.Add(xWall); xCorner.JoinedWalls.Add(xSecondWall); //Так как точку пересечения находит не совсем точно, делаем дополнительную проверку, чтоб //найти именно ту точку, которая нам нужна... if EQDP(ip,xWall.FPlanObject.el1) then ip := xWall.FPlanObject.el1 else if EQDP(ip,xWall.FPlanObject.el2) then ip := xWall.FPlanObject.el2; //если у двух стен точки не лежат друг на друге if (not EQDP(xWall.FPlanObject.el1,xWall.FPlanObject.el2))and (not EQDP(xSecondWall.FPlanObject.el1,xSecondWall.FPlanObject.el2)) then begin //Узнаем ID точки////////////////////////////////////////////// for k := 0 to FPlanObject.Points.Count - 1 do // if EQDP(ip,PDoublepoint(FPlanObject.Points[k])^) then // break; // ID := Integer(FPlanObject.FPointIDs[k]); // //Узнаем ноуд Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true); //узнаем СКС компонент xCorner.FSCSCompon := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node); xCorner.FPoints := ip; HeightWall1 := xCorner.FSCSCompon.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(FPlanObject.Owner).MapScale); //устанавливаем углу точку Z xCorner.FPoints.z := HeightWall1; end; FCorner.add(xCorner); end;} end; end; end; end else begin //Тут распарсить углы.Так как почти вся прога построена на указателях и листах, //шаг вправо, шаг влево - взрыв))) Потому добавлять углы будем следующим образом: //Берем две стены, точнее - их координаты, и проверяем на пересекаемость. //Если есть точка пересечения - значит это угол, добавляем его. Пока так... for i := 0 to FWalls.Count - 1 do begin xWall := T3DWall(FWalls[i]); for j := i+1 to FWalls.Count - 1 do begin xSecondWall := T3DWall(FWalls[j]); if LinesCross(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^) then begin //находим точку пересечения if GetInterSectionPoint(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^, ip) then begin CornerName := _3DCornerName + xSecondWall.FName + '/' + xWall.FName; xRoom := T3DRoom(xWall.FParent); xCorner := T3DCorner.Create(xRoom,CornerName); xCorner.JoinedWalls.Add(xWall); xCorner.JoinedWalls.Add(xSecondWall); xCorner.FPoints := ip; { xFigure := GCadForm.PCad.CheckByPoint(8, ip.x, ip.y); p^ := ip; if xFigure <> nil then if xFigure is TNet then xCorner.FSCSCompon := GetArchCornerByPoint(Tnet(xFigure),p); { p^ := ip; xCorner.FSCSCompon := GetArchCornerByPoint(xSecondWall.FPlanObject.Net,p);} FCorner.add(xCorner); end; end; end; //Tolik 23/12/2021 -- не добавлено пересечение последней и первой стены if i = FWalls.count - 1 then begin j := 0; xSecondWall := T3DWall(FWalls[j]); if LinesCross(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^) then begin //находим точку пересечения if GetInterSectionPoint(xSecondWall.FPlanObject.IP1^, xSecondWall.FPlanObject.IP2^, xWall.FPlanObject.IP1^, xWall.FPlanObject.IP2^, ip) then begin CornerName := _3DCornerName + xSecondWall.FName + '/' + xWall.FName; xRoom := T3DRoom(xWall.FParent); xCorner := T3DCorner.Create(xRoom,CornerName); xCorner.JoinedWalls.Add(xWall); xCorner.JoinedWalls.Add(xSecondWall); xCorner.FPoints := ip; { xFigure := GCadForm.PCad.CheckByPoint(8, ip.x, ip.y); p^ := ip; if xFigure <> nil then if xFigure is TNet then xCorner.FSCSCompon := GetArchCornerByPoint(Tnet(xFigure),p); { p^ := ip; xCorner.FSCSCompon := GetArchCornerByPoint(xSecondWall.FPlanObject.Net,p);} FCorner.add(xCorner); end; end; end; // end; end; //*****************\ROOF********************** {$if Defined(ES_GRAPH_SC)} if not ItSRoof then CollectFloor(aFaces); CollectCeiling(aFaces); {$else} // Tolik 31/08/2018 -- для СКС if fWalls.Count > 2 then begin // Tolik 13/01/2020 if Length(FNetConture) > 0 then begin if (aSCSPathList <> nil) and (aSCSPathList.Count > 0) then begin CollectFloor(aFaces, TNetPath(aSCSPathList[0]).Net.Points); CollectCeiling(aFaces, TNetPath(aSCSPathList[0]).Net.Points); end else begin CollectFloor(aFaces, nil); CollectCeiling(aFaces, nil); end; end else begin FFloor := nil; FCeiling := nil; end; end else begin FFloor := nil; FCeiling := nil; end; {$ifEnd} except on E: Exception do AddExceptionToLogEx('T3DRoom.CollectRoom', E.Message); end; end; {TODO} { constructor T3DRoom.Create(aFaces: TList; aNet: TNet; aParent: T3DModel); begin try inherited Create; FClassName := 'T3DRoom'; FPlanObject := aNet; if aNet <> nil then begin FSCSCompon := GetArchObjByCADObj(aNet); FSCSComponID := FSCSCompon.ID; FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark; FNetConture := aNet.GetRoomConture; FFloorConture := aNet.GetFloorConture; FCeilingConture := aNet.GetCeilingConture; end; FWalls := TList.Create; F3DSObjects := TList.Create; FParent := aParent; if aFaces <> nil then CollectRoom(aFaces); except on E: Exception do AddExceptionToLogEx('T3DRoom.Create', E.Message); end; end; } function CheckByNetPath(aNet:TNet; Point1,POint2: TDoublepoint): boolean; var i: integer; xPath: TnetPath; begin result := false; for i := 0 to aNet.Paths.Count - 1 do begin xPath := TNetPath(aNet.Paths[i]); if xPath.AreYou(point1,point2) then begin result := true; break; end; end; end; Procedure FillCeilingBySortOut(aNet: TNet; var aCeilingConture: TDoublePointArr); var i,j: integer; Startpoint: TDoublePoint; EndPoint: PDoublePOint; xPath: TNetPath; xPaths: Tlist; begin xPaths := Tlist.Create; if aCeilingConture = nil then SetLength(aCeilingConture, aNet.Points.Count+1); //начальная и конечная точки первого ребра(TNetPath) xPath := TNetPath(aNet.Paths[0]); Startpoint := PDoublepoint(xPath.p1)^; Startpoint.z := GetZPoint(aNet,xPath.p1); EndPoint := xPath.p2; aCeilingConture[0] := Startpoint; for i := 1 to Length(aCeilingConture) - 2 do begin xPaths.Clear; aNet.GetPathsOfKnot(EndPOint,xPaths); xPaths.Remove(xPath); for j := 0 to xPaths.Count - 1 do begin xPath := TNetPath(xPaths[j]); if EQDP(EndPOint^,xPath.p1^) then begin Startpoint := PDoublepoint(xPath.p1)^; Startpoint.z := GetZPoint(aNet,xPath.p1); aCeilingConture[i] := Startpoint; EndPoint := xPath.p2; end else begin Startpoint := PDoublepoint(xPath.p2)^; Startpoint.z := GetZPoint(aNet,xPath.p2); aCeilingConture[i] := Startpoint; EndPoint := xPath.p1; end; end; end; FreeAndNil(xPaths); end; Procedure GetCeilingConture(aNet: TNet; aPaths: Tlist; var aCeilingConture: TDoublePointArr); var i,j, ID: integer; Heightcorner: double; xNetPath: TNetPath; xSCSCompon,CornerSCS: TSCSComponent; Point1,Point2,StartPoint: TDoublePoint; ArchContainer: TSCSCatalog; Node: TTreeNode; ArchObj: TSCSComponent; ObjData: TObjectData; WrongPath: Boolean; begin SetLength(aCeilingConture, 0); WrongPath := false; if aNet.FComponID <> 0 then begin ArchObj := GetArchObjByCADObj(aNet); if ArchObj <> nil then begin SetLength(aCeilingConture, aNet.Points.Count+1); StartPOint := PDoublepoint(aNet.Points[0])^; for i := 0 to aNet.Points.Count - 1 do begin ID := Integer(anet.FPointIDs[i]); Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true); CornerSCS := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node); Heightcorner := CornerSCS.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(aNet.Owner).MapScale); aCeilingConture[i] := PDoublepoint(aNet.Points[i])^; aCeilingConture[i].z := Heightcorner; if i > 0 then if not CheckByNetPath(aNet,StartPOint, PDoublepoint(aNet.Points[i])^) then begin SetLength(aCeilingConture, 0); SetLength(aCeilingConture, aNet.Points.Count+1); WrongPath := true; break; end; StartPOint := PDoublepoint(aNet.Points[i])^; end; end; if WrongPath then begin FillCeilingBySortOut(aNet,aCeilingConture); aCeilingConture[4] := aCeilingConture[0]; end else aCeilingConture[i] := aCeilingConture[0]; end; end; // MARK constructor T3DRoom.Create(aFaces: TList; aNet: TNet; aParent: T3DModel); var i: integer; vPaths: TList; begin try inherited Create; FClassName := 'T3DRoom'; FPlanObject := aNet; FListID := GCadForm.FCADListID; SetLength(FFloorContureForNormal, 0); // Tolik 14/01/2020 if aNet <> nil then begin VPaths := Nil; {$if Defined (ES_GRAPH_SC)} FSCSCompon := GetArchObjByCADObj(aNet); FSCSComponID := FSCSCompon.ID; FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark; {$else} FName := _3DRoomName; {$ifEnd} vPaths := GetVirtualNetPathsByRealNet(aNet, FGroupNet); {$if Defined (ES_GRAPH_SC)} if GArch3DInnerSidesFromVirtual and Assigned(FGroupNet) then begin FNetConture := FGroupNet.GetRoomConture(vPaths); GetPathsConturePoints(vPaths, nil, @FCeilingConture, true, nil, nil, nil, nil); //28.05.2012 end else begin if not IfFiguraIsRoof(aNet) then begin FNetConture := aNet.GetRoomConture(aNet.Paths); GetPathsConturePoints(aNet.Paths, nil, @FCeilingConture, true, nil, nil, nil, nil); //28.05.2012 end else begin FNetConture := aNet.GetRoomConture(aNet.Paths); GetCeilingConture(aNet,aNet.Paths,FCeilingConture); end; end; if (aNet.Paths.Count > 0) and (TNetPath(aNet.Paths[0]).FIsConture) then begin //FFloorConture := aNet.GetFloorConture; //FCeilingConture := aNet.GetCeilingConture; if Length(FCeilingConture) > 0 then SetLength(FCeilingConture, Length(FCeilingConture)-1); SetLength(FFloorConture, Length(FCeilingConture)); for i := 0 to Length(FCeilingConture) - 1 do begin FFloorConture[i] := FCeilingConture[i]; FFloorConture[i].z := 0; //FCeilingConture[i].z := FCeilingConture[i].z * FScaleDelta + FFCeilingDelta; FCeilingConture[i].z := FCeilingConture[i].z + FFCeilingDelta; end; end; {$else} {if GArch3DInnerSidesFromVirtual and Assigned(FGroupNet) then begin FNetConture := FGroupNet.GetRoomConture(vPaths); //GetPathsConturePoints(vPaths, nil, @FCeilingConture, true, nil, nil, nil, nil); //28.05.2012 end else begin if not IfFiguraIsRoof(aNet) then begin FNetConture := aNet.GetRoomConture(aNet.Paths); //GetPathsConturePoints(aNet.Paths, nil, @FCeilingConture, true, nil, nil, nil, nil); //28.05.2012 end else begin FNetConture := aNet.GetRoomConture(aNet.Paths); //GetCeilingConture(aNet,aNet.Paths,FCeilingConture); end; end;} {$ifEnd} FreeAndNil(vPaths); end; FWalls := TList.Create; FCorner := TList.Create; F3DSObjects := TList.Create; FParent := aParent; FVisible := True; {$if Defined (ES_GRAPH_SC)} if aFaces <> nil then begin if GCurrentRoom3DView = nil then begin CollectRoom(aFaces); end else begin if FSCSComponID = GCurrentRoom3DView.ID then CollectRoom(aFaces) else begin CollectRoom(aFaces); FVisible := False; end; end; end; {$ifEnd} except on E: Exception do AddExceptionToLogEx('T3DRoom.Create', E.Message); end; end; destructor T3DRoom.destroy; begin try {$if Defined (ES_GRAPH_SC)} {$else} SetLength(FNetConture, 0); SetLength(FFloorConture, 0); SetLength(FCeilingConture, 0); SetLength(FFloorContureForNormal, 0); // Tolik 14/01/2020 FreeObjectList(FWalls); FreeObjectList(F3DSObjects); if FFloor <> nil then FFloor.Free; if FCeiling <> nil then FCeiling.Free; FreeObjectList(FCorner); {$ifEnd} inherited; except on E: Exception do AddExceptionToLogEx('T3DRoom.Destroy', E.Message); end; end; procedure T3DRoom.ReadFromStream(Stream: TStream); var isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 20: FParentIndex := IntVal; 21: FSCSComponID := intVal; 22: FListID := intVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); case xCode of 90: begin if byteVal = 0 then FVisible := False else FVisible := True; end; end; end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DRoom.ReadFromStream', E.Message); end; end; procedure T3DRoom.SetRelations; begin try if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DModel(ModelObjectsList.Items[FParentIndex]); T3DModel(FParent).FRooms.Add(self); end; except on E: Exception do AddExceptionToLogEx('T3DRoom.SetRelations', E.Message); end; end; procedure T3DRoom.WriteToStream(Stream: TStream); var xInt: Integer; xByte: Byte; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); if FVisible then xByte := 1 else xByte := 0; WriteField(90, Stream, xByte, sizeof(xByte)); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DRoom.WriteToStream', E.Message); end; end; { T3DSide } procedure T3DSide.CollectWallElementSide(aFaces: TList; ap: T3DPointArray; fTrans: boolean = False); var aFace: TFaceRecord; begin try SetLength(FPoints, 4); SetLength(FGLPoints, 4); FPoints[0] := ap[0]; FPoints[1] := ap[1]; FPoints[2] := ap[2]; FPoints[3] := ap[3]; aFace := TFaceRecord.Create(FPoints, clGray, FFaceType, 1, fTrans, nil); aFace.FFaceWallType := FWallType; aFace.FWallSideType := FSideType; aFaces.Add(aFace); FFace := aFace; except on E: Exception do AddExceptionToLogEx('T3DSide.CollectWallElementSide', E.Message); end; end; procedure T3DSide.CollectWallSide(aFaces: TList; ap: T3DPointArray); var aFace: TFaceRecord; begin try SetLength(FPoints, 4); SetLength(FGLPoints, 4); FPoints[0] := ap[0]; FPoints[1] := ap[1]; FPoints[2] := ap[3]; FPoints[3] := ap[2]; aFace := TFaceRecord.Create(FPoints, clGray, FFaceType, 1, False, nil); aFace.FFaceWallType := FWallType; aFace.FWallSideType := FSideType; aFaces.Add(aFace); FFace := aFace; except on E: Exception do AddExceptionToLogEx('T3DSide.CollectWallSide', E.Message); end; end; procedure T3DSide.CollectWallSideEx(aFaces: TList; ap: T3DPointArray); var i: integer; aFace: TFaceRecord; begin try SetLength(FPoints, Length(ap)); SetLength(FGLPoints, Length(ap)); for i := 0 to Length(ap) - 1 do FPoints[i] := ap[i]; aFace := TFaceRecord.Create(FPoints, clGray, FFaceType, 1, False, nil); aFace.FFaceWallType := FWallType; aFace.FWallSideType := FSideType; aFaces.Add(aFace); FFace := aFace; except on E: Exception do AddExceptionToLogEx('T3DSide.CollectWallSide', E.Message); end; end; procedure T3DSide.CollectArcWallSide(aFaces: TList; ap: T3DPointArray); var i: integer; j: integer; aFace: TFaceRecord; aFPoints: T3DPointArray; begin try SetLength(aFPoints, 4); if (FSideType = wstUpper) or (FSideType = wstUnder) then begin SetLength(FPoints, Length(ap)); SetLength(FGLPoints, Length(ap)); for i := 0 to Length(ap) - 1 do FPoints[i] := ap[i]; aFace := TFaceRecord.Create(FPoints, clGray, FFaceType, 1, False, nil); aFace.FFaceWallType := FWallType; aFace.FWallSideType := FSideType; aFaces.Add(aFace); FFace := aFace; FAsArc := True; end else begin SetLength(FPoints, 4); SetLength(FGLPoints, 4); j := 0; while j + 1 < (Length(ap) div 2) do begin aFPoints[0] := ap[j]; aFPoints[1] := ap[j + 1]; //aFPoints[2] := ap[Length(ap) - j - 2]; //aFPoints[3] := ap[Length(ap) - j - 1]; aFPoints[2] := ap[(Length(ap) div 2) + 1 + j]; aFPoints[3] := ap[(Length(ap) div 2) + j]; //aFPoints[2] := ap[j + 2]; //aFPoints[3] := ap[j + 3]; if j = 0 then begin FPoints[0] := aFPoints[0]; FPoints[1] := aFPoints[1]; FPoints[2] := aFPoints[2]; FPoints[3] := aFPoints[3]; end; aFace := TFaceRecord.Create(aFPoints, clGray, FFaceType, 1, False, nil); aFace.FFaceWallType := FWallType; aFace.FWallSideType := FSideType; aFaces.Add(aFace); if j = 0 then FFace := aFace; FAsArc := True; j := j + 1; end; end; except on E: Exception do AddExceptionToLogEx('T3DSide.CollectWallSide', E.Message); end; end; constructor T3DSide.Create(aFaceType: TFaceType; aWallType: TFaceWallType; aSideType: TWallSideType; aParent: TObject; aNetPath: TNetPath=nil); begin try inherited Create; FClassName := 'T3DSide'; FColor := clGray; FFaceType := aFaceType; FWallType := aWallType; FSideType := aSideType; FParent := aParent; FGLObject := nil; FFace := nil; FDescription := TStringList.Create; FTextureRotate := 0; FTextureScale := 100; FMirror := False; FAsArc := False; FTextureHash := ''; FTexture_ext := ''; FSubSides := TList.Create; FNetPath := aNetPath; //29.05.2012 if FParent <> nil then begin if FParent is T3DWall then begin FName := cSide + ' ' + IntToStr(T3DWall(FParent).FSides.Count + 1); end; if FParent is T3DWallElement then begin FName := cSide + ' ' + IntToStr(T3DWallElement(FParent).FSides.Count + 1); end; if FParent is T3DBalconElement then begin FName := cSide + ' ' + IntToStr(T3DBalconElement(FParent).FSides.Count + 1); end; if FParent is T3DSlope then begin FName := cSide + ' ' + IntToStr(T3DSlope(FParent).FSides.Count + 1); end; if FParent is T3DSide then begin FName := cSubSide + ' ' + IntToStr(T3DSide(FParent).FSubSides.Count + 1); end; end; if FNetPath <> nil then begin if FNetPath.FComponID in [128,133,150,148] then begin EmptyProcedure; if aWallType = fwtOuter then begin EmptyProcedure; if FNetPath.FComponID = 128 then EmptyProcedure; if FNetPath.FComponID = 133 then EmptyProcedure; if FNetPath.FComponID = 150 then EmptyProcedure; if FNetPath.FComponID = 158 then EmptyProcedure; end; end; end; except on E: Exception do AddExceptionToLogEx('T3DSide.Create', E.Message); end; end; // Tolik 24/07/2018 -- destructor T3DSide.destroy; begin FDescription.Free; FreeAndNil(FSubSides); SetLength(FPoints, 0); SetLength(FGLPoints, 0); inherited; end; // procedure T3DSide.ReadFromStream(Stream: TStream); var isOk: Boolean; i, xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; xd, yd, zd: Double; pCnt: Integer; mStr: TMemoryStream; fStr: TFileStream; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xCode of 20: FParentIndex := IntVal; 21: FFaceType := TFaceType(IntVal); 22: FWallType := TFaceWallType(IntVal); 23: FSideType := TWallSideType(IntVal); 24: FColor := IntVal; 25: FTextureRotate := IntVal; 26: FTextureScale := IntVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); case xCode of 90: begin if byteVal = 0 then FMirror := False else FMirror := True; end; 91: begin if byteVal = 0 then FAsArc := False else FAsArc := True; end; end; end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); Case xcode of 150: begin pCnt := xSize div 24; SetLength(FPoints, pCnt); for i := 0 to pCnt - 1 do begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPoints[i].x := xd; FPoints[i].y := yd; FPoints[i].z := zd; end; end; 151: begin pCnt := xSize div 24; SetLength(FGLPoints, pCnt); for i := 0 to pCnt - 1 do begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FGLPoints[i].x := xd; FGLPoints[i].y := yd; FGLPoints[i].z := zd; end; end; // 152: begin // mStr := TMemoryStream.Create; // StreamToStream(Stream, mStr, xSize); // mStr.Position := 0; // mStr.SaveToFile('C:\govno_test.bmp'); // FreeAndNil(mStr); // end; end; end else if (xCode >= 180) and (xCode < 220) then begin strVal := ReadStringFromStream(Stream); case xCode of 180: isOk := true; 181: FDescription.Text := strVal; 182: FTextureHash := strVal; 183: FTexture_ext := strVal; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DSide.ReadFromStream', E.Message); end; end; procedure T3DSide.SetRelations; begin try if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := TObject(ModelObjectsList.Items[FParentIndex]); if FParent is T3DRoom then begin if FFaceType = ftNetCeiling then T3DRoom(FParent).FCeiling := self; if FFaceType = ftNetFloor then T3DRoom(FParent).FFloor := self; end; if FParent is T3DWall then begin T3DWall(FParent).FSides.Add(self); end; if FParent is T3DWallElement then begin T3DWallElement(FParent).FSides.Add(self); end; if FParent is T3DBalconElement then begin T3DBalconElement(FParent).FSides.Add(self); end; if FParent is T3DSlope then begin T3DSlope(FParent).FSides.Add(self); end; if FParent is T3DSide then begin T3DSide(FParent).FSubSides.Add(self); end; end; except on E: Exception do AddExceptionToLogEx('T3DSide.SetRelations', E.Message); end; end; function T3DSide.GetArea: Double; var PointCnt: Integer; begin Result := 0; PointCnt := Length(Self.FPoints); if PointCnt = 4 then Result := GetTriangleArea3D(Self.FPoints[0], Self.FPoints[1], Self.FPoints[2])+ GetTriangleArea3D(Self.FPoints[2], Self.FPoints[3], Self.FPoints[0]); end; // Tolik 04/04/2019 -- старая закомменчена ниже procedure T3DSide.WriteToStream(Stream: TStream); var i, xCount, xInt: Integer; xByte: Byte; aPoints: pInt; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := Ord(FFaceType); WriteField(21, Stream, xInt, sizeof(xInt)); xInt := Ord(FWallType); WriteField(22, Stream, xInt, sizeof(xInt)); xInt := Ord(FSideType); WriteField(23, Stream, xInt, sizeof(xInt)); xInt := FColor; WriteField(24, Stream, xInt, sizeof(xInt)); xInt := FTextureRotate; WriteField(25, Stream, xInt, sizeof(xInt)); xInt := FTextureScale; WriteField(26, Stream, xInt, sizeof(xInt)); if FMirror then xByte := 1 else xByte := 0; WriteField(90, Stream, xByte, sizeof(xByte)); if FAsArc then xByte := 1 else xByte := 0; WriteField(91, Stream, xByte, sizeof(xByte)); xCount := Length(FPoints); GetMem(aPoints, xCount * 24); for i := 0 to xCount - 1 do begin pDouble(PAnsiChar(aPoints) + (i * 24) + 0)^ := FPoints[i].x; pDouble(PAnsiChar(aPoints) + (i * 24) + 8)^ := FPoints[i].y; pDouble(PAnsiChar(aPoints) + (i * 24) + 16)^ := FPoints[i].z; end; WriteBinField(150, Stream, pByte(aPoints), xCount * 24); FreeMem(aPoints, xCount * 24); xCount := Length(FGLPoints); GetMem(aPoints, xCount * 24); for i := 0 to xCount - 1 do begin pDouble(PAnsiChar(aPoints) + (i * 24) + 0)^ := FGLPoints[i].x; pDouble(PAnsiChar(aPoints) + (i * 24) + 8)^ := FGLPoints[i].y; pDouble(PAnsiChar(aPoints) + (i * 24) + 16)^ := FGLPoints[i].z; end; WriteBinField(151, Stream, pByte(aPoints), xCount * 24); FreeMem(aPoints, xCount * 24); WriteStrField(181, Stream, FDescription.Text); WriteStrField(182, Stream, FTextureHash); WriteStrField(183, Stream, FTexture_ext); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DSide.WriteToStream', E.Message); end; end; { procedure T3DSide.WriteToStream(Stream: TStream); var i, xCount, xInt: Integer; xByte: Byte; xStr: string; xDouble: Double; aPoints, bPoints: pInt; xFName: string; xStream: TFileStream; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := Ord(FFaceType); WriteField(21, Stream, xInt, sizeof(xInt)); xInt := Ord(FWallType); WriteField(22, Stream, xInt, sizeof(xInt)); xInt := Ord(FSideType); WriteField(23, Stream, xInt, sizeof(xInt)); xInt := FColor; WriteField(24, Stream, xInt, sizeof(xInt)); xInt := FTextureRotate; WriteField(25, Stream, xInt, sizeof(xInt)); xInt := FTextureScale; WriteField(26, Stream, xInt, sizeof(xInt)); if FMirror then xByte := 1 else xByte := 0; WriteField(90, Stream, xByte, sizeof(xByte)); if FAsArc then xByte := 1 else xByte := 0; WriteField(91, Stream, xByte, sizeof(xByte)); xCount := Length(FPoints); GetMem(aPoints, xCount * 24); for i := 0 to xCount - 1 do begin pDouble(pChar(aPoints) + (i * 24) + 0)^ := FPoints[i].x; pDouble(pChar(aPoints) + (i * 24) + 8)^ := FPoints[i].y; pDouble(pChar(aPoints) + (i * 24) + 16)^ := FPoints[i].z; end; WriteBinField(150, Stream, pByte(aPoints), xCount * 24); FreeMem(aPoints, xCount * 24); xCount := Length(FGLPoints); GetMem(aPoints, xCount * 24); for i := 0 to xCount - 1 do begin pDouble(pChar(aPoints) + (i * 24) + 0)^ := FGLPoints[i].x; pDouble(pChar(aPoints) + (i * 24) + 8)^ := FGLPoints[i].y; pDouble(pChar(aPoints) + (i * 24) + 16)^ := FGLPoints[i].z; end; WriteBinField(151, Stream, pByte(aPoints), xCount * 24); FreeMem(aPoints, xCount * 24); // Write Texture // xFName := frm3D.GetImageFileByHash(FTextureHash); // if xFName <> '' then // begin // xStream := TFileStream.Create(xFName, fmOpenRead); // WriteStreamField(152, Stream, xStream); // FreeAndNil(xStream); // end; // WriteStrField(181, Stream, FDescription.Text); WriteStrField(182, Stream, FTextureHash); WriteStrField(183, Stream, FTexture_ext); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DSide.WriteToStream', E.Message); end; end; } { T3DWall } function T3DWall.CalcPointHeight(p1, p2, Point: TDoublePoint; p1h, p2h: Double): Double; var x, y: Double; p: TDoublePoint; begin try Result := 0; // Координату У будем рассматривать как Z // чтобы нормализировать Y (тоесть для p1, p2 был одинаковый), будем считать от ноля, считая остапльные координаты по длинам x := GetLineLenght(p1, Point); y := 1; p := LineIntersect(DoublePoint(0, p1h), DoublePoint(GetLineLenght(p1, p2), p2h), DoublePoint(x,0), DoublePoint(x,1000)); x := GetLineLenght(p1, Point)+1; PointToLine(DoublePoint(1, p1h+1), DoublePoint(GetLineLenght(p1, p2)+1, p2h+1), x, y); Result := y; Result := p.y; except on E: Exception do AddExceptionToLogEx('T3DWall.CalcPointHeight', E.Message); end; end; function T3DWall.CollectInnerWall(aFaces: TList; ap: T3DPointArray; aWallViewType: TWallViewType; isRightInner: Boolean = False): TList; var i: integer; a3DPointArr, a3DPointArrArc: T3DPointArray; aFace: TFaceRecord; WallSideConture: TDoublePointArr; pp: PDoublePoint; p: TDoublePoint; l1, l2: TDoublePoint; xSide: T3DSide; begin try Result := TList.Create; SetLength(a3DPointArr, 4); // Нижняя грань ************************************************************ if not (wvtNoUnder in aWallViewType) then begin a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[2]; a3DPointArr[3] := ap[3]; if PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3]) then xSide := T3DSide.Create(ftNetPath, fwtInner, wstUnder, self, FPlanObject) else xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUnder, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else xSide.CollectWallSide(aFaces, a3DPointArr); // new *** FSides.Add(xSide); Result.Add(xSide); end; // Верхняя грань *********************************************************** if not (wvtNoUpper in aWallViewType) then begin a3DPointArr[0] := ap[4]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[6]; a3DPointArr[3] := ap[7]; if PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3]) then xSide := T3DSide.Create(ftNetPath, fwtInner, wstUpper, self, FPlanObject) else xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUpper, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else xSide.CollectWallSide(aFaces, a3DPointArr); // new *** FSides.Add(xSide); Result.Add(xSide); end; // Левая грань ************************************************************* if not (wvtNoLeft in aWallViewType) then begin a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[4]; a3DPointArr[3] := ap[5]; if (PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2])) or (PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3])) then begin xSide := T3DSide.Create(ftNetPath, fwtInner, wstLeft, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr, True); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else xSide.CollectWallSide(aFaces, a3DPointArr); // new *** FSides.Add(xSide); Result.Add(xSide); end; end; // Правая грань if not (wvtNoRight in aWallViewType) then begin a3DPointArr[0] := ap[2]; a3DPointArr[1] := ap[3]; a3DPointArr[2] := ap[6]; a3DPointArr[3] := ap[7]; if (PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2])) or (PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3])) then begin xSide := T3DSide.Create(ftNetPath, fwtInner, wstRight, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr, True); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else xSide.CollectWallSide(aFaces, a3DPointArr); // new *** FSides.Add(xSide); Result.Add(xSide); end else if isRightInner then begin xSide := T3DSide.Create(ftNetPath, fwtInner, wstRight, self, FPlanObject); xSide.CollectWallSide(aFaces, a3DPointArr); FSides.Add(xSide); Result.Add(xSide); end; end; except on E: Exception do AddExceptionToLogEx('T3DWall.CollectWall', E.Message); end; end; function T3DWall.CollectOuterWall(aFaces: TList; ap: T3DPointArray; aWallViewType: TWallViewType; aKnotFlag: Byte=0; aSideFlag: Byte=0): TList; var i: integer; a3DPointArr, a3DPointArrArc: T3DPointArray; aFace: TFaceRecord; WallSideConture: TDoublePointArr; pp: PDoublePoint; p: TDoublePoint; l1, l2: TDoublePoint; xSide: T3DSide; function CheckSideInWall(aSide: T3DSide): Boolean; var i: Integer; CurrSide: T3DSide; function SamePoints(aPoint1, aPoint2: TDoublePoint): Boolean; begin Result := False; if (CompareValue(aPoint1.x, aPoint2.x) = 0) then if (CompareValue(aPoint1.y, aPoint2.y) = 0) then if (CompareValue(aPoint1.z, aPoint2.z) = 0) then Result := True; end; begin Result := False; for i := 0 to FSides.Count - 1 do begin currSide := T3DSide(FSides[i]); if SamePoints(currSide.FPoints[0], aSide.FPoints[0]) and SamePoints(currSide.FPoints[1], aSide.FPoints[1]) and SamePoints(currSide.FPoints[2], aSide.FPoints[2]) and SamePoints(currSide.FPoints[3], aSide.FPoints[3]) then begin Result := True; exit; end; end; end; begin try Result := TList.Create; // Нижняя грань ************************************************************ if not (wvtNoUnder in aWallViewType) then begin if (aKnotFlag = 0) or FIsArc then begin SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[2]; a3DPointArr[3] := ap[3]; end else if not FIsArc then begin if aKnotFlag = 1 then begin SetLength(a3DPointArr, 5); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[3]; a3DPointArr[3] := ap[2]; a3DPointArr[4] := ap[8]; end else if aKnotFlag = 2 then begin SetLength(a3DPointArr, 5); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[9]; a3DPointArr[3] := ap[3]; a3DPointArr[4] := ap[2]; end else if aKnotFlag = 12 then begin SetLength(a3DPointArr, 6); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[9]; a3DPointArr[3] := ap[3]; a3DPointArr[4] := ap[2]; a3DPointArr[5] := ap[8]; end; end; if PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3]) then xSide := T3DSide.Create(ftNetPath, fwtInner, wstUnder, self, FPlanObject) else xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUnder, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else begin if aKnotFlag = 0 then xSide.CollectWallSide(aFaces, a3DPointArr) else xSide.CollectWallSideEx(aFaces, a3DPointArr); end; // new *** if CheckSideInWall(xSide) then begin xSide.Free; aFaces.Delete(aFaces.Count - 1); end else begin FSides.Add(xSide); Result.Add(xSide); end; end; // Верхняя грань *********************************************************** if not (wvtNoUpper in aWallViewType) then begin if (aKnotFlag = 0) or FIsArc then begin SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[4]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[6]; a3DPointArr[3] := ap[7]; end else if Not FIsArc then begin if aKnotFlag = 1 then begin SetLength(a3DPointArr, 5); a3DPointArr[0] := ap[4]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[7]; a3DPointArr[3] := ap[6]; a3DPointArr[4] := ap[10]; end else if aKnotFlag = 2 then begin SetLength(a3DPointArr, 5); a3DPointArr[0] := ap[4]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[11]; a3DPointArr[3] := ap[7]; a3DPointArr[4] := ap[6]; end else if aKnotFlag = 12 then begin SetLength(a3DPointArr, 6); a3DPointArr[0] := ap[4]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[11]; a3DPointArr[3] := ap[7]; a3DPointArr[4] := ap[6]; a3DPointArr[5] := ap[10]; end; end; if PtInPolygon(FParent.FNetConture, a3DPointArr[0]) and PtInPolygon(FParent.FNetConture, a3DPointArr[1]) and PtInPolygon(FParent.FNetConture, a3DPointArr[2]) and PtInPolygon(FParent.FNetConture, a3DPointArr[3]) then xSide := T3DSide.Create(ftNetPath, fwtInner, wstUpper, self, FPlanObject) else xSide := T3DSide.Create(ftNetPath, fwtOuter, wstUpper, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else begin if aKnotFlag = 0 then xSide.CollectWallSide(aFaces, a3DPointArr) else xSide.CollectWallSideEx(aFaces, a3DPointArr); end; // new *** if CheckSideInWall(xSide) then begin xSide.Free; aFaces.Delete(aFaces.Count - 1); end else begin FSides.Add(xSide); Result.Add(xSide); end; end; // Левая грань ************************************************************* if not (wvtNoLeft in aWallViewType) then begin SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[4]; a3DPointArr[3] := ap[5]; xSide := T3DSide.Create(ftNetPath, fwtOuter, wstLeft, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr, True); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else xSide.CollectWallSide(aFaces, a3DPointArr); // new *** if CheckSideInWall(xSide) then begin xSide.Free; aFaces.Delete(aFaces.Count - 1); end else begin FSides.Add(xSide); Result.Add(xSide); end; end; // левая боковая грань if (aSideFlag = 1) or (aSideFlag = 12) then begin a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[4]; a3DPointArr[2] := ap[2]; a3DPointArr[3] := ap[6]; xSide := T3DSide.Create(ftNetPath, fwtOuter, wstLeftSide, self, FPlanObject); xSide.CollectWallSide(aFaces, a3DPointArr); if CheckSideInWall(xSide) then begin xSide.Free; aFaces.Delete(aFaces.Count - 1); end else begin FSides.Add(xSide); Result.Add(xSide); end; end; // Tolik -- 28/08/2018- {$if DEFINED (ES_GRAPH_SC)} //29.05.2012 - Правая грань (если стена сама по себе с одной стороны не подключена к другой стене) if Not FPlanObject.FIsConture then //if (aKnotFlag = 0) and (aSideFlag = 1) then begin SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[2]; a3DPointArr[1] := ap[3]; a3DPointArr[2] := ap[6]; a3DPointArr[3] := ap[7]; xSide := T3DSide.Create(ftNetPath, fwtOuter, wstRight, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr, True); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else xSide.CollectWallSide(aFaces, a3DPointArr); // new *** FSides.Add(xSide); Result.Add(xSide); end; {$else} begin if Not FPlanObject.FIsInner then //if (aKnotFlag = 0) and (aSideFlag = 1) then begin SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[2]; a3DPointArr[1] := ap[3]; a3DPointArr[2] := ap[6]; a3DPointArr[3] := ap[7]; xSide := T3DSide.Create(ftNetPath, fwtOuter, wstRight, self, FPlanObject); // new *** if FIsArc then begin a3DPointArrArc := GetArcWallPoints(a3DPointArr, True); xSide.CollectArcWallSide(aFaces, a3DPointArrArc); end else xSide.CollectWallSide(aFaces, a3DPointArr); // new *** if CheckSideInWall(xSide) then begin xSide.Free; aFaces.Delete(aFaces.Count - 1); end else begin FSides.Add(xSide); Result.Add(xSide); end; end; end; {$ifEnd} // правая боковая грань if (aSideFlag = 2) or (aSideFlag = 12) then begin a3DPointArr[0] := ap[1]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[3]; a3DPointArr[3] := ap[7]; xSide := T3DSide.Create(ftNetPath, fwtOuter, wstRightSide, self, FPlanObject); xSide.CollectWallSide(aFaces, a3DPointArr); if CheckSideInWall(xSide) then begin xSide.Free; aFaces.Delete(aFaces.Count - 1); end else begin FSides.Add(xSide); Result.Add(xSide); end; end; except on E: Exception do AddExceptionToLogEx('T3DWall.CollectOuterWall', E.Message); end; end; constructor T3DWall.Create(aFaces: TList; aNetPath: TNetPath; aParent: T3DRoom); begin try inherited Create; FClassName := 'T3DWall'; FPlanObject := aNetPath; FVPath := nil; if aNetPath <> nil then begin FIsArc := FPlanObject.isArc; {$if Defined(ES_GRAPH_SC)} // Tolik 15/06/2018 -- отвязать от компонента, если не графмодуль FSCSCompon := GetArchObjByCADObj(aNetPath); FSCSComponID := FSCSCompon.ID; FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark; {$ELSE} FName := _3DWallName; {$ifend} end; FWallElements := TList.Create; FSides := TList.Create; FParent := aParent; if aFaces <> nil then if Not GArch3DInnerSidesFromVirtual or Not Assigned(FGroupNet) then if Not IfFiguraIsRoof(aNetPath) then //Tolik --17/07/2018 -- begin // ParseWallForInner(aFaces, nil); {$if Defined(ES_GRAPH_SC)} ParseWallForInner(aFaces, nil); {$Else} //ParseWallForInner(aFaces, aNetPath); {$IfEnd} end; // FFaceType := ftLine; FGLObject := nil; FZOrder := 0; except on E: Exception do AddExceptionToLogEx('T3DWall.Create', E.Message); end; end; // Tolik 24/07/2018 -- Destructor T3DWall.Destroy; begin FPlanObject := nil; FreeObjectList(FWallElements); FreeObjectList(FSides); inherited; end; // function GetArcWallPointsAll(aPoints: T3DPointArray; FPlanObject: TNetPath; isWall: boolean = False): T3DPointArray; var Fpoints: T2DPointArray; Radius: Double; a1,a2: Double; Cnt: Integer; i, idx: Integer; p1Join, p2Join, pJoin, PathPt: PDoublePoint; p1, p2: TDoublePoint; FPointsInOrder: Boolean; // Новые точки добавлять в порядке котором пришли, или обратном OldDxfMode: Boolean; ModVal: Integer; PathPoints: TList; PointsJoin: TList; arcPoints: TList; arcLPoints: TList; procedure DefineJoinPoints(aNum: Integer); var i, j: integer; begin p1Join := nil; p2Join := nil; PathPoints.Clear; PathPoints.Add(@p1); PathPoints.Add(@p2); for i := 0 to PointsJoin.Count - 1 do begin PathPt := PathPoints[i]; for j := 0 to arcPoints.Count - 1 do begin if CmpPoints(PDoublePoint(arcPoints[j])^, PathPt^) then begin if Not EQDP(PDoublePoint(arcPoints[j])^, PDoublePoint(arcLPoints[j])^) then begin if aNum = 2 then EmptyProcedure; Pointer(PointsJoin[i]^) := arcLPoints[j]; Break; //// BREAK //// end; end else if CmpPoints(PDoublePoint(arcLPoints[j])^, PathPt^) then begin if Not EQDP(PDoublePoint(arcLPoints[j])^, PDoublePoint(arcPoints[j])^) then begin // Иногда нужно видеть доп кусок внешней грани Pointer(PointsJoin[i]^) := arcPoints[i]; Break; //// BREAK //// //EmptyProcedure; end; end; end; end; end; procedure AddPointToArray(APoint: TDoublePoint; var AArray: T3DPointArray); begin SetLength(AArray, Length(AArray)+1); AArray[Length(AArray)-1] := APoint; end; procedure AddFirstPointToArray(APoint: TDoublePoint; aPtJoin: PDoublePoint; var AArray: T3DPointArray); begin if aPtJoin <> nil then AddPointToArray(DoublePoint(aPtJoin^.x, aPtJoin^.y, APoint.z), AArray); AddPointToArray(APoint, AArray); end; procedure AddLastPointToArray(APoint: TDoublePoint; aPtJoin: PDoublePoint; var AArray: T3DPointArray); begin AddPointToArray(APoint, AArray); if aPtJoin <> nil then AddPointToArray(DoublePoint(aPtJoin^.x, aPtJoin^.y, APoint.z), AArray); end; function IsPointsInOrder(aFirstPt: PDoublePoint): Boolean; begin Result := GetLineLength(aFirstPt^, DoublePoint(FPoints[0].x, FPoints[0].y)) < GetLineLength(aFirstPt^, DoublePoint(FPoints[cnt-1].x, FPoints[cnt-1].y)); end; begin try SetLength(Result, 0); // 1-st ARC p1 := aPoints[0]; p2 := aPoints[1]; PathPoints := Tlist.Create; PointsJoin := TList.Create; PointsJoin.Add(@p1Join); PointsJoin.Add(@p2Join); arcPoints := TList.Create; arcLPoints := TList.Create; FPlanObject.FillArcJoinPoints(arcPoints, arcLPoints); ModVal := 5; //10; DefineJoinPoints(1); //12.06.2012 Radius := GetLineLenght(p1, FPlanObject.ArcCenter); a1 := GetRadOfLine(FPlanObject.ArcCenter, p1); a2 := GetRadOfLine(FPlanObject.ArcCenter, p2); if Not FPlanObject.Inverted then ExchangeDouble(a1, a2); OldDxfMode := DxfMode; // повышаем точность - количество точек для дуги DxfMode := True; try BezierArcPoints(FPoints, FPlanObject.ArcCenter.x, FPlanObject.ArcCenter.y, Radius, a1, a2); finally DxfMode := OldDxfMode; end; Cnt := Length(FPoints); AddFirstPointToArray(p1, p1Join, Result); if Cnt > 2 then begin //15.06.2012 FPointsInOrder := EQDP(p1, DoublePoint(FPoints[0].x, FPoints[0].y)); FPointsInOrder := IsPointsInOrder(@p1); for i := 1 to cnt - 2 do begin if FPointsInOrder then idx := i else idx := cnt - i - 1; if (i mod ModVal) = 0 then AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p1.z), Result); end; end; AddLastPointToArray(p2, p2Join, Result); if length(aPoints) > 3 then begin // 2-nd ARC p1 := aPoints[2]; p2 := aPoints[3]; DefineJoinPoints(2); //12.06.2012 Radius := GetLineLenght(p1, FPlanObject.ArcCenter); a1 := GetRadOfLine(FPlanObject.ArcCenter, p1); a2 := GetRadOfLine(FPlanObject.ArcCenter, p2); if Not FPlanObject.Inverted then ExchangeDouble(a1, a2); OldDxfMode := DxfMode; // повышаем точность - количество точек для дуги DxfMode := True; try BezierArcPoints(FPoints, FPlanObject.ArcCenter.x, FPlanObject.ArcCenter.y, Radius, a1, a2); finally DxfMode := OldDxfMode; end; Cnt := Length(FPoints); if isWall then begin AddFirstPointToArray(p1, p1Join, Result); if Cnt > 2 then begin //15.06.2012 FPointsInOrder := EQDP(p1, DoublePoint(FPoints[0].x, FPoints[0].y)); FPointsInOrder := IsPointsInOrder(@p1); for i := 1 to cnt - 2 do begin if FPointsInOrder then idx := i else idx := cnt - i - 1; if (i mod ModVal) = 0 then AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p2.z), Result); end; end; AddLastPointToArray(p2, p2Join, Result); end else begin AddFirstPointToArray(p2, p2Join, Result); if Cnt > 2 then begin //15.06.2012 FPointsInOrder := EQDP(p2, DoublePoint(FPoints[0].x, FPoints[0].y)); FPointsInOrder := IsPointsInOrder(@p2); for i := 1 to cnt - 2 do begin if FPointsInOrder then idx := i else idx := cnt - i - 1; if (i mod ModVal) = 0 then AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y, p2.z), Result); end; end; AddLastPointToArray(p1, p1Join, Result); end; end; PathPoints.Free; PointsJoin.Free; arcPoints.Free; arcLPoints.Free; except on E: Exception do AddExceptionToLogEx('T3DWall.GetArcWallPoints', E.Message); end; end; function T3DWall.GetArcWallPoints(aPoints: T3DPointArray; isWall: boolean = False): T3DPointArray; begin if FVPath = nil then Result := GetArcWallPointsAll(aPoints, FPlanObject, isWall) else Result := GetArcWallPointsAll(aPoints, FVPath, isWall); end; function T3DWall.GetFullDoors: TList; var i, j: integer; CAD: TF_CAD; CADWallChilds: TList; WallChild: TNetDoor; WallConture: TDoublePointArr; xl1, xr1, da1, da2, db1, db2: TDoublePoint; xlen, ylen, len1, len2: double; Inserted: Boolean; begin try Result := TList.Create; for i := 0 to FPlanObject.Doors.Count - 1 do Result.Add(FPlanObject.Doors[i]); // искать со смежных стен общие обьекты CAD := TF_CAD(TPowerCad(FPlanObject.Net.Owner).Owner); CADWallChilds := GetAllWallChildsFromCAD(CAD, []); if CADWallChilds.Count > 0 then begin FPlanObject.DefineDoorsOwner; WallConture := FPlanObject.GetConturePolygon; // Перебираем все объекты и смотрим попадают ли они в стену по координатам for i := 0 to CADWallChilds.Count - 1 do begin WallChild := TNetDoor(CADWallChilds[i]); if WallChild.FPath <> FPlanObject then begin if IsPtInPolygon(WallChild.p1, WallConture) and IsPtInPolygon(WallChild.p2, WallConture) then begin len1 := GetLineLenght(FPlanObject.l1, WallChild.a1); len2 := GetLineLenght(FPlanObject.l1, WallChild.a2); ylen := Min(len1, len2); Inserted := False; for j := 0 to Result.Count - 1 do begin len1 := GetLineLenght(FPlanObject.l1, TNetDoor(Result[j]).a1); len2 := GetLineLenght(FPlanObject.l1, TNetDoor(Result[j]).a2); xlen := Min(len1, len2); if ylen < xlen then begin Result.Insert(j, WallChild); Inserted := True; break; end; end; if not Inserted then Result.Add(WallChild); end; end; end; end; except on E: Exception do AddExceptionToLogEx('T3DWall.GetFullDoors', E.Message); end; end; function T3DWall.GetKnotsCount(aNetPath: TNetPath; p: TDoublePoint): Byte; var i, j, xCount: integer; xNets: TList; xNet: TNet; xNetPath: TNetPath; begin try Result := 0; if FGroupNet <> nil then begin xNet := FGroupNet; for j := 0 to xNet.Paths.Count - 1 do begin xNetPath := TNetPath(xNet.Paths[j]); if xNetPath <> aNetPath then begin if EQDP(xNetPath.p1^, p) or EQDP(xNetPath.p2^, p) then Result := Result + 1; end; end; end; { xNets := GetAllNets(GCadForm); for i := 0 to xNets.Count - 1 do begin xNet := TNet(xNets[i]); for j := 0 to xNet.Paths.Count - 1 do begin xNetPath := TNetPath(xNet.Paths[j]); if xNetPath <> aNetPath then begin if EQDP(xNetPath.p1^, p) or EQDP(xNetPath.p2^, p) then Result := Result + 1; end; end; end; } except on E: Exception do AddExceptionToLogEx('T3DWall.GetKnotsCount', E.Message); end; end; procedure T3DWall.ParseWallForInner(aFaces: TList; aVNetPath: TNetPath); var aDoor, PrevDoor: TNetDoor; i, j, k: integer; WallComponID: Integer; l1, l2, r1, r2: TDoublePoint; DoorSCSCompon, PrevDoorSCSCompon, BalconDoor, BalconWnd, InnerSlope, OuterSlope: TSCSComponent; wall_h1, wall_h2, door_h1, door_h2, wnd_h1, wnd_h2, w, door_w, wnd_w, corner_side1, corner_side2: double; Points, Points1, Points2: T3DPointArray; oxl1, oxr1, oxl2, oxr2, xl1, xr1, xl2, xr2, da1, da2, db1, db2: TDoublePoint; ba1, ba2, ba3, bb1, bb2, bb3: TDoublePoint; ca1, ca2, cb1, cb2: TDoublePoint; AllDoors, WallSides: TList; len1, len2: double; hor_a1, hor_a2, hor_b1, hor_b2, ver_a, ver_b, depth, depth_a, depth_b: double; WallType: TFaceWallType; WallViewType: TWallViewType; xWallElement, xPrevWallElement: T3DWallElement; xSlope: T3DSlope; xSide: T3DSide; Corners: TSCSComponents; lenminb: Double; lenmina: Double; NetPath: TNetPath; TmpPath: TNetPath; IsConture: Boolean; { function checkisCrossPoint: Boolean; begin Result := not ((((CompareValue(FPlanObject.p1.x, aVNetPath.p1.x) = 0) and (CompareValue(FPlanObject.p1.y, aVNetPath.p1.y) = 0)) and ((CompareValue(FPlanObject.p2.x, aVNetPath.p2.x) = 0) and (CompareValue(FPlanObject.p2.y, aVNetPath.p2.y) = 0))) or (((CompareValue(FPlanObject.p1.x, aVNetPath.p2.x) = 0) and (CompareValue(FPlanObject.p1.y, aVNetPath.p2.y) = 0)) and ((CompareValue(FPlanObject.p2.x, aVNetPath.p1.x) = 0) and (CompareValue(FPlanObject.p2.y, aVNetPath.p1.y) = 0)))); if Result then Result := (((CompareValue(FPlanObject.p1.x, aVNetPath.p1.x) = 0) and (CompareValue(FPlanObject.p1.y, aVNetPath.p1.y) = 0)) or ((CompareValue(FPlanObject.p1.x, aVNetPath.p2.x) = 0) and (CompareValue(FPlanObject.p1.y, aVNetPath.p2.y) = 0)) or ((CompareValue(FPlanObject.p2.x, aVNetPath.p1.x) = 0) and (CompareValue(FPlanObject.p2.y, aVNetPath.p1.y) = 0)) or ((CompareValue(FPlanObject.p2.x, aVNetPath.p2.x) = 0) and (CompareValue(FPlanObject.p2.y, aVNetPath.p2.y) = 0))); end; } begin try { //Tolik 23/12/2021 -- исключаем сас с собой и те, что не касаются if FPlanObject.id = aVNetPath.Id then exit; if not checkisCrossPoint then exit; // } //if Not FPlanObject.FIsConture then // Exit; ///// EXIT ///// //06.06.2012 NetPath := FPlanObject; IsConture := FPlanObject.FIsConture; //06.06.2012 Ишем виртуальный сегмент по FPlanObject xSlope := Nil; //Tolik 17/07/2018 -- if GArch3DInnerSidesFromVirtual then begin if aVNetPath = nil then begin TmpPath := FindVirtualNetPathByReal(FGroupNet, FPlanObject); if TmpPath <> nil then begin NetPath := TmpPath; FVPath := TmpPath; end; end else begin NetPath := aVNetPath; FVPath := aVNetPath; end; if NetPath = FPlanObject then EmptyProcedure; end; {//02.07.2012 WallComponID := FSCSComponID; wall_h1 := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; wall_h2 := wall_h1 + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; Corners := GetArchCornersForWall(FSCSCompon); corner_side1 := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if corner_side1 = 0 then corner_side1 := wall_h2; corner_side2 := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if corner_side2 = 0 then corner_side2 := wall_h2;{} {$if Defined(ES_GRAPH_SC)} // Tolik 22/08/2018 -- WallComponID := FSCSComponID; wall_h1 := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; wall_h2 := wall_h1 + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if NetPath = FPlanObject then begin Corners := GetArchCornersForWall(FSCSCompon); corner_side1 := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; corner_side2 := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; end else begin corner_side1 := NetPath.p1H * FScaleDelta; corner_side2 := NetPath.p2H * FScaleDelta; end; if corner_side1 = 0 then corner_side1 := wall_h2; if corner_side2 = 0 then corner_side2 := wall_h2; {} SetLength(Points, 8); WallSides := nil; if GArch3DInnerSidesFromVirtual and (NetPath <> FPlanObject) then begin AllDoors := TList.Create; AllDoors.Assign(NetPath.Doors); end else begin // все двери с учетом смежных AllDoors := GetFullDoors; end; // если внутри есть двери, окна ... (алгоритм построения №1) if AllDoors.Count > 0 then begin // l - внешние // r - внутренние // a - внешние // b - внутренние //if Not GArch3DInnerSidesFromVirtual then //18.06.2012 begin //определить какая действительно внутренняя!!! if PtInPolygon(FParent.FNetConture, NetPath.l1) then begin xl1 := NetPath.r1; xr1 := NetPath.l1; xl2 := NetPath.r2; xr2 := NetPath.l2; oxl1 := NetPath.r1; oxr1 := NetPath.l1; oxl2 := NetPath.r2; oxr2 := NetPath.l2; end else begin if PtInPolygon(FParent.FNetConture, NetPath.r1) then begin xl1 := NetPath.l1; xr1 := NetPath.r1; xl2 := NetPath.l2; xr2 := NetPath.r2; oxl1 := NetPath.l1; oxr1 := NetPath.r1; oxl2 := NetPath.l2; oxr2 := NetPath.r2; end else begin xl1 := NetPath.r1; xr1 := NetPath.l1; xl2 := NetPath.r2; xr2 := NetPath.l2; oxl1 := NetPath.r1; oxr1 := NetPath.l1; oxl2 := NetPath.r2; oxr2 := NetPath.l2; end end; end; //else //begin // xl1 := NetPath.op1^; // xr1 := NetPath.ip1^; // xl2 := NetPath.op2^; // xr2 := NetPath.ip2^; // oxl1 := NetPath.op1^; // oxr1 := NetPath.ip1^; // oxl2 := NetPath.op2^; // oxr2 := NetPath.ip2^; //end; //13.06.2012 //xl1 := NetPath.ip1^; //xr1 := NetPath.op1^; //xl2 := NetPath.ip2^; //xr2 := NetPath.op2^; //oxl1 := NetPath.ip1^; //oxr1 := NetPath.op1^; //oxl2 := NetPath.ip2^; //oxr2 := NetPath.op2^; PrevDoor := nil; PrevDoorSCSCompon := nil; xPrevWallElement := nil; for j := 0 to AllDoors.Count - 1 do begin aDoor := TNetDoor(AllDoors[j]); xWallElement := T3DWallElement.Create(aFaces, aDoor, aDoor.DoorObjType, Self); FWallElements.Add(xWallElement); DoorSCSCompon := GetArchObjByCADObj(aDoor); //if Not GArch3DInnerSidesFromVirtual then //18.06.2012 begin // определить часть стены, от начала до след. обьекта if PtInPolygon(FParent.FNetConture, aDoor.b1) then begin len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.a2); if len1 < len2 then begin da1 := aDoor.a1; da2 := aDoor.a2; db1 := aDoor.b1; db2 := aDoor.b2; ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2; end else begin da1 := aDoor.a2; da2 := aDoor.a1; db1 := aDoor.b2; db2 := aDoor.b1; ca1 := aDoor.ca2; ca2 := aDoor.ca1; cb1 := aDoor.cb2; cb2 := aDoor.cb1; end; end else begin len1 := GetLineLenght(xl1, aDoor.b1); len2 := GetLineLenght(xl1, aDoor.b2); if len1 < len2 then begin da1 := aDoor.b1; da2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; ca1 := aDoor.cb1; ca2 := aDoor.cb2; cb1 := aDoor.ca1; cb2 := aDoor.ca2; end else begin da1 := aDoor.b2; da2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; ca1 := aDoor.cb2; ca2 := aDoor.cb1; cb1 := aDoor.ca2; cb2 := aDoor.ca1; end; end; end; //else //begin // da1 := aDoor.a1; // da2 := aDoor.a2; // db1 := aDoor.b1; // db2 := aDoor.b2; // // ca1 := aDoor.ca1; // ca2 := aDoor.ca2; // cb1 := aDoor.cb1; // cb2 := aDoor.cb2; //end; { len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.a2); lenmina := min(len1, len2); lenminb := min(GetLineLenght(xl1, aDoor.b1), GetLineLenght(xl1, aDoor.b2)); if lenmina > lenminb then begin len1 := GetLineLenght(xl1, aDoor.b1); len2 := GetLineLenght(xl1, aDoor.b2); if len1 < len2 then begin da1 := aDoor.b1; da2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2; end else begin da1 := aDoor.b2; da2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; ca1 := aDoor.ca2; ca2 := aDoor.ca1; cb1 := aDoor.cb2; cb2 := aDoor.cb1; end; end else begin if len1 < len2 then begin // half work //da1 := aDoor.a1; //da2 := aDoor.a2; //db1 := aDoor.b1; //db2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; da1 := aDoor.b1; da2 := aDoor.b2; ca1 := aDoor.cb1; ca2 := aDoor.cb2; cb1 := aDoor.ca1; cb2 := aDoor.ca2; end else begin // half work //da1 := aDoor.a2; //da2 := aDoor.a1; //db1 := aDoor.b2; //db2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; da1 := aDoor.b2; da2 := aDoor.b1; ca1 := aDoor.cb2; ca2 := aDoor.cb1; cb1 := aDoor.ca2; cb2 := aDoor.ca1; end; end; //ca1 := aDoor.ca1; //ca2 := aDoor.ca2; //cb1 := aDoor.cb1; //cb2 := aDoor.cb2; } // скорректировать точки стены с учетом откосов hor_a1 := 0; hor_b1 := 0; hor_a2 := 0; hor_b2 := 0; WallViewType := [wvtNoLeftSide, wvtNoRightSide]; WallType := GetWallTypeByDoorType(aDoor); if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then begin InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Внутренний откос // Окно if WallType = fwtWindowSlope then begin OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Внешний откос // есть окно и не смежная стена, то брать внешние откосы if (OuterSlope <> nil) then begin hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a2 := hor_a1; ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_a := 0; depth_a := 0; end; if InnerSlope <> nil then begin hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_b2 := hor_b1; ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_b := 0; depth_b := 0; end; end else // Дверь if WallType = fwtDoorSlope then begin if InnerSlope <> nil then begin hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a2 := hor_a1; hor_b1 := hor_a1; hor_b2 := hor_a1; ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; ver_b := ver_a; depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_a := 0; ver_b := 0; depth_a := 0; depth_b := 0; end; end else // Балкон if WallType = fwtBalconSlope then begin if InnerSlope <> nil then begin BalconDoor := GetChildComponByIsLine(DoorSCSCompon, ctArhDoor); // Дверь балкона hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a2 := hor_a1; hor_b1 := hor_a1; hor_b2 := hor_a1; ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - BalconDoor.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; ver_b := ver_a; depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_a := 0; ver_b := 0; depth_a := 0; depth_b := 0; end; end; end; GetWallPointsWithSlope(da1, da2, db1, db2, hor_a1, hor_a2, hor_b1, hor_b2); //if PtInPolygon(FParent.FNetConture, FPlanObject.l1) then //begin // len1 := depth_a; // depth_a := depth_b; // depth_b := len1; //end; GetDoorPointsWithSlope(ca1, da1, depth_a); GetDoorPointsWithSlope(ca2, da2, depth_a); GetDoorPointsWithSlope(cb1, db1, depth_b); GetDoorPointsWithSlope(cb2, db2, depth_b); Points[0] := xl1; Points[0].z := wall_h1; Points[1] := da1; Points[1].z := wall_h1; Points[2] := xr1; Points[2].z := wall_h1; Points[3] := db1; Points[3].z := wall_h1; if IsConture then //13.06.2012 begin // первый блок - взять высоту с модпоинта if j = 0 then begin Points[4] := xl1; Points[4].z := corner_side1; Points[5] := da1; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[6] := xr1; Points[6].z := corner_side1; Points[7] := db1; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); end else begin Points[4] := xl1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, xl1, corner_side1, corner_side2); Points[5] := da1; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[6] := xr1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, xr1, corner_side1, corner_side2); Points[7] := db1; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); end; WallViewType := WallViewType + [wvtNoUpper, wvtNoUnder]; WallSides := CollectInnerWall(aFaces, Points, WallViewType); // поставить тип стены по предыдущему обьекту TNetDoor if (j > 0) and (PrevDoor <> nil) then begin WallType := GetWallTypeByDoorType(PrevDoor); if WallType in [fwtNiche, fwtArc] then SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement); end; // поставить тип стены по следующему обьекту TNetDoor WallType := GetWallTypeByDoorType(aDoor); if WallType in [fwtNiche, fwtArc] then SetWallTypeToWallSide(WallSides, wstRightSide, WallType, xWallElement); end; //if PtInPolygon(FParent.FNetConture, da2) then //begin // xl1 := db2; // xr1 := da2; //end //else begin //xl1 := da2; //xr1 := db2; xl1 := da2; xr1 := db2; end; // Обьект - Дверь if aDoor.DoorObjType = dotDoor then begin door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth); // построить дверь Points[0] := ca1; Points[0].z := door_h1; Points[1] := ca2; Points[1].z := door_h1; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h1; Points[4] := ca1; Points[4].z := door_h2; Points[5] := ca2; Points[5].z := door_h2; Points[6] := cb1; Points[6].z := door_h2; Points[7] := cb2; Points[7].z := door_h2; xWallElement.CollectDoor(aFaces, Points); if IsConture then //13.06.2012 begin // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); SetWallTypeToWallSide(WallSides, wstUpper, fwtDoorSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2); WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); end; // построить откосы для двери if InnerSlope <> nil then begin xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement); xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope); xSlope.FSCSComponID := xSlope.FSCSCompon.ID; xSlope.FName := xSlope.FSCSCompon.Name; xWallElement.FSlopes.Add(xSlope); // внешние Points[0] := da1; Points[0].z := door_h1; Points[1] := da1; Points[1].z := door_h2 + ver_a; Points[2] := ca1; Points[2].z := door_h1; Points[3] := ca1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := da2; Points[0].z := door_h1; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := ca2; Points[2].z := door_h1; Points[3] := ca2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := ca1; Points[0].z := door_h2; Points[1] := ca2; Points[1].z := door_h2; Points[2] := da1; Points[2].z := door_h2 + ver_a; Points[3] := da2; Points[3].z := door_h2 + ver_a; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; if OuterSlope <> nil then begin // внутренние Points[0] := db1; Points[0].z := door_h1; Points[1] := db1; Points[1].z := door_h2 + ver_b; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := db2; Points[0].z := door_h1; Points[1] := db2; Points[1].z := door_h2 + ver_b; Points[2] := cb2; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := cb1; Points[0].z := door_h2; Points[1] := cb2; Points[1].z := door_h2; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; end; // Обьект - Окно if aDoor.DoorObjType = dotWindow then begin door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth); // построить окно Points[0] := ca1; Points[0].z := door_h1; Points[1] := ca2; Points[1].z := door_h1; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h1; Points[4] := ca1; Points[4].z := door_h2; Points[5] := ca2; Points[5].z := door_h2; Points[6] := cb1; Points[6].z := door_h2; Points[7] := cb2; Points[7].z := door_h2; xWallElement.CollectWindow(aFaces, Points); if IsConture then //13.06.2012 begin // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); SetWallTypeToWallSide(WallSides, wstUpper, fwtWindowSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2); WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); end; // построить откосы для окна // внутренние {TODO} // для внешних сделать аналогично и для всех остальных объектов!!! if InnerSlope <> nil then begin xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement); xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope); xSlope.FSCSComponID := xSlope.FSCSCompon.ID; xSlope.FName := xSlope.FSCSCompon.Name; xWallElement.FSlopes.Add(xSlope); Points[0] := db1; Points[0].z := door_h1; Points[1] := db1; Points[1].z := door_h2 + ver_b; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := db2; Points[0].z := door_h1; Points[1] := db2; Points[1].z := door_h2 + ver_b; Points[2] := cb2; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := cb1; Points[0].z := door_h2; Points[1] := cb2; Points[1].z := door_h2; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; // внешние if OuterSlope <> nil then begin xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement); xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhOuterSlope); xSlope.FSCSComponID := xSlope.FSCSCompon.ID; xSlope.FName := xSlope.FSCSCompon.Name; xWallElement.FSlopes.Add(xSlope); // end; Points[0] := da1; Points[0].z := door_h1; Points[1] := da1; Points[1].z := door_h2 + ver_a; Points[2] := ca1; Points[2].z := door_h1; Points[3] := ca1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := da2; Points[0].z := door_h1; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := ca2; Points[2].z := door_h1; Points[3] := ca2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := ca1; Points[0].z := door_h2; Points[1] := ca2; Points[1].z := door_h2; Points[2] := da1; Points[2].z := door_h2 + ver_a; Points[3] := da2; Points[3].z := door_h2 + ver_a; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; end; // Обьект - Балкон if aDoor.DoorObjType = dotBalcony then begin BalconDoor := GetChildComponByIsLine(DoorSCSCompon, ctArhDoor); // Дверь балкона BalconWnd := GetChildComponByIsLine(DoorSCSCompon, ctArhWindow); // Окно балкона door_h1 := BalconDoor.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; door_h2 := door_h1 + BalconDoor.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; door_w := BalconDoor.GetPropertyValueAsFloat(pnWidth) * FScaleDelta; wnd_h1 := door_h2 - BalconWnd.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if wnd_h1 < FStartDoorObject then wnd_h1 := FStartDoorObject; wnd_h2 := door_h2; wnd_w := BalconWnd.GetPropertyValueAsFloat(pnWidth) * FScaleDelta; // вычислить точки для двери и окна ba1 := ca1; ba3 := ca2; bb1 := cb1; bb3 := cb2; //GetParallelPoints(ba1, bb1, ba2, bb2, -door_w); if PtInPolygon(FParent.FNetConture, NetPath.l1) then GetParallelPoints(ba1, bb1, ba2, bb2, door_w) else GetParallelPoints(ba1, bb1, ba2, bb2, -door_w); Setlength(Points1, 8); Setlength(Points2, 8); // для балконной двери Points1[0] := ba1; Points1[0].z := door_h1; Points1[1] := ba2; Points1[1].z := door_h1; Points1[2] := bb1; Points1[2].z := door_h1; Points1[3] := bb2; Points1[3].z := door_h1; Points1[4] := ba1; Points1[4].z := door_h2; Points1[5] := ba2; Points1[5].z := door_h2; Points1[6] := bb1; Points1[6].z := door_h2; Points1[7] := bb2; Points1[7].z := door_h2; // для балконного окна Points2[0] := ba2; Points2[0].z := wnd_h1; Points2[1] := ba3; Points2[1].z := wnd_h1; Points2[2] := bb2; Points2[2].z := wnd_h1; Points2[3] := bb3; Points2[3].z := wnd_h1; Points2[4] := ba2; Points2[4].z := wnd_h2; Points2[5] := ba3; Points2[5].z := wnd_h2; Points2[6] := bb2; Points2[6].z := wnd_h2; Points2[7] := bb3; Points2[7].z := wnd_h2; xWallElement.CollectBalcon(aFaces, Points1, Points2); if IsConture then //13.06.2012 begin // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); SetWallTypeToWallSide(WallSides, wstUpper, fwtBalconSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2); WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); end; // достроить блок стены в проем ba1 := da1; ba3 := da2; bb1 := db1; bb3 := db2; //GetParallelPoints(ba1, bb1, ba2, bb2, -door_w); if PtInPolygon(FParent.FNetConture, FPlanObject.l1) then GetParallelPoints(ba1, bb1, ba2, bb2, door_w) else GetParallelPoints(ba1, bb1, ba2, bb2, -door_w); Points[0] := ba2; Points[0].z := door_h1; Points[1] := ba3; Points[1].z := door_h1; Points[2] := bb2; Points[2].z := door_h1; Points[3] := bb3; Points[3].z := door_h1; Points[4] := ba2; Points[4].z := wnd_h1 - FDoorObjectDelta; Points[5] := ba3; Points[5].z := wnd_h1 - FDoorObjectDelta; Points[6] := bb2; Points[6].z := wnd_h1 - FDoorObjectDelta; Points[7] := bb3; Points[7].z := wnd_h1 - FDoorObjectDelta; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); if Not IsConture then begin //13.06.2012 - внутренние меняем на внешние for k := 0 to WallSides.Count - 1 do begin xSide := T3DSide(WallSides[k]); if xSide.FWallType = fwtInner then begin xSide.FWallType := fwtOuter; xSide.FFace.FFaceWallType := fwtOuter; end; end; end; SetWallTypeToWallSide(WallSides, wstUpper, fwtBalconSlope, xWallElement); SetWallTypeToWallSide(WallSides, wstLeftSide, fwtBalconSlope, xWallElement); // построить откосы для балкона if InnerSlope <> nil then begin xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement); xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope); xSlope.FSCSComponID := xSlope.FSCSCompon.ID; xSlope.FName := xSlope.FSCSCompon.Name; xWallElement.FSlopes.Add(xSlope); // внешние Points[0] := da1; Points[0].z := door_h1; Points[1] := da1; Points[1].z := door_h2 + ver_a; Points[2] := ca1; Points[2].z := door_h1; Points[3] := ca1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := da2; Points[0].z := wnd_h1; Points[1] := da2; Points[1].z := wnd_h2 + ver_a; Points[2] := ca2; Points[2].z := wnd_h1; Points[3] := ca2; Points[3].z := wnd_h2; xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := ca1; Points[0].z := door_h2; Points[1] := ca2; Points[1].z := door_h2; Points[2] := da1; Points[2].z := door_h2 + ver_a; Points[3] := da2; Points[3].z := door_h2 + ver_a; xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; // внутренние if OuterSlope <> nil then begin Points[0] := db1; Points[0].z := door_h1; Points[1] := db1; Points[1].z := door_h2 + ver_b; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := db2; Points[0].z := wnd_h1; Points[1] := db2; Points[1].z := wnd_h2 + ver_b; Points[2] := cb2; Points[2].z := wnd_h1; Points[3] := cb2; Points[3].z := wnd_h2; xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := cb1; Points[0].z := door_h2; Points[1] := cb2; Points[1].z := door_h2; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; xSide := T3DSide.Create(ftNetPath, fwtBalconSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; end; // Обьект - Арка if aDoor.DoorObjType = dotArc then begin door_h1 := 0; door_h2 := DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth); // построить арку //Points[0] := aDoor.a1; Points[0] := da1; Points[0].z := door_h1; //Points[1] := aDoor.b1; Points[1] := db1; Points[1].z := door_h1; //Points[2] := aDoor.a1; Points[2] := da1; Points[2].z := door_h2; //Points[3] := aDoor.b1; Points[3] := db1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtArc, wstNone, xWallElement, FPlanObject); xSide.CollectWallSide(aFaces, Points); xWallElement.FSides.Add(xSide); //Points[0] := aDoor.a2; Points[0] := da2; Points[0].z := door_h1; //Points[1] := aDoor.b2; Points[1] := db2; Points[1].z := door_h1; //Points[2] := aDoor.a2; Points[2] := da2; Points[2].z := door_h2; //Points[3] := aDoor.b2; Points[3] := db2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtArc, wstNone, xWallElement, FPlanObject); xSide.CollectWallSide(aFaces, Points); xWallElement.FSides.Add(xSide); // построить блок стены сверху if IsConture then begin //Points[0] := aDoor.a1; Points[0] := da1; Points[0].z := door_h2; //Points[1] := aDoor.a2; Points[1] := da2; Points[1].z := door_h2; //Points[2] := aDoor.b1; Points[2] := db1; Points[2].z := door_h2; //Points[3] := aDoor.b2; Points[3] := db2; Points[3].z := door_h2; //Points[4] := aDoor.a1; Points[4] := da1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); //Points[5] := aDoor.a2; Points[5] := da2; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2); //Points[6] := aDoor.b1; Points[6] := db1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); //Points[7] := aDoor.b2; Points[7] := db2; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2); WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoLeftSide, wvtNoRightSide]); SetWallTypeToWallSide(WallSides, wstUnder, fwtArc, xWallElement); end; end; // Обьект - Ниша if aDoor.DoorObjType = dotNiche then begin door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth); depth := DoorSCSCompon.GetPropertyValueAsFloat(pnDepth); // построить нишу Points[0] := aDoor.b1; //Points[0] := db1; Points[0].z := door_h1; Points[1] := aDoor.ca1; //Points[1] := ca1; Points[1].z := door_h1; Points[2] := aDoor.b1; //Points[2] := db1; Points[2].z := door_h2; Points[3] := aDoor.ca1; //Points[3] := ca1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtNiche, wstNone, xWallElement); xSide.CollectWallSide(aFaces, Points); xWallElement.FSides.Add(xSide); Points[0] := aDoor.b2; //Points[0] := db2; Points[0].z := door_h1; Points[1] := aDoor.ca2; //Points[1] := ca2; Points[1].z := door_h1; Points[2] := aDoor.b2; //Points[2] := db2; Points[2].z := door_h2; Points[3] := aDoor.ca2; //Points[3] := ca2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtNiche, wstNone, xWallElement); xSide.CollectWallSide(aFaces, Points); xWallElement.FSides.Add(xSide); Points[0] := aDoor.b1; //Points[0] := db1; Points[0].z := door_h1; Points[1] := aDoor.b2; //Points[1] := db2; Points[1].z := door_h1; Points[2] := aDoor.ca1; //Points[2] := ca1; Points[2].z := door_h1; Points[3] := aDoor.ca2; //Points[3] := ca2; Points[3].z := door_h1; xSide := T3DSide.Create(ftNetPath, fwtNiche, wstNone, xWallElement); xSide.CollectWallSide(aFaces, Points); xWallElement.FSides.Add(xSide); Points[0] := aDoor.b1; //Points[0] := db1; Points[0].z := door_h2; Points[1] := aDoor.b2; //Points[1] := db2; Points[1].z := door_h2; Points[2] := aDoor.ca1; //Points[2] := ca1; Points[2].z := door_h2; Points[3] := aDoor.ca2; //Points[3] := ca2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtNiche, wstNone, xWallElement); xSide.CollectWallSide(aFaces, Points); xWallElement.FSides.Add(xSide); // достроить блок стены от нишы Points[0] := aDoor.a1; //Points[0] := da1; Points[0].z := door_h1; Points[1] := aDoor.a2; //Points[1] := da2; Points[1].z := door_h1; Points[2] := aDoor.ca1; //Points[2] := ca1; Points[2].z := door_h1; Points[3] := aDoor.ca2; //Points[3] := ca2; Points[3].z := door_h1; Points[4] := aDoor.a1; //Points[4] := da1; Points[4].z := door_h2; Points[5] := aDoor.a2; //Points[5] := da2; Points[5].z := door_h2; Points[6] := aDoor.ca1; //Points[6] := ca1; Points[6].z := door_h2; Points[7] := aDoor.ca2; //Points[7] := ca2; Points[7].z := door_h2; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide], True); SetWallTypeToWallSide(WallSides, wstRight, fwtNiche, xWallElement); if IsConture then //13.06.2012 begin // построить блок стены снизу Points[0] := aDoor.a1; //Points[0] := da1; Points[0].z := wall_h1; Points[1] := aDoor.a2; //Points[1] := da2; Points[1].z := wall_h1; Points[2] := aDoor.b1; //Points[2] := db1; Points[2].z := wall_h1; Points[3] := aDoor.b2; //Points[3] := db2; Points[3].z := wall_h1; Points[4] := aDoor.a1; //Points[4] := da1; Points[4].z := door_h1; Points[5] := aDoor.a2; //Points[5] := da2; Points[5].z := door_h1; Points[6] := aDoor.b1; //Points[6] := db1; Points[6].z := door_h1; Points[7] := aDoor.b2; //Points[7] := db2; Points[7].z := door_h1; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); SetWallTypeToWallSide(WallSides, wstUpper, fwtNiche, xWallElement); // построить блок стены сверху Points[0] := aDoor.a1; //Points[0] := da1; Points[0].z := door_h2; Points[1] := aDoor.a2; //Points[1] := da2; Points[1].z := door_h2; Points[2] := aDoor.b1; //Points[2] := db1; Points[2].z := door_h2; Points[3] := aDoor.b2; //Points[3] := db2; Points[3].z := door_h2; Points[4] := aDoor.a1; //Points[4] := da1; {TODO} // глянуть так ли здесь высоты должны определяться!!! //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[5] := aDoor.a2; //Points[5] := da2; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, aDoor.a2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2); Points[6] := aDoor.b1; //Points[6] := db1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); Points[7] := aDoor.b2; //Points[7] := db2; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, aDoor.b2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2); WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); SetWallTypeToWallSide(WallSides, wstUnder, fwtNiche, xWallElement); end; end; PrevDoor := aDoor; PrevDoorSCSCompon := DoorSCSCompon; xPrevWallElement := xWallElement; end; WallViewType := [wvtNoLeftSide, wvtNoRightSide]; WallType := fwtNone; if PrevDoor <> nil then WallType := GetWallTypeByDoorType(PrevDoor); if IsConture then //13.06.2012 begin Points[0] := xl1; Points[0].z := wall_h1; Points[1] := xl2; Points[1].z := wall_h1; Points[2] := xr1; Points[2].z := wall_h1; Points[3] := xr2; Points[3].z := wall_h1; Points[4] := xl1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, xl1, corner_side1, corner_side2); Points[5] := xl2; Points[5].z := corner_side2; Points[6] := xr1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, xr1, corner_side1, corner_side2); Points[7] := xr2; Points[7].z := corner_side2; WallViewType := WallViewType + [wvtNoUpper, wvtNoUnder, wvtNoRightSide]; WallSides := CollectInnerWall(aFaces, Points, WallViewType); // поставить тип стены по следующему обьекту TNetDoor if WallType in [fwtNiche, fwtArc] then SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement); end; end else // если внутри ничего нет (алгоритм построения №2) begin if IsConture then //13.06.2012 begin {//08.06.2012 s Points[0] := NetPath.l1; Points[0].z := wall_h1; Points[1] := NetPath.l2; Points[1].z := wall_h1; Points[2] := NetPath.r1; Points[2].z := wall_h1; Points[3] := NetPath.r2; Points[3].z := wall_h1; Points[4] := NetPath.l1; Points[4].z := corner_side1; Points[5] := NetPath.l2; Points[5].z := corner_side2; Points[6] := NetPath.r1; Points[6].z := corner_side1; Points[7] := NetPath.r2; Points[7].z := corner_side2;} if GArch3DInnerSidesFromVirtual then begin {if NetPath.FIsInner then begin Points[0] := NetPath.op1^; Points[1] := NetPath.op2^; Points[4] := NetPath.op1^; Points[5] := NetPath.op2^; end else begin Points[0] := NetPath.ip1^; Points[1] := NetPath.ip2^; Points[4] := NetPath.ip1^; Points[5] := NetPath.ip2^; end;} Points[0] := NetPath.op1^; Points[1] := NetPath.op2^; Points[4] := NetPath.op1^; Points[5] := NetPath.op2^; Points[2] := NetPath.ip1^; Points[3] := NetPath.ip2^; Points[6] := NetPath.ip1^; Points[7] := NetPath.ip2^; end else begin Points[0] := NetPath.l1; Points[1] := NetPath.l2; Points[2] := NetPath.r1; Points[3] := NetPath.r2; Points[4] := NetPath.l1; Points[5] := NetPath.l2; Points[6] := NetPath.r1; Points[7] := NetPath.r2; end; Points[0].z := wall_h1; Points[1].z := wall_h1; Points[2].z := wall_h1; Points[3].z := wall_h1; Points[4].z := corner_side1; Points[5].z := corner_side2; Points[6].z := corner_side1; Points[7].z := corner_side2; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); end; end; {$else} //Tolik 22/08/2018 -- это для СКС !!! WallComponID := FSCSComponID; wall_h1 := 0; Wall_h2 := 0; corner_side1 := -1; corner_side2 := -1; if NetPath <> nil then begin if ((NetPath.p1H < 0) or (NetPath.p2H < 0)) then //Tolik 25/08/2021 -- FScaleDeltaSCS { Wall_h2 := Get3DWallHeight * FScaleDelta else wall_h2 := Max(NetPath.p1H, NetPath.p2H) * FScaleDelta; if NetPath.p1H >= 0 then corner_side1 := NetPath.p1H * FScaleDelta; if NetPath.p2H >= 0 then corner_side2 := NetPath.p2H * FScaleDelta; end; if Wall_h2 = 0 then wall_h2 := Get3DWallHeight * FScaleDelta; } Wall_h2 := Get3DWallHeight * FScaleDeltaSCS else wall_h2 := Max(NetPath.p1H, NetPath.p2H) * FScaleDeltaSCS; if NetPath.p1H >= 0 then corner_side1 := NetPath.p1H * FScaleDeltaSCS; if NetPath.p2H >= 0 then corner_side2 := NetPath.p2H * FScaleDeltaSCS; end; if Wall_h2 = 0 then wall_h2 := Get3DWallHeight * FScaleDeltaSCS; // if corner_side1 = -1 then corner_side1 := wall_h2; if corner_side2 = -1 then corner_side2 := wall_h2; {corner_side1 := Get3DWallHeight * FScaleDelta; corner_side2 := Get3DWallHeight * FScaleDelta;} SetLength(Points, 8); WallSides := nil; //if GArch3DInnerSidesFromVirtual and (NetPath <> FPlanObject) then //begin AllDoors := TList.Create; AllDoors.Assign(NetPath.Doors); //end //else //begin // все двери с учетом смежных // AllDoors := GetFullDoors; //end; // если внутри есть двери, окна ... (алгоритм построения №1) if AllDoors.Count > 0 then begin // l - внешние // r - внутренние // a - внешние // b - внутренние //if Not GArch3DInnerSidesFromVirtual then //18.06.2012 begin //определить какая действительно внутренняя!!! if PtInPolygon(FParent.FNetConture, NetPath.l1) then begin xl1 := NetPath.r1; xr1 := NetPath.l1; xl2 := NetPath.r2; xr2 := NetPath.l2; oxl1 := NetPath.r1; oxr1 := NetPath.l1; oxl2 := NetPath.r2; oxr2 := NetPath.l2; end else begin if PtInPolygon(FParent.FNetConture, NetPath.r1) then begin xl1 := NetPath.l1; xr1 := NetPath.r1; xl2 := NetPath.l2; xr2 := NetPath.r2; oxl1 := NetPath.l1; oxr1 := NetPath.r1; oxl2 := NetPath.l2; oxr2 := NetPath.r2; end else begin xl1 := NetPath.r1; xr1 := NetPath.l1; xl2 := NetPath.r2; xr2 := NetPath.l2; oxl1 := NetPath.r1; oxr1 := NetPath.l1; oxl2 := NetPath.r2; oxr2 := NetPath.l2; end end; end; PrevDoor := nil; PrevDoorSCSCompon := nil; xPrevWallElement := nil; for j := 0 to AllDoors.Count - 1 do begin aDoor := TNetDoor(AllDoors[j]); xWallElement := T3DWallElement.Create(aFaces, aDoor, aDoor.DoorObjType, Self); FWallElements.Add(xWallElement); //DoorSCSCompon := GetArchObjByCADObj(aDoor); //if Not GArch3DInnerSidesFromVirtual then //18.06.2012 begin // определить часть стены, от начала до след. обьекта if PtInPolygon(FParent.FNetConture, aDoor.b1) then begin len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.a2); if len1 < len2 then begin da1 := aDoor.a1; da2 := aDoor.a2; db1 := aDoor.b1; db2 := aDoor.b2; ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2; end else begin da1 := aDoor.a2; da2 := aDoor.a1; db1 := aDoor.b2; db2 := aDoor.b1; ca1 := aDoor.ca2; ca2 := aDoor.ca1; cb1 := aDoor.cb2; cb2 := aDoor.cb1; end; end else begin len1 := GetLineLenght(xl1, aDoor.b1); len2 := GetLineLenght(xl1, aDoor.b2); if len1 < len2 then begin da1 := aDoor.b1; da2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; ca1 := aDoor.cb1; ca2 := aDoor.cb2; cb1 := aDoor.ca1; cb2 := aDoor.ca2; end else begin da1 := aDoor.b2; da2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; ca1 := aDoor.cb2; ca2 := aDoor.cb1; cb1 := aDoor.ca2; cb2 := aDoor.ca1; end; end; end; // скорректировать точки стены с учетом откосов hor_a1 := 0; hor_b1 := 0; hor_a2 := 0; hor_b2 := 0; WallViewType := [wvtNoLeftSide, wvtNoRightSide]; WallType := GetWallTypeByDoorType(aDoor); if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then begin //InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Внутренний откос InnerSlope := nil; // Окно if WallType = fwtWindowSlope then begin //OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Внешний откос OuterSlope := nil; // есть окно и не смежная стена, то брать внешние откосы if (OuterSlope <> nil) then begin //Tolik 25/08/2021 -- //hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDeltaSCS / 2; // hor_a2 := hor_a1; //Tolik 25/08/2021 -- //ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDeltaSCS; //depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDeltaSCS; // end else begin ver_a := 0; depth_a := 1; end; if InnerSlope <> nil then begin //Tolik 25/08/2021 -- //hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDeltaSCS / 2; // hor_b2 := hor_b1; // //ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDeltaSCS; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; //depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDeltaSCS; // end else begin ver_b := 0; depth_b := 1; end; end else // Дверь if WallType = fwtDoorSlope then begin if InnerSlope <> nil then begin //Tolik 25/08/2021 //hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDeltaSCS / 2; // hor_a2 := hor_a1; hor_b1 := hor_a1; hor_b2 := hor_a1; //ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDeltaSCS; ver_b := ver_a; depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; {depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDeltaSCS; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDeltaSCS;} end else begin ver_a := 0; ver_b := 0; depth_a := 1; depth_b := 1; end; end end; GetWallPointsWithSlope(da1, da2, db1, db2, hor_a1, hor_a2, hor_b1, hor_b2); //if PtInPolygon(FParent.FNetConture, FPlanObject.l1) then //begin // len1 := depth_a; // depth_a := depth_b; // depth_b := len1; //end; GetDoorPointsWithSlope(ca1, da1, depth_a); GetDoorPointsWithSlope(ca2, da2, depth_a); GetDoorPointsWithSlope(cb1, db1, depth_b); GetDoorPointsWithSlope(cb2, db2, depth_b); Points[0] := xl1; Points[0].z := wall_h1; Points[1] := da1; Points[1].z := wall_h1; Points[2] := xr1; Points[2].z := wall_h1; Points[3] := db1; Points[3].z := wall_h1; if IsConture then //13.06.2012 begin // первый блок - взять высоту с модпоинта if j = 0 then begin Points[4] := xl1; Points[4].z := corner_side1; Points[5] := da1; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[6] := xr1; Points[6].z := corner_side1; Points[7] := db1; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); end else begin Points[4] := xl1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, xl1, corner_side1, corner_side2); Points[5] := da1; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[6] := xr1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, xr1, corner_side1, corner_side2); Points[7] := db1; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); end; WallViewType := WallViewType + [wvtNoUpper, wvtNoUnder]; WallSides := CollectInnerWall(aFaces, Points, WallViewType); // поставить тип стены по предыдущему обьекту TNetDoor if (j > 0) and (PrevDoor <> nil) then begin WallType := GetWallTypeByDoorType(PrevDoor); if WallType in [fwtNiche, fwtArc] then SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement); end; // поставить тип стены по следующему обьекту TNetDoor WallType := GetWallTypeByDoorType(aDoor); if WallType in [fwtNiche, fwtArc] then SetWallTypeToWallSide(WallSides, wstRightSide, WallType, xWallElement); end; //if PtInPolygon(FParent.FNetConture, da2) then //begin // xl1 := db2; // xr1 := da2; //end //else begin //xl1 := da2; //xr1 := db2; xl1 := da2; xr1 := db2; end; // Обьект - Дверь if aDoor.DoorObjType = dotDoor then begin //door_h1 := aDoor.WndPlacementHeight * FScaleDelta; door_h1 := aDoor.WndPlacementHeight * FScaleDeltaSCS; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; //door_h2 := door_h1 + aDoor.Height * FScaleDelta; //door_h1 + GetDoorHeightfor3DModel * FScaleDelta; door_h2 := door_h1 + aDoor.Height * FScaleDeltaSCS; //door_h1 + GetDoorHeightfor3DModel * FScaleDelta; w := aDoor.Width * FScaleDelta / 2; //w := aDoor.Width * FScaleDeltaSCS / 2; OuterSlope := Nil; InnerSlope := Nil; // построить дверь Points[0] := ca1; Points[0].z := door_h1; Points[1] := ca2; Points[1].z := door_h1; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h1; Points[4] := ca1; Points[4].z := door_h2; Points[5] := ca2; Points[5].z := door_h2; Points[6] := cb1; Points[6].z := door_h2; Points[7] := cb2; Points[7].z := door_h2; xWallElement.CollectDoor(aFaces, Points); if IsConture then //13.06.2012 begin // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); SetWallTypeToWallSide(WallSides, wstUpper, fwtDoorSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2); WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); end; { // построить откосы для двери if InnerSlope <> nil then begin xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement); xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope); xSlope.FSCSComponID := xSlope.FSCSCompon.ID; xSlope.FName := xSlope.FSCSCompon.Name; xWallElement.FSlopes.Add(xSlope); // внешние Points[0] := da1; Points[0].z := door_h1; Points[1] := da1; Points[1].z := door_h2 + ver_a; Points[2] := ca1; Points[2].z := door_h1; Points[3] := ca1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := da2; Points[0].z := door_h1; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := ca2; Points[2].z := door_h1; Points[3] := ca2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := ca1; Points[0].z := door_h2; Points[1] := ca2; Points[1].z := door_h2; Points[2] := da1; Points[2].z := door_h2 + ver_a; Points[3] := da2; Points[3].z := door_h2 + ver_a; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; if OuterSlope <> nil then begin // внутренние Points[0] := db1; Points[0].z := door_h1; Points[1] := db1; Points[1].z := door_h2 + ver_b; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := db2; Points[0].z := door_h1; Points[1] := db2; Points[1].z := door_h2 + ver_b; Points[2] := cb2; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := cb1; Points[0].z := door_h2; Points[1] := cb2; Points[1].z := door_h2; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; } // построить откосы для двери //if InnerSlope <> nil then begin xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement); xWallElement.FSlopes.Add(xSlope); // внешние Points[0] := da1; Points[0].z := door_h1; Points[1] := da1; Points[1].z := door_h2 + ver_a; Points[2] := ca1; Points[2].z := door_h1; Points[3] := ca1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := da2; Points[0].z := door_h1; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := ca2; Points[2].z := door_h1; Points[3] := ca2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := ca1; Points[0].z := door_h2; Points[1] := ca2; Points[1].z := door_h2; Points[2] := da1; Points[2].z := door_h2 + ver_a; Points[3] := da2; Points[3].z := door_h2 + ver_a; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; //if OuterSlope <> nil then begin // внутренние Points[0] := db1; Points[0].z := door_h1; Points[1] := db1; Points[1].z := door_h2 + ver_b; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := db2; Points[0].z := door_h1; Points[1] := db2; Points[1].z := door_h2 + ver_b; Points[2] := cb2; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := cb1; Points[0].z := door_h2; Points[1] := cb2; Points[1].z := door_h2; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; xSide := T3DSide.Create(ftNetPath, fwtDoorSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; end; // Обьект - Окно if aDoor.DoorObjType = dotWindow then begin //door_h1 := aDoor.WndPlacementHeight * FScaleDelta; //0.7 * FScaleDelta; door_h1 := aDoor.WndPlacementHeight * FScaleDeltaSCS; //0.7 * FScaleDelta;door_h1 := aDoor.WndPlacementHeight * FScaleDelta; //0.7 * FScaleDelta; {if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject;} //door_h2 := door_h1 + aDoor.Height * FScaleDelta;//GetWndHeightFor3DModel * FScaleDelta; door_h2 := door_h1 + aDoor.Height * FScaleDeltaSCS;//GetWndHeightFor3DModel * FScaleDelta; w := aDoor.Width * FScaleDelta / 2; // построить окно Points[0] := ca1; Points[0].z := door_h1; Points[1] := ca2; Points[1].z := door_h1; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h1; Points[4] := ca1; Points[4].z := door_h2; Points[5] := ca2; Points[5].z := door_h2; Points[6] := cb1; Points[6].z := door_h2; Points[7] := cb2; Points[7].z := door_h2; xWallElement.CollectWindow(aFaces, Points); if IsConture then //13.06.2012 begin // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); SetWallTypeToWallSide(WallSides, wstUpper, fwtWindowSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; Points[4].z := CalcPointHeight(oxl1, oxl2, da1, corner_side1, corner_side2); Points[5] := da2; Points[5].z := CalcPointHeight(oxl1, oxl2, da2, corner_side1, corner_side2); Points[6] := db1; Points[6].z := CalcPointHeight(oxr1, oxr2, db1, corner_side1, corner_side2); Points[7] := db2; Points[7].z := CalcPointHeight(oxr1, oxr2, db2, corner_side1, corner_side2); WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); end; // построить откосы для окна // внутренние {TODO} // для внешних сделать аналогично и для всех остальных объектов!!! //if InnerSlope <> nil then begin xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement); //xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhInnerSlope); //xSlope.FSCSComponID := xSlope.FSCSCompon.ID; //xSlope.FName := xSlope.FSCSCompon.Name; xSlope.FSCSCompon := nil; xSlope.FSCSComponID := 0; xSlope.FName := 'xSlope'; xWallElement.FSlopes.Add(xSlope); Points[0] := db1; Points[0].z := door_h1; Points[1] := db1; Points[1].z := door_h2 + ver_b; Points[2] := cb1; Points[2].z := door_h1; Points[3] := cb1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := db2; Points[0].z := door_h1; Points[1] := db2; Points[1].z := door_h2 + ver_b; Points[2] := cb2; Points[2].z := door_h1; Points[3] := cb2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := cb1; Points[0].z := door_h2; Points[1] := cb2; Points[1].z := door_h2; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; // внешние //if OuterSlope <> nil then begin xSlope := T3DSlope.Create(aFaces, aDoor, xWallElement); xSlope.FSCSCompon := nil; xSlope.FSCSComponID := 0; xSlope.FName := 'xSlope'; //xSlope.FSCSCompon := GetChildComponByIsLine(xWallElement.FSCSCompon, ctArhOuterSlope); //xSlope.FSCSComponID := xSlope.FSCSCompon.ID; //xSlope.FName := xSlope.FSCSCompon.Name; xWallElement.FSlopes.Add(xSlope); // end; Points[0] := da1; Points[0].z := door_h1; Points[1] := da1; Points[1].z := door_h2 + ver_a; Points[2] := ca1; Points[2].z := door_h1; Points[3] := ca1; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := da2; Points[0].z := door_h1; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := ca2; Points[2].z := door_h1; Points[3] := ca2; Points[3].z := door_h2; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); Points[0] := ca1; Points[0].z := door_h2; Points[1] := ca2; Points[1].z := door_h2; Points[2] := da1; Points[2].z := door_h2 + ver_a; Points[3] := da2; Points[3].z := door_h2 + ver_a; xSide := T3DSide.Create(ftNetPath, fwtWindowSlope, wstNone, xSlope, FPlanObject); xSide.CollectWallSide(aFaces, Points); xSlope.FSides.Add(xSide); end; end; PrevDoor := aDoor; PrevDoorSCSCompon := DoorSCSCompon; xPrevWallElement := xWallElement; end; WallViewType := [wvtNoLeftSide, wvtNoRightSide]; WallType := fwtNone; if PrevDoor <> nil then WallType := GetWallTypeByDoorType(PrevDoor); if IsConture then //13.06.2012 begin Points[0] := xl1; Points[0].z := wall_h1; Points[1] := xl2; Points[1].z := wall_h1; Points[2] := xr1; Points[2].z := wall_h1; Points[3] := xr2; Points[3].z := wall_h1; Points[4] := xl1; //Points[4].z := CalcPointHeight(FPlanObject.l1, FPlanObject.l2, xl1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oxl1, oxl2, xl1, corner_side1, corner_side2); Points[5] := xl2; Points[5].z := corner_side2; Points[6] := xr1; //Points[6].z := CalcPointHeight(FPlanObject.r1, FPlanObject.r2, xr1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oxr1, oxr2, xr1, corner_side1, corner_side2); Points[7] := xr2; Points[7].z := corner_side2; WallViewType := WallViewType + [wvtNoUpper, wvtNoUnder, wvtNoRightSide]; WallSides := CollectInnerWall(aFaces, Points, WallViewType); // поставить тип стены по следующему обьекту TNetDoor if WallType in [fwtNiche, fwtArc] then SetWallTypeToWallSide(WallSides, wstLeftSide, WallType, xWallElement); end; end else // если внутри ничего нет (алгоритм построения №2) begin if IsConture then //13.06.2012 begin if GArch3DInnerSidesFromVirtual then begin Points[0] := NetPath.op1^; Points[1] := NetPath.op2^; Points[4] := NetPath.op1^; Points[5] := NetPath.op2^; Points[2] := NetPath.ip1^; Points[3] := NetPath.ip2^; Points[6] := NetPath.ip1^; Points[7] := NetPath.ip2^; end else begin Points[0] := NetPath.l1; Points[1] := NetPath.l2; Points[2] := NetPath.r1; Points[3] := NetPath.r2; Points[4] := NetPath.l1; Points[5] := NetPath.l2; Points[6] := NetPath.r1; Points[7] := NetPath.r2; end; Points[0].z := wall_h1; Points[1].z := wall_h1; Points[2].z := wall_h1; Points[3].z := wall_h1; Points[4].z := corner_side1; Points[5].z := corner_side2; Points[6].z := corner_side1; Points[7].z := corner_side2; WallSides := CollectInnerWall(aFaces, Points, [wvtNoUpper, wvtNoUnder, wvtNoLeftSide, wvtNoRightSide]); end; end; {$ifEnd} if WallSides <> nil then FreeAndNil(WallSides); except on E: Exception do AddExceptionToLogEx('T3DWall.ParseWallForInner', E.Message); end; end; procedure T3DWall.ParseWallForOuter(aFaces: TList; aVNetPath: TNetPath); var aDoor, PrevDoor: TNetDoor; i, j, k: integer; WallComponID: Integer; l1, l2, r1, r2, p1, p2: TDoublePoint; DoorSCSCompon, PrevDoorSCSCompon, BalconDoor, BalconWnd, InnerSlope, OuterSlope: TSCSComponent; wall_h1, wall_h2, door_h1, door_h2, wnd_h1, wnd_h2, w, door_w, wnd_w, corner_side1, corner_side2: double; Points, Points1, Points2: T3DPointArray; oip1, oop1, oip2, oop2, xip2, xop2, xl2, xr2, xl1, xr1, da1, da2, db1, db2: TDoublePoint; ba1, ba2, ba3, bb1, bb2, bb3: TDoublePoint; ca1, ca2, cb1, cb2: TDoublePoint; AllDoors, WallSides: TList; len1, len2: double; hor_a1, hor_a2, hor_b1, hor_b2, ver_a, ver_b, depth, depth_a, depth_b: double; WallType: TFaceWallType; WallViewType: TWallViewType; xWallElement, xPrevWallElement: T3DWallElement; xSlope: T3DSlope; xSide: T3DSide; Corners, Corners1: TSCSComponents; knot1, knot2, KnotFlag, SideFlag: byte; p1h, p2h: Double; tmppoint: TDoublePoint; lenminb: Double; lenmina: Double; aVNetPathP1, aVNetPathP2: TDoublePoint; //05.06.2012 NetPath: TNetPath; PathIsNoConture: Boolean; //22.06.2012 - является ли хоть с одной стороны не контуром (разорваным) { function checkisCrossPoint: Boolean; begin Result := not ((((CompareValue(FPlanObject.p1.x, aVNetPath.p1.x) = 0) and (CompareValue(FPlanObject.p1.y, aVNetPath.p1.y) = 0)) and ((CompareValue(FPlanObject.p2.x, aVNetPath.p2.x) = 0) and (CompareValue(FPlanObject.p2.y, aVNetPath.p2.y) = 0))) or (((CompareValue(FPlanObject.p1.x, aVNetPath.p2.x) = 0) and (CompareValue(FPlanObject.p1.y, aVNetPath.p2.y) = 0)) and ((CompareValue(FPlanObject.p2.x, aVNetPath.p1.x) = 0) and (CompareValue(FPlanObject.p2.y, aVNetPath.p1.y) = 0)))); if Result then Result := (((CompareValue(FPlanObject.p1.x, aVNetPath.p1.x) = 0) and (CompareValue(FPlanObject.p1.y, aVNetPath.p1.y) = 0)) or ((CompareValue(FPlanObject.p1.x, aVNetPath.p2.x) = 0) and (CompareValue(FPlanObject.p1.y, aVNetPath.p2.y) = 0)) or ((CompareValue(FPlanObject.p2.x, aVNetPath.p1.x) = 0) and (CompareValue(FPlanObject.p2.y, aVNetPath.p1.y) = 0)) or ((CompareValue(FPlanObject.p2.x, aVNetPath.p2.x) = 0) and (CompareValue(FPlanObject.p2.y, aVNetPath.p2.y) = 0))); end; } begin try //Tolik 23/12/2021 -- исключаем сас с собой и те, что не касаются { if FPlanObject.id = aVNetPath.Id then exit; if not checkisCrossPoint then exit; } // WallComponID := FSCSComponID; NetPath := FPlanObject; if GArch3DInnerSidesFromVirtual then NetPath := aVNetPath; PathIsNoConture := Not NetPath.FIsConture; if GArch3DInnerSidesFromVirtual then begin NetPath := aVNetPath; for i := 0 to aVNetPath.FSrcPaths.Count - 1 do begin if Not TNetPath(aVNetPath.FSrcPaths[i]).FIsConture then begin PathIsNoConture := true; Break; //// BREAK //// end; end; end; xWallElement := nil; aVNetPathP1 := {Mpoint(aVNetPath.er1, aVNetPath.el1); //} aVNetPath.p1^; aVNetPathP2 := {Mpoint(aVNetPath.er2, aVNetPath.el2); //} aVNetPath.p2^; {$if Defined(ES_GRAPH_SC)} wall_h1 := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; wall_h2 := wall_h1 + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; Corners := GetArchCornersForWall(FSCSCompon); // Tolik -- 17/10/2016-- уголков может и не быть .... if Corners.Count > 0 then begin corner_side1 := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if corner_side1 = 0 then corner_side1 := wall_h2; corner_side2 := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if corner_side2 = 0 then corner_side2 := wall_h2; // correct *** p1h := aVNetPath.p1H; p2h := aVNetPath.p2H; corner_side1 := p1h * FScaleDelta; if corner_side1 = 0 then corner_side1 := wall_h2; corner_side2 := p2h * FScaleDelta; if corner_side2 = 0 then corner_side2 := wall_h2; // correct *** SetLength(Points, 12); WallSides := nil; // все двери с учетом смежных AllDoors := aVNetPath.Doors; //GetFullDoors; // если внутри есть двери, окна ... (алгоритм построения №1) if AllDoors.Count > 0 then begin // l - внешние // r - внутренние // a - внешние // b - внутренние // oop oip изначальные оригинальные правильно определенные! // xop xip - в случае необходимости могут внутри цикла еще переопределяться! if {NetPath.FIsConture} Not PathIsNoConture then //if NetPath.FIsConture and Not GArch3DInnerSidesFromVirtual then begin //xl1 := aVNetPath.op1^; //xr1 := aVNetPath.ip1^ if Not (PtInPolygon(FParent.FNetConture, aVNetPath.op1^) {or IsPtInArray(aVNetPath.op1^, @FParent.FNetConture)}) then begin xl1 := aVNetPath.op1^; xr1 := aVNetPath.ip1^; end else begin xl1 := aVNetPath.ip1^; xr1 := aVNetPath.op1^ end; //xl2 := aVNetPath.op2^; //xr2 := aVNetPath.ip2^; if Not (PtInPolygon(FParent.FNetConture, aVNetPath.op2^) {or IsPtInArray(aVNetPath.op2^, @FParent.FNetConture)}) then begin xl2 := aVNetPath.op2^; xr2 := aVNetPath.ip2^; end else begin xl2 := aVNetPath.ip2^; xr2 := aVNetPath.op2^; end; end else begin //xl1 := aVNetPath.ip1^; //xl2 := aVNetPath.ip2^; //xr1 := aVNetPath.op1^; //xr2 := aVNetPath.op2^; // Соответствие точкам, если без дверей, окон, и т.д // 0 xl1 op1 // 1 xop2 op2 // 2 xr1 ip1 // 3 xip2 ip2 // 4 xl1 op1 // 5 xop2 op2 // 6 xr1 ip1 // 7 xip2 ip2 //xl1 := aVNetPath.op1^; //xr1 := aVNetPath.ip1^; // На всякий случай //xl2 := aVNetPath.op2^; //xr2 := aVNetPath.ip2^; //13.06.2012 //xl1 := aVNetPath.ip1^; //xr1 := aVNetPath.op1^; //// На всякий случай //xl2 := aVNetPath.ip2^; //xr2 := aVNetPath.op2^; //13.06.2012 -------------------------------- xl1 := aVNetPath.op1^; xr1 := aVNetPath.ip1^; // На всякий случай xl2 := aVNetPath.op2^; xr2 := aVNetPath.ip2^; end; oop1 := xl1; oop2 := xl2; oip1 := xr1; oip2 := xr2; //if NetPath.FIsConture and Not GArch3DInnerSidesFromVirtual then //if NetPath.FIsConture then if Not PathIsNoConture then begin if PtInPolygon(FParent.FNetConture, xl1) {or IsPtInArray(xl1, @FParent.FNetConture)} then begin if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) {or IsPtInArray(aVNetPath.ip2^, @FParent.FNetConture)} then xop2 := aVNetPath.ip2^ else xop2 := aVNetPath.op2^; end else begin if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) then xop2 := aVNetPath.op2^ else //if PtInPolygon(FParent.FNetConture, aVNetPath.op2^) then //29.06.2012 xop2 := aVNetPath.ip2^; end; if PtInPolygon(FParent.FNetConture, xr1) {or IsPtInArray(xr1, @FParent.FNetConture)} then begin if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) {or IsPtInArray(aVNetPath.ip2^, @FParent.FNetConture)} then xip2 := aVNetPath.ip2^ else //if PtInPolygon(FParent.FNetConture, aVNetPath.op2^) then //29.06.2012 xip2 := aVNetPath.op2^; end else begin if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) then xip2 := aVNetPath.op2^ else xip2 := aVNetPath.ip2^; end; end else begin //13.06.2012 //xip2 := aVNetPath.op2^; //xop2 := aVNetPath.ip2^; ////xip2 := aVNetPath.ip2^; ////xop2 := aVNetPath.op2^; //13.06.2012 xip2 := aVNetPath.ip2^; xop2 := aVNetPath.op2^; end; p1 := aVNetPathP1; //aVNetPath.p1^; p2 := aVNetPathP2; //aVNetPath.p2^; PrevDoor := nil; PrevDoorSCSCompon := nil; xPrevWallElement := nil; for j := 0 to AllDoors.Count - 1 do begin aDoor := TNetDoor(AllDoors[j]); DoorSCSCompon := GetArchObjByCADObj(aDoor); // определить часть стены, от начала до след. обьекта //if Not GArch3DInnerSidesFromVirtual then begin //if NetPath.FIsConture then if Not PathIsNoConture then begin if PtInPolygon(FParent.FNetConture, aDoor.b1) then //if (NetPath.FIsConture or (aDoor.DoorObjType = dotBalcony)) and PtInPolygon(FParent.FNetConture, aDoor.b1) then //if PtInPolygon(FParent.FNetConture, aDoor.b1) then begin len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.a2); if len1 < len2 then begin da1 := aDoor.a1; da2 := aDoor.a2; db1 := aDoor.b1; db2 := aDoor.b2; ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2; end else begin da1 := aDoor.a2; da2 := aDoor.a1; db1 := aDoor.b2; db2 := aDoor.b1; ca1 := aDoor.ca2; ca2 := aDoor.ca1; cb1 := aDoor.cb2; cb2 := aDoor.cb1; end; end else begin len1 := GetLineLenght(xl1, aDoor.b1); len2 := GetLineLenght(xl1, aDoor.b2); if len1 < len2 then begin da1 := aDoor.b1; da2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; ca1 := aDoor.cb1; ca2 := aDoor.cb2; cb1 := aDoor.ca1; cb2 := aDoor.ca2; end else begin da1 := aDoor.b2; da2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; ca1 := aDoor.cb2; ca2 := aDoor.cb1; cb1 := aDoor.ca2; cb2 := aDoor.ca1; end; end; end else begin len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.a2); if len1 < len2 then begin len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.b1); if len1 < len2 then begin da1 := aDoor.a1; da2 := aDoor.a2; db1 := aDoor.b1; db2 := aDoor.b2; ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2; end else // Переворот в поперек begin da1 := aDoor.b1; da2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; ca1 := aDoor.cb1; ca2 := aDoor.cb2; cb1 := aDoor.ca1; cb2 := aDoor.ca2; end; end else // Переворот в доль begin len1 := GetLineLenght(xl1, aDoor.a2); len2 := GetLineLenght(xl1, aDoor.b2); if len1 < len2 then begin da1 := aDoor.a2; da2 := aDoor.a1; db1 := aDoor.b2; db2 := aDoor.b1; ca1 := aDoor.ca2; ca2 := aDoor.ca1; cb1 := aDoor.cb2; cb2 := aDoor.cb1; end else // Переворот в поперек begin da1 := aDoor.b2; da2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; ca1 := aDoor.cb2; ca2 := aDoor.cb1; cb1 := aDoor.ca2; cb2 := aDoor.ca1; end; end; {da1 := aDoor.a1; da2 := aDoor.a2; db1 := aDoor.b1; db2 := aDoor.b2; ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2;} end; end; // else // begin // da1 := aDoor.a1; // da2 := aDoor.a2; // db1 := aDoor.b1; // db2 := aDoor.b2; // // ca1 := aDoor.ca1; // ca2 := aDoor.ca2; // cb1 := aDoor.cb1; // cb2 := aDoor.cb2; // end; (* len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.a2); lenmina := min(len1, len2); lenminb := min(GetLineLenght(xl1, aDoor.b1), GetLineLenght(xl1, aDoor.b2)); if lenmina > lenminb then begin len1 := GetLineLenght(xl1, aDoor.b1); len2 := GetLineLenght(xl1, aDoor.b2); if len1 < len2 then begin da1 := aDoor.b1; da2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; end else begin da1 := aDoor.a2; da2 := aDoor.a1; db1 := aDoor.b2; db2 := aDoor.b1; end; end else begin if len1 < len2 then begin da1 := aDoor.a1; da2 := aDoor.a2; db1 := aDoor.b1; db2 := aDoor.b2; end else begin da1 := aDoor.b2; da2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; end; end; len1 := GetLineLenght(xl1, aDoor.ca1); len2 := GetLineLenght(xl1, aDoor.ca2); lenmina := min(len1, len2); lenminb := min(GetLineLenght(xl1, aDoor.cb1), GetLineLenght(xl1, aDoor.cb2)); //if lenmina > lenminb then //begin // ca1 := aDoor.cb1; // ca2 := aDoor.cb2; // cb1 := aDoor.ca1; // cb2 := aDoor.ca2; //end //else begin ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2; end; //ca1 := aDoor.ca1; //ca2 := aDoor.ca2; //cb1 := aDoor.cb1; //cb2 := aDoor.cb2; *) // скорректировать точки стены с учетом откосов hor_a1 := 0; hor_b1 := 0; hor_a2 := 0; hor_b2 := 0; WallViewType := []; WallType := GetWallTypeByDoorType(aDoor); if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then begin InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Внутренний откос // Окно if WallType = fwtWindowSlope then begin OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Внешний откос // есть окно и не смежная стена, то брать внешние откосы if (OuterSlope <> nil) then begin hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a2 := hor_a1; ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_a := 0; depth_a := 0; end; if InnerSlope <> nil then begin hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_b2 := hor_b1; ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_b := 0; depth_b := 0; end; end else // Дверь if WallType = fwtDoorSlope then begin if InnerSlope <> nil then begin hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a2 := hor_a1; hor_b1 := hor_a1; hor_b2 := hor_a1; ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; ver_b := ver_a; depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_a := 0; ver_b := 0; depth_a := 0; depth_b := 0; end; end else // Балкон if WallType = fwtBalconSlope then begin if InnerSlope <> nil then begin BalconDoor := GetChildComponByIsLine(DoorSCSCompon, ctArhDoor); // Дверь балкона hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a2 := hor_a1; hor_b1 := hor_a1; hor_b2 := hor_a1; ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - BalconDoor.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; ver_b := ver_a; depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_a := 0; ver_b := 0; depth_a := 0; depth_b := 0; end; end; end; GetWallPointsWithSlope(da1, da2, db1, db2, hor_a1, hor_a2, hor_b1, hor_b2); GetDoorPointsWithSlope(ca1, da1, depth_a); GetDoorPointsWithSlope(ca2, da2, depth_a); GetDoorPointsWithSlope(cb1, db1, depth_b); GetDoorPointsWithSlope(cb2, db2, depth_b); Points[0] := xl1; Points[0].z := wall_h1; Points[1] := da1; Points[1].z := wall_h1; Points[2] := xr1; Points[2].z := wall_h1; Points[3] := db1; Points[3].z := wall_h1; // первый блок - взять высоту с модпоинта if j = 0 then begin Points[4] := xl1; Points[4].z := corner_side1; Points[5] := da1; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[6] := xr1; Points[6].z := corner_side1; Points[7] := db1; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); Points[8] := p1; Points[8].z := wall_h1; Points[10] := p1; Points[10].z := corner_side1; if aVNetPath.FIsInner then WallViewType := [wvtNoLeft]; knot1 := GetKnotsCount(aVNetPath, p1); if knot1 >= 2 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 0) else if knot1 >= 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0) else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1); end else begin Points[4] := xl1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, xl1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, xl1, corner_side1, corner_side2); Points[5] := da1; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[6] := xr1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, xr1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, xr1, corner_side1, corner_side2); Points[7] := db1; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoLeft]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); end; xl1 := da2; xr1 := db2; // Обьект - Дверь if aDoor.DoorObjType = dotDoor then begin door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth); // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; if aVNetPath.FIsInner then WallViewType := [wvtNoUpper, wvtNoLeft] else WallViewType := [wvtNoUpper]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstUpper, fwtDoorSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoUnder, wvtNoLeft] else WallViewType := [wvtNoUnder]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); end; // Обьект - Окно if aDoor.DoorObjType = dotWindow then begin door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth); // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; if aVNetPath.FIsInner then WallViewType := [wvtNoUpper, wvtNoLeft] else WallViewType := [wvtNoUpper]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstUpper, fwtWindowSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoUnder, wvtNoLeft] else WallViewType := [wvtNoUnder]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); end; // Обьект - Балкон if aDoor.DoorObjType = dotBalcony then begin BalconDoor := GetChildComponByIsLine(DoorSCSCompon, ctArhDoor); // Дверь балкона BalconWnd := GetChildComponByIsLine(DoorSCSCompon, ctArhWindow); // Окно балкона door_h1 := BalconDoor.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; door_h2 := door_h1 + BalconDoor.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; door_w := BalconDoor.GetPropertyValueAsFloat(pnWidth) * FScaleDelta; wnd_h1 := door_h2 - BalconWnd.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if wnd_h1 < FStartDoorObject then wnd_h1 := FStartDoorObject; wnd_h2 := door_h2; wnd_w := BalconWnd.GetPropertyValueAsFloat(pnWidth) * FScaleDelta; // вычислить точки для двери и окна ba1 := ca1; ba3 := ca2; bb1 := cb1; bb3 := cb2; //GetParallelPoints(ba1, bb1, ba2, bb2, -door_w); //if NetPath.FIsConture then if Not PathIsNoConture then begin if PtInPolygon(FParent.FNetConture, aDoor.b1) then GetParallelPoints(ba1, bb1, ba2, bb2, -door_w) else GetParallelPoints(ba1, bb1, ba2, bb2, door_w); end else GetParallelPoints(ba1, bb1, ba2, bb2, -door_w); // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; if aVNetPath.FIsInner then WallViewType := [wvtNoUpper, wvtNoLeft] else WallViewType := [wvtNoUpper]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstUpper, fwtBalconSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoUnder, wvtNoLeft] else WallViewType := [wvtNoUnder]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); // достроить блок стены в проем ba1 := da1; ba3 := da2; bb1 := db1; bb3 := db2; //GetParallelPoints(ba1, bb1, ba2, bb2, -door_w); //if NetPath.FIsConture then if Not PathIsNoConture then begin if PtInPolygon(FParent.FNetConture, aDoor.b1) then GetParallelPoints(ba1, bb1, ba2, bb2, -door_w) else GetParallelPoints(ba1, bb1, ba2, bb2, door_w); end; Points[0] := ba2; Points[0].z := door_h1; Points[1] := ba3; Points[1].z := door_h1; Points[2] := bb2; Points[2].z := door_h1; Points[3] := bb3; Points[3].z := door_h1; Points[4] := ba2; Points[4].z := wnd_h1 - FDoorObjectDelta; Points[5] := ba3; Points[5].z := wnd_h1 - FDoorObjectDelta; Points[6] := bb2; Points[6].z := wnd_h1 - FDoorObjectDelta; Points[7] := bb3; Points[7].z := wnd_h1 - FDoorObjectDelta; if aVNetPath.FIsInner then WallViewType := [wvtNoUpper, wvtNoUnder, wvtNoLeft] else WallViewType := [wvtNoUpper, wvtNoUnder]; //WallSides := CollectOuterWall(aFaces, Points, WallViewType); WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1); SetWallTypeToWallSide(WallSides, wstUpper, fwtBalconSlope, xWallElement); SetWallTypeToWallSide(WallSides, wstLeftSide, fwtBalconSlope, xWallElement); end; // Обьект - Арка if aDoor.DoorObjType = dotArc then begin door_h1 := 0; door_h2 := DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth); // построить блок стены сверху //Points[0] := aDoor.a1; Points[0] := da1; Points[0].z := door_h2; //Points[1] := aDoor.a2; Points[1] := da2; Points[1].z := door_h2; //Points[2] := aDoor.b1; Points[2] := db1; Points[2].z := door_h2; //Points[3] := aDoor.b2; Points[3] := db2; Points[3].z := door_h2; //Points[4] := aDoor.a1; Points[4] := da1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, aDoor.a1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); //Points[5] := aDoor.a2; Points[5] := da2; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, aDoor.a2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2); //Points[6] := aDoor.b1; Points[6] := db1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, aDoor.b1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); //Points[7] := aDoor.b2; Points[7] := db2; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, aDoor.b2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoUnder, wvtNoLeft] else WallViewType := [wvtNoUnder]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstUnder, fwtArc, xWallElement); end; // Обьект - Ниша if aDoor.DoorObjType = dotNiche then begin door_h1 := DoorSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; door_h2 := door_h1 + DoorSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; w := DoorSCSCompon.GetPropertyValueAsFloat(pnWidth); depth := DoorSCSCompon.GetPropertyValueAsFloat(pnDepth); // достроить блок стены от нишы Points[0] := aDoor.a1; //Points[0] := da1; Points[0].z := door_h1; Points[1] := aDoor.a2; //Points[1] := da2; Points[1].z := door_h1; Points[2] := aDoor.ca1; //Points[2] := ca1; Points[2].z := door_h1; Points[3] := aDoor.ca2; //Points[3] := ca2; Points[3].z := door_h1; Points[4] := aDoor.a1; //Points[4] := da1; Points[4].z := door_h2; Points[5] := aDoor.a2; //Points[5] := da2; Points[5].z := door_h2; Points[6] := aDoor.ca1; //Points[6] := ca1; Points[6].z := door_h2; Points[7] := aDoor.ca2; //Points[7] := ca2; Points[7].z := door_h2; //if aVNetPath.FIsInner then // WallViewType := [wvtNoLeft] //else // WallViewType := []; if aVNetPath.FIsInner then WallViewType := [wvtNoLeft, wvtNoUpper, wvtNoUnder] else WallViewType := [wvtNoUpper, wvtNoUnder]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstRight, fwtNiche, xWallElement); // построить блок стены снизу //Points[0] := aDoor.a1; Points[0] := da1; Points[0].z := wall_h1; //Points[1] := aDoor.a2; Points[1] := da2; Points[1].z := wall_h1; //Points[2] := aDoor.b1; Points[2] := db1; Points[2].z := wall_h1; //Points[3] := aDoor.b2; Points[3] := db2; Points[3].z := wall_h1; //Points[4] := aDoor.a1; Points[4] := da1; Points[4].z := door_h1; //Points[5] := aDoor.a2; Points[5] := da2; Points[5].z := door_h1; //Points[6] := aDoor.b1; Points[6] := db1; Points[6].z := door_h1; //Points[7] := aDoor.b2; Points[7] := db2; Points[7].z := door_h1; if aVNetPath.FIsInner then WallViewType := [wvtNoUpper, wvtNoLeft] else WallViewType := [wvtNoUpper]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstUpper, fwtNiche, xWallElement); // построить блок стены сверху //Points[0] := aDoor.a1; Points[0] := da1; Points[0].z := door_h2; //Points[1] := aDoor.a2; Points[1] := da2; Points[1].z := door_h2; //Points[2] := aDoor.b1; Points[2] := db1; Points[2].z := door_h2; //Points[3] := aDoor.b2; Points[3] := db2; Points[3].z := door_h2; //Points[4] := aDoor.a1; Points[4] := da1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, aDoor.a1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); //Points[5] := aDoor.a2; Points[5] := da2; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, aDoor.a2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2); //Points[6] := aDoor.b1; Points[6] := db1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, aDoor.b1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); //Points[7] := aDoor.b2; Points[7] := db2; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, aDoor.b2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoUnder, wvtNoLeft] else WallViewType := [wvtNoUnder]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstUnder, fwtNiche, xWallElement); end; PrevDoor := aDoor; PrevDoorSCSCompon := DoorSCSCompon; xPrevWallElement := xWallElement; end; WallType := fwtNone; if PrevDoor <> nil then WallType := GetWallTypeByDoorType(PrevDoor); Points[0] := xl1; Points[0].z := wall_h1; //Points[1] := aVNetPath.op2^; //if (GetLineLenght(xl1, aVNetPath.ip2^)) < (GetLineLenght(xl1, aVNetPath.op2^)) then // Points[1] := aVNetPath.ip2^ //else // Points[1] := aVNetPath.op2^; Points[1] := xop2; Points[1].z := wall_h1; Points[2] := xr1; Points[2].z := wall_h1; //Points[3] := aVNetPath.ip2^; //if (GetLineLenght(xr1, aVNetPath.ip2^)) < (GetLineLenght(xr1, aVNetPath.op2^)) then // Points[3] := aVNetPath.ip2^ //else // Points[3] := aVNetPath.op2^; Points[3] := xip2; Points[3].z := wall_h1; Points[4] := xl1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, xl1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, xop2, xl1, corner_side1, corner_side2); //Points[5] := aVNetPath.op2^; Points[5] := xop2; Points[5].z := corner_side2; Points[6] := xr1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, xr1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, xip2, xr1, corner_side1, corner_side2); //Points[7] := aVNetPath.ip2^; Points[7] := xip2; Points[7].z := corner_side2; Points[9] := aVNetPathP2; //aVNetPath.p2^; Points[9].z := wall_h1; Points[11] := aVNetPathP2; //aVNetPath.p2^; Points[11].z := corner_side2; if aVNetPath.FIsInner then WallViewType := [wvtNoLeft] else WallViewType := []; knot2 := GetKnotsCount(aVNetPath, aVNetPathP2); if knot2 >= 2 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 0) else if knot2 >= 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0) else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2); end else // если внутри ничего нет (алгоритм построения №2) begin Points[0] := aVNetPath.op1^; Points[0].z := wall_h1; Points[1] := aVNetPath.op2^; Points[1].z := wall_h1; Points[2] := aVNetPath.ip1^; Points[2].z := wall_h1; Points[3] := aVNetPath.ip2^; Points[3].z := wall_h1; Points[4] := aVNetPath.op1^; Points[4].z := corner_side1; Points[5] := aVNetPath.op2^; Points[5].z := corner_side2; Points[6] := aVNetPath.ip1^; Points[6].z := corner_side1; Points[7] := aVNetPath.ip2^; Points[7].z := corner_side2; Points[8] := aVNetPathP1; //aVNetPath.p1^; Points[8].z := wall_h1; Points[9] := aVNetPathP2; //aVNetPath.p2^; Points[9].z := wall_h1; Points[10] := aVNetPathP1; //aVNetPath.p1^; Points[10].z := corner_side1; Points[11] := aVNetPathP2; //aVNetPath.p2^; Points[11].z := corner_side2; if aVNetPath.FComponID in [128,133,150,148] then begin EmptyProcedure; end; if aVNetPath.FIsInner then WallViewType := [wvtNoLeft] else WallViewType := []; knot1 := GetKnotsCount(aVNetPath, aVNetPathP1); knot2 := GetKnotsCount(aVNetPath, aVNetPathP2); if (knot1 >= 2) and (knot2 >= 2) then begin WallSides := CollectOuterWall(aFaces, Points, WallViewType, 12, 0); end else if knot1 >= 2 then begin if knot2 = 0 then //29.05.2012 if knot2 = 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 2) else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 0); end else if knot2 >= 2 then begin if knot1 = 0 then //29.05.2012 if knot1 = 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 1) else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 0); end else begin if (knot1 = 1) and (knot2 >= 1) then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0) else if knot1 = 0 then //29.05.2012 if knot1 = 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1) //08.06.2012 WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2) else if knot2 = 0 then //29.05.2012 if knot2 = 1 then begin if knot1 = 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2) else // на всякий случай - походу сюда попасть не должны так как выше есть условие if knot1 = 0 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1) end else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 12); end; end; //if WallSides <> nil then // FreeAndNil(WallSides); end; {$else} // Tolik 22/08/2018 -- Это чисто для СКС !!! wall_h1 := 0; if ((aVNetPath.p1H < 0) or (aVNetPath.p2H < 0)) then wall_h2 := 0 else //wall_h2 := Max(aVNetPath.p1H, aVNetPath.p2H) * FScaleDelta; wall_h2 := Max(aVNetPath.p1H, aVNetPath.p2H) * FScaleDeltaSCS; //PathIsNoConture := (aVNetPath.Net.Paths.Count = 1); begin {corner_side1 := aVNetPath.p1.z * FScaleDelta; corner_side2 := aVNetPath.p2.z * FScaleDelta; if corner_side1 = 0 then corner_side1 := wall_h2; if corner_side2 = 0 then corner_side2 := wall_h2;} corner_side1 := -1; corner_side2 := -1; if aVNetPath.p1H >= 0 then //corner_side1 := aVNetPath.p1H * FScaleDelta; corner_side1 := aVNetPath.p1H * FScaleDeltaSCS; if aVNetPath.p2H >= 0 then corner_side2 := aVNetPath.p2H * FScaleDeltaSCS; if Wall_h2 = 0 then wall_h2 := Get3DWallHeight * FScaleDeltaSCS; if corner_side1 = -1 then corner_side1 := wall_h2; if corner_side2 = -1 then corner_side2 := wall_h2; // correct *** SetLength(Points, 12); WallSides := nil; // все двери с учетом смежных AllDoors := aVNetPath.Doors; //GetFullDoors; // если внутри есть двери, окна ... (алгоритм построения №1) if AllDoors.Count > 0 then begin // l - внешние // r - внутренние // a - внешние // b - внутренние // oop oip изначальные оригинальные правильно определенные! // xop xip - в случае необходимости могут внутри цикла еще переопределяться! if Not PathIsNoConture then begin if Not (PtInPolygon(FParent.FNetConture, aVNetPath.op1^) {or IsPtInArray(aVNetPath.op1^, @FParent.FNetConture)}) then begin xl1 := aVNetPath.op1^; xr1 := aVNetPath.ip1^; end else begin xl1 := aVNetPath.ip1^; xr1 := aVNetPath.op1^ end; if Not (PtInPolygon(FParent.FNetConture, aVNetPath.op2^) {or IsPtInArray(aVNetPath.op2^, @FParent.FNetConture)}) then begin xl2 := aVNetPath.op2^; xr2 := aVNetPath.ip2^; end else begin xl2 := aVNetPath.ip2^; xr2 := aVNetPath.op2^; end; end else begin xl1 := aVNetPath.op1^; xr1 := aVNetPath.ip1^; // На всякий случай xl2 := aVNetPath.op2^; xr2 := aVNetPath.ip2^; end; oop1 := xl1; oop2 := xl2; oip1 := xr1; oip2 := xr2; if Not PathIsNoConture then begin if PtInPolygon(FParent.FNetConture, xl1) {or IsPtInArray(xl1, @FParent.FNetConture)} then begin if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) {or IsPtInArray(aVNetPath.ip2^, @FParent.FNetConture)} then xop2 := aVNetPath.ip2^ else xop2 := aVNetPath.op2^; end else begin if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) then xop2 := aVNetPath.op2^ else //if PtInPolygon(FParent.FNetConture, aVNetPath.op2^) then //29.06.2012 xop2 := aVNetPath.ip2^; end; if PtInPolygon(FParent.FNetConture, xr1) {or IsPtInArray(xr1, @FParent.FNetConture)} then begin if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) {or IsPtInArray(aVNetPath.ip2^, @FParent.FNetConture)} then xip2 := aVNetPath.ip2^ else //if PtInPolygon(FParent.FNetConture, aVNetPath.op2^) then //29.06.2012 xip2 := aVNetPath.op2^; end else begin if PtInPolygon(FParent.FNetConture, aVNetPath.ip2^) then xip2 := aVNetPath.op2^ else xip2 := aVNetPath.ip2^; end; end else begin xip2 := aVNetPath.ip2^; xop2 := aVNetPath.op2^; end; p1 := aVNetPathP1; //aVNetPath.p1^; p2 := aVNetPathP2; //aVNetPath.p2^; PrevDoor := nil; PrevDoorSCSCompon := nil; xPrevWallElement := nil; for j := 0 to AllDoors.Count - 1 do begin aDoor := TNetDoor(AllDoors[j]); // определить часть стены, от начала до след. обьекта begin if Not PathIsNoConture then begin if PtInPolygon(FParent.FNetConture, aDoor.b1) then begin len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.a2); if len1 < len2 then begin da1 := aDoor.a1; da2 := aDoor.a2; db1 := aDoor.b1; db2 := aDoor.b2; ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2; end else begin da1 := aDoor.a2; da2 := aDoor.a1; db1 := aDoor.b2; db2 := aDoor.b1; ca1 := aDoor.ca2; ca2 := aDoor.ca1; cb1 := aDoor.cb2; cb2 := aDoor.cb1; end; end else begin len1 := GetLineLenght(xl1, aDoor.b1); len2 := GetLineLenght(xl1, aDoor.b2); if len1 < len2 then begin da1 := aDoor.b1; da2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; ca1 := aDoor.cb1; ca2 := aDoor.cb2; cb1 := aDoor.ca1; cb2 := aDoor.ca2; end else begin da1 := aDoor.b2; da2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; ca1 := aDoor.cb2; ca2 := aDoor.cb1; cb1 := aDoor.ca2; cb2 := aDoor.ca1; end; end; end else begin len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.a2); if len1 < len2 then begin len1 := GetLineLenght(xl1, aDoor.a1); len2 := GetLineLenght(xl1, aDoor.b1); if len1 < len2 then begin da1 := aDoor.a1; da2 := aDoor.a2; db1 := aDoor.b1; db2 := aDoor.b2; ca1 := aDoor.ca1; ca2 := aDoor.ca2; cb1 := aDoor.cb1; cb2 := aDoor.cb2; end else // Переворот в поперек begin da1 := aDoor.b1; da2 := aDoor.b2; db1 := aDoor.a1; db2 := aDoor.a2; ca1 := aDoor.cb1; ca2 := aDoor.cb2; cb1 := aDoor.ca1; cb2 := aDoor.ca2; end; end else // Переворот в доль begin len1 := GetLineLenght(xl1, aDoor.a2); len2 := GetLineLenght(xl1, aDoor.b2); if len1 < len2 then begin da1 := aDoor.a2; da2 := aDoor.a1; db1 := aDoor.b2; db2 := aDoor.b1; ca1 := aDoor.ca2; ca2 := aDoor.ca1; cb1 := aDoor.cb2; cb2 := aDoor.cb1; end else // Переворот в поперек begin da1 := aDoor.b2; da2 := aDoor.b1; db1 := aDoor.a2; db2 := aDoor.a1; ca1 := aDoor.cb2; ca2 := aDoor.cb1; cb1 := aDoor.ca2; cb2 := aDoor.ca1; end; end; end; end; // скорректировать точки стены с учетом откосов hor_a1 := 0; hor_b1 := 0; hor_a2 := 0; hor_b2 := 0; WallViewType := []; WallType := GetWallTypeByDoorType(aDoor); if WallType in [fwtDoorSlope, fwtWindowSlope, fwtBalconSlope] then begin //InnerSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhInnerSlope); // Внутренний откос InnerSlope := nil; // Окно if WallType = fwtWindowSlope then begin //OuterSlope := GetChildComponByIsLine(DoorSCSCompon, ctArhOuterSlope); // Внешний откос { OuterSlope := nil; // есть окно и не смежная стена, то брать внешние откосы if (OuterSlope <> nil) then begin hor_a1 := (OuterSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a2 := hor_a1; ver_a := (OuterSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; depth_a := OuterSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_a := 0; depth_a := 0; end; if InnerSlope <> nil then begin hor_b1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_b2 := hor_b1; ver_b := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin ver_b := 0; depth_b := 0; end; } hor_a1 := 0; hor_a2 := 0; //ver_a := 1; ver_a := 0; //depth_a := (aVNetPath.Width /2);// * FScaleDelta; hor_b1 := 0; hor_b2 := 0; //ver_b := 1;//GetWndHeightFor3DModel * FScaleDelta; ver_b := 0; //depth_b := (aVNetPath.Width /2);// * FScaleDelta; end else // Дверь if WallType = fwtDoorSlope then begin if InnerSlope <> nil then begin hor_a1 := (InnerSlope.GetPropertyValueAsFloat(pnWidth) - DoorSCSCompon.GetPropertyValueAsFloat(pnWidth)) * FScaleDelta / 2; hor_a2 := hor_a1; hor_b1 := hor_a1; hor_b2 := hor_a1; //ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta; ver_a := (InnerSlope.GetPropertyValueAsFloat(pnHeight) - DoorSCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDeltaSCS; ver_b := ver_a; depth_a := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; depth_b := InnerSlope.GetPropertyValueAsFloat(pnDepth) * FScaleDelta; end else begin { ver_a := 0; ver_b := 0; depth_a := 0; depth_b := 0;} hor_a1 := 0; hor_a2 := 0; ver_a := 0; //depth_a := (aVNetPath.Width /4);// * FScaleDelta; //depth_a := (aVNetPath.Width /2);// * FScaleDelta; hor_b1 := 0; hor_b2 := 0; ver_b := 0;//GetWndHeightFor3DModel * FScaleDelta; //depth_b := (aVNetPath.Width /4);// * FScaleDelta; //depth_b := (aVNetPath.Width /2);// * FScaleDelta; end; end; end; GetWallPointsWithSlope(da1, da2, db1, db2, hor_a1, hor_a2, hor_b1, hor_b2); GetDoorPointsWithSlope(ca1, da1, depth_a); GetDoorPointsWithSlope(ca2, da2, depth_a); GetDoorPointsWithSlope(cb1, db1, depth_b); GetDoorPointsWithSlope(cb2, db2, depth_b); Points[0] := xl1; Points[0].z := wall_h1; Points[1] := da1; Points[1].z := wall_h1; Points[2] := xr1; Points[2].z := wall_h1; Points[3] := db1; Points[3].z := wall_h1; // первый блок - взять высоту с модпоинта if j = 0 then begin Points[4] := xl1; Points[4].z := corner_side1; Points[5] := da1; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[6] := xr1; Points[6].z := corner_side1; Points[7] := db1; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); Points[8] := p1; Points[8].z := wall_h1; Points[10] := p1; Points[10].z := corner_side1; if aVNetPath.FIsInner then WallViewType := [wvtNoLeft]; knot1 := GetKnotsCount(aVNetPath, p1); if knot1 >= 2 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 0) else if knot1 >= 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0) else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1); end else begin Points[4] := xl1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, xl1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, xl1, corner_side1, corner_side2); Points[5] := da1; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[6] := xr1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, xr1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, xr1, corner_side1, corner_side2); Points[7] := db1; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoLeft]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); end; xl1 := da2; xr1 := db2; // Обьект - Дверь if aDoor.DoorObjType = dotDoor then begin //door_h1 := adoor.WndPlacementHeight * FScaleDelta; door_h1 := adoor.WndPlacementHeight * FScaleDeltaSCS; if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject; //door_h2 := door_h1 + aDoor.Height * FScaleDelta;//GetDoorHeightfor3DModel * FScaleDelta; door_h2 := door_h1 + aDoor.Height * FScaleDeltaSCS;//GetDoorHeightfor3DModel * FScaleDelta; w := aDoor.Width * FScaleDelta / 2; // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; if aVNetPath.FIsInner then WallViewType := [wvtNoUpper, wvtNoLeft] else WallViewType := [wvtNoUpper]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstUpper, fwtDoorSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoUnder, wvtNoLeft] else WallViewType := [wvtNoUnder]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); end; // Обьект - Окно if aDoor.DoorObjType = dotWindow then begin //door_h1 := aDoor.WndPlacementHeight * FScaleDelta;//0.7 * FScaleDelta; door_h1 := aDoor.WndPlacementHeight * FScaleDeltaSCS;//0.7 * FScaleDelta; {if door_h1 < FStartDoorObject then door_h1 := FStartDoorObject;} //door_h2 := door_h1 + aDoor.Height * FScaleDelta;//GetWndHeightFor3DModel * FScaleDelta; door_h2 := door_h1 + aDoor.Height * FScaleDeltaSCS;//GetWndHeightFor3DModel * FScaleDelta; w := aDoor.Width * FScaleDelta / 2; // построить блок стены снизу Points[0] := da1; Points[0].z := wall_h1; Points[1] := da2; Points[1].z := wall_h1; Points[2] := db1; Points[2].z := wall_h1; Points[3] := db2; Points[3].z := wall_h1; Points[4] := da1; Points[4].z := door_h1 - FDoorObjectDelta; Points[5] := da2; Points[5].z := door_h1 - FDoorObjectDelta; Points[6] := db1; Points[6].z := door_h1 - FDoorObjectDelta; Points[7] := db2; Points[7].z := door_h1 - FDoorObjectDelta; if aVNetPath.FIsInner then WallViewType := [wvtNoUpper, wvtNoLeft] else WallViewType := [wvtNoUpper]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); SetWallTypeToWallSide(WallSides, wstUpper, fwtWindowSlope, xWallElement); // построить блок стены сверху Points[0] := da1; Points[0].z := door_h2 + ver_a; Points[1] := da2; Points[1].z := door_h2 + ver_a; Points[2] := db1; Points[2].z := door_h2 + ver_b; Points[3] := db2; Points[3].z := door_h2 + ver_b; Points[4] := da1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, oop2, da1, corner_side1, corner_side2); Points[5] := da2; //Points[5].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, da2, corner_side1, corner_side2); Points[5].z := CalcPointHeight(oop1, oop2, da2, corner_side1, corner_side2); Points[6] := db1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, oip2, db1, corner_side1, corner_side2); Points[7] := db2; //Points[7].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, db2, corner_side1, corner_side2); Points[7].z := CalcPointHeight(oip1, oip2, db2, corner_side1, corner_side2); if aVNetPath.FIsInner then WallViewType := [wvtNoUnder, wvtNoLeft] else WallViewType := [wvtNoUnder]; WallSides := CollectOuterWall(aFaces, Points, WallViewType); end; PrevDoor := aDoor; xPrevWallElement := xWallElement; end; WallType := fwtNone; if PrevDoor <> nil then WallType := GetWallTypeByDoorType(PrevDoor); Points[0] := xl1; Points[0].z := wall_h1; Points[1] := xop2; Points[1].z := wall_h1; Points[2] := xr1; Points[2].z := wall_h1; Points[3] := xip2; Points[3].z := wall_h1; Points[4] := xl1; //Points[4].z := CalcPointHeight(aVNetPath.op1^, aVNetPath.op2^, xl1, corner_side1, corner_side2); Points[4].z := CalcPointHeight(oop1, xop2, xl1, corner_side1, corner_side2); //Points[5] := aVNetPath.op2^; Points[5] := xop2; Points[5].z := corner_side2; Points[6] := xr1; //Points[6].z := CalcPointHeight(aVNetPath.ip1^, aVNetPath.ip2^, xr1, corner_side1, corner_side2); Points[6].z := CalcPointHeight(oip1, xip2, xr1, corner_side1, corner_side2); //Points[7] := aVNetPath.ip2^; Points[7] := xip2; Points[7].z := corner_side2; Points[9] := aVNetPathP2; //aVNetPath.p2^; Points[9].z := wall_h1; Points[11] := aVNetPathP2; //aVNetPath.p2^; Points[11].z := corner_side2; if aVNetPath.FIsInner then WallViewType := [wvtNoLeft] else WallViewType := []; knot2 := GetKnotsCount(aVNetPath, aVNetPathP2); if knot2 >= 2 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 0) else if knot2 >= 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0) else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2); end else // если внутри ничего нет (алгоритм построения №2) begin Points[0] := aVNetPath.op1^; Points[0].z := wall_h1; Points[1] := aVNetPath.op2^; Points[1].z := wall_h1; Points[2] := aVNetPath.ip1^; Points[2].z := wall_h1; Points[3] := aVNetPath.ip2^; Points[3].z := wall_h1; Points[4] := aVNetPath.op1^; Points[4].z := corner_side1; Points[5] := aVNetPath.op2^; Points[5].z := corner_side2; Points[6] := aVNetPath.ip1^; Points[6].z := corner_side1; Points[7] := aVNetPath.ip2^; Points[7].z := corner_side2; Points[8] := aVNetPathP1; //aVNetPath.p1^; Points[8].z := wall_h1; Points[9] := aVNetPathP2; //aVNetPath.p2^; Points[9].z := wall_h1; Points[10] := aVNetPathP1; //aVNetPath.p1^; Points[10].z := corner_side1; Points[11] := aVNetPathP2; //aVNetPath.p2^; Points[11].z := corner_side2; if aVNetPath.FComponID in [128,133,150,148] then begin EmptyProcedure; end; if aVNetPath.FIsInner then WallViewType := [wvtNoLeft] else WallViewType := []; knot1 := GetKnotsCount(aVNetPath, aVNetPathP1); knot2 := GetKnotsCount(aVNetPath, aVNetPathP2); //Tolik 29/08/2018 -- if ((knot2 = 0) and (knot1 = 0)) then begin WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 12); end else // if (knot1 >= 2) and (knot2 >= 2) then begin WallSides := CollectOuterWall(aFaces, Points, WallViewType, 12, 0); end else if knot1 >= 2 then begin if knot2 = 0 then //29.05.2012 if knot2 = 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 2) else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 1, 0); end else if knot2 >= 2 then begin if knot1 = 0 then //29.05.2012 if knot1 = 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 1) else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 2, 0); end else begin if (knot1 = 1) and (knot2 >= 1) then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 0) else if knot1 = 0 then //29.05.2012 if knot1 = 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1) //08.06.2012 WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2) else if knot2 = 0 then //29.05.2012 if knot2 = 1 then begin if knot1 = 1 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 2) else // на всякий случай - походу сюда попасть не должны так как выше есть условие if knot1 = 0 then WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 1) end else WallSides := CollectOuterWall(aFaces, Points, WallViewType, 0, 12); end; end; end; {$ifEnd} if WallSides <> nil then FreeAndNil(WallSides); except on E: Exception do AddExceptionToLogEx('T3DWall.ParseWallForOuter', E.Message); end; end; procedure T3DWall.ParseWallForPerpendSides(aFaces: TList; aVNetPath: TNetPath); var Corners: TSCSComponents; wall_h1, wall_h2: Double; corner_side1, corner_side2: Double; p1H, p2H: Double; wall_h: TDoubleArray; corner_side: TDoubleArray; pH: TDoubleArray; procedure AddPerpendSide(PathPt, OtherSidePt, PerpendPt: PDoublePoint; aSide: Integer); var a3DPointArr: T3DPointArray; xSide: T3DSide; //corner_side: Double; //pH: Double; FaceWallType: TFaceWallType; //DirectionKoeff: Integer; LinePt1, LinePt2: TDoublePoint; begin if PerpendPt <> nil then begin if Corners = nil then begin SetLength(wall_h, 2); SetLength(corner_side, 2); SetLength(pH, 2); {$if Defined(ES_GRAPH_SC)} wall_h[0] := FSCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; wall_h[1] := wall_h[0] + FSCSCompon.GetPropertyValueAsFloat(pnHeight) * FScaleDelta; Corners := GetArchCornersForWall(FSCSCompon); corner_side[0] := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if corner_side[0] = 0 then corner_side[0] := wall_h[1]; corner_side[1] := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if corner_side[1] = 0 then corner_side[1] := wall_h[1]; // correct *** ph[0] := aVNetPath.p1H; ph[1] := aVNetPath.p2H; corner_side[0] := ph[0] * FScaleDelta; if corner_side[0] = 0 then corner_side[0] := wall_h[1]; corner_side[1] := ph[1] * FScaleDelta; if corner_side[1] = 0 then corner_side[1] := wall_h[1]; // {$else} wall_h[0] := 0; //wall_h[1] := Get3DWallHeight * FScaleDelta; wall_h[1] := Get3DWallHeight * FScaleDeltaSCS; //corner_side[0] := Get3DWallHeight * FScaleDelta; //corner_side[1] := Get3DWallHeight * FScaleDelta; corner_side[0] := Get3DWallHeight * FScaleDeltaSCS; corner_side[1] := Get3DWallHeight * FScaleDeltaSCS; // correct *** //Tolik 18/11/2019 -- if aVNetPath.p1H > 0 then begin ph[0] := aVNetPath.p1H; //corner_side[0] := ph[0] * FScaleDelta; corner_side[0] := ph[0] * FScaleDeltaSCS; if corner_side[0] = 0 then corner_side[0] := wall_h[1]; end; if aVNetPath.p2H > 0 then begin ph[1] := aVNetPath.p2H; //corner_side[1] := ph[1] * FScaleDelta; corner_side[1] := ph[1] * FScaleDeltaSCS; if corner_side[1] = 0 then corner_side[1] := wall_h[1]; end; { ph[0] := aVNetPath.p1H; ph[1] := aVNetPath.p2H; corner_side[0] := ph[0] * FScaleDelta; if corner_side[0] = 0 then corner_side[0] := wall_h[1]; corner_side[1] := ph[1] * FScaleDelta; if corner_side[1] = 0 then corner_side[1] := wall_h[1]; } {$ifEnd} end; LinePt1 := PathPt^; LinePt2 := PerpendPt^; FaceWallType := fwtNone; if aVNetPath.FIsInner then begin FaceWallType := fwtInner; //DirectionKoeff := GetParallelPointDirectionKoeff(PathPt^, PerpendPt^, OtherSidePt^); //GetParallelPoints(PathPt^, PerpendPt^, LinePt1, LinePt2, 1 * DirectionKoeff); end else begin if aVNetPath.FIsConture then begin if (PathPt = aVNetPath.op1) or (PathPt = aVNetPath.op2) then FaceWallType := fwtOuter else if (PathPt = aVNetPath.ip1) or (PathPt = aVNetPath.ip2) then FaceWallType := fwtInner; end else //08.06.2012 - здесь ставим что внешний, если нет замкнутого контура FaceWallType := fwtOuter; end; SetLength(a3DPointArr, 4); a3DPointArr[0] := LinePt1; a3DPointArr[0].z := wall_h[0]; a3DPointArr[1] := LinePt2; a3DPointArr[1].z := wall_h[0]; a3DPointArr[2] := LinePt1; a3DPointArr[2].z := corner_side[aSide-1]; a3DPointArr[3] := LinePt2; a3DPointArr[3].z := corner_side[aSide-1]; xSide := T3DSide.Create(ftNetPath, FaceWallType, wstUnder, self); xSide.CollectWallSide(aFaces, a3DPointArr); FSides.Add(xSide); end; end; begin Corners := nil; AddPerpendSide(@aVNetPath.el1, @aVNetPath.el2, aVNetPath.epl1, 1); AddPerpendSide(@aVNetPath.el2, @aVNetPath.el1, aVNetPath.epl2, 2); AddPerpendSide(@aVNetPath.er1, @aVNetPath.er2, aVNetPath.epr1, 1); AddPerpendSide(@aVNetPath.er2, @aVNetPath.er1, aVNetPath.epr2, 2); end; // Tolik 31/08/2018 -- Procedure T3DWall.ParseWallForJoint(aPathList: TList; aFaces: TList; aPoint: PDoublePoint); // стыки стен с разной толщиной на пересечении 3-х стен var UPoint1, UPoint2: PDoublePoint; i, j, PathIndex: Integer; currPath: TNetPath; xSide: T3DSide; a3DPointArr: T3DPointArray; Wall_H: Double; FaceWallType: TFaceWallType; function isUniquePoint(aPoint: TDoublePoint; PathIndex: Integer): Boolean; var i: Integer; RelatedPath: TNetPath; begin Result := true; for i := 0 to aPathList.Count - 1 do begin if i <> PathIndex then begin RelatedPath := TNetPath(aPathList[i]); if ((CompareValue(aPoint.x, RelatedPath.r1.x) = 0) and (CompareValue(aPoint.y, RelatedPath.r1.y) = 0)) or ((CompareValue(aPoint.x, RelatedPath.r2.x) = 0) and (CompareValue(aPoint.y, RelatedPath.r2.y) = 0)) or ((CompareValue(aPoint.x, RelatedPath.l1.x) = 0) and (CompareValue(aPoint.y, RelatedPath.l1.y) = 0)) or ((CompareValue(aPoint.x, RelatedPath.l2.x) = 0) and (CompareValue(aPoint.y, RelatedPath.l2.y) = 0)) then begin Result := False; break; end; end; end; end; Procedure AddPoint(addPoint: TDoublePoint; zCoord: Double); begin if UPoint1 = nil then begin New(UPoint1); UPoint1.x := AddPoint.x; UPoint1.y := AddPoint.y; UPoint1.z := zCoord; end else begin New(UPoint2); UPoint2.x := AddPoint.x; UPoint2.y := AddPoint.y; UPoint2.z := zCoord; end; end; begin UPoint1 := nil; UPoint2 := nil; for i := 0 to aPathList.Count - 1 do begin currPath := TNetPath(aPathList[i]); if ((CompareValue(aPoint.x, currPath.P1.x) = 0) and (CompareValue(aPoint.y, currPath.P1.y) = 0)) then begin if isUniquePoint(currPath.r1, i) then AddPoint(currPath.r1, currPath.p1.z); if UPoint2 <> nil then break; if isUniquePoint(currPath.l1, i) then AddPoint(currPath.l1, currPath.p1.z); if UPoint2 <> nil then break; end else if ((CompareValue(aPoint.x, currPath.P2.x) = 0) and (CompareValue(aPoint.y, currPath.P2.y) = 0)) then begin if isUniquePoint(currPath.r2, i) then AddPoint(currPath.r2, currPath.p2.z); if UPoint2 <> nil then break; if isUniquePoint(currPath.l2, i) then AddPoint(currPath.l2, currPath.p2.z); if UPoint2 <> nil then break; end; end; if UPoint2 <> nil then begin SetLength(a3DPointArr, 4); //Wall_H := Max(UPoint1.z, UPoint2.z) * FScaleDelta; Wall_H := Max(UPoint1.z, UPoint2.z) * FScaleDeltaSCS; if Wall_H = 0 then //Wall_H := Get3DWallHeight * FScaleDelta; Wall_H := Get3DWallHeight * FScaleDeltaSCS; a3DPointArr[0].x := UPoint1.x; a3DPointArr[0].y := UPoint1.y; a3DPointArr[0].z := 0; a3DPointArr[1].x := UPoint2.x; a3DPointArr[1].y := UPoint2.y; a3DPointArr[1].z := 0; a3DPointArr[2].x := UPoint1.x; a3DPointArr[2].y := UPoint1.y; a3DPointArr[2].z := Wall_H; a3DPointArr[3].x := UPoint2.x; a3DPointArr[3].y := UPoint2.y; a3DPointArr[3].z := Wall_H; FaceWallType := fwtOuter; xSide := T3DSide.Create(ftNetPath, FaceWallType, wstUnder, self); xSide.CollectWallSide(aFaces, a3DPointArr); FSides.Add(xSide); freeMem(UPoint1); freeMem(UPoint2); end else freeMem(UPoint1); end; procedure T3DWall.ReadFromStream(Stream: TStream); var isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 20: FParentIndex := IntVal; 21: FSCSComponID := intVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); case xCode of 90: begin if byteVal = 0 then FIsArc := False else FIsArc := True; end; end; end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DWall.ReadFromStream', E.Message); end; end; procedure T3DWall.SetRelations; begin try if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DRoom(ModelObjectsList.Items[FParentIndex]); T3DRoom(FParent).FWalls.Add(self); end; except on E: Exception do AddExceptionToLogEx('T3DWall.SetRelations', E.Message); end; end; procedure T3DWall.SetWallTypeToWallSide(aWallSides: TList; aWallSideType: TWallSideType; aWallType: TFaceWallType; aWallElement: T3DWallElement); var i: integer; WallSide: T3DSide; begin try for i := 0 to aWallSides.Count - 1 do begin WallSide := T3DSide(aWallSides[i]); if WallSide.FFace.FWallSideType = aWallSideType then begin WallSide.FFace.FFaceWallType := aWallType; WallSide.FWallType := aWallType; if (aWallType = fwtNiche) or (aWallType = fwtArc) then begin if aWallElement <> nil then aWallElement.FSides.Add(WallSide); FSides.Remove(WallSide); end; Break; end; end; except on E: Exception do AddExceptionToLogEx('T3DWall.SetWallTypeToWallSide', E.Message); end; end; procedure T3DWall.WriteToStream(Stream: TStream); var xInt: Integer; xByte: Byte; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); if FIsArc then xByte := 1 else xByte := 0; WriteField(90, Stream, xByte, sizeof(xByte)); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DWall.WriteToStream', E.Message); end; end; { T3DWallElement } procedure T3DWallElement.CollectBalcon(aFaces: TList; ap1, ap2: T3DPointArray); var a3DPointArr: T3DPointArray; aFace: TFaceRecord; xBalconElement: T3DBalconElement; begin try xBalconElement := T3DBalconElement.Create(aFaces, dotDoor, self); xBalconElement.FSCSCompon := GetChildComponByIsLine(FSCSCompon, ctArhDoor); xBalconElement.FSCSComponID := xBalconElement.FSCSCompon.ID; xBalconElement.FName := xBalconElement.FSCSCompon.Name; xBalconElement.CollectBalconDoor(aFaces, ap1); FBalconElements.Add(xBalconElement); xBalconElement := T3DBalconElement.Create(aFaces, dotWindow, self); xBalconElement.FSCSCompon := GetChildComponByIsLine(FSCSCompon, ctArhWindow); xBalconElement.FSCSComponID := xBalconElement.FSCSCompon.ID; xBalconElement.FName := xBalconElement.FSCSCompon.Name; xBalconElement.CollectBalconWindow(aFaces, ap2); FBalconElements.Add(xBalconElement); except on E: Exception do AddExceptionToLogEx('T3DWallElement.CollectBalcon', E.Message); end; end; procedure T3DWallElement.CollectDoor(aFaces: TList; ap: T3DPointArray); var a3DPointArr: T3DPointArray; aFace: TFaceRecord; xSide: T3DSide; begin try SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[3]; a3DPointArr[3] := ap[2]; xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[4]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[7]; a3DPointArr[3] := ap[6]; xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[5]; a3DPointArr[3] := ap[4]; xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[2]; a3DPointArr[1] := ap[3]; a3DPointArr[2] := ap[7]; a3DPointArr[3] := ap[6]; xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[4]; a3DPointArr[2] := ap[6]; a3DPointArr[3] := ap[2]; xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[1]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[7]; a3DPointArr[3] := ap[3]; xSide := T3DSide.Create(ftNetDoor, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); except on E: Exception do AddExceptionToLogEx('T3DWallElement.CollectDoor', E.Message); end; end; procedure T3DWallElement.CollectWindow(aFaces: TList; ap: T3DPointArray); var a3DPointArr: T3DPointArray; aFace: TFaceRecord; xSide: T3DSide; begin try SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[3]; a3DPointArr[3] := ap[2]; xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[4]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[7]; a3DPointArr[3] := ap[6]; xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[1]; a3DPointArr[2] := ap[5]; a3DPointArr[3] := ap[4]; xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self ); xSide.CollectWallElementSide(aFaces, a3DPointArr, True); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[2]; a3DPointArr[1] := ap[3]; a3DPointArr[2] := ap[7]; a3DPointArr[3] := ap[6]; xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr, True); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[0]; a3DPointArr[1] := ap[4]; a3DPointArr[2] := ap[6]; a3DPointArr[3] := ap[2]; xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap[1]; a3DPointArr[1] := ap[5]; a3DPointArr[2] := ap[7]; a3DPointArr[3] := ap[3]; xSide := T3DSide.Create(ftNetWindow, fwtNone, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); except on E: Exception do AddExceptionToLogEx('T3DWallElement.CollectWindow', E.Message); end; end; constructor T3DWallElement.Create(aFaces: TList; aNetDoor: TNetDoor; aElementType: TDoorObjType; aParent: T3DWall); begin try inherited Create; FClassName := 'T3DWallElement'; FPlanObject := aNetDoor; if aNetDoor <> nil then begin {$if Defined(ES_GRAPH_SC)} FSCSCompon := GetArchObjByCADObj(aNetDoor); FSCSComponID := FSCSCompon.ID; FName := FSCSCompon.Name + ' ' + FSCSCompon.NameMark; {$else} FName := 'WallElement'; {$ifEnd} end; FParent := aParent; FElementType := aElementType; FSlopes := TList.Create; FSides := TList.Create; FBalconElements := TList.Create; except on E: Exception do AddExceptionToLogEx('T3DWallElement.Create', E.Message); end; end; procedure T3DWallElement.ReadFromStream(Stream: TStream); var isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 20: FParentIndex := IntVal; 21: FSCSComponID := intVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DWallElement.ReadFromStream', E.Message); end; end; procedure T3DWallElement.SetRelations; begin try if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DWall(ModelObjectsList.Items[FParentIndex]); T3DWall(FParent).FWallElements.Add(self); end; except on E: Exception do AddExceptionToLogEx('T3DWallElement.SetRelations', E.Message); end; end; procedure T3DWallElement.WriteToStream(Stream: TStream); var xInt: Integer; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DWallElement.WriteToStream', E.Message); end; end; { T3DSlope } constructor T3DSlope.Create(aFaces: TList; aNetDoor: TNetDoor; aParent: T3DWallElement); begin try inherited Create; FClassName := 'T3DSlope'; {$if DEFINED (ES_GRAPH_SC)} // Tolik 28/08/2018 -- if aNetDoor <> nil then begin FSCSCompon := GetArchObjByCADObj(aNetDoor); FSCSComponID := FSCSCompon.ID; end; {$else} FSCSCompon := nil; FSCSComponID := 0; FName := _3DSlopeName; {$ifEnd} FParent := aParent; FSides := TList.Create; except on E: Exception do AddExceptionToLogEx('T3DSlope.Create', E.Message); end; end; procedure T3DSlope.ReadFromStream(Stream: TStream); var isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 20: FParentIndex := IntVal; 21: FSCSComponID := intVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DSlope.ReadFromStream', E.Message); end; end; procedure T3DSlope.SetRelations; begin try if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DWallElement(ModelObjectsList.Items[FParentIndex]); T3DWallElement(FParent).FSlopes.Add(self); end; except on E: Exception do AddExceptionToLogEx('T3DSlope.SetRelations', E.Message); end; end; procedure T3DSlope.WriteToStream(Stream: TStream); var xInt: Integer; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DSlope.WriteToStream', E.Message); end; end; { T3DBalconElement } procedure T3DBalconElement.CollectBalconDoor(aFaces: TList; ap1: T3DPointArray); var a3DPointArr: T3DPointArray; aFace: TFaceRecord; xSide: T3DSide; begin try // собрать балконную дверь SetLength(a3DPointArr, 4); a3DPointArr[0] := ap1[0]; a3DPointArr[1] := ap1[1]; a3DPointArr[2] := ap1[3]; a3DPointArr[3] := ap1[2]; xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap1[4]; a3DPointArr[1] := ap1[5]; a3DPointArr[2] := ap1[7]; a3DPointArr[3] := ap1[6]; xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap1[0]; a3DPointArr[1] := ap1[1]; a3DPointArr[2] := ap1[5]; a3DPointArr[3] := ap1[4]; xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr, True); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap1[2]; a3DPointArr[1] := ap1[3]; a3DPointArr[2] := ap1[7]; a3DPointArr[3] := ap1[6]; xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr, True { Trans }); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap1[0]; a3DPointArr[1] := ap1[4]; a3DPointArr[2] := ap1[6]; a3DPointArr[3] := ap1[2]; xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap1[1]; a3DPointArr[1] := ap1[5]; a3DPointArr[2] := ap1[7]; a3DPointArr[3] := ap1[3]; xSide := T3DSide.Create(ftNetBalconDoor, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); except on E: Exception do AddExceptionToLogEx('T3DBalconElement.CollectBalconDoor', E.Message); end; end; procedure T3DBalconElement.CollectBalconWindow(aFaces: TList; ap2: T3DPointArray); var a3DPointArr: T3DPointArray; aFace: TFaceRecord; xSide: T3DSide; begin try // собрать балконное окно SetLength(a3DPointArr, 4); a3DPointArr[0] := ap2[0]; a3DPointArr[1] := ap2[1]; a3DPointArr[2] := ap2[3]; a3DPointArr[3] := ap2[2]; xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap2[4]; a3DPointArr[1] := ap2[5]; a3DPointArr[2] := ap2[7]; a3DPointArr[3] := ap2[6]; xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap2[0]; a3DPointArr[1] := ap2[1]; a3DPointArr[2] := ap2[5]; a3DPointArr[3] := ap2[4]; xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr, True); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap2[2]; a3DPointArr[1] := ap2[3]; a3DPointArr[2] := ap2[7]; a3DPointArr[3] := ap2[6]; xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr, True); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap2[0]; a3DPointArr[1] := ap2[4]; a3DPointArr[2] := ap2[6]; a3DPointArr[3] := ap2[2]; xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); SetLength(a3DPointArr, 4); a3DPointArr[0] := ap2[1]; a3DPointArr[1] := ap2[5]; a3DPointArr[2] := ap2[7]; a3DPointArr[3] := ap2[3]; xSide := T3DSide.Create(ftNetBalconWindow, fwtBalconSlope, wstNone, self); xSide.CollectWallElementSide(aFaces, a3DPointArr); FSides.Add(xSide); except on E: Exception do AddExceptionToLogEx('T3DBalconElement.CollectBalconWindow', E.Message); end; end; constructor T3DBalconElement.Create(aFaces: TList; aElementType: TDoorObjType; aParent: T3DWallElement); begin try inherited Create; FClassName := 'T3DBalconElement'; FParent := aParent; FElementType := aElementType; FSides := TList.Create; except on E: Exception do AddExceptionToLogEx('T3DBalconElement.Create', E.Message); end; end; procedure T3DBalconElement.ReadFromStream(Stream: TStream); var isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 20: FParentIndex := IntVal; 21: FSCSComponID := intVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DBalconElement.ReadFromStream', E.Message); end; end; procedure T3DBalconElement.SetRelations; begin try if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DWallElement(ModelObjectsList.Items[FParentIndex]); T3DWallElement(FParent).FBalconElements.Add(self); end; except on E: Exception do AddExceptionToLogEx('T3DBalconElement.SetRelations', E.Message); end; end; procedure T3DBalconElement.WriteToStream(Stream: TStream); var xInt: Integer; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DBalconElement.WriteToStream', E.Message); end; end; { T3DSObject } constructor T3DSObject.Create(aParent: T3DRoom); begin try inherited Create; FClassName := 'T3DSObject'; FName := ''; FDescription := TStringList.Create; FParent := aParent; FGLObject := nil; FFace := nil; FScale.x := 1; FScale.y := 1; FScale.z := 1; FPosition.x := 0; FPosition.y := 0; FPosition.z := 0; FRotate.x := 0; FRotate.y := 0; FRotate.z := 0; FObjectHash := ''; FTextureHash := ''; FTexture_ext := ''; //FFiles := TStringList.Create; //FHashs := TStringList.Create; except on E: Exception do AddExceptionToLogEx('T3DSObject.Create', E.Message); end; end; procedure T3DSObject.ReadFromStream(Stream: TStream); var i, j: integer; isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; xd, yd, zd: Double; mStr: TMemoryStream; fStr: TFileStream; CanAdd: Boolean; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 20: FParentIndex := IntVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); Case xcode of 150: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPosition.x := xd; FPosition.y := yd; FPosition.z := zd; end; 151: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FScale.x := xd; FScale.y := yd; FScale.z := zd; end; 152: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FRotate.x := xd; FRotate.y := yd; FRotate.z := zd; end; // 153: begin // mStr := TMemoryStream.Create; // StreamToStream(Stream, mStr, xSize); // mStr.Position := 0; // mStr.SaveToFile('C:\govno_test.3ds'); // FreeAndNil(mStr); // end; end; end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; 181: FDescription.Text := strVal; 182: FObjectHash := strVal; 183: FTextureHash := strVal; 184: FTexture_ext := strVal; end; {TODO} // пересмотреть - хрень по ходу здесь делаетс - ограниченный набор файлов только пишется // И НЕ ТАМ - должны раз только писаться эти два стрима!!! //if (xCode >= 185) and (xCode <= 199) then //begin //CanAdd := True; //for j := 0 to FFiles.Count - 1 do //begin // if FFiles[j] = StrVal then // CanAdd := False; //end; //if CanAdd then // FFiles.Add(strVal); //end; //if (xCode >= 200) and (xCode <= 219) then //begin //CanAdd := True; //for j := 0 to FHashs.Count - 1 do //begin // if FHashs[j] = StrVal then // CanAdd := False; //end; //if CanAdd then // FHashs.Add(strVal); //end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DSObject.ReadFromStream', E.Message); end; end; procedure T3DSObject.SetRelations; begin try if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DRoom(ModelObjectsList.Items[FParentIndex]); T3DRoom(FParent).F3DSObjects.Add(self); end; except on E: Exception do AddExceptionToLogEx('T3DSObject.SetRelations', E.Message); end; end; // Tolik 04/04/2019 - - procedure T3DSObject.WriteToStream(Stream: TStream); var xInt: Integer; aPoint: pInt; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FPosition.x; pDouble(PAnsiChar(aPoint) + 8)^ := FPosition.y; pDouble(PAnsiChar(aPoint) + 16)^ := FPosition.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FScale.x; pDouble(PAnsiChar(aPoint) + 8)^ := FScale.y; pDouble(PAnsiChar(aPoint) + 16)^ := FScale.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FRotate.x; pDouble(PAnsiChar(aPoint) + 8)^ := FRotate.y; pDouble(PAnsiChar(aPoint) + 16)^ := FRotate.z; WriteBinField(152, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); // Write 3DS File // if FPath <> '' then // begin // xStream := TFileStream.Create(FPath, fmOpenRead); // WriteStreamField(153, Stream, xStream); // FreeAndNil(xStream); // end; {TODO} // пересмотреть - хрень по ходу здесь делаетс - ограниченный набор файлов только пишется // И ВОЗМОЖНО НЕ ТАМ - должны раз только писаться эти два стрима!!! // Короче пересмотреть всю организацию этой хрени! //for i := 0 to FFiles.Count - 1 do //begin // xStr := FFiles[i]; // if ((185 + i) <= 199) then // WriteStrField(185 + i, Stream, xStr); //end; //for i := 0 to FHashs.Count - 1 do //begin // xStr := FHashs[i]; // if ((200 + i) <= 219) then // WriteStrField(200 + i, Stream, xStr); //end; WriteStrField(181, Stream, FDescription.Text); WriteStrField(182, Stream, FObjectHash); WriteStrField(183, Stream, FTextureHash); WriteStrField(184, Stream, FTexture_ext); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DSObject.WriteToStream', E.Message); end; end; (* procedure T3DSObject.WriteToStream(Stream: TStream); var i, xCount, xInt: Integer; xByte: Byte; xStr: string; xDouble: Double; aPoint: pInt; xStream: TFileStream; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := ModelObjectsList.IndexOf(FParent); WriteField(20, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FPosition.x; pDouble(pChar(aPoint) + 8)^ := FPosition.y; pDouble(pChar(aPoint) + 16)^ := FPosition.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FScale.x; pDouble(pChar(aPoint) + 8)^ := FScale.y; pDouble(pChar(aPoint) + 16)^ := FScale.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FRotate.x; pDouble(pChar(aPoint) + 8)^ := FRotate.y; pDouble(pChar(aPoint) + 16)^ := FRotate.z; WriteBinField(152, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); // Write 3DS File // if FPath <> '' then // begin // xStream := TFileStream.Create(FPath, fmOpenRead); // WriteStreamField(153, Stream, xStream); // FreeAndNil(xStream); // end; {TODO} // пересмотреть - хрень по ходу здесь делаетс - ограниченный набор файлов только пишется // И ВОЗМОЖНО НЕ ТАМ - должны раз только писаться эти два стрима!!! // Короче пересмотреть всю организацию этой хрени! //for i := 0 to FFiles.Count - 1 do //begin // xStr := FFiles[i]; // if ((185 + i) <= 199) then // WriteStrField(185 + i, Stream, xStr); //end; //for i := 0 to FHashs.Count - 1 do //begin // xStr := FHashs[i]; // if ((200 + i) <= 219) then // WriteStrField(200 + i, Stream, xStr); //end; WriteStrField(181, Stream, FDescription.Text); WriteStrField(182, Stream, FObjectHash); WriteStrField(183, Stream, FTextureHash); WriteStrField(184, Stream, FTexture_ext); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DSObject.WriteToStream', E.Message); end; end; *) { T3DConnector } procedure T3DConnector.CollectConnector(aFaces: TList; ap: T3DPointArray); var aFace: TFaceRecord; i: Integer; begin try //Tolik 08/04/2025 //FPoint := ap[0]; if Self.FisPipeElement then begin if Length(ap) = 3 then FPoint := ap[1] else FPoint := ap[0]; end else FPoint := ap[0]; // {TODO ZCoord} //ap[0].z := ap[0].z * FScaleDelta; for i := 0 to (Length(ap) - 1) do ap[i].z := ap[i].z * FScaleDeltaSCS; // NEWNEW if not Self.FisPipeElement then aFace := TFaceRecord.Create(ap, clRed, ftPipe, 0.1, False, FSCSObject) else aFace := TFaceRecord.Create(ap, clGreen, ftPipe, 0.1, False, FSCSObject); aFaces.Add(aFace); FFace := aFace; except on E: Exception do AddExceptionToLogEx('T3DConnector.CollectConnector', E.Message); end; end; // Tolik 24/09/1218 //constructor T3DConnector.Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel); constructor T3DConnector.Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel; aIsPipe: Boolean = False); // var i: integer; begin try inherited Create; // Tolik 12/10/20108 -- //if aSCSObject.ConnectorType = ct_NB then // T3DModelFile := Get3DModelFileName(aSCSObject) //else T3DModelFile :=''; FUse3DSize := False; // FisPipeElement := aIsPipe; FClassName := 'T3DConnector'; FSCSObject := aSCSObject; FListID := GCadForm.FCADListID; FDescription := TStringList.Create; FCaptions := TStringList.Create; FNotes := TStringList.Create; FConnType := ct_Empty; FParent := aParent; // Tolik 26/09/2018 -- SetLength(FPipeRadiusArray, 0); F3dModelFileName := ''; HasPipeElements := False; // if aSCSObject <> nil then begin if aSCSObject.ConnectorType <> ct_Clear then begin if not aSCSObject.FIsApproach then // Tolik 14/02/2020 -- если попадется дом на Каде ... // компонента не будет begin FSCSCompon := GetSCSComponByCADObj(aSCSObject); FSCSComponID := FSCSCompon.ID; end else FSCSComponID := -1; end else begin FSCSCompon := nil; //Tolik 18/4/2025 -- //FSCSComponID := -1; FSCSComponID := aSCSObject.ID; // end; FName := FSCSObject.Name; FIndex := FSCSObject.FIndex; //for i := 0 to FSCSObject.OutTextCaptions.Count - 1 do // FDescription.Add(FSCSObject.OutTextCaptions.Strings[i]); for i := 0 to FSCSObject.OutTextCaptions.Count - 1 do FCaptions.Add(FSCSObject.OutTextCaptions.Strings[i]); for i := 0 to FSCSObject.OutTextNotes.Count - 1 do FNotes.Add(FSCSObject.OutTextNotes.Strings[i]); if FSCSObject.ConnectorType <> ct_Clear then FConnType := ct_Full; end; FGLObject := nil; FGLObject1 := nil; FGLCaption := nil; FFace := nil; FPoint.x := 0; FPoint.y := 0; FPoint.z := 0; FGLPoint.x := 0; FGLPoint.y := 0; FGLPoint.z := 0; FOffset.x := 0; FOffset.y := 0; FOffset.z := 0; FScale.x := 1; FScale.y := 1; FScale.z := 1; FRotate.x := 0; FRotate.y := 0; FRotate.z := 0; FObjectHash := ''; FTextureHash := ''; FTexture_ext := ''; //FFiles := TStringList.Create; //FHashs := TStringList.Create; FColor := clrBlack; FJoinedConnectorsList := TList.Create; FJoinedLinesList := TList.Create; FRelatedLines := TList.Create; // -- Tolik 03/4/2025 список трасс, по которым прохоит соединение FLength := 0; // Tolik 03/04/05 -- длина соединения except on E: Exception do AddExceptionToLogEx('T3DConnector.Create', E.Message); end; end; procedure T3DConnector.ReadFromStream(Stream: TStream); var i, j: integer; isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; xd, yd, zd: Double; mStr: TMemoryStream; fStr: TFileStream; CanAdd: Boolean; begin try isOk := False; FName := ReadStringFromStream(Stream); F3dModelFileName := ReadStringFromStream(Stream); // Tolik 03/10/2018 - - repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 21: FSCSComponID := intVal; 22: FListID := intVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); Case xcode of 150: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPoint.x := xd; FPoint.y := yd; FPoint.z := zd; end; 151: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FScale.x := xd; FScale.y := yd; FScale.z := zd; end; 152: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FRotate.x := xd; FRotate.y := yd; FRotate.z := zd; end; 153: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FOffset.x := xd; FOffset.y := yd; FOffset.z := zd; end; end; end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; 181: FDescription.Text := strVal; 182: FObjectHash := strVal; 183: FTextureHash := strVal; 184: FTexture_ext := strVal; end; {TODO} // пересмотреть - хрень по ходу здесь делаетс - ограниченный набор файлов только пишется // И НЕ ТАМ - должны раз только писаться эти два стрима!!! //if (xCode >= 185) and (xCode <= 199) then //begin //CanAdd := True; //for j := 0 to FFiles.Count - 1 do //begin // if FFiles[j] = StrVal then // CanAdd := False; //end; //if CanAdd then // FFiles.Add(strVal); //end; //if (xCode >= 200) and (xCode <= 219) then //begin //CanAdd := True; //for j := 0 to FHashs.Count - 1 do //begin // if FHashs[j] = StrVal then // CanAdd := False; //end; //if CanAdd then // FHashs.Add(strVal); //end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DConnector.ReadFromStream', E.Message); end; end; procedure T3DConnector.SetRelations; begin if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DModel(ModelObjectsList.Items[FParentIndex]); T3DModel(FParent).FScsObjects.Add(self); end; end; Function T3DConnector.Get3DModelFileName(aSCSObject: TConnectorObject): String; var i, j: Integer; SCSCatalog: TSCSCatalog; SCSCompon: TSCSComponent; A_Cad: TF_CaD; currList: TSCSList; begin Result := ''; A_Cad := Nil; if TPowerCad(ASCSObject.Owner) <> nil then if TF_Cad(TPowerCad(ASCSObject.Owner).Owner) <> nil then A_Cad := TF_Cad(TPowerCad(ASCSObject.Owner).Owner); if A_Cad <> nil then begin currList := F_ProjMan.GSCSBase.CurrProject.GetListByID(A_Cad.FCADListID); if CurrList <> nil then begin SCSCatalog := CurrList.GetCatalogFromReferencesBySCSID(aSCSObject.ID); if SCSCatalog <> nil then begin for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSCompon := SCSCatalog.ComponentReferences[i]; for j := 0 to SCSCompon.Properties.Count - 1 do begin if UpperCase(PProperty(SCSCompon.Properties).SysName) = '3DS_MODEL' then begin Result := PProperty(SCSCompon.Properties).Value; break; end; end; if Result <> '' then break; end; end; end; end; end; // Tolik 04/04/2019 -- procedure T3DConnector.WriteToStream(Stream: TStream); var xInt: Integer; aPoint: pInt; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); WriteString(Stream, F3dModelFileName); // Tolik 03/10/2018 -- xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FPoint.x; pDouble(PAnsiChar(aPoint) + 8)^ := FPoint.y; pDouble(PAnsiChar(aPoint) + 16)^ := FPoint.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FScale.x; pDouble(PAnsiChar(aPoint) + 8)^ := FScale.y; pDouble(PAnsiChar(aPoint) + 16)^ := FScale.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FRotate.x; pDouble(PAnsiChar(aPoint) + 8)^ := FRotate.y; pDouble(PAnsiChar(aPoint) + 16)^ := FRotate.z; WriteBinField(152, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FOffset.x; pDouble(PAnsiChar(aPoint) + 8)^ := FOffset.y; pDouble(PAnsiChar(aPoint) + 16)^ := FOffset.z; WriteBinField(153, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); {TODO} // пересмотреть - хрень по ходу здесь делается - ограниченный набор файлов только пишется // И НЕ ТАМ - должны раз только писаться эти два стрима!!! //for i := 0 to FFiles.Count - 1 do //begin // xStr := FFiles[i]; // if ((185 + i) <= 199) then // WriteStrField(185 + i, Stream, xStr); //end; //for i := 0 to FHashs.Count - 1 do //begin // xStr := FHashs[i]; // if ((200 + i) <= 219) then // WriteStrField(200 + i, Stream, xStr); //end; WriteStrField(181, Stream, FDescription.Text); WriteStrField(182, Stream, FObjectHash); WriteStrField(183, Stream, FTextureHash); WriteStrField(184, Stream, FTexture_ext); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message); end; end; (* procedure T3DConnector.WriteToStream(Stream: TStream); var i, xCount, xInt: Integer; xByte: Byte; xStr: string; xDouble: Double; aPoint: pInt; xStream: TFileStream; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); WriteString(Stream, F3dModelFileName); // Tolik 03/10/2018 -- xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FPoint.x; pDouble(pChar(aPoint) + 8)^ := FPoint.y; pDouble(pChar(aPoint) + 16)^ := FPoint.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FScale.x; pDouble(pChar(aPoint) + 8)^ := FScale.y; pDouble(pChar(aPoint) + 16)^ := FScale.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FRotate.x; pDouble(pChar(aPoint) + 8)^ := FRotate.y; pDouble(pChar(aPoint) + 16)^ := FRotate.z; WriteBinField(152, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FOffset.x; pDouble(pChar(aPoint) + 8)^ := FOffset.y; pDouble(pChar(aPoint) + 16)^ := FOffset.z; WriteBinField(153, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); {TODO} // пересмотреть - хрень по ходу здесь делается - ограниченный набор файлов только пишется // И НЕ ТАМ - должны раз только писаться эти два стрима!!! //for i := 0 to FFiles.Count - 1 do //begin // xStr := FFiles[i]; // if ((185 + i) <= 199) then // WriteStrField(185 + i, Stream, xStr); //end; //for i := 0 to FHashs.Count - 1 do //begin // xStr := FHashs[i]; // if ((200 + i) <= 219) then // WriteStrField(200 + i, Stream, xStr); //end; WriteStrField(181, Stream, FDescription.Text); WriteStrField(182, Stream, FObjectHash); WriteStrField(183, Stream, FTextureHash); WriteStrField(184, Stream, FTexture_ext); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message); end; end; *) { T3DComponent } // -- Tolik 17/10/2018 -- constructor T3DComponent.Create; begin inherited; FClassName := 'T3DComponent'; isGroupedFigure := False; end; {} { T3DLine } procedure T3DLine.CollectLine(aFaces: TList; ap: T3DPointArray); var aFace: TFaceRecord; k: integer; GetConn: TConnectorObject; // Tolik 26/04/2018 -- TrunkConn: TConnectorObject; TrunkZ: double; Procedure CollectComponDiams; var i: Integer; SCSCatalog: TSCSCatalog; LineCadList: TSCSList; SCSLine: TOrthoLine; MaxCableDiam, MaxPipeDiam, MaxCableChannelDiam: String; SCSCompon: TSCSComponent; ComponDiam: Double; begin if Self.FSCSObject <> nil then begin MaxCableDiam := '-1'; MaxPipeDiam := '-1'; MaxCableChannelDiam := '-1'; SCSCatalog := Nil; SCSLine := Self.FSCSObject; LineCadList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID); if LineCadList <> nil then SCSCatalog := LineCadList.GetCatalogFromReferencesBySCSID(SCSLine.ID); if SCSCatalog <> nil then begin for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSCompon := SCSCatalog.ComponentReferences[i]; //Tolik 10/04/2025 -- //if SCSCompon.ComponentType.SysName <> ctsnCableChannelAccessory then if ((SCSCompon.ComponentType.SysName <> ctsnCableChannelAccessory) and (SCSCompon.ComponentType.SysName <> ctsnWireTray)) then begin ComponDiam := getLineComponOutRadius(SCSCompon); if isCableComponent(SCSCompon) then //кабель begin if CompareValue(ComponDiam, StrToFloat_My(ComponDiameterList[0])) = 1 then ComponDiameterList[0] := FloatToStr(ComponDiam); end else //труба или гофра if (SCSCompon.ComponentType.SysName = ctsnTube) or (SCSCompon.Componenttype.GUID = '{80B7A366-98B3-4D3A-A115-C64A3498218E}') then // труба begin if (CompareValue(ComponDiam, StrToFloat_My(ComponDiameterList[1])) = 1) then ComponDiameterList[1] := FloatToStr(ComponDiam); end else // кабельный канал if SCSCompon.ComponentType.SysName = ctsnCableChannel then // кабельный канал или гофра begin if (CompareValue(ComponDiam, StrToFloat_My(ComponDiameterList[2])) = 1) then ComponDiameterList[2] := FloatToStr(ComponDiam); end; end; end; end; end; end; // begin try FPoint1 := ap[0]; FPoint2 := ap[1]; {TODO ZCoord} //ap[0].z := ap[0].z * FScaleDelta; //ap[1].z := ap[1].z * FScaleDelta; ap[0].z := ap[0].z * FScaleDeltaSCS; // NEWNEW ap[1].z := ap[1].z * FScaleDeltaSCS; // NEWNEW // Tolik 26/04/2018 -- if TOrthoLine(FSCSObject).FisRaiseUpDown then if ((HListOfCadsFor3DModel <> nil) or (LListOfCadsFor3DModel <> nil)) then begin TrunkConn := Nil; if TConnectorObject(TOrthoLine(FSCSObject).JoinConnector1).FConnRaiseType = crt_TrunkUP then begin TrunkConn := TConnectorObject(TOrthoLine(FSCSObject).JoinConnector1); TrunkZ := Ap[0].z; end else if TConnectorObject(TOrthoLine(FSCSObject).JoinConnector2).FConnRaiseType = crt_TrunkUP then begin TrunkConn := TConnectorObject(TOrthoLine(FSCSObject).JoinConnector2); TrunkZ := Ap[1].z; end end; // // переназначить первую сторону if FSCSObject.JoinConnector1 <> nil then begin if TConnectorObject(FSCSObject.JoinConnector1).JoinedConnectorsList.Count = 0 then GetConn := TConnectorObject(FSCSObject.JoinConnector1) else GetConn := TConnectorObject(TConnectorObject(FSCSObject.JoinConnector1).JoinedConnectorsList[0]); if GetConn <> nil then begin ap[0].x := GetConn.ActualPoints[1].x; ap[0].y := GetConn.ActualPoints[1].y; end; end; // переназначить вторую сторону if FSCSObject.JoinConnector2 <> nil then begin if TConnectorObject(FSCSObject.JoinConnector2).JoinedConnectorsList.Count = 0 then GetConn := TConnectorObject(FSCSObject.JoinConnector2) else GetConn := TConnectorObject(TConnectorObject(FSCSObject.JoinConnector2).JoinedConnectorsList[0]); if GetConn <> nil then begin ap[1].x := GetConn.ActualPoints[1].x; ap[1].y := GetConn.ActualPoints[1].y; end; end; // Tolik -- 26/04/2018 -- if TrunkConn <> nil then begin TrunkZ := GetTrunkZ(TrunkConn, TrunkZ); if TOrthoLine(FSCSObject).JoinConnector1.Id = TrunkConn.Id then AP[0].z := TrunkZ else if TOrthoLine(FSCSObject).JoinConnector2.Id = TrunkConn.Id then AP[1].z := TrunkZ; end; // CollectComponDiams; aFace := TFaceRecord.Create(ap, clBlack, ftLine, 0.1, False, FSCSObject); aFaces.Add(aFace); FFace := aFace; except on E: Exception do AddExceptionToLogEx('T3DLine.CollectLine', E.Message); end; end; constructor T3DLine.Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel); var i: integer; begin try inherited Create; FClassName := 'T3DLine'; FSCSObject := aSCSObject; FListID := GCadForm.FCADListID; FDescription := TStringList.Create; FCaptions := TStringList.Create; FNotes := TStringList.Create; FLineType := lt_Line; FParent := aParent; FLength := 0; // Tolik 08/11/2018 -- ComponDiameterList := TStringList.Create; ComponDiameterList.Add('-1'); // cable ComponDiameterList.Add('-1'); // tube ComponDiameterList.Add('-1'); // CableChannel // if aSCSObject <> nil then begin FSCSCompon := GetSCSComponByCADObj(aSCSObject); if FSCSCompon <> nil then FSCSComponID := FSCSCompon.ID else FSCSComponID := -1; FName := FSCSObject.Name; FIndex := FSCSObject.FIndex; //for i := 0 to FSCSObject.OutTextCaptions.Count - 1 do // FDescription.Add(FSCSObject.OutTextCaptions.Strings[i]); for i := 0 to FSCSObject.OutTextCaptions.Count - 1 do FCaptions.Add(FSCSObject.OutTextCaptions.Strings[i]); for i := 0 to FSCSObject.OutTextNotes.Count - 1 do FNotes.Add(FSCSObject.OutTextNotes.Strings[i]); if FScsObject.Name = cCadClasses_Mes25 then FLineType := lt_Raise; if FScsObject.Name = cCadClasses_Mes27 then FLineType := lt_FloorRaise; FLength := FSCSObject.LineLength; end; FGLObject := nil; FGLCaption := nil; FFace := nil; FPoint1.x := 0; FPoint1.y := 0; FPoint1.z := 0; FPoint2.x := 0; FPoint2.y := 0; FPoint2.z := 0; FGLPoint1.x := 0; FGLPoint1.y := 0; FGLPoint1.z := 0; FGLPoint2.x := 0; FGLPoint2.y := 0; FGLPoint2.z := 0; FColor := clBlack; FJoinConnector1 := nil; FJoinConnector2 := nil; except on E: Exception do AddExceptionToLogEx('T3DLine.Create', E.Message); end; end; // Tolik 24/07/2018 -- destructor T3DLine.destroy; begin FDescription.Free; FCaptions.Free; FNotes.Free; ComponDiameterList.Free; // Tolik 08/11/2018 -- inherited; end; // procedure T3DLine.ReadFromStream(Stream: TStream); var i, j: integer; isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; xd, yd, zd: Double; mStr: TMemoryStream; fStr: TFileStream; CanAdd: Boolean; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 21: FSCSComponID := intVal; 22: FListID := intVal; end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); Case xcode of 150: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPoint1.x := xd; FPoint1.y := yd; FPoint1.z := zd; end; 151: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPoint2.x := xd; FPoint2.y := yd; FPoint2.z := zd; end; end; end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; 181: FDescription.Text := strVal; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DLine.ReadFromStream', E.Message); end; end; procedure T3DLine.SetRelations; begin if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DModel(ModelObjectsList.Items[FParentIndex]); T3DModel(FParent).FScsObjects.Add(self); end; end; // Tolik 04/04/2019 -- procedure T3DLine.WriteToStream(Stream: TStream); var xInt: Integer; aPoint: pInt; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FPoint1.x; pDouble(PAnsiChar(aPoint) + 8)^ := FPoint1.y; pDouble(PAnsiChar(aPoint) + 16)^ := FPoint1.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FPoint2.x; pDouble(PAnsiChar(aPoint) + 8)^ := FPoint2.y; pDouble(PAnsiChar(aPoint) + 16)^ := FPoint2.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); WriteStrField(181, Stream, FDescription.Text); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message); end; end; { procedure T3DLine.WriteToStream(Stream: TStream); var i, xCount, xInt: Integer; xByte: Byte; xStr: string; xDouble: Double; aPoint: pInt; xStream: TFileStream; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FPoint1.x; pDouble(pChar(aPoint) + 8)^ := FPoint1.y; pDouble(pChar(aPoint) + 16)^ := FPoint1.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FPoint2.x; pDouble(pChar(aPoint) + 8)^ := FPoint2.y; pDouble(pChar(aPoint) + 16)^ := FPoint2.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); WriteStrField(181, Stream, FDescription.Text); WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message); end; end; } // Tolik 18/10/2018 -- Constructor T3DLineComponent.Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel); begin inherited; FClassName := 'T3DLineComponent'; end; // {Tolik 18/09/2018 -- T3DTube -- труба...} constructor T3DTube.Create(aFaces: TList; aSCSObject: TOrthoLine; aParent: T3DModel; aSCSCompon: TSCSComponent; aTubeDiameter: Double; aTailTubeList: TList = nil); var i: integer; begin try inherited Create; FClassName := 'T3DTube'; FSCSObject := aSCSObject; FListID := GCadForm.FCADListID; FDescription := TStringList.Create; FCaptions := TStringList.Create; FNotes := TStringList.Create; FLineType := lt_Line; FParent := aParent; FLength := 0; FColor := clBlue; FTopDiameter := 0.5; FBottomDiameter := 0.5; if aSCSCompon <> nil then if not aSCSCompon.ServToDelete then begin FSCSCompon := aSCSCompon; FSCSComponID := FSCSCompon.ID; FName := ASCSCompon.GetNameForVisible; FIndex := FSCSObject.FIndex; if aSCSCompon.IsLine = biTrue then FLength := aSCSCompon.GetPartLength; FTopDiameter := aTubeDiameter; FBottomDiameter := aTubeDiameter; for i := 0 to aSCSCompon.Properties.Count - 1 do begin if UPPERCASE(PProperty(aSCSCompon.Properties[i]).SysName) = 'COLOR' then begin try FColor := TColor(strtoInt(PProperty(aSCSCompon.Properties[i]).Value)); except end; end; {else if UPPERCASE(PProperty(aSCSCompon.Properties[i]).SysName) = pnOutDiametr then begin try FTopDiameter := StrToFloat_My(PProperty(aSCSCompon.Properties[i]).Value); FBottomDiameter := StrToFloat_My(PProperty(aSCSCompon.Properties[i]).Value); except end; end;} end; end; FGLObject := nil; FGLCaption := nil; FFace := nil; FPoint1.x := 0; FPoint1.y := 0; FPoint1.z := 0; FPoint2.x := 0; FPoint2.y := 0; FPoint2.z := 0; FGLPoint1.x := 0; FGLPoint1.y := 0; FGLPoint1.z := 0; FGLPoint2.x := 0; FGLPoint2.y := 0; FGLPoint2.z := 0; //FColor := clBlack; FJoinConnector1 := nil; FJoinConnector2 := nil; except on E: Exception do AddExceptionToLogEx('T3DLine.Create', E.Message); end; end; procedure T3DTube.CollectCylinder(aFaces: TList; ap: T3DPointArray); var aFace: TFaceRecord; k: integer; GetConn: TConnectorObject; // Tolik 26/04/2018 -- TrunkConn: TConnectorObject; TrunkZ: double; // begin TrunkConn := Nil; try FPoint1 := ap[0]; FPoint2 := ap[1]; {TODO ZCoord} //ap[0].z := ap[0].z * FScaleDelta; //ap[1].z := ap[1].z * FScaleDelta; ap[0].z := ap[0].z * FScaleDeltaSCS; // NEWNEW ap[1].z := ap[1].z * FScaleDeltaSCS; // NEWNEW // Tolik 26/04/2018 -- if TOrthoLine(FSCSObject).FisRaiseUpDown then if ((HListOfCadsFor3DModel <> nil) or (LListOfCadsFor3DModel <> nil)) then begin TrunkConn := Nil; if TConnectorObject(TOrthoLine(FSCSObject).JoinConnector1).FConnRaiseType = crt_TrunkUP then begin TrunkConn := TConnectorObject(TOrthoLine(FSCSObject).JoinConnector1); TrunkZ := Ap[0].z; end else if TConnectorObject(TOrthoLine(FSCSObject).JoinConnector2).FConnRaiseType = crt_TrunkUP then begin TrunkConn := TConnectorObject(TOrthoLine(FSCSObject).JoinConnector2); TrunkZ := Ap[1].z; end end; // { // переназначить первую сторону if FSCSObject.JoinConnector1 <> nil then begin if TConnectorObject(FSCSObject.JoinConnector1).JoinedConnectorsList.Count = 0 then GetConn := TConnectorObject(FSCSObject.JoinConnector1) else GetConn := TConnectorObject(TConnectorObject(FSCSObject.JoinConnector1).JoinedConnectorsList[0]); if GetConn <> nil then begin //ap[0].x := GetConn.ActualPoints[1].x; //ap[0].y := GetConn.ActualPoints[1].y; end; end; // переназначить вторую сторону if FSCSObject.JoinConnector2 <> nil then begin if TConnectorObject(FSCSObject.JoinConnector2).JoinedConnectorsList.Count = 0 then GetConn := TConnectorObject(FSCSObject.JoinConnector2) else GetConn := TConnectorObject(TConnectorObject(FSCSObject.JoinConnector2).JoinedConnectorsList[0]); if GetConn <> nil then begin ap[1].x := GetConn.ActualPoints[1].x; ap[1].y := GetConn.ActualPoints[1].y; end; end; } // Tolik -- 26/04/2018 -- if TrunkConn <> nil then begin TrunkZ := GetTrunkZ(TrunkConn, TrunkZ); if TOrthoLine(FSCSObject).JoinConnector1.Id = TrunkConn.Id then AP[0].z := TrunkZ else if TOrthoLine(FSCSObject).JoinConnector2.Id = TrunkConn.Id then AP[1].z := TrunkZ; end; // aFace := TFaceRecord.Create(ap, FColor, ftCylinder, 0.1, False, FSCSObject); aFaces.Add(aFace); FFace := aFace; except on E: Exception do AddExceptionToLogEx('T3DLine.CollectLine', E.Message); end; end; // Tolik 04/04/2019 -- procedure T3DTube.WriteToStream(Stream: TStream); var xInt: Integer; aPoint: pInt; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FPoint1.x; pDouble(PAnsiChar(aPoint) + 8)^ := FPoint1.y; pDouble(PAnsiChar(aPoint) + 16)^ := FPoint1.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FPoint2.x; pDouble(PAnsiChar(aPoint) + 8)^ := FPoint2.y; pDouble(PAnsiChar(aPoint) + 16)^ := FPoint2.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); WriteStrField(181, Stream, FDescription.Text); xInt := Integer(FColor); WriteField(23, Stream, xInt, sizeof(xInt)); // Color WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message); end; end; { procedure T3DTube.WriteToStream(Stream: TStream); var i, xCount, xInt: Integer; xByte: Byte; xStr: string; xDouble: Double; aPoint: pInt; xStream: TFileStream; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FPoint1.x; pDouble(pChar(aPoint) + 8)^ := FPoint1.y; pDouble(pChar(aPoint) + 16)^ := FPoint1.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FPoint2.x; pDouble(pChar(aPoint) + 8)^ := FPoint2.y; pDouble(pChar(aPoint) + 16)^ := FPoint2.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); WriteStrField(181, Stream, FDescription.Text); xInt := Integer(FColor); WriteField(23, Stream, xInt, sizeof(xInt)); // Color WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message); end; end; } procedure T3DTube.ReadFromStream(Stream: TStream); var i, j: integer; isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; xd, yd, zd: Double; mStr: TMemoryStream; fStr: TFileStream; CanAdd: Boolean; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 21: FSCSComponID := intVal; 22: FListID := intVal; 23: FColor := TColor(intVal); end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); Case xcode of 150: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPoint1.x := xd; FPoint1.y := yd; FPoint1.z := zd; end; 151: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPoint2.x := xd; FPoint2.y := yd; FPoint2.z := zd; end; end; end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; 181: FDescription.Text := strVal; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DLine.ReadFromStream', E.Message); end; end; procedure T3DTube.SetRelations; begin if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DModel(ModelObjectsList.Items[FParentIndex]); T3DModel(FParent).FScsObjects.Add(self); end; end; destructor T3DTube.destroy; begin FDescription.Free; FCaptions.Free; FNotes.Free; inherited; end; ///// T3DBooblick -- Tolik 20/09/2018 -- constructor T3DBooblick.Create(aFaces: TList; aSCSObject: TConnectorObject; aParent: T3DModel); var i: integer; begin try inherited Create; FClassName := 'T3DBooblick'; FSCSObject := aSCSObject; FListID := GCadForm.FCADListID; FDescription := TStringList.Create; FCaptions := TStringList.Create; FNotes := TStringList.Create; FLineType := lt_Line; FParent := aParent; FLength := 0; FColor := clBlue; FTopDiameter := 0.5; FBottomDiameter := 0.5; FGLObject := nil; FGLCaption := nil; FFace := nil; FPoint1.x := 0; FPoint1.y := 0; FPoint1.z := 0; FPoint2.x := 0; FPoint2.y := 0; FPoint2.z := 0; FGLPoint1.x := 0; FGLPoint1.y := 0; FGLPoint1.z := 0; FGLPoint2.x := 0; FGLPoint2.y := 0; FGLPoint2.z := 0; //FColor := clBlack; FJoinConnector1 := nil; FJoinConnector2 := nil; except on E: Exception do AddExceptionToLogEx('T3DLine.Create', E.Message); end; end; procedure T3DBooblick.CollectBooblick(aFaces: TList; ap: T3DPointArray); var aFace: TFaceRecord; k: integer; GetConn: TConnectorObject; // Tolik 26/04/2018 -- TrunkConn: TConnectorObject; TrunkZ: double; // begin TrunkConn := Nil; try FPoint1 := ap[0]; FPoint2 := ap[1]; aFace := TFaceRecord.Create(ap, FColor, ftBooblick, 0.1, False, FSCSObject); aFaces.Add(aFace); FFace := aFace; except on E: Exception do AddExceptionToLogEx('T3DLine.CollectLine', E.Message); end; end; // Tolik 04/04/2019 -- procedure T3DBooblick.WriteToStream(Stream: TStream); var xInt: Integer; aPoint: pInt; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FPoint1.x; pDouble(PAnsiChar(aPoint) + 8)^ := FPoint1.y; pDouble(PAnsiChar(aPoint) + 16)^ := FPoint1.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(PAnsiChar(aPoint) + 0)^ := FPoint2.x; pDouble(PAnsiChar(aPoint) + 8)^ := FPoint2.y; pDouble(PAnsiChar(aPoint) + 16)^ := FPoint2.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); WriteStrField(181, Stream, FDescription.Text); xInt := Integer(FColor); WriteField(23, Stream, xInt, sizeof(xInt)); // Color WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message); end; end; { procedure T3DBooblick.WriteToStream(Stream: TStream); var i, xCount, xInt: Integer; xByte: Byte; xStr: string; xDouble: Double; aPoint: pInt; xStream: TFileStream; begin try WriteString(Stream, FClassName); WriteString(Stream, FName); xInt := FSCSComponID; WriteField(21, Stream, xInt, sizeof(xInt)); xInt := FListID; WriteField(22, Stream, xInt, sizeof(xInt)); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FPoint1.x; pDouble(pChar(aPoint) + 8)^ := FPoint1.y; pDouble(pChar(aPoint) + 16)^ := FPoint1.z; WriteBinField(150, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); GetMem(aPoint, 24); pDouble(pChar(aPoint) + 0)^ := FPoint2.x; pDouble(pChar(aPoint) + 8)^ := FPoint2.y; pDouble(pChar(aPoint) + 16)^ := FPoint2.z; WriteBinField(151, Stream, pByte(aPoint), 24); FreeMem(aPoint, 24); WriteStrField(181, Stream, FDescription.Text); xInt := Integer(FColor); WriteField(23, Stream, xInt, sizeof(xInt)); // Color WriteStrField(180, Stream, 'BaseEnd'); except on E: Exception do AddExceptionToLogEx('T3DConnector.WriteToStream', E.Message); end; end; } procedure T3DBooblick.ReadFromStream(Stream: TStream); var i, j: integer; isOk: Boolean; xCode, xSize: Integer; intVal: Integer; byteVal: Byte; wordVal: Word; strVal: string; dblval: Double; xByte: pByte; xd, yd, zd: Double; mStr: TMemoryStream; fStr: TFileStream; CanAdd: Boolean; begin try isOk := False; FName := ReadStringFromStream(Stream); repeat xCode := 0; Stream.Read(xCode, 1); if (xCode >= 20) and (xCode < 90) then begin Stream.Read(intVal, 4); Case xcode of 21: FSCSComponID := intVal; 22: FListID := intVal; 23: FColor := TColor(intVal); end; end else if (xCode >= 90) and (xCode < 120) then begin Stream.Read(byteVal, 1); end else if (xCode >= 120) and (xCode < 150) then begin Stream.Read(wordVal, 2); end else if (xCode >= 150) and (xCode < 180) then begin Stream.Read(xSize, 4); Case xcode of 150: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPoint1.x := xd; FPoint1.y := yd; FPoint1.z := zd; end; 151: begin Stream.read(xd, 8); Stream.read(yd, 8); Stream.read(zd, 8); FPoint2.x := xd; FPoint2.y := yd; FPoint2.z := zd; end; end; end else if (xCode >= 180) and (xCode < 220) then begin strval := ReadStringFromStream(Stream); case xCode of 180: isOk := true; 181: FDescription.Text := strVal; end; end else if (xCode >= 220) and (xCode < 240) then begin Stream.Read(dblval, 8); end; until isOk; except on E: Exception do AddExceptionToLogEx('T3DLine.ReadFromStream', E.Message); end; end; procedure T3DBooblick.SetRelations; begin if FParentIndex = - 1 then begin FParent := nil; end else begin FParent := T3DModel(ModelObjectsList.Items[FParentIndex]); T3DModel(FParent).FScsObjects.Add(self); end; end; destructor T3DBooblick.destroy; begin FDescription.Free; FCaptions.Free; FNotes.Free; inherited; end; //// ///////////////////////////////////////////////////////// ///////////////////////Добавлено 10.12.2013 Митяй Д.В.////////////////////////// //*************** -ROOF- ************************** constructor T3DCorner.Create(AParent: T3DRoom; AName: string); begin inherited Create; FClassName := 'T3DCorner'; FName := AName; FParent := AParent; FZOrder := 0; FGLObject := nil; FFaceType := ftLine; JoinedWalls := TList.Create; FSCSCompon := nil; end; // Tolik 24/07/2018 -- destructor T3DCorner.destroy; begin SetLength(FGLPOints, 0); JoinedWalls.Free; inherited; end; destructor T3DWallElement.destroy; var i: Integer; begin for i := 0 to FSlopes.Count - 1 do begin T3DSlope(FSlopes[i]).free; end; FSlopes.free; for i := 0 to FSides.Count - 1 do begin T3DSide(FSides[i]).Free; end; FSides.Free; for i := 0 to FBalconElements.Count - 1 do begin T3DBalconElement(FBalconElements[i]).Free; end; FBalconElements.Free; inherited; end; Destructor T3DBalconElement.destroy; var i: Integer; begin for i := 0 to FSides.Count - 1 do begin T3DSide(FSides[i]).Free; end; FSides.Free; inherited; end; Destructor T3DSlope.destroy; var i: Integer; begin for i := 0 to FSides.Count - 1 do begin T3DSide(FSides[i]).Free; end; FSides.Free; inherited; end; Destructor T3DSObject.destroy; begin FDescription.free; inherited; end; Destructor T3DConnector.destroy; begin FDescription.Free; FCaptions.Free; FNotes.Free; FJoinedConnectorsList.Free; FJoinedLinesList.Free; FRelatedLines.Free; inherited; end; //*************** -\ROOF- ************************** end.