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

12467 lines
468 KiB
ObjectPascal
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit U_ArchCommon;
interface
uses Forms, StdCtrls, SysUtils, Classes, ComCtrls, Windows, Controls, Contnrs, Messages, ExtCtrls, Dialogs, Math, TypInfo,
Variants, Graphics,
U_BaseConstants, U_Constants,U_SCSComponent, U_SCSLists, U_TrunkSCS, DrawObjects, fplan, PowerCad, rrEllipses,
DB,kbmMemTable,kbmMemBinaryStreamFormat, RzRadChk,
PCTypesUtils, U_BaseCommon, U_ArchClasses, U_ArchStroyCalc, U_ESCadClasess, Keyboard, FastStrings, GLKeyboard;
const
ctDefWallHeight = 3;
ctDefRoofHipHeight = 0;
// Arch Objs sizes keys
aoskPathWidth = 'PATH_WIDTH';
aoskPathDoorSize = 'PATH_DR_SZ';
//Tolik -- ïî ïðîñüáå Àíòîøêè äîáàâëåíû ïàðàìåòðû äëÿ ñîõðàíåíèÿ è àâòîìàòè÷åñêîãî ñîçäàíèÿ äâåðè ñ ïàðàìåòðàìè ïîñëåäíåé
// ðåäàêòèðóåìîé äâåðè
aoskPathDoorMirrored = 'PATH_DR_MIRRORED';
aoskPathDoorDoubled = 'PATH_DR_DOUBLED';
aoskPathDoorLeftRight = 'PATH_DR_LEFTRIGHT';
aoskPathDoorOpened = 'PATH_DR_OPENED';
aoskPathDoorHalfOpened = 'PATH_DR_HALFOPENED';
//
type
TArchSlopeInfo = class;
TArchInfoBasicClass = class of TArchInfoBasic;
TArchInfoBasic = class(TComponent)
public
procedure Assign(Source: TPersistent); override;
end;
// Êîìíàòà
TArchRoomInfo = class(TArchInfoBasic)
private
FLength: Double;
FWidth: Double;
FHeightWall: Double;
FThicknessFront: Double;
FThicknessLeft: Double;
FThicknessRight: Double;
FThicknessBack: Double;
FBasement: Boolean;
published
Property Length: Double read FLength write FLength;
Property Width: Double read FWidth write FWidth;
Property HeightWall: Double read FHeightWall write FHeightWall;
Property Height_Walls: Double read FHeightWall write FHeightWall; // ÷òîáû èìÿ ñîâïàëî ñ ñèñòåìíûì èìåíåì ñâîéñòâà ñïðàâî÷íèêà
Property ThicknessFront: Double read FThicknessFront write FThicknessFront;
Property ThicknessLeft: Double read FThicknessLeft write FThicknessLeft;
Property ThicknessRight: Double read FThicknessRight write FThicknessRight;
Property ThicknessBack: Double read FThicknessBack write FThicknessBack;
Property Basement: Boolean read FBasement write FBasement;
end;
// Ñòåíà
TArchWallInfo = class(TArchInfoBasic)
private
FP1, FP2: TDoublePoint;
FHeight: Double;
FWidth: Double;
FThickness: Double;
//FLength: Double;
FWidthOut: Double;
FGroupName: String;
FBasement: Boolean;
FPlinthThickness: Double;
FPlinthHeight: Double;
FBasementThickness: Double;
FBasementDepth: Double;
FBasementColumnCount: Integer;
FBasementColumnH: Double;
FBasementColumnW: Double;
FBasementColumnL: Double;
public
Property P1: TDoublePoint read FP1 write FP1;
Property P2: TDoublePoint read FP2 write FP2;
published
Property Height: Double read FHeight write FHeight;
Property Width: Double read FWidth write FWidth;
Property Thickness: Double read FThickness write FThickness;
//Property Length: Double read FLength write FLength;
Property WidthOut: Double read FWidthOut write FWidthOut;
Property Width_Out: Double read FWidthOut write FWidthOut; // ÷òîáû èìÿ ñîâïàëî ñ ñèñòåìíûì èìåíåì ñâîéñòâà ñïðàâî÷íèêà
Property GroupName: String read FGroupName write FGroupName;
Property Group_Name: String read FGroupName write FGroupName;
Property Basement: Boolean read FBasement write FBasement;
Property PlinthThickness: Double read FPlinthThickness write FPlinthThickness;
Property Plinth_Thickness: Double read FPlinthThickness write FPlinthThickness;
Property PlinthHeight: Double read FPlinthHeight write FPlinthHeight;
Property Plinth_Height: Double read FPlinthHeight write FPlinthHeight;
Property BasementThickness: Double read FBasementThickness write FBasementThickness;
Property Basement_Thickness: Double read FBasementThickness write FBasementThickness;
Property BasementDepth: Double read FBasementDepth write FBasementDepth;
Property Basement_Depth: Double read FBasementDepth write FBasementDepth;
Property BasementColumnCount: Integer read FBasementColumnCount write FBasementColumnCount;
Property Basement_Column_Count: Integer read FBasementColumnCount write FBasementColumnCount;
Property BasementColumnH: Double read FBasementColumnH write FBasementColumnH;
Property Basement_Column_H: Double read FBasementColumnH write FBasementColumnH;
Property BasementColumnW: Double read FBasementColumnW write FBasementColumnW;
Property Basement_Column_W: Double read FBasementColumnW write FBasementColumnW;
Property BasementColumnL: Double read FBasementColumnL write FBasementColumnL;
Property Basement_Column_L: Double read FBasementColumnL write FBasementColumnL;
end;
// Ïåðåñòåíîê
TArchWallDivInfo = class(TArchWallInfo)
private
FCoordz: Double;
//FLength: Double;
published
Property Coordz: Double read FCoordz write FCoordz;
//Property Length: Double read FLength write FLength;
end;
// Îêíî, äâåðü
TArchWndInfo = class(TArchInfoBasic)
private
FHeight: Double;
FWidth: Double;
FCoordz: Double;
//FLength: Double;
FInnerSlope: TArchSlopeInfo; // Âíóòðåííèé îòêîñ
FOuterSlope: TArchSlopeInfo; // Âíåøíèé îòêîñ
FInnerSlopeOn: Boolean; // Âíóòðåííèé îòêîñ
FOuterSlopeOn: Boolean; // Âíåøíèé îòêîñ
public
Property InnerSlope: TArchSlopeInfo read FInnerSlope write FInnerSlope;
Property OuterSlope: TArchSlopeInfo read FOuterSlope write FOuterSlope;
procedure CreateChilds;
published
Property Height: Double read FHeight write FHeight;
Property Width: Double read FWidth write FWidth;
Property Coordz: Double read FCoordz write FCoordz;
//Property Length: Double read FLength write FLength;
Property InnerSlopeOn: Boolean read FInnerSlopeOn write FInnerSlopeOn; // Âíóòðåííèé îòêîñ
Property OuterSlopeOn: Boolean read FOuterSlopeOn write FOuterSlopeOn; // Âíåøíèé îòêîñ
end;
// Áàëêîííûé ïðîåì
TArchBalconyInfo = class(TArchInfoBasic)
private
FWidth: Double;
FWndInfo: TArchWndInfo; // Îêíî
FDoorInfo: TArchWndInfo; // Äâåðü
FInnerSlope: TArchSlopeInfo; // Âíóòðåííèé îòêîñ
public
Property WndInfo: TArchWndInfo read FWndInfo write FWndInfo;
Property DoorInfo: TArchWndInfo read FDoorInfo write FDoorInfo;
Property InnerSlope: TArchSlopeInfo read FInnerSlope write FInnerSlope;
procedure Assign(Source: TPersistent); override;
procedure CreateChilds;
published
Property Width: Double read FWidth write FWidth;
end;
// Îòêîñ
TArchSlopeInfo = class(TArchInfoBasic)
private
FHeight: Double;
FWidth: Double;
FDepth: Double;
published
Property Width: Double read FWidth write FWidth;
Property Height: Double read FHeight write FHeight;
Property Depth: Double read FDepth write FDepth;
end;
// Íèøà
TArchNicheInfo = class(TArchInfoBasic)
private
FWidth: Double;
FHeight: Double;
FDepth: Double;
FCoordz: Double;
//FLength: Double;
published
Property Width: Double read FWidth write FWidth;
Property Height: Double read FHeight write FHeight;
Property Depth: Double read FDepth write FDepth;
Property Coordz: Double read FCoordz write FCoordz;
//Property Length: Double read FLength write FLength;
end;
// êëàññ äëÿ ýêñïîðòà ñâîéñòâ àðõ. îáúåêòà â SC îáúåêò
{TArchObjPropExp = class(TMyObject)
FCaption: String;
FObjectSN: String;
FPropsSN: TStringList; // ñèñò.èìåíà ñâîéñòâ, êîòîðûå áóäóò ñóììèðîâàòüñÿ â ãðóïïå
// - ïåðâûì â ñïèñêå áóäåò ñâîéñòâî èç êîòîðîãî ñîçäàåòñÿ ýòîò îáúåêò
FGroupPropsSN: TStringList; // ñèñò.èìåíà ñâîéñòâ, ïî êîòîðûì áóäåò èäòè ãðóïïèðîâêà
FGroupedObjects: TObjectList; // ñãðóïïèðîâàííûå îáúåêòû
FObjectPropsSN: TStringList; // îñòàëüíûå ñèñò.èìåíà ñâîéñòâ, êîòîðûå ïîéäóò â îáúåêò SC
FAllObjectPropsSN: TStringList; // âåñü ïåðå÷åíü ñâîéñòâ, êîòîðûå ïîéäóò â îáúåêò SC
FPropsCorrespond: TStringList; // ñîîòâåòñòâèå ñèñòþèìåíå ñâîéñòâ àðõ.îáúåêòîâ è SC
procedure AddPropCorrespond(const AArchPropSN, ASCPropSN: String);
function AddGrpPropObj(const APropSN: string; AValue: string='0'): TStringList;
procedure AddPropValToGrp(const AGrpPropSN, AGrpVal, APropSN: String; AVal: Double);
function GetGrpObj(const AGrpPropSN, AGrpVal: String): TStringList; // Âåðíåò ãðóïïîâîé îáúåêò-StringList ïî íàçâàíèþ è çíà÷. ñâîéñòâà
constructor Create;
destructor Destroy; override;
procedure DefineAllProps;
end;}
TArchRoofSegInfo = class (TArchRoomInfo)
end;
TArchRoofHipInfo = class (TArchInfoBasic)
private
FP1, FP2: TDoublePoint;
FHeight: Double;
FLength: Double;
FLengthProj: Double;
FGroupName: String;
public
Property P1: TDoublePoint read FP1 write FP1;
Property P2: TDoublePoint read FP2 write FP2;
published
Property Height: Double read FHeight write FHeight;
Property Length: Double read FLength write FLength;
Property LengthProj: Double read FLengthProj write FLengthProj;
Property Length_Proj: Double read FLengthProj write FLengthProj;
Property GroupName: String read FGroupName write FGroupName;
Property Group_Name: String read FGroupName write FGroupName;
end;
function CreateArchObj(ATrgObject: TObject; ASrcObj: TSCSComponent; ASelect: Boolean = false): TSCSComponent;
function CreateArchObjFromNB(ATrgObject: TObject; ANBIsLine: Integer): TSCSComponent;
procedure CreateArchObjWizard(AIDList: Integer; ASrcObj: TSCSComponent; ACAD: TForm; ATrgObj: TObject);
procedure CreateArchObjWizardByType(AIDList: Integer; ASrcObjType: Integer; ACAD: TForm; ATrgObj: TObject);
procedure CreateArchObjWizardByCAD(ASrcObjType: Integer; ACAD: TForm; ATrgObj: TObject);
procedure CreateArchRoomByTool(ASrcObj: TSCSComponent; ACAD: TForm);
procedure CreateArchRoomWizard(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm);
procedure CreateArchWallDivisionWizard(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm);
procedure CreateArchWallChildWizard(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm; ATrgObj: TObject);
procedure CreateArchNicheWizard(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm);
procedure CreateArchRoom(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm; AArchRoomInfo: TArchRoomInfo);
function CreateArchRoomByWallInfo(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm; AObjType: Integer; AArchRoomInfo: TArchRoomInfo;
AWalsPoints: TDoublePointArr; AWallThickness, AWallWidths: TDoubleArray; ASelectInPM, AFromShadow: Boolean): TSCSComponent;
procedure CreateArchWall(ARoomObj, ASrcObj: TSCSComponent; ANet: TNet; AArchWallInfo: TArchWallInfo);
procedure CreateArchWallByNet(ANet: TNet; AWallType: Integer; AArchWallInfo: TArchWallInfo);
procedure CreateArchWallChild(AWallObj, ASrcObj: TSCSComponent; AWallPath: TNetPath; ACAD: TForm; AArchObjInfo: TComponent);
function CreateArchChild(ATarget: TSCSComponent; AChldInfo: TArchInfoBasic; AIsLine: Integer): TSCSComponent;
// Äëÿ ìîä.ïîèíòîâ îïðåäåëÿåò/ñîçäàåò êîìïîíåíòû
procedure DefineCADPointCornersObjects(ACAD: TForm);
procedure DivideNetWallByPoint(ACAD: TForm; APoint: TDoublePoint);
procedure EditCADArchObj(AObject: TObject);
function EditSelectedCADArchObj: Boolean;
function GetArchInfoClassByIsLine(AIsLine: Integer): TArchInfoBasicClass;
function AllowApplyObjForAll(AObj: TSCSComponent): Boolean;
// Ðàññ÷åò ñâîéñòâ äëÿ ñòåíû
procedure CalcArchWallProps(AArchWall: TSCSComponent; APath: TNetPath; AProperWidth, AOutWidth: Double; ASquare: Pointer);
// Ðàñ÷åò ïàðàìåòðîâ íà óãëàõ êîìíàòû
procedure CalcArchRoomCorners(AArchRoom: TSCSComponent; ANet: TNet);
procedure CalcAcrhRoofSegAreaByMaterial(AArchObj: TSCSComponent; ANet: TNet; AResidueSquare: Double; AShow: Boolean=false; APCAD: TPowerCad=nil);
// Ðàñ÷èòûâàåò ïàðàìåòðû ñåãìåíòà êðûøè
procedure CalcAcrhRoofSegProps(AArcjObj: TSCSComponent; ANet: TNet);
// Ñ÷èòàåò ïëîùàäü íàïóñêîâ è ñïóñêîâ
function CalcArchRoofSquareDesentVent(AArchObj: TSCSComponent; ANet: TNet): Double;
// Ðàññ÷èòûâàåò ïëîùàäü ôàñàäîâ ïîìåùåíèé íà ëèñòå
function CalcArchRoomsFacadeArea(ACAD: TForm): Double;
procedure ChangeArchChildObjWidthDelta(AObj: TSCSComponent; AChildType: Integer; ADelta: Double);
procedure ChangeArchChildObjWidthKoeff(AObj: TSCSComponent; AChildType: Integer; AKoeff: Double);
function CheckContureIntersectNet(AObjType: Integer; AConturePoints: PDoublePointArr; ACAD: TForm): Boolean;
// ïðîâåðÿåò ÿâëÿåòñÿ ëè âûïóêëûì ñåãìåíò êðûøè
function CheckNetRoofSegCortex(ANet: TNet; AArchObj: TSCSComponent): Boolean;
// Ïðîâåðÿåò åñòü ëè â ñïèñêå îáúåêò, êîòîðûé ñâÿçàí ïî àðõ. ñåãìåíòàì ïëàíà
function CheckPathInListByRelatedInCAD(APath: TNetPath; APathList: TList): Boolean;
// Ïðîâåðÿåò, ñî ñòîëáöàìè ëè ôóíäàìåíò ñåãìåíòà
function CheckWallWithBasementColumn(AWallobj: TSCSComponent): Boolean;
function CmpPathsHeights(APath1, APath2: TNetPath): Boolean;
function CreateArchSegmentInfo(AIsLine: Integer): TArchInfoBasic;
function CmpPoints(AP1, AP2: TDoublePoint): Boolean;
function DefineArchContainer(AList: TSCSList): TSCSCatalog;
// îïðåäåëÿåò íàèìåíîâàíèå äëÿ óãëà ñòåíû
procedure DefineArchCornerName(ACorner: TSCSComponent; ANet: TNet=nil);
// îïðåäåëÿåò íàèìåíîâàíèå äëÿ óãëîâ ñòåí
procedure DefineArchCornersNames(ACorners: TSCSComponents);
// Îïðåäåëèòü âûñîòû òî÷åê TNet âõîäÿùåãî â äðóãîé TNet
procedure DefineArchNetPointsHeight(ANet: TNet);
// Îïðåäåëèòü âûñîòû òî÷åê TNet âõîäÿùåãî â äðóãîé TNet, ANetDockSite - ïðèíèìàåìûé, AReceiveNet - ïðèåìíûé
procedure DefineArchNetPointsHeightInDock(ADockSiteNet, AReceiveNet: TNet; ADockSiteObj, AReceiveObj: TSCSComponent);
// Îïðåäåëÿåò ñâîéñòâà îáúåêòîâ ïîñëå Resize (âûñîòû/øèðèíû îòêîñîâ)
procedure DefineArchObjPropsOnResize(AArchObj: TSCSComponent; ACadObj: TObject=nil);
// Îïðåäåëÿåò íàèìåíîâàíèÿ âñåõ óãëîâ êîìíàòû
procedure DefineArchRoomCornersNamesByCadObj(ACADObj: TObject);
// Îïðåäåëÿåò íàèìåíîâàíèÿ âñåõ óãëîâ ñòåíû îò CAD îáúåêòà
procedure DefineArchWallCornersNamesByCadObj(ACADWallObj: TObject);
// Îïðåäåëÿåò íàèìåíîâàíèÿ âñåõ óãëîâ ñòåíû îò SCS îáúåêòà
procedure DefineArchWallCornersNames(AArchWall: TSCSComponent);
function DelArchCADObj(AObject: TObject): Boolean;
function DelArchObjByCADObj(ACADObject: TObject): Boolean;
function DelCADObjByArchObj(AObj: TSCSComponent): Boolean;
procedure DefineBasementProps(AArchWallObj: TSCSComponent; ACanRemove: Boolean; AIsCreatingObject: Boolean);
procedure DefinePropsByVal(AArchObj: TSCSComponent; const APropSN, AVal: String);
procedure DeleteArchObjDefaultParams(AObjectType: Integer);
procedure ExpArchObjPropToGrpObject(AArchObj: TSCSComponent; AObjPropExp: TArchObjPropExp; aAllowEmptyVal: Boolean=false);
procedure Exp3DToSCBuilding(AProject: TSCSProject; ASCBuilding: TASCBuilding);
procedure ExpRoofToSCBuilding(AList: TSCSList; ASCBuilding: TASCBuilding);
procedure ExpProjToStroyCalcAddPropToMT(AMT: TkbmMemTable; const AMTSysName, AValue: String);
function ExpProjToStroyCalcCreateMT: TkbmMemTable;
procedure ExpProjToStroyCalcGrpPropsToObjs(AProject: TSCSProject; AGrpObjs: TArchObjPropExp; ADestObj: TCollection; APropNameToCaption: Boolean=true; AMT: TkbmMemTable=nil);
procedure ExpProjToStroyCalcFile(AProject: TSCSProject; const AFileName: string);
procedure ExpProjToStroyCalcStream(AProject: TSCSProject; AStream: TStream);
procedure ExpProjToStroyCalcTest;
function GetAllRelatedNets(aNet: TNet): TList;
// Ïîëó÷èòü âñå îêíà/äâåðè/àðêè ñ ÊÀÄà
function GetAllWallChildsFromCAD(ACAD: TForm; AFilter: TDoorObjTypes): TList;
function GetArchCADObjCaption(ACADObj, AChildObj: TObject; const ADefault: String=''): String;
function GetArchCADObjLenCaption(ACADObj, AChildObj: TObject): String;
function GetArchCornersForNet(ANet: TNet; AArchObj: TSCSComponent): TSCSComponents;
// Âåðíåò óãëû äëÿ ñòåíû
function GetArchCornersForWall(AArchWall: TSCSComponent): TSCSComponents;
function GetArchCornerByPoint(ANet: TNet; p: PDoublePoint; aLookInList: Boolean=false): TSCSComponent;
function GetArchCornerByPointWithJoined(ANetList: TList; p: PDoublePoint): TSCSComponent;
function GetArchContainerByCADObj(ACADObj: TObject): TSCSCatalog;
function GetArchObjByCADObj(ACADObj: TObject; AArchContainer: TSCSCatalog=nil): TSCSComponent;
function GetArchObjsByCADObjs(ACADObjs: TList): TSCSComponents;
// âåðíåò êðàòêîå íàèìåíîâàíèå ñâîéñòâà
function GetArchObjPropShortName(const AName, ASysName: string): String;
// Âåðíåò ñâîéñòâî îáúåêòà â êîòîðîãî åñòü íóæíîå çíà÷åíèå (åñëè çàïðàøèâàåìîå ïóñòîå, òî çíà÷. ì.á. â äðóãîì)
function GetArchObjPropVal(AArchObj: TSCSComponent; const APropSN: String): PProperty;
function GetArchSegByPtWithJoined(ANetList: TList; p1, p2: PDoublePoint): TSCSComponents;
function GetArchSegTypeForFrame(AIsLine: Integer): Integer;
function GetArchWallCornersHeights(AArchWall: TSCSComponent; var ARes1,ARes2: Double; ACorners: TSCSComponents=nil): Boolean;
// Âåðíåò çíà÷åíèå ñâîéñòâà ñ óãîëêîâ ñòåíû
function GetArchWallCornersProps(AArchWall: TSCSComponent; const APropSN: String; var ARes1,ARes2: Double; ACorners: TSCSComponents=nil): Boolean;
// Âåðíåò ñòåíû äëÿ êîìïîíåíòà "ÓÃÎË ÑÒÅÍÛ"
function GetArchWallsForCorner(ACornerObject: TSCSComponent; ANet: TNet=nil): TSCSComponents;
// Âåðíåò îáúåêò ñ íàñòðîéêàìè ïî óìîë÷àíèþ äëÿ àðõ. îáúåêòà
function GetArchObjDefaultParams(AObjectType: Integer): TComponent;
// Îïðåäåëÿåò TNet â êîòîðûé âõîäèò ANet è êîòîðûå âõîäÿò â ANet
function GetInnerOuterNets(ANet: TNet; AArchObj: TSCSComponent; var AOuterNet: TNet; AInnerNets: TList;
AInnerNetsSquaes: TStringList=nil): Boolean;
function GetNetSquae(ANet: TNet; AArchObj: TSCSComponent): string;
// Âåðíåò ôóíäàìåíò ïî òèïó ïåðåñå÷åíèÿ èç ðåçóëüòàòà ïîèñêà ñìåæíûõ ñåãìåíòîâ
function GetRelBasementByIntersectType(AIntersectType: Integer; APaths, ACmpRes: TList): TSCSComponent;
function GetCADObjByArchObj(AArchObj: TObject; ACAD: TForm=nil): TObject;
function GetCADFormByObj(ACadObj: TObject): TForm;
function GetCADFormBySCSObject(ASCSObject: TObject): TForm;
function GetDoorObjTypeByIsLine(AIsLine: Integer): TDoorObjType;
function GetNBArchObj(AIsLine: Integer): TSCSComponent;
// Âåðíåò òî÷êó ñïðîåöèðîâàííóþ â 2D èç ìàññèâà ïî 3D òî÷êå
function GetNet2DPoint(ANet: TNet; A3DPt: PDoublePoint; APointsID: TList; A2DPoints: PDoublePointArr): PDoublePoint;
function GetNetByComponID(AComponID: Integer; ACAD: TForm): TNet;
function GetNetByComponIDFromList(AComponID: Integer; ANetList: TList): TNet;
function GetNetFromCADObj(ACADObj: TObject): TNet;
function GetNetPathByComponIDFromNet(AComponID: Integer; ANet: TNet): TNetPath;
function GetNetPathByComponID(AComponID: Integer; ACAD: TForm): TNetPath;
// Âåðíåò ñàìûé íèæíèé
function GetNetPathByLowerHeight(AArchObj: TSCSComponent; ANet: TNet): TNetPath;
function GetNetPathByProp(AArchObj: TSCSComponent; ANet: TNet; const APropSN, APropVal: String): TNetPath;
function GetNetPathInnerLen(APath: TNetPath): Double;
procedure GetNetRegionPathPoints(ANet: TNet; ARoomObj: TSCSComponent; var AResult: TDoublePointArr);
// ïîëó÷èòü óãîë ìåæäó äâóìÿ âûäåëåííûìè ñåãìåíòàìè
function GetNetSelPathsAngleInCAD(ANet: TNet; AArchObj: TSCSComponent): Double;
//procedure GetNetWallsPathsPoints(ANet: TNet; var AResult: TDoublePointArr);
function GetNetWallPathList(ANet: TNet; ARoomObj: TSCSComponent): TList;
//10.04.2012 - Íàéòè íàïðàâëåíèå îò ëèíèè ê òî÷êå - îïðåäåëèòü ñìîòðåòü ïàðàëåëüíî â + èëè -
function GetParallelPointDirectionKoeff(aLineP1, aLineP2, aPoint: TDoublePoint): Integer;
// Âåðíóòü òî÷êó èç óãëà
function GetPointByArchCorner(AArchCorner: TSCSComponent): PDoublePoint;
// Ïîëó÷èòü îêíà/äâåðè äëÿ ñòåíû èç ñìåæíûõ ñòåí
function GetWallArchChildsFromIntersectWall(AWall: TSCSComponent; AWallPath: TNetPath; ACADWallChilds: TList): TSCSComponents;
// Ïîëó÷èòü CAD îêíà/äâåðè äëÿ ñòåíû èç ñìåæíûõ ñòåí
function GetWallCADChildsFromIntersectWall(AWallPath: TNetPath; ACADWallChilds: TList; AFilter: TDoorObjTypes): TList;
function GetWallChildByComponID(AComponID: Integer; ACAD: TForm): TNetDoor;
// Âåðíåò äî÷åðíèå ýëåìåíòû äëÿ ñòåíû, â òîì ÷èñëå ñî ñìåæíûõ ñòåí
function GetWallChildsWithIntersect(AWall: TSCSComponent; AWallPath: TNetPath; ACADWallChilds: TList): TSCSComponents;
function GetWallNicheArea(AWallObj, ANicheObj: TSCSComponent; ATrgObjType: Integer; ALoadNicheProps: Boolean=true): Double;
function GetPathByPoint(ACAD: TForm; x, y: Double): TNetPath;
// Âåðíåò ñåãìåíòû äëÿ óãëà
function GetPathListForArchCorner(ACornerObject: TSCSComponent; ANet:TNet=nil): TList;
// Âåðíåò ñåãìåíòû, â êîòîðûå ïîïàäàåò òî÷êà
function GetPathListForPointIn(x,y: Double): TList;
procedure GetPathsPoints(ANetPaths: TList; var AResult: TDoublePointArr);
//procedure GetPathsConturePoints(ANetPaths: TList; AResultOuter, AResultInner: Pointer; AOutPaths, AInnPaths: TList);
function GetRoomArea(ANet: TNet; ARoomObj: TSCSComponent): Double;
procedure GetRoomInnerConturePoints(ANet: TNet; ARoomObj: TSCSComponent; AResult: PDoublePointArr; AWithHeights: Boolean{; AResHeights: PDoubleArray});
function GetRoomObjByNet(ANet: TNet; ARoomObj: TSCSComponent): TSCSComponent;
function GetRoomNetByPoint(APoint: TDoublePoint; ACAD: TForm): TNet;
function GetRoomObjByPoint(AList: TSCSList; APoint: TDoublePoint; ACAD: TForm; ARelNet: Pointer=nil): TSCSComponent;
function GetSCSComponByCADObj(ACADObj: TObject): TSCSComponent;
function GetSCSListByCAD(ACAD: TForm): TSCSList;
function GetSCSListByCADObj(ACADObj: TObject): TSCSList;
// Âåðíåò òî÷êè (óãëû), â êîòîðûõ âûñîòû áîëüøå íóëÿ
function GetTopArchCorners(AArchContainer: TSCSCatalog; AHeight: PDouble=nil): TSCSComponents;
function GetWallByPoint(ACAD: TForm; x, y: Double): TNetPath;
function GroupRoomNets(ACAD: TForm; aNetList: TList = nil; AShowTest: Boolean=false): TNet;
//10.05.2012 - Âñå ëè ñâÿçàííûå TNet îáúåêòû (÷åðåç îáúåêòû) â ñïèñêå
function IsAllRelatedNetsInList(aNet: TNet; aList: TList; aCheckCounts: Boolean=true): Boolean;
function LoadArchObjDefaultParams(AObj: TComponent; AObjectType: Integer): TComponent;
procedure LoadArchObjPropsFromCAD(AArchObj: TSCSComponent; ACADObj: TObject=nil);
procedure LoadArchObjPropsToCAD(AArchObj: TSCSComponent);
procedure OnSetArchObjProp(AProperty, AOldProperty: PProperty; AObj: TSCSComponent; aCallIdx:Integer=0);
procedure RefreshArchObjNode(ACADObj: TObject);
procedure RefreshNet(ANet: TNet);
procedure RotateNetByAngle(aNet: TNet; aAngle: Double);
function RotateNetTo2D(ANet: TNet; APointsID: TList; AShow: Boolean=false; APCAD: TPowerCad=nil): TDoublePointArr;
procedure SelectArchObjByCADObj(ACADObj: TObject; AArchObj: TSCSComponent=nil);
procedure SelectCADObjByArchObj(AArchObj: TObject);
procedure SetArchObjToDefaultParams(AObject: TComponent; AObjectType: Integer; ACanDelete: Boolean=false);
//procedure SetCADArchObjComponID(ACADObj: TObject; AComponID: Integer);
//procedure SetCADArchObjComponIDByCompon(ACompon: TSCSComponent; AComponID: Integer);
procedure SetCADArchObjectsNewID(AList: TSCSList; AOldIDs, NewIDs: TIntList);
// Óñòàíàâëèâàåò êýïøåíû ëýéáàì ôîðìû
procedure SetLableCaptions(AForm: TForm; AUOM: Integer);
procedure SetNetPathChildsWidth(APathArchObj: TSCSComponent; APath: TNetPath; AWidth: Double);
procedure SetNetPathColorByObj(APath: TNetPath; AObj: TSCSComponent);
function SetPathRoofHipType(ANetObj: TNet; APath: TNetPath; AValue: Integer): Boolean;
// Óñòàíîâèòü çíà÷åíèå òèïà ðåáðà êðûøè â òåêóùèé
function SetSelPathRoofHipType(ANetObj: TObject; AValue: Integer): Boolean;
function SetTopArchCornersHeight(AArchCorners: TSCSComponents; AOldHeight, ANewHeight: Double): TSCSComponents;
procedure ShowRoofParams(aCAD: TForm; aSCSList: TSCSList; aFigures: TList=nil; aFromNet: TNet=nil);
// Igor
function GetAllOtherNetWallsFromCAD(ACAD: TForm; aNet: TNet): TList;
function GetAllOtherNetsFromCAD(ACAD: TForm; aNet: TNet): TList;
// Èùåò ïëîùó ïîëèãîíà
//function GetAreaFromPolygon(APolygon: TDoublePointArr): Double;
function GetAreaFromPolygonM(APCAD: TPowerCad; APolygon: TDoublePointArr): Double;
function GetTrapezeArea(AHeightA, AHeightB, AWidth: Double): Double;
function GetTriangleArea(p1,p2,p3: TDoublePoint): Double;
// Åñòü ëè ïåðåñåêàþùèåñÿ ëèíèè ïî òî÷êàì
function IsCrossExistsByPoints(APoints: TDoublePointArr): Boolean;
//function IsPtInPolygon(APt: TDoublePoint; APollygonPaths: TDoublePointArr): Boolean;
function LinesCross(LineAP1, LineAP2, LineBP1, LineBP2 : TDoublePoint; AllowCommonPoint: Boolean=true): boolean;
function LineIntersect(AP1, AP2, BP1, BP2: TDoublePoint) : TDoublePoint;
function VectDot(v1,v2:TDoublePoint):Double;
function VectMul(v1:TDoublePoint;A:Double):TDoublePoint;
function VectSubtract(AVec1, AVec2 : TDoublePoint): TDoublePoint;
function VectNorm(V:TDoublePoint):TDoublePoint;
function VectProject(A,B:TDoublePoint):TDoublePoint;
function Perpendicular(A,B:TDoublePoint; C:TDoublePoint): TDoublePoint;
function NetGetSelPath: TNetPath;
procedure NetPathToArc;
procedure NetArcInvert;
function NetDoorRotate(aPath: TNetPath): TNetDoor;
procedure NetDoorShowOutNicheMessage(aNet: TNet; const aMsg: String);
procedure NetPathPerpendSideRotate(aPath: TNetPath);
procedure NetProps;
procedure IncDefWallType;
procedure ServDefineNetSegsHeights;
var
GArchEngine: TArchEngine;
implementation
// 2011-05-10
uses U_Main, U_ArchRoomParams, U_ArchWndDoorParams, U_ArchBalconyParams,
U_ArchNicheParams, U_ArchWallParams, U_CAD, U_Common, PCDrawing, {U_Arch3D}U_Arch3DNew,
U_ObjsProp, U_SCSClasses, U_BlockParams, USCS_Main;
{ TArchInfoBasic }
procedure TArchInfoBasic.Assign(Source: TPersistent);
begin
ObjectPropsToObj(Source, Self);
end;
procedure TArchWndInfo.CreateChilds;
begin
if Self.FInnerSlope = nil then
Self.FInnerSlope := TArchSlopeInfo.Create(Self);
if Self.FOuterSlope = nil then
Self.FOuterSlope := TArchSlopeInfo.Create(Self);
end;
{ TArchBalconyInfo }
procedure TArchBalconyInfo.Assign(Source: TPersistent);
var
Src: TArchBalconyInfo;
begin
if Source is TArchBalconyInfo then
begin
Src := TArchBalconyInfo(Source);
if Src.FWndInfo <> nil then
begin
if Self.FWndInfo = nil then
Self.FWndInfo := TArchWndInfo.Create(Self);
Self.FWndInfo.Assign(Src.FWndInfo);
end;
if Src.FDoorInfo <> nil then
begin
if Self.FDoorInfo = nil then
Self.FDoorInfo := TArchWndInfo.Create(Self);
Self.FDoorInfo.Assign(Src.FDoorInfo);
end;
if Src.FInnerSlope <> nil then
begin
if Self.FInnerSlope = nil then
Self.FInnerSlope := TArchSlopeInfo.Create(Self);
Self.FInnerSlope.Assign(Src.FInnerSlope);
end;
end;
end;
procedure TArchBalconyInfo.CreateChilds;
begin
if Self.FWndInfo = nil then
Self.FWndInfo := TArchWndInfo.Create(Self);
if Self.FDoorInfo = nil then
Self.FDoorInfo := TArchWndInfo.Create(Self);
if Self.FInnerSlope = nil then
Self.FInnerSlope := TArchSlopeInfo.Create(Self);
end;
{ TArchObjPropExp }
{
procedure TArchObjPropExp.AddPropCorrespond(const AArchPropSN, ASCPropSN: String);
begin
AddStrObjToStrings(FPropsCorrespond, AArchPropSN, ASCPropSN);
end;
function TArchObjPropExp.AddGrpPropObj(const APropSN: string; AValue: string): TStringList;
begin
//Result := Self.GetGrpObj(APropSN);
//if Result = nil then
//begin
Result := TStringList.Create;
AddGUIDIDToStrings(APropSN, AValue, 0, Result);
Self.FGroupedObjects.Add(Result);
Self.FPropsSN.Add(APropSN);
//end;
end;
procedure TArchObjPropExp.AddPropValToGrp(const AGrpPropSN, AGrpVal, APropSN: String; AVal: Double);
var
GrpObject: TStringList;
PropVal: String;
begin
// Èùåì ãðóïïîâîé îáúåêò ïî èìåíè ñâîéñòâà è çíà÷åíèþ
GrpObject := GetGrpObj(AGrpPropSN, AGrpVal);
// Åñëè íå íàøëè òî ñîçäàåì è äîáàâëÿåì ãðóïïîâîå ñâîéñòâî
if GrpObject = nil then
begin
GrpObject := AddGrpPropObj(APropSN);
FGroupPropsSN.Add(AGrpPropSN);
AddGUIDIDToStrings(AGrpPropSN, AGrpVal, 0, GrpObject);
end;
if GrpObject <> nil then
begin
PropVal := GetGUIDFromStrings(GrpObject, APropSN);
if PropVal <> '' then
PropVal := FloatToStrU(StrToFloatU(PropVal) + AVal)
else
PropVal := FloatToStrU(AVal);
SetGUIDToStrings(GrpObject, PropVal, APropSN);
end;
end;
function TArchObjPropExp.GetGrpObj(const AGrpPropSN, AGrpVal: String): TStringList;
var
i: integer;
CurrGrpObject: TStringList;
GrpPropVal: String;
begin
Result := nil;
for i := 0 to Self.FGroupedObjects.Count - 1 do
begin
CurrGrpObject := TStringList(Self.FGroupedObjects[i]);
GrpPropVal := GetGUIDFromStrings(CurrGrpObject, AGrpPropSN);
if GrpPropVal = AGrpVal then
begin
Result := CurrGrpObject;
Break; //// BREAK ////
end;
end;
end;
constructor TArchObjPropExp.Create;
begin
FPropsSN := TStringList.Create;
FGroupPropsSN := TStringList.Create;
FGroupedObjects := TObjectList.Create(true);
FObjectPropsSN := TStringList.Create;
FAllObjectPropsSN := TStringList.Create;
FPropsCorrespond := TStringList.Create;
end;
destructor TArchObjPropExp.Destroy;
var
i: Integer;
GrpObject: TStringList;
begin
FGroupPropsSN.Free;
FObjectPropsSN.Free;
FAllObjectPropsSN.Free;
for i := 0 to FGroupedObjects.Count - 1 do
begin
GrpObject := TStringList(FGroupedObjects[i]);
RemoveGUIDIDFromStrings(GrpObject, true);
end;
FGroupedObjects.Free;
FreeStringsObjects(FPropsCorrespond, true);
FPropsCorrespond.Free;
inherited;
end;
procedure TArchObjPropExp.DefineAllProps;
begin
FAllObjectPropsSN.Clear;
FAllObjectPropsSN.AddStrings(FPropsSN);
FAllObjectPropsSN.AddStrings(FGroupPropsSN);
FAllObjectPropsSN.AddStrings(FObjectPropsSN);
end;
}
function CreateArchObj(ATrgObject: TObject; ASrcObj: TSCSComponent; ASelect: Boolean = false): TSCSComponent;
var
SCSList: TSCSList;
SCSComponent: TSCSComponent;
ArchCntnr: TSCSCatalog;
NewComponID: Integer;
NewSCCompon: TSCSComponent;
Timer_DefineObjetsParamsInCAD: TTimer;
begin
Result := nil;
try
if ATrgObject <> nil then
begin
NewComponID := 0;
if ATrgObject is TSCSList then
begin
SCSList := TSCSList(ATrgObject); //F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(AIDList);
if SCSList <> nil then
begin
ArchCntnr := DefineArchContainer(SCSList);
if ArchCntnr <> nil then
begin
NewComponID := F_ProjMan.CopyComponentFromNbToPm(F_NormBase, F_NormBase.FProjectMan, ASrcObj.TreeViewNode, ArchCntnr.TreeViewNode,
ASrcObj.ID, ckCompon, true);
Result := ArchCntnr.GetComponentFromReferences(NewComponID);
end;
end;
end
else if ATrgObject is TSCSComponent then
begin
SCSComponent := TSCSComponent(ATrgObject);
if SCSComponent.TreeViewNode = nil then
TF_Main(SCSComponent.ActiveForm).FindComponOrDirInTree(SCSComponent.ID, true);
NewComponID := F_ProjMan.CopyComponentFromNbToPm(F_NormBase, F_NormBase.FProjectMan, ASrcObj.TreeViewNode, SCSComponent.TreeViewNode,
ASrcObj.ID, ckCompl, true);
Result := SCSComponent.GetComponentFromReferences(NewComponID);
SCSComponent.ComplectWith(Result, -1, true, true);
end;
if Result <> nil then
begin
Timer_DefineObjetsParamsInCAD := F_ProjMan.F_ChoiceConnectSide.Timer_DefineObjetsParamsInCAD;
if Timer_DefineObjetsParamsInCAD.Enabled then
if Assigned(Timer_DefineObjetsParamsInCAD.OnTimer) then
Timer_DefineObjetsParamsInCAD.OnTimer(Timer_DefineObjetsParamsInCAD);
if ASelect then
TF_Main(Result).SelectComponByIDInTree(Result.ID);
end;
end;
except
on E: Exception do AddExceptionToLogEx('CreateArchObj', E.Message);
end;
end;
function CreateArchObjFromNB(ATrgObject: TObject; ANBIsLine: Integer): TSCSComponent;
var
NBSrcObj: TSCSComponent;
begin
Result := nil;
NBSrcObj := GetNBArchObj(ANBIsLine); //07.10.2010 GetNBArchObj(ctArhFloor);
if NBSrcObj <> nil then
begin
Result := CreateArchObj(ATrgObject, NBSrcObj);
FreeAndNil(NBSrcObj);
end;
end;
procedure CreateArchObjWizard(AIDList: Integer; ASrcObj: TSCSComponent; ACAD: TForm; ATrgObj: TObject);
var
SCSList: TSCSList;
IsProgressActive: Boolean;
begin
IsProgressActive := GIsProgress; //GetIsActiveFormProgress;
if IsProgressActive then
PauseProgress(true);
try
if TF_CAD(ACAD).CurrentLayer <> lnArch then
TF_CAD(ACAD).CurrentLayer := lnArch;
SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(AIDList);
case ASrcObj.IsLine of
ctArhWall:
//GetRoomObjByPoint(SCSList, DoublePoint(TF_CAD(ACAD).DragX, TF_CAD(ACAD).DragY), ACAD);
DivideNetWallByPoint(ACAD, DoublePoint(TF_CAD(ACAD).DragX, TF_CAD(ACAD).DragY));
ctArhWallDivision:
CreateArchWallDivisionWizard(SCSList, ASrcObj, ACAD);
ctArhFloor:;
ctArhCeiling:;
ctArhEmbrasure:;
ctArhWindow, ctArhDoor, ctArhArc, ctArhBalcony, ctArhNiche:
CreateArchWallChildWizard(SCSList, ASrcObj, ACAD, ATrgObj);
ctArhRoof:
F_NormBase.Act_SendModelToProject.Execute;
else
begin
if IsArchTopComponByIsLine(ASrcObj.IsLine) then
begin
if TF_CAD(ACAD).FCreateObjectOnClick then
begin
CreateArchRoomByTool(ASrcObj, ACAD);
if ((aCad <> nil) and (ACad = GCadForm)) then // Tolik 04/03/2021 --
RestoreCadGridStatus;
end
else
CreateArchRoomWizard(SCSList, ASrcObj, ACAD);
end;
end;
end;
finally
if IsProgressActive then
PauseProgress(False);
end;
end;
procedure CreateArchObjWizardByType(AIDList: Integer; ASrcObjType: Integer; ACAD: TForm; ATrgObj: TObject);
var
SrcObj: TSCSComponent;
begin
if IsArchComponByIsLine(ASrcObjType) then
begin
SrcObj := GetNBArchObj(ASrcObjType);
if SrcObj <> nil then
begin
CreateArchObjWizard(AIDList, SrcObj, ACAD, ATrgObj);
FreeAndNil(SrcObj);
end;
end;
end;
procedure CreateArchObjWizardByCAD(ASrcObjType: Integer; ACAD: TForm; ATrgObj: TObject);
begin
if ACAD is TF_CAD then
CreateArchObjWizardByType(TF_CAD(ACAD).FCADListID, ASrcObjType, ACAD, ATrgObj);
end;
procedure CreateArchRoomByTool(ASrcObj: TSCSComponent; ACAD: TForm);
//var
//CAD: TF_CAD;
//CurrPos: TPoint;
begin
//CAD := TF_CAD(ACAD);
//GetCursorPos(CurrPos);
//CurrPos := CAD.ScreenToClient(CurrPos);
//RaiseActiveNet(CAD);
//if CAD.CurrentLayer <> lnArch then
// CAD.CurrentLayer := lnArch;
//CAD.PCad.SimulateUp(CurrPos.X, CurrPos.Y);
//CAD.PCad.SetTool(toFigure, TRoomWallRect.ClassName);
GArchEngine.SetRoomWallRectTool(ACAD);
end;
procedure CreateArchRoomWizard(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm);
var
RoomInfo: TArchRoomInfo;
begin
RoomInfo := ShowArchRoomParams(ASrcObj.IsLine, ASrcObj.GetPropertyValueAsBooleanDef(pnBasement, false));
if RoomInfo <> nil then
begin
TF_CAD(ACAD).BeginSaveForUndo(uat_None, True, False);
try
CreateArchRoom(AList, ASrcObj, ACAD, RoomInfo);
finally
TF_CAD(ACAD).EndSaveForUndo;
end;
FreeAndNil(RoomInfo);
end;
end;
procedure CreateArchWallDivisionWizard(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm);
var
CAD: TF_CAD;
IsSetTool: Boolean;
WallDivPath: TNetPath;
WallDivObj: TSCSComponent;
begin
IsSetTool := true;
CAD := TF_CAD(ACAD);
WallDivPath := GetWallByPoint(ACAD, TF_CAD(ACAD).DragX, TF_CAD(ACAD).DragY);
if WallDivPath <> nil then
begin
WallDivObj := GetArchObjByCADObj(WallDivPath);
if (WallDivObj <> nil) and (WallDivObj.IsLine = ctArhWallDivision) then
begin
IsSetTool := false;
if MessageQuastYN(cArchCommon_Msg02) = IDYes then
DivideNetWallByPoint(ACAD, DoublePoint(CAD.DragX, CAD.DragY));
end;
end;
if IsSetTool then
begin
RaiseActiveNet(CAD);
CAD.FCreateObjectOnClick := False;
if ((Cad <> nil) and (Cad = GCadForm)) then
RestoreCadGridStatus; // Tolik 04/03/2021 --
CAD.CurrentLayer := 8;
CAD.PCad.SetTool(toFigure, TWallDivPath.ClassName); //06.10.2010 CAD.PCad.SetTool(toFigure, 'TWallDivPath');
// CAD.PCad.MouseUp(mbLeft, [], CAD.DragX, CAD.DragY);
CAD.PCad.SimulateUp(CAD.DragX, CAD.DragY);
end;
end;
procedure CreateArchWallChildWizard(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm; ATrgObj: TObject);
var
CAD: TF_CAD;
WallPath: TNetPath;
WallObj: TSCSComponent;
ArchObjInfo: TComponent;
Msg: String;
begin
CAD := TF_CAD(ACAD);
WallPath := nil;
if (ATrgObj <> nil) and (ATrgObj is TNetPath) then
WallPath := TNetPath(ATrgObj);
if (WallPath = nil) and (CAD.DragX >= 0) and (CAD.DragY >= 0) then
WallPath := GetWallByPoint(ACAD, CAD.DragX, CAD.DragY);
// Tolik -- íå äàòü ïîëüçîâàòåëþ ðàçìåñòèòü îêíî/äâåðü/áàëêîí è ò.ï. íà ñòåíå â âèäå äóãè (õóéíÿ áóäåò ïîëíàÿ)
if (WallPath <> nil) and WallPath.isArc then
begin
ShowMessage(cDropOnArchWallWarning);
exit;
end;
//
if WallPath = nil then
begin
Msg := '';
case ASrcObj.IsLine of
ctArhWindow:
Msg := cArchParams_Msg08_01;
ctArhDoor:
Msg := cArchParams_Msg08_02;
ctArhNiche:
Msg := cArchParams_Msg08_03;
ctArhArc:
Msg := cArchParams_Msg08_05;
ctArhBalcony:
Msg := cArchParams_Msg08_06;
end;
if Msg <> '' then
MessageInfo(Msg);
end
else
begin
ArchObjInfo := nil;
case ASrcObj.IsLine of
ctArhWindow, ctArhDoor:
ArchObjInfo := ShowArchWndDoorParams(ASrcObj.IsLine, nil);
ctArhNiche, ctArhArc:
ArchObjInfo := ShowArchNicheParams(ASrcObj.IsLine, nil);
ctArhBalcony:
ArchObjInfo := ShowArchBalconyParams(ASrcObj.IsLine, nil);
end;
if ArchObjInfo <> nil then
begin
WallObj := AList.GetComponentFromReferences(WallPath.FComponID);
if WallObj <> nil then
begin
TF_CAD(ACAD).BeginSaveForUndo(uat_None, True, False);
try
CreateArchWallChild(WallObj, ASrcObj, WallPath, ACAD, ArchObjInfo);
finally
TF_CAD(ACAD).EndSaveForUndo;
end;
end;
end;
end;
end;
procedure CreateArchNicheWizard(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm);
begin
end;
procedure CreateArchRoom(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm; AArchRoomInfo: TArchRoomInfo);
var
//SCSList: TSCSList;
RoomObj: TSCSComponent;
WallSrcObj: TSCSComponent;
NewArchObj: TSCSComponent;
WalsPoints: TDoublePointArr;
//WalPoints: TDoublePointArr;
WallThickness: TDoubleArray; //array of Double;
WallWidths: TDoubleArray; //array of Double;
Net: TNet;
SavedActiveNet: TNet;
//NewPath: TNetPath;
CAD: TF_CAD;
CoordKoef: Double;
ArchWallInfo: TArchWallInfo;
i: integer;
begin
CAD := TF_CAD(ACAD);
CoordKoef := 1000/CAD.PCad.MapScale;
SetLength(WalsPoints, 5);
// Øèðèíà ñòåí (íå òîëùèíà)
SetLength(WallWidths, 4);
WallWidths[0] := AArchRoomInfo.FLength;
WallWidths[1] := AArchRoomInfo.FWidth;
WallWidths[2] := AArchRoomInfo.FLength;
WallWidths[3] := AArchRoomInfo.FWidth;
if (ASrcObj = nil) or (ASrcObj.isLine <> ctArhRoofSeg) then
begin
AArchRoomInfo.FLength := AArchRoomInfo.FLength + AArchRoomInfo.FThicknessRight/2 + AArchRoomInfo.FThicknessLeft/2;
AArchRoomInfo.FWidth := AArchRoomInfo.FWidth + AArchRoomInfo.FThicknessFront/2 + AArchRoomInfo.FThicknessBack/2;
end;
WalsPoints[0] := DoublePoint(CAD.DragX, CAD.DragY);
WalsPoints[1] := DoublePoint(CAD.DragX + AArchRoomInfo.FLength*CoordKoef, CAD.DragY);
WalsPoints[2] := DoublePoint(CAD.DragX + AArchRoomInfo.FLength*CoordKoef, CAD.DragY + AArchRoomInfo.FWidth*CoordKoef);
WalsPoints[3] := DoublePoint(CAD.DragX, CAD.DragY + AArchRoomInfo.FWidth*CoordKoef);
WalsPoints[4] := DoublePoint(CAD.DragX, CAD.DragY);
SetLength(WallThickness, 4);
WallThickness[0] := AArchRoomInfo.FThicknessFront;
WallThickness[1] := AArchRoomInfo.FThicknessRight;
WallThickness[2] := AArchRoomInfo.FThicknessBack;
WallThickness[3] := AArchRoomInfo.FThicknessLeft;
if Not CheckContureIntersectNet(ASrcObj.Isline, @WalsPoints, ACAD) then
RoomObj := CreateArchRoomByWallInfo(AList, ASrcObj, ACAD, ASrcObj.Isline, AArchRoomInfo, WalsPoints, WallThickness, WallWidths, true, false);
////SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(AIDList);
// RoomObj := CreateArchObj(AList, ASrcObj);
// if RoomObj <> nil then
// begin
// //RoomObj.SetPropertyValueAsFloat(pnHeightWalls, AArchRoomInfo.FHeightWall, false);
// ObjectPropsToSCSObj(AArchRoomInfo, RoomObj);
//
// // Äîáàâëÿåì ïîë
// CreateComponInPMByType(RoomObj, ctsnArhFloor, ctArhFloor);
// // Äîáàâëÿåì ïîòîëîê
// CreateComponInPMByType(RoomObj, ctsnArhCeiling, ctArhCeiling);
//
// WallSrcObj := GetNBArchObj(ctArhWall);
// if WallSrcObj <> nil then
// begin
// CAD := TF_CAD(ACAD);
// CoordKoef := 1000/CAD.PCad.MapScale;
// SetLength(WalsPoints, 5);
// // Øèðèíà ñòåí (íå òîëùèíà)
// SetLength(WallWidths, 4);
// WallWidths[0] := AArchRoomInfo.FLength;
// WallWidths[1] := AArchRoomInfo.FWidth;
// WallWidths[2] := AArchRoomInfo.FLength;
// WallWidths[3] := AArchRoomInfo.FWidth;
//
// AArchRoomInfo.FLength := AArchRoomInfo.FLength + AArchRoomInfo.FThicknessRight/2 + AArchRoomInfo.FThicknessLeft/2;
// AArchRoomInfo.FWidth := AArchRoomInfo.FWidth + AArchRoomInfo.FThicknessFront/2 + AArchRoomInfo.FThicknessBack/2;
//
// WalsPoints[0] := DoublePoint(CAD.DragX, CAD.DragY);
// WalsPoints[1] := DoublePoint(CAD.DragX + AArchRoomInfo.FLength*CoordKoef, CAD.DragY);
// WalsPoints[2] := DoublePoint(CAD.DragX + AArchRoomInfo.FLength*CoordKoef, CAD.DragY + AArchRoomInfo.FWidth*CoordKoef);
// WalsPoints[3] := DoublePoint(CAD.DragX, CAD.DragY + AArchRoomInfo.FWidth*CoordKoef);
// WalsPoints[4] := DoublePoint(CAD.DragX, CAD.DragY);
//
// SetLength(WallThickness, 4);
// WallThickness[0] := AArchRoomInfo.FThicknessFront;
// WallThickness[1] := AArchRoomInfo.FThicknessRight;
// WallThickness[2] := AArchRoomInfo.FThicknessBack;
// WallThickness[3] := AArchRoomInfo.FThicknessLeft;
//
//
// Net := Tnet.create(8, mydsNormal, CAD.PCad);
// //Net.FID := GenNewSCSID;
// Net.FComponID := RoomObj.ID;
// //Net.FOnAutoAddPath := GArchEngine.OnAutoAddPath;
// GArchEngine.SetHandlersToObj(Net);
// CAD.PCad.AddCustomFigure(8, Net, False);
//
// SavedActiveNet := ActiveNet;
// try
// ActiveNet := Net;
// RaiseActiveNet(CAD);
//
// // Äîáàâëÿåì ñòåíû
// ArchWallInfo := TArchWallInfo.Create(nil);
// for i := 1 to 4 do
// begin
// ArchWallInfo.FP1 := WalsPoints[i-1];
// ArchWallInfo.FP2 := WalsPoints[i];
// ArchWallInfo.FThickness := WallThickness[i-1];
// ArchWallInfo.FHeight := AArchRoomInfo.FHeightWall;
// ArchWallInfo.FWidth := WallWidths[i-1];
// CreateArchWall(RoomObj, WallSrcObj, Net, ArchWallInfo);
// end;
//
// FreeAndNil(ArchWallInfo);
// RefreshNet(Net);
// Net.Modified := True;
//
// RefreshCAD(CAD.PCad);
// finally
// ActiveNet := SavedActiveNet;
// end;
// FreeAndNil(WallSrcObj);
// end;
//
// TF_Main(RoomObj.ActiveForm).SelectComponByIDInTree(RoomObj.ID);
// end;
end;
function CreateArchRoomByWallInfo(AList: TSCSList; ASrcObj: TSCSComponent; ACAD: TForm; AObjType: Integer; AArchRoomInfo: TArchRoomInfo;
AWalsPoints: TDoublePointArr; AWallThickness, AWallWidths: TDoubleArray; ASelectInPM, AFromShadow: Boolean): TSCSComponent;
var
ObjType: Integer;
ArchRoomInfo: TArchRoomInfo;
RoomObj: TSCSComponent;
WallSrcObj: TSCSComponent;
NewArchObj: TSCSComponent;
CAD: TF_CAD;
Net: TNet;
SavedActiveNet: TNet;
DefArchWallInfo: TArchWallInfo;
ArchWallInfo: TArchWallInfo;
CoordKoef: Double;
DefThickness: Double;
i: integer;
begin
Result := nil;
if AList = nil then
AList := GetSCSListByCAD(ACAD);
RoomObj := nil;
if ASrcObj = nil then
begin
if AObjType = ctNone then
begin
if IsArchTopComponByIsLine(F_NormBase.GSCSBase.SCSComponent.IsLine) then
RoomObj := CreateArchObj(AList, F_NormBase.GSCSBase.SCSComponent)
else
RoomObj := CreateArchObjFromNB(AList, ctArhRoom);
end
else
begin
if AObjType = F_NormBase.GSCSBase.SCSComponent.IsLine then
RoomObj := CreateArchObj(AList, F_NormBase.GSCSBase.SCSComponent)
else
RoomObj := CreateArchObjFromNB(AList, AObjType);
end;
end
else
RoomObj := CreateArchObj(AList, ASrcObj);
if RoomObj <> nil then
begin
Result := RoomObj;
GArchEngine.BeginInsertObject(RoomObj.IsLine);
try
//26.04.2011 DefArchWallInfo := TArchWallInfo(GetArchObjDefaultParams(ctArhWall));
DefArchWallInfo := TArchWallInfo(GetArchObjDefaultParams(GetArchSegTypeForFrame(AObjType)));
ArchRoomInfo := AArchRoomInfo;
if ArchRoomInfo = nil then
begin
ArchRoomInfo := TArchRoomInfo.Create(nil);
if DefArchWallInfo <> nil then
ArchRoomInfo.HeightWall := DefArchWallInfo.FHeight
else
begin
if AObjType = ctArhRoofSeg then
ArchRoomInfo.HeightWall := ctDefRoofHipHeight
else
ArchRoomInfo.HeightWall := ctDefWallHeight;
end;
//04.07.2012 - ÷òîáû íå ïîòåðÿëîñü çíà÷åíèå ôëàãà íà ïðèìåíåíèè ïàðàìåòðîâ ê îáúåêòó â ObjectPropsToSCSObj
ArchRoomInfo.FBasement := RoomObj.GetPropertyValueAsBooleanDef(pnBasement, false);
end;
ObjectPropsToSCSObj(ArchRoomInfo, RoomObj);
if AObjType in [ctArhRoom, ctArhBrickWall] then
begin
// Äîáàâëÿåì ïîë
CreateComponInPMByType(RoomObj, ctsnArhFloor, ctArhFloor);
// Äîáàâëÿåì ïîòîëîê
CreateComponInPMByType(RoomObj, ctsnArhCeiling, ctArhCeiling);
end;
WallSrcObj := nil; //GetNBArchObj(ctArhWall);
//if WallSrcObj <> nil then
begin
CAD := TF_CAD(ACAD);
CoordKoef := 1000/CAD.PCad.MapScale;
Net := Tnet.create(8, mydsNormal, CAD.PCad);
//Net.FID := GenNewSCSID;
Net.FComponID := RoomObj.ID;
//Net.FOnAutoAddPath := GArchEngine.OnAutoAddPath;
Net.FDisableMergePaths := true; //15.10.2010
GArchEngine.SetHandlersToObj(Net);
CAD.PCad.AddCustomFigure(lnArch, Net, False);
SavedActiveNet := ActiveNet;
try
DefThickness := 0;
if AWallThickness = nil then
begin
if DefArchWallInfo <> nil then
DefThickness := DefArchWallInfo.FThickness
else if RoomObj.IsLine = ctArhRoofSeg then
DefThickness := cstWallLineWidth
else
DefThickness := 0.4;
end;
if AFromShadow and (DefThickness <> 0) then
if IsArchRoomComponByIsLine(RoomObj.IsLine) then
case CAD.FShowPathTraceLengthType of
sltOuter:
// Åñëè íàðèñîâàëè êîíòóð êàê âíåøíèé, òîãäà åãî óìåíüøàåì íà ïîëîâèíó øèðèíû
ScaleConturePoints(AWalsPoints, DefThickness*(-0.5) * CoordKoef);
sltInner:
// Åñëè íàðèñîâàëè êîíòóð êàê âíóòðåííèé, òîãäà åãî óâåëè÷èì íà ïîëîâèíó øèðèíû
ScaleConturePoints(AWalsPoints, DefThickness*0.5 * CoordKoef);
end;
ActiveNet := Net;
RaiseActiveNet(CAD);
// Äîáàâëÿåì ñòåíû
ArchWallInfo := TArchWallInfo.Create(nil);
if Assigned(AArchRoomInfo) then
ArchWallInfo.FBasement := AArchRoomInfo.FBasement
else if RoomObj.GetPropertyBySysName(pnBasement) <> nil then
ArchWallInfo.FBasement := RoomObj.GetPropertyValueAsBooleanDef(pnBasement, false)
else
ArchWallInfo.FBasement := F_NormBase.Act_DrawBasement.Checked;
for i := 1 to Length(AWalsPoints)-1 do //14.10.2010 for i := 1 to 4 do
begin
ArchWallInfo.FP1 := AWalsPoints[i-1];
ArchWallInfo.FP2 := AWalsPoints[i];
if AWallThickness <> nil then
ArchWallInfo.FThickness := AWallThickness[i-1]
else
ArchWallInfo.FThickness := DefThickness;
//19.04.2011 else if DefArchWallInfo <> nil then
//19.04.2011 ArchWallInfo.FThickness := DefArchWallInfo.FThickness
//19.04.2011 else
//19.04.2011 ArchWallInfo.FThickness := 0.4;
ArchWallInfo.FHeight := ArchRoomInfo.FHeightWall;
if AWallWidths <> nil then
ArchWallInfo.FWidth := AWallWidths[i-1]
else
ArchWallInfo.FWidth := GetLineLength(ArchWallInfo.FP1, ArchWallInfo.FP2) * (CAD.PCad.MapScale/1000) - ArchWallInfo.FThickness;
CreateArchWall(RoomObj, WallSrcObj, Net, ArchWallInfo);
end;
FreeAndNil(ArchWallInfo);
RefreshNet(Net);
Net.Modified := True;
RefreshCAD(CAD.PCad);
finally
Net.FDisableMergePaths := false;
ActiveNet := SavedActiveNet;
end;
if WallSrcObj <> nil then
FreeAndNil(WallSrcObj);
end;
if AArchRoomInfo = nil then
ArchRoomInfo.Free;
if ASelectInPM then
TF_Main(RoomObj.ActiveForm).SelectComponByIDInTree(RoomObj.ID);
if DefArchWallInfo <> nil then
DefArchWallInfo.Free;
finally
GArchEngine.EndInsertObject(RoomObj.ID);
end;
end;
end;
procedure CreateArchWall(ARoomObj, ASrcObj: TSCSComponent; ANet: TNet; AArchWallInfo: TArchWallInfo);
var
WallObj: TSCSComponent;
WalPoints: TDoublePointArr;
NewPath: TNetPath;
begin
SetLength(WalPoints, 2);
WalPoints[0] := AArchWallInfo.FP1;
WalPoints[1] := AArchWallInfo.FP2;
NewPath := ANet.MakePath(WalPoints, false);
if NewPath <> nil then
begin
WallObj := nil;
if ASrcObj = nil then
begin
if ARoomObj.IsLine = ctArhRoofSeg then
WallObj := TSCSComponent(CreateComponInPMByType(ARoomObj, ctsnArhRoofHip, ctArhRoofHip))
else
WallObj := TSCSComponent(CreateComponInPMByType(ARoomObj, ctsnArhWall, ctArhWall))
end
else
WallObj := CreateArchObj(ARoomObj, ASrcObj);
if WallObj <> nil then
begin
//WallObj.SetPropertyValueAsFloat(pnThickness, AArchWallInfo.FThickness, false);
//WallObj.SetPropertyValueAsFloat(pnHeight, AArchWallInfo.FHeight, false);
//WallObj.SetPropertyValueAsFloat(pnWidth, AArchWallInfo.FWidth, false);
ObjectPropsToSCSObj(AArchWallInfo, WallObj);
NewPath.FComponID := WallObj.ID;
if WallObj.IsLine = ctArhRoofHip then
begin
NewPath.WStyle := wsLine;
NewPath.Width := 0; //06.05.2011 0.1;
end
else
NewPath.Width := AArchWallInfo.FThickness * (1000/ TPowerCad(ANet.Owner).MapScale);
//NewPath.WStyle := wsLine;
//22.11.2010
// // Ïîä÷èùàåì ñâîéñòâà êîòîðûå íå áóäóò èñïîëüçîâàòüñÿ
// // îáúåìû ôóíäàìåíòà òîëüêî äëÿ êèð.ñòåíû
// if ARoomObj.IsLine <> ctArhBrickWall then
// begin
// WallObj.RemovePropertyBySysName(pnBasementVolumeAboveGround);
// WallObj.RemovePropertyBySysName(pnBasementVolumeunderGround);
// WallObj.RemovePropertyBySysName(pnBasementVolume);
// WallObj.RemovePropertyBySysName(pnBasementThicknessAboveGround);
// WallObj.RemovePropertyBySysName(pnBasementThicknessUnderGround);
// end
// else
// WallObj.SetPropertyValueAsFloat(pnBasementThicknessAboveGround, AArchWallInfo.FThickness); // òîëùèíà ôóíäàìåíòà îò òîëùèíû ñòåíû
// Ñâîéñòâà äëÿ ôóíäàìåíòà
DefineBasementProps(WallObj, true, true); //22.11.2010
SetNetPathColorByObj(NewPath, WallObj);
end;
//NewPath.FComponID := WallObj.ID;
//NewPath.Width := AArchWallInfo.FThickness * (1000/ TPowerCad(ANet.Owner).MapScale);
//NewPath.FOnSelect := GArchEngine.OnSelectObj;
GArchEngine.SetHandlersToObj(NewPath);
SetLength(WalPoints, 0); // Tolik 24/12/2019 --
end;
end;
procedure CreateArchWallByNet(ANet: TNet; AWallType: Integer; AArchWallInfo: TArchWallInfo);
var
RoomObj: TSCSComponent;
SrcObj: TSCSComponent;
begin
GArchEngine.BeginInsertObject(AWallType);
try
RoomObj := GetRoomObjByNet(ANet, nil);
if RoomObj <> nil then
begin
SrcObj := GetNBArchObj(AWallType);
if SrcObj <> nil then
begin
CreateArchWall(RoomObj, SrcObj, ANet, AArchWallInfo);
FreeAndNil(SrcObj);
end;
end;
finally
GArchEngine.EndInsertObject(0);
end;
end;
procedure CreateArchWallChild(AWallObj, ASrcObj: TSCSComponent; AWallPath: TNetPath; ACAD: TForm; AArchObjInfo: TComponent);
var
NewObj: TSCSComponent;
NewPath: TNetPath;
ChildObj: TSCSComponent;
WallPath: TNetPath;
DoorObjType: TDoorObjType;
NewDoor: TNetDoor;
ObjWidth: Double;
begin
NewObj := CreateArchObj(AWallObj, ASrcObj);
if NewObj <> nil then
begin
//NewObj.SetPropertyValueAsFloat(pnCoordZ, AArchWndInfo.FCoordz, false);
//NewObj.SetPropertyValueAsFloat(pnWidth, AArchWndInfo.FWidth, false);
//NewObj.SetPropertyValueAsFloat(pnHeight, AArchWndInfo.FHeight, false);
ObjectPropsToSCSObj(AArchObjInfo, NewObj);
// Ñîçäàåì îòêîñû
if AArchObjInfo is TArchWndInfo then
begin
if TArchWndInfo(AArchObjInfo).InnerSlopeOn then
CreateArchChild(NewObj, TArchWndInfo(AArchObjInfo).InnerSlope, ctArhInnerSlope);
if TArchWndInfo(AArchObjInfo).OuterSlopeOn then
CreateArchChild(NewObj, TArchWndInfo(AArchObjInfo).OuterSlope, ctArhOuterSlope);
end
// Ñîçäàåì îêíî, äâåðü, îòêîñû áàëêîíà
else if AArchObjInfo is TArchBalconyInfo then
begin
CreateArchChild(NewObj, TArchBalconyInfo(AArchObjInfo).InnerSlope, ctArhInnerSlope);
ChildObj := CreateArchChild(NewObj, TArchBalconyInfo(AArchObjInfo).WndInfo, ctArhWindow);
ChildObj.RemovePropertyBySysName(pnSquareSlope);
ChildObj.RemovePropertyBySysName(pnCoordZ);
ChildObj := CreateArchChild(NewObj, TArchBalconyInfo(AArchObjInfo).DoorInfo, ctArhDoor);
ChildObj.RemovePropertyBySysName(pnSquareSlope);
ChildObj.RemovePropertyBySysName(pnCoordZ);
end;
WallPath := AWallPath;
if WallPath = nil then
WallPath := GetNetPathByComponID(AWallObj.ID, ACAD);
if WallPath <> nil then
begin
DoorObjType := GetDoorObjTypeByIsLine(NewObj.IsLine);
if DoorObjType <> dotNone then
begin
//ObjWidth := AArchWndInfo.FWidth * 1000 / TF_CAD(ACAD).PCad.MapScale;
ObjWidth := GetPropValue(AArchObjInfo, 'Width') * 1000 / TF_CAD(ACAD).PCad.MapScale;
if ObjWidth >= WallPath.InnerLen then
ObjWidth := 0.7 * WallPath.InnerLen;
//NewDoor := WallPath.NewDoor(15, ObjWidth, DoorObjType);
NewDoor := WallPath.AddDoorAtPt(DoublePoint(TF_CAD(ACAD).DragX, TF_CAD(ACAD).DragY), ObjWidth, DoorObjType);
NewDoor.FComponID := NewObj.ID;
//NewDoor.FOnDoorChangePathQuery := GArchEngine.OnDoorChangePathQuery;
//NewDoor.FOnSelect := GArchEngine.OnSelectObj;
GArchEngine.SetHandlersToObj(NewDoor);
WallPath.Net.RefreshPaths;
RefreshCAD_T(TF_CAD(ACAD).PCad);
end;
end;
TF_Main(NewObj.ActiveForm).SelectComponByIDInTree(NewObj.ID);
end;
end;
function CreateArchChild(ATarget: TSCSComponent; AChldInfo: TArchInfoBasic; AIsLine: Integer): TSCSComponent;
var
ComponTypeSysName: String;
begin
Result := nil;
if AChldInfo <> nil then
begin
ComponTypeSysName := '';
case AIsLine of
ctArhInnerSlope:
ComponTypeSysName := ctsnArhInnerSlope;
ctArhOuterSlope:
ComponTypeSysName := ctsnArhOuterSlope;
ctArhWindow:
ComponTypeSysName := ctsnArhWindow;
ctArhDoor:
ComponTypeSysName := ctsnArhDoor;
end;
if ComponTypeSysName <> '' then
begin
Result := TSCSComponent(CreateComponInPMByType(ATarget, ComponTypeSysName, AIsLine));
if Result <> nil then
ObjectPropsToSCSObj(AChldInfo, Result);
end;
end;
end;
procedure DefineCADPointCornersObjects(ACAD: TForm);
var
Figure: TFigure;
Net: TNet;
PointID: Integer;
i, j: Integer;
begin
if ACAD <> nil then
begin
for i := 0 to TF_CAD(ACAD).PCad.Figures.Count - 1 do
begin
Figure := TFigure(TF_CAD(ACAD).PCad.Figures[i]);
if Figure is TNet then
begin
Net := TNet(Figure);
if (Net.FComponID <> 0) and Assigned(Net.FOnAddPoint) then
begin
// Point IDs
for j := 0 to Net.FPointIDs.Count - 1 do
begin
PointID := Integer(Net.FPointIDs[j]);
if PointID = 0 then
begin
GArchEngine.BeginInsertObject(ctNone);
try
Net.FPointIDs[j] := Pointer(Net.FOnAddPoint(Net, nil, Net.Points[j], 0));
finally
GArchEngine.EndInsertObject;
end;
end;
end;
end;
end;
end;
end;
end;
procedure DivideNetWallByPoint(ACAD: TForm; APoint: TDoublePoint);
var
WallPath: TNetPath;
begin
WallPath := GetWallByPoint(ACAD, APoint.x, APoint.y);
if WallPath = nil then
begin
MessageInfo(cArchParams_Msg08_04);
end
else
begin
WallPath.Net.DivPath(WallPath, APoint);
end;
end;
procedure EditCADArchObj(AObject: TObject);
var
OldArchObj: TSCSComponent;
Net: TNet;
ArchObj: TSCSComponent;
ArchObjInfo: TComponent;
ArchObjNewInfo: TComponent;
ArchInfoClass: TArchInfoBasicClass;
CAD: TForm;
IsArc: Boolean;
i, j: integer;
PropList: TStringList;
ExistsRoofHipConnection: Boolean;
ptrConnection: PComplect;
RelPaths: TList;
Path: TNetPath;
PathArchObj: TSCSComponent;
begin
try
CAD := GetCADFormByObj(AObject);
ArchObj := GetArchObjByCADObj(AObject);
Net := GetNetFromCADObj(AObject);
if ArchObj <> nil then
begin
LoadArchObjPropsFromCAD(ArchObj);
IsArc := false;
if AObject is TNetPath then
IsArc := TNetPath(AObject).IsArc;
ArchObjInfo := nil;
ArchObjNewInfo := nil;
//case ArchObj.IsLine of
// ctArhWindow, ctArhDoor:
// ArchObjInfo := TArchWndInfo.Create(nil);
// ctArhNiche, ctArhArc:
// ArchObjInfo := TArchNicheInfo.Create(nil);
// ctArhWall, ctArhWallDivision:
// ArchObjInfo := CreateWallInfo(ArchObj.IsLine);
//end;
ArchInfoClass := GetArchInfoClassByIsLine(ArchObj.IsLine);
if ArchInfoClass <> nil then
begin
// Çàïîìèíàåì ñâîéñòâà îáúåêòà
OldArchObj := TSCSComponent.Create(ArchObj.ActiveForm);
OldArchObj.AssignOnlyComponent(ArchObj);
OldArchObj.AssignProperties(ArchObj.Properties);
ArchObjInfo := ArchInfoClass.Create(nil);
if ArchObjInfo is TArchBalconyInfo then
begin
TArchBalconyInfo(ArchObjInfo).CreateChilds;
ObjectPropsFromSCSChild(TArchBalconyInfo(ArchObjInfo).WndInfo, ArchObj, ctArhWindow);
ObjectPropsFromSCSChild(TArchBalconyInfo(ArchObjInfo).DoorInfo, ArchObj, ctArhDoor);
ObjectPropsFromSCSChild(TArchBalconyInfo(ArchObjInfo).InnerSlope, ArchObj, ctArhInnerSlope);
end;
ObjectPropsFromSCSObj(ArchObjInfo, ArchObj);
case ArchObj.IsLine of
ctArhWindow, ctArhDoor:
ArchObjNewInfo := ShowArchWndDoorParams(ArchObj.IsLine, ArchObjInfo);
ctArhNiche, ctArhArc:
ArchObjNewInfo := ShowArchNicheParams(ArchObj.IsLine, ArchObjInfo);
//26.04.2011 ctArhWall, ctArhWallDivision:
//26.04.2011 ArchObjNewInfo := ShowArchWallParams(ArchObj.IsLine, ArchObjInfo, IsArc);
ctArhBalcony:
ArchObjNewInfo := ShowArchBalconyParams(ArchObj.IsLine, ArchObjInfo);
ctArhRoofSeg:
EditObjectProps(F_ProjMan, ArchObj, AllowApplyObjForAll(ArchObj), F_ProjMan.FOnSetPropValue);
else
begin
ExistsRoofHipConnection := false;
//11.05.2012 Åñëè ðåáðî êðûøè ïîäêëþ÷åíî ê äðóãîìó ðåáðó, òî âûâîäèì ïàðàìåòðû âñåé êðûøè
if (ArchObj.IsLine = ctArhRoofHip) and (AObject is TNetPath) then
begin
//12.05.2012 òàêæå ñìîòðèì íà ñìåæíûå ñåãìåíòû (ðåáðà êðûø)
RelPaths := Net.GetRelatedPaths(TNetPath(AObject));
if RelPaths = nil then
RelPaths := TList.Create;
RelPaths.Insert(0, AObject);
for i := 0 to RelPaths.Count - 1 do
begin
Path := TNetPath(RelPaths[i]);
PathArchObj := nil;
if Path = AObject then
PathArchObj := ArchObj
else
PathArchObj := GetArchObjByCADObj(Path);
if PathArchObj <> nil then
begin
for j := 0 to PathArchObj.JoinedComponents.Count - 1 do
begin
if (Path.Net <> nil) and (PathArchObj.JoinedComponents[j].IsLine = ctArhRoofHip) then
begin
ExistsRoofHipConnection := true;
ShowRoofParams(CAD, nil, nil, Path.Net);
Break; //// BREAK ////
end;
end;
if ExistsRoofHipConnection then
Break; //// BREAK ////
end;
end;
RelPaths.Free;
{for i := 0 to ArchObj.JoinedComponents.Count - 1 do
begin
if ArchObj.JoinedComponents[i].IsLine = ctArhRoofHip then
begin
ExistsRoofHipConnection := true;
ShowRoofParams(CAD, nil, nil, Net);
Break; //// BREAK ////
end;
end;}
end;
if Not ExistsRoofHipConnection then
if IsArchSegmentComponByIsLine(ArchObj.IsLine) then
begin
ArchObjNewInfo := ShowArchWallParams(ArchObj.IsLine, ArchObjInfo, IsArc);
end;
end;
end;
if ArchObjNewInfo <> nil then
begin
TF_CAD(CAD).BeginSaveForUndo(uat_None, True, False);
try
// èç îáúåêòà â ñâîéñòâà àðõ.îáúåêòà
ObjectPropsToSCSObj(ArchObjNewInfo, ArchObj);
if ArchObjInfo is TArchBalconyInfo then
begin
ObjectPropsToSCSChild(TArchBalconyInfo(ArchObjNewInfo).WndInfo, ArchObj, ctArhWindow);
ObjectPropsToSCSChild(TArchBalconyInfo(ArchObjNewInfo).DoorInfo, ArchObj, ctArhDoor);
ObjectPropsToSCSChild(TArchBalconyInfo(ArchObjNewInfo).InnerSlope, ArchObj, ctArhInnerSlope);
end
else if ArchObjInfo is TArchWallInfo then
begin
// Øèðèíà ôóíäàìåíòà ïî óìîë÷àíèþ îò øèðèíû ñòåíû
//if TArchWallInfo(ArchObjInfo).FThickness = ArchObj.GetPropertyValueAsFloat(pnPlinthThickness) then
// ArchObj.SetPropertyValueAsFloat(pnPlinthThickness, TArchWallInfo(ArchObjNewInfo).FThickness);
// Åñëè çàäàí ôóíäàìåíò, òî äîîïðåäåëÿåì ñâîéñòâà â îáúåêòå
if TArchWallInfo(ArchObjNewInfo).Basement then
begin
DefineBasementProps(ArchObj, false, false);
// Åùå ðàç ïîäòÿãèâàåì ñâîéñòâà, íà ñëó÷àé åñëè êàêèåòî áûëè ðàíüøå íå ñîçäàíû
ObjectPropsToSCSObj(ArchObjNewInfo, ArchObj);
end;
end;
// Ïîäãðóæàåì íà ÊÀÄ
//16.05.2012 - ïåðåíåñåíî äî OnSetArchObjProp, òàê êàê òàì èíîãäà ðàçáèâàþòñÿ ñåãìåíòû ïî òî÷êàì, è ïîëó÷èì ñåãìåíòû äðóãîé äëèíû
LoadArchObjPropsToCAD(ArchObj);
// Îòðàáàòûâàåì ñîáûòèå óñòàíîâêè çíà÷åíèÿ ñâîéñòâà
// Êðîìå áàëêîíîâ, òàê êàê ïåðåóñòàíîâèòñÿ øèðèíà äëÿ îêíà/äâåðè áàëêîíà
if Not (ArchObjInfo is TArchBalconyInfo) then
begin
PropList := ObjectProps(ArchObjNewInfo);
for i := 0 to PropList.Count - 1 do
OnSetArchObjProp(ArchObj.GetPropertyBySysName(PropList[i]), OldArchObj.GetPropertyBySysName(PropList[i]), ArchObj);
PropList.Free;
end;
//if ArchObjInfo is TArchBalconyInfo then
//begin
// // Øèðèíà îò îêíà è äâåðè
// ArchObj.SetPropertyValueAsFloat(pnWidth, TArchBalconyInfo(ArchObjNewInfo).WndInfo.Width + TArchBalconyInfo(ArchObjNewInfo).DoorInfo.Width);
//end;
finally
TF_CAD(CAD).EndSaveForUndo;
end;
FreeAndNil(ArchObjNewInfo);
if Net <> nil then
Net.RefreshPaths;
RefreshCAD_T(TF_CAD(CAD).PCad); //24.01.2011
F_ProjMan.RefreshNode(false);
end;
if ArchObjInfo <> nil then
FreeAndNil(ArchObjInfo);
FreeAndNil(OldArchObj);
end;
end;
except
on E: Exception do AddExceptionToLogEx('EditCADArchObj', E.Message);
end;
end;
function EditSelectedCADArchObj: Boolean;
var
SelObj: TSCSComponent;
CADArchObj: TObject;
begin
Result := false;
SelObj := F_ProjMan.GetActualSelectedComponent;
if SelObj <> nil then
begin
CADArchObj := GetCADObjByArchObj(SelObj);
if CADArchObj <> nil then
begin
Result := True;
EditCADArchObj(CADArchObj);
end;
end;
end;
function GetArchInfoClassByIsLine(AIsLine: Integer): TArchInfoBasicClass;
begin
Result := nil;
case AIsLine of
ctArhRoom, ctArhBrickWall:
Result := TArchRoomInfo;
ctArhWindow, ctArhDoor:
Result := TArchWndInfo;
ctArhNiche, ctArhArc:
Result := TArchNicheInfo;
ctArhWall:
Result := TArchWallInfo;
ctArhWallDivision:
Result := TArchWallDivInfo;
ctArhBalcony:
Result := TArchBalconyInfo;
ctArhInnerSlope, ctArhOuterSlope:
Result := TArchSlopeInfo;
ctArhWndInnerSlope, ctArhWndOuterSlope, ctArhDoorInnerSlope, ctArhBalconyInnerSlope:
Result := TArchSlopeInfo;
ctArhBalconyWnd, ctArhBalconyDoor:
Result := TArchWndInfo;
ctArhRoofSeg:
Result := TArchRoofSegInfo;
ctArhRoofHip:
Result := TArchRoofHipInfo;
end;
end;
{
procedure CalcArchWallProps(AArchWall: TSCSComponent; AProperWidth: Double; AOutSquare: Pointer);
var
Corners: TSCSComponents;
DefinedSquare: Boolean;
PBasementThicknessAboveGround: Double;
PBasementThicknessUnderGround: Double;
PHeightA: Double;
PHeightB: Double;
PBasementVolumeAboveGround: Double;
//PBasementVolumeUnderGround: Double;
PTrenchVolume: Double;
PThickness: Double;
PWidth: Double;
PHeight: Double;
PSquare: Double;
PSquareProper: Double;
function GetTrapezeVolume(AHeightA, AHeightB, AThickness, AWidth: Double): Double;
begin
Result := GetTrapezeArea(AHeightA, AHeightB, AWidth) * AThickness;
end;
procedure DefCornerBasementTotalHeight(ACorner: TSCSComponent);
begin
// Îáùàÿ âûñîòà ôóíäàìåíòà = Âûñîòà öîêîëÿ îò çåìëè + Ãëóáèíà ôóíäàìåíòà îòíîñèòåëüíî çåìëè
//ACorner.SetPropertyValueAsFloat(pnBasementTotalHeight,
// ACorner.GetPropertyValueAsFloat(pnPlinthHeightFromGround) +
// ACorner.GetPropertyValueAsFloat(pnBasementDepthToGround));
LoadArchObjPropsFromCAD(ACorner);
end;
begin
try
DefinedSquare := false;
PWidth := AArchWall.GetPropertyValueAsFloat(pnWidth);
PThickness := AArchWall.GetPropertyValueAsFloat(pnThickness);
PSquare := 0;
PSquareProper := 0;
Corners := GetArchCornersForWall(AArchWall);
if Corners <> nil then
begin
if Corners.Count = 2 then
begin
DefCornerBasementTotalHeight(Corners[0]);
DefCornerBasementTotalHeight(Corners[1]);
PBasementThicknessAboveGround := AArchWall.GetPropertyValueAsFloat(pnPlinthThickness);
if PBasementThicknessAboveGround = 0 then
PBasementThicknessAboveGround := PThickness;
PBasementThicknessUnderGround := AArchWall.GetPropertyValueAsFloat(pnBasementThickness);
if PBasementThicknessUnderGround = 0 then
PBasementThicknessUnderGround := PBasementThicknessAboveGround;
// Ñâîéñòâî "Îáúåì ôóíäàìåíòà íàä çåìëåé"
PHeightA := Corners[0].GetPropertyValueAsFloat(pnPlinthHeight);
PHeightB := Corners[1].GetPropertyValueAsFloat(pnPlinthHeight);
PBasementVolumeAboveGround := GetTrapezeVolume(PHeightA, PHeightB, PBasementThicknessAboveGround, AProperWidth);
// Ñâîéñòâî "Îáúåì ôóíäàìåíòà ïîä çåìëåé"
//PHeightA := Corners[0].GetPropertyValueAsFloat(pnBasementDepthToGround);
//PHeightB := Corners[1].GetPropertyValueAsFloat(pnBasementDepthToGround);
//PBasementVolumeUnderGround := GetTrapezeVolume(PHeightA, PHeightB, PBasementThicknessUnderGround, AProperWidth);
// Ñâîéñòâî "Îáúåì òðàíøåè"
PHeightA := Corners[0].GetPropertyValueAsFloat(pnTrenchDepth);
PHeightB := Corners[1].GetPropertyValueAsFloat(pnTrenchDepth);
PTrenchVolume := GetTrapezeVolume(PHeightA, PHeightB, PBasementThicknessUnderGround, AProperWidth);
// Ñâîéñòâî "Ïëîùàäü ñòåíû"
PHeightA := Corners[0].GetPropertyValueAsFloat(pnHeight);
PHeightB := Corners[1].GetPropertyValueAsFloat(pnHeight);
if (PHeightA > 0) and (PHeightB > 0) then
begin
PSquare := GetTrapezeArea(PHeightA, PHeightB, PWidth);
PSquareProper := GetTrapezeArea(PHeightA, PHeightB, AProperWidth);
DefinedSquare := true;
end;
AArchWall.SetPropertyValueAsFloat(pnPlinthVolume, PBasementVolumeAboveGround);
//AArchWall.SetPropertyValueAsFloat(pnBasementVolumeunderGround, PBasementVolumeUnderGround);
//AArchWall.SetPropertyValueAsFloat(pnBasementVolume, PBasementVolumeAboveGround+PBasementVolumeUnderGround);
end;
Corners.Free;
end;
// Îïðåäåëÿåì ïëîùàäü
if Not DefinedSquare then
begin
PHeight := AArchWall.GetPropertyValueAsFloat(pnHeight);
PSquare := PWidth*PHeight;
PSquareProper := AProperWidth*PHeight;
end;
if AOutSquare <> nil then
Double(Pointer(AOutSquare)^) := PSquare;
AArchWall.SetPropertyValueAsFloat(pnSquare, PSquare);
// Ñâîéñòâî "Îáúåì ñòåíû"
AArchWall.SetPropertyValueAsFloat(pnVolume, PSquareProper*PThickness);
except
on E: Exception do AddExceptionToLogEx('CalcArchWallProps', E.Message);
end;
end;}
function AllowApplyObjForAll(AObj: TSCSComponent): Boolean;
begin
Result := true;
// Íå ïðèìåíÿåì äëÿ âñåõ ôðîíòîíû è îñíîàíèÿ êðûø
if AObj.IsLine = ctArhRoofSeg then
if AObj.GetPropertyValueAsInteger(pnMaterialType) in [pmtFronton, pmtRoofBase] then
Result := false;
end;
procedure CalcArchWallProps(AArchWall: TSCSComponent; APath: TNetPath; AProperWidth, AOutWidth: Double; ASquare: Pointer);
var
Corners: TSCSComponents;
DefinedSquare: Boolean;
//PBasementThicknessAboveGround: Double;
//PBasementThicknessUnderGround: Double;
PBasementThickness: Double;
PPlinthThickness: Double;
PHeightA: Double;
PHeightB: Double;
PBasementDepth: Double;
PBasementArea: Double;
PBasementVolume: Double;
PPlinthHeight: Double;
PPlinthSidesSquare: Double;
PPlinthSurfaceSquare: Double;
PPlinthVolume: Double;
PTrenchVolume: Double;
PVolume: Double;
PThickness: Double;
PWidth: Double;
PHeight: Double;
PSquare: Double;
PSquareOut: Double; //24.01.2011
PSquareProper: Double;
PropList: TStringList;
// ñ÷èòàåò ïàðàìåòðû íå äëÿ 4-õ óãîëüíèêà êàæäîé ñòîðîíû, à äëÿ 3-óãîëüíèêà (â îäíîé òî÷êå 2-à òðåóãîëüíèêà êîòîðûå âìåñòå ÿâëÿþòñÿ 4-õ óãîëüíèêîì)
procedure CalcForCorner(APoint, AOtherPoint: PDoublePoint);
var
PointNum: Integer;
L, R, T: TDoublePoint;
Area: Double;
Corner: TSCSComponent;
OtherCorner: TSCSComponent;
PHeightTmp: Double;
begin
if Not APath.Net.IsPointInArc(APoint) and Assigned(Corners) then
begin
Corner := Corners.GetComponenByID(APath.Net.GetPointID(APoint));
OtherCorner := Corners.GetComponenByID(APath.Net.GetPointID(AOtherPoint));
PointNum := APath.IsKnotIn(APoint);
if (PointNum <> 0) and Assigned(Corner) then
begin
if APath.GetTrianglePointsBySide(PointNum, L, R, T) then
begin
// ïëîùàäü òðåóãîëüíèêà óãëà
Area := GetTriangleArea(L, R, T) * sqr((TPowerCad(APath.Net.Owner).MapScale / 1000));
// Ïëîùàäü îñíîâàíèÿ ôóíäàìåíòà
PBasementArea := PBasementArea + Area;
// Ïëîùàäü ïîâåðõíîñòè öîêîëÿ
PPlinthSurfaceSquare := PPlinthSurfaceSquare + Area;
// Ñâîéñòâî "Îáúåì ôóíäàìåíòà"
PHeightTmp := AArchWall.GetPropertyValueAsFloat(pnBasementDepth);
PBasementVolume := PBasementVolume + (Area * PHeightTmp);
// Ñâîéñòâî "Îáúåì Öîêîëÿ"
PHeightTmp := AArchWall.GetPropertyValueAsFloat(pnPlinthHeight);
PPlinthVolume := PPlinthVolume + (Area * PHeightTmp);
// Ñâîéñòâî "Îáúåì òðàíøåè"
PHeightTmp := Corner.GetPropertyValueAsFloat(pnTrenchDepth);
PHeightTmp := FloatNoZero(PHeightTmp, PBasementDepth);
PTrenchVolume := PTrenchVolume + (Area * PHeightTmp);
// Ñâîéñòâî "Îáúåì ñòåíû"
PHeightTmp := Corner.GetPropertyValueAsFloat(pnHeight);
// Áåðåì âûñîòó ïî ñòåíå åñëè íà îáîèõ òî÷êàõ âûñîòà 0
if (PHeightTmp <= 0) and (OtherCorner<>nil) and (OtherCorner.GetPropertyValueAsFloat(pnHeight) <= 0) then
PHeightTmp := AArchWall.GetPropertyValueAsFloat(pnHeight);
if (PHeightTmp >= 0) then
begin
PVolume := PVolume + (Area * PHeightTmp);
end;
end;
end;
end;
end;
function GetTrapezeVolume(AHeightA, AHeightB, AThickness, AWidth: Double): Double;
begin
Result := GetTrapezeArea(AHeightA, AHeightB, AWidth) * AThickness;
end;
function GetObjVolumeByProps(AObj: TSCSComponent; const AHeight: String; AThickness, AWidth: Double): Double;
begin
Result := AObj.GetPropertyValueAsFloat(AHeight)*AThickness * AWidth;
end;
procedure DefCornerBasementTotalHeight(ACorner: TSCSComponent);
begin
// Îáùàÿ âûñîòà ôóíäàìåíòà = Âûñîòà öîêîëÿ îò çåìëè + Ãëóáèíà ôóíäàìåíòà îòíîñèòåëüíî çåìëè
//ACorner.SetPropertyValueAsFloat(pnBasementTotalHeight,
// ACorner.GetPropertyValueAsFloat(pnPlinthHeightFromGround) +
// ACorner.GetPropertyValueAsFloat(pnBasementDepthToGround));
LoadArchObjPropsFromCAD(ACorner);
end;
procedure SetPropToObj(const APropSN: String; AVal: Double);
begin
PropList.Clear;
PropList.Add(APropSN);
AddPropsToComponFromSprBySysNames(AArchWall, PropList, '0');
AArchWall.SetPropertyValueAsFloat(APropSN, AVal);
end;
begin
try
PropList := TStringList.Create;
DefinedSquare := false;
PHeight := AArchWall.GetPropertyValueAsFloat(pnHeight);
PWidth := AArchWall.GetPropertyValueAsFloat(pnWidth);
PThickness := AArchWall.GetPropertyValueAsFloat(pnThickness);
PSquare := 0;
PSquareOut := 0;
PSquareProper := 0;
PVolume := 0;
// Îïðåäåëÿåì òîëùèíû
PBasementThickness := AArchWall.GetPropertyValueAsFloat(pnBasementThickness);
if PBasementThickness = 0 then
PBasementThickness := PThickness;
PPlinthThickness := AArchWall.GetPropertyValueAsFloat(pnPlinthThickness);
if PPlinthThickness = 0 then
PPlinthThickness := PBasementThickness;
PBasementDepth := AArchWall.GetPropertyValueAsFloat(pnBasementDepth);
PBasementArea := PBasementThickness * AProperWidth;
PBasementVolume := PBasementDepth * PBasementThickness * AProperWidth; //GetObjVolumeByProps(AArchWall, pnBasementDepth, PBasementThickness, AProperWidth);
PPlinthHeight := AArchWall.GetPropertyValueAsFloat(pnPlinthHeight);
PPlinthVolume := PPlinthHeight * PPlinthThickness * AProperWidth; //GetObjVolumeByProps(AArchWall, pnPlinthHeight, PPlinthThickness, AProperWidth);
PPlinthSidesSquare := (PPlinthHeight * AProperWidth) + (PPlinthHeight * AOutWidth); // Ïëîùàäü áîêîâóøåê öîêîëÿ
PPlinthSurfaceSquare := PPlinthThickness * AProperWidth; // Ïëîùàäü ïîâåðõíîñòè öîêîëÿ
PTrenchVolume := 0;
Corners := GetArchCornersForWall(AArchWall);
if Corners <> nil then
begin
if Corners.Count = 2 then
begin
DefCornerBasementTotalHeight(Corners[0]);
DefCornerBasementTotalHeight(Corners[1]);
// Ñâîéñòâî "Îáúåì òðàíøåè"
PHeightA := Corners[0].GetPropertyValueAsFloat(pnTrenchDepth);
PHeightB := Corners[1].GetPropertyValueAsFloat(pnTrenchDepth);
PHeightA := FloatNoZero(PHeightA, PBasementDepth);
PHeightB := FloatNoZero(PHeightB, PBasementDepth);
PTrenchVolume := GetTrapezeVolume(PHeightA, PHeightB, PBasementThickness, AProperWidth);
// Ñâîéñòâî "Ïëîùàäü ñòåíû"
PHeightA := Corners[0].GetPropertyValueAsFloat(pnHeight);
PHeightB := Corners[1].GetPropertyValueAsFloat(pnHeight);
if (PHeightA > 0) or (PHeightB > 0) then
begin
PHeightA := FloatNoZero(PHeightA, PHeight);
PHeightB := FloatNoZero(PHeightB, PHeight);
PSquare := GetTrapezeArea(PHeightA, PHeightB, PWidth);
PSquareOut := GetTrapezeArea(PHeightA, PHeightB, AOutWidth);
PSquareProper := GetTrapezeArea(PHeightA, PHeightB, AProperWidth);
DefinedSquare := true;
end;
end;
end;
// Îïðåäåëÿåì ïëîùàäü
if Not DefinedSquare then
begin
PSquare := PWidth*PHeight;
PSquareOut := AOutWidth*PHeight;
PSquareProper := AProperWidth*PHeight;
end;
PVolume := PSquareProper*PThickness;
// Äîîïðåäåëÿåì ïàðàìåòðû ñî ñðåçà óãëîâ ñóãìåíòà
CalcForCorner(APath.p1, APath.p2);
CalcForCorner(APath.p2, APath.p1);
if ASquare <> nil then
Double(Pointer(ASquare)^) := PSquare;
AArchWall.SetPropertyValueAsFloat(pnSquare, PSquare);
if AArchWall.IsLine <> ctArhRoofHip then
begin
// Ïëîùàäü ñíàðóæè
SetPropToObj(pnSquareOut, PSquareOut);
// Ñâîéñòâî "Îáúåì ñòåíû"
AArchWall.SetPropertyValueAsFloat(pnVolume, PVolume);
AArchWall.SetPropertyValueAsFloat(pnBasementVolume, PBasementVolume);
AArchWall.SetPropertyValueAsFloat(pnPlinthVolume, PPlinthVolume);
AArchWall.SetPropertyValueAsFloat(pnTrenchVolume, PTrenchVolume);
// Ïëîùàäü îñíîâàíèÿ ôóíäàìåíòà
//if PBasementVolume = 0 then
// PBasementArea := 0;
//PropList.Add(pnBasementArea);
//AddPropsToComponFromSprBySysNames(AArchWall, PropList, '0');
//AArchWall.SetPropertyValueAsFloat(pnBasementArea, PBasementArea);
SetPropToObj(pnBasementArea, PBasementArea);
if PPlinthHeight > 0 then
begin
SetPropToObj(pnPlinthSidesSquare, PPlinthSidesSquare);
SetPropToObj(pnPlinthSurfaceSquare, PPlinthSurfaceSquare);
end;
// Îáúåì êîëîí ôóíäàìåíòà
AArchWall.SetPropertyValueAsFloat(pnBasementColumnVBetwCorner,
AArchWall.GetPropertyValueAsFloat(pnBasementColumnCount)*
AArchWall.GetPropertyValueAsFloat(pnBasementColumnW)*
AArchWall.GetPropertyValueAsFloat(pnBasementColumnL)*
AArchWall.GetPropertyValueAsFloat(pnBasementColumnH));
end;
PropList.Free;
if Corners <> nil then
Corners.Free;
except
on E: Exception do AddExceptionToLogEx('CalcArchWallProps', E.Message);
end;
end;
procedure CalcArchRoomCorners(AArchRoom: TSCSComponent; ANet: TNet);
var
i: Integer;
ChildArchObj: TSCSComponent;
WallPath: TNetPath;
LookedPoints: TList;
// ñ÷èòàåò ïàðàìåòðû íå äëÿ 4-õ óãîëüíèêà êàæäîé ñòîðîíû, à äëÿ 3-óãîëüíèêà (â îäíîé òî÷êå 2-à òðåóãîëüíèêà êîòîðûå âìåñòå ÿâëÿþòñÿ 4-õ óãîëüíèêîì)
procedure CalcForCorner(APath: TNetPath; APoint: PDoublePoint);
var
PointNum: Integer;
L, R, T: TDoublePoint;
Area: Double;
Corner: TSCSComponent;
PHeight: Double;
PBasementVolumeAboveGround: Double;
//PBasementVolumeUnderGround: Double;
PTrenchVolume: Double;
PVolume: Double;
begin
if {(LookedPoints.IndexOf(APoint) = -1) and} Not ANet.IsPointInArc(APoint) then
begin
Corner := AArchRoom.GetComponentFromReferences(APath.Net.GetPointID(APoint));
PointNum := APath.IsKnotIn(APoint);
if (PointNum <> 0) and Assigned(Corner) then
begin
if APath.GetTrianglePointsBySide(PointNum, L, R, T) then
begin
// ïëîùàäü òðåóãîëüíèêà óãëà
Area := GetTriangleArea(L, R, T) * sqr((TPowerCad(ANet.Owner).MapScale / 1000));
PBasementVolumeAboveGround := 0;
//PBasementVolumeUnderGround := 0;
// Ñâîéñòâî "Îáúåì ôóíäàìåíòà íàä çåìëåé"
PHeight := Corner.GetPropertyValueAsFloat(pnPlinthHeight);
PBasementVolumeAboveGround := Area * PHeight;
AArchRoom.AddPropertyValueAsFloat(pnPlinthVolume, PBasementVolumeAboveGround);
//// Ñâîéñòâî "Îáúåì ôóíäàìåíòà ïîä çåìëåé"
//PHeight := Corner.GetPropertyValueAsFloat(pnBasementDepthToGround);
//PBasementVolumeUnderGround := Area * PHeight;
//AArchRoom.AddPropertyValueAsFloat(pnBasementVolumeunderGround, PBasementVolumeUnderGround);
//// Ñâîéñòâî "Îáùèé îáúåì ôóíäàìåíòà"
//AArchRoom.AddPropertyValueAsFloat(pnBasementVolume, PBasementVolumeAboveGround+PBasementVolumeUnderGround);
// Ñâîéñòâî "Îáúåì òðàíøåè"
PHeight := Corner.GetPropertyValueAsFloat(pnTrenchDepth);
PTrenchVolume := Area * PHeight;
// Ñâîéñòâî "Îáúåì ñòåíû"
PHeight := Corner.GetPropertyValueAsFloat(pnHeight);
if PHeight <= 0 then
PHeight := ChildArchObj.GetPropertyValueAsFloat(pnHeight);
if (PHeight > 0) then
begin
PVolume := Area * PHeight;
AArchRoom.AddPropertyValueAsFloat(pnWallsVolume, PVolume);
end;
end;
end;
//LookedPoints.Add(APoint);
end;
end;
begin
LookedPoints := TList.Create;
for i := 0 to AArchRoom.ChildComplects.Count - 1 do
begin
ChildArchObj := AArchRoom.ChildComplects[i];
if ChildArchObj.IsLine = ctArhWall then
begin
WallPath := GetNetPathByComponIDFromNet(ChildArchObj.ID, ANet);
if WallPath <> nil then
begin
CalcForCorner(WallPath, WallPath.p1);
CalcForCorner(WallPath, WallPath.p2);
end;
end;
end;
LookedPoints.Free;
end;
procedure CalcAcrhRoofSegAreaByMaterial(AArchObj: TSCSComponent; ANet: TNet;
AResidueSquare: Double; AShow: Boolean=false; APCAD: TPowerCad=nil);
var
Cad: TF_CAD;
PCAD: TPowerCad;
LayerNum: Integer;
Points: TDoublePointArr;
PointsID: TList;
CoordKoef, CoordKoefUOM: Double;
DirectionVKoef, DirectionHKoef: Integer;
MatType: Integer;
MatHeight, SegMatHeight, SegMatEffectHeight: Double;
MatHeightUsed, MatHeightFree: Double;
MatWidth, SegMatWidth: Double;
DescentSize, VentSideSize: Double;
VentSideSize1, VentSideSize2: Double; // Áîêîâîé íàïóñê ñ îäíîé è âòîðîé ñòîðîíû
Overlapping, OverlappingLateral: Double; // Ïåðåêðûòèå è Ïåðåêðûòèå áîêîâîå
IsConsiderRemains: Boolean; // Ó÷èòûâàòü îñòàòêè
RemainsMinUseSize: Double;
AddVentSide1Size, AddVentSide2Size: Boolean;
PrevAddVentSide1Size, PrevAddVentSide2Size: Boolean;
EavesPath: TNetPath;
EavesP1, EavesP2: PDoublePoint;
EavesConnP1, EavesConnP2: PDoublePoint; // Òî÷êè ëèíèé ïîäêëþ÷åííûå ê òî÷êàì ñâåñà
DescentPt1, DescentPt2: TDoublePoint; // Êðàéíèå òî÷êè ñïóñêà îò êàðíèçíîãî ñâåñà
PrevPt1, PrevPt2: TDoublePoint;
NextPt1, NextPt2: TDoublePoint;
NextPt1Exists, NextPt2Exists: Boolean;
FarPt: PDoublePoint;
TempPt, TempPt1, TempPt2, FullSizePt1, FullSizePt2: TDoublePoint;
LastFarPtLength: Double;
LengthToPt: Double;
DistPlus, DistMinus: Double;
i, j: integer;
MeetEaves: Boolean; // Ïðè ñåãìåíòàöèè âñòðåòèëè ëè êàðíèçíûé ñâåñ
HipEndPoints: TList; // òî÷êè ñåãìåíòîâ òîðöîâ
Hip1Pt1, Hip1Pt2: PDoublePoint; // Ðåáðî 1, êîòîðîå ïåðåñåêàåò ñåãìåíò ïî ìàòåðèàëó
Hip2Pt1, Hip2Pt2: PDoublePoint; // Ðåáðî 2, êîòîðîå ïåðåñåêàåò ñåãìåíò ïî ìàòåðèàëó
SideStartPt1, SideStartPt2, SideEndPt1, SideEndPt2, SideLimitPt1, SideLimitPt2: TDoublePoint;
ChildObj: TSCSComponent;
Path: TNetPath;
AllSegmentsArea: Double;
AllSegmentsMatCount: Integer; // Êîëè÷åñòâî ìàòåðèàëà íà âñåõ ñåãìåíòàõ
PartArea: Double;
LineLen: Double;
SegmentArea: Double;
SegmentLen: Double; // Äëèíà ñåãìåíòà
SegmentLenOverlap: Double; // // Äëèíà ñåãìåíòà ñ âû÷åòîì ïåðåêðûòèÿ áîêîâîãî
SegmentMatCount: Integer; // Êîëè÷åñòâî ìàòåðèàëà íà ñåãìåíòå
SegmentMatRemainsCount: Integer; // Êîëè÷åñòâî ìàòåðèàëà íà ñåãìåíòå äîáàâëåíîå â îñòàòêè
SegmentIndex: Integer;
SegmentHeights: TStringList;
SegmentHeightIdx: Integer;
SegmentWidhts: TStringList;
SegmentWidhtIdx: Integer;
SegmentMinWidht: Double;
SegmentSettedWidth: Double;
SegmentsTypeSizeElemCount: TStringList; // Êîëè÷åñòâî ëèñòîâ (ýëåìåíòîâ) äëÿ êàæäîãî òèïî-ðàçìåðà íà êàæäîì ñåãìåíòå
SegTypeSizeElemCount: TIntList; // Êîëè÷åñòâî ëèñòîâ (ýëåìåíòîâ) äëÿ êàæäîãî òèïî-ðàçìåðà äëÿ îäíîãî ñåãìåíòà
TypeSizesElemCount: TIntList; // Êîëè÷åñòâî ëèñòîâ (ýëåìåíòîâ) äëÿ êàæäîãî òèïî-ðàçìåðà
IsTopRemainSegment, IsTopSegment: Boolean; // Âåðõíèé ñåãìåíò ñ îñòàòêîì
Polygon, PolygonTypeSize: TDoublePointArr;
//d1, d2: Double;
TypeSizeI: Double;
TypeSizeRowCountI: Integer;
TypeSizeIdx: Integer;
TypeSizeColors: TIntList;
SquareVent: Double; // // ïëîùàäü áîêîâûõ íàïóñêîâ
SquareDesentVent: Double; // ïëîùàäü ñ ó÷åòîì áîêîâûõ íàïóñêîâ è êàðíèçíûõ ñïóñêîâ
TempNet: TNet;
OldFigureCount: Integer;
NewFigures: TList;
NewFiguresRect: TDoubleRect;
DrawEaves: Boolean;
DrawEnd: Boolean;
DrawLegendItemPt: TDoublePoint;
WalPoints: TDoublePointArr;
Rect: TPolyline;
RectColor: Integer;
TextObject: TRichText;
TextOffset, TextOffsetStep: Integer;
TextPt1, TextPt2: TDoublePoint;
//function GetNet2DPoint(A3DPt: PDoublePoint; APointsID: TList; A2DPoints: PDoublePointArr): PDoublePoint;
//end;
function Add2DPointToList(APt: PDoublePoint; AList: TList): Integer;
var
pt: PDoublePoint;
begin
Result := -1;
pt := GetNet2DPoint(ANet, APt, PointsID, @Points);
if (pt <> nil) and (AList.IndexOf(pt) = -1) then
Result := AList.Add(pt);
end;
procedure DrawLegendItem(const AText: String; AColor: Integer; AFill: Boolean=false);
var
Line: TLine;
Rect: TRectangle;
TextObject: TRichText;
s,c,abrs,abrc:integer;
begin
//Line := TLine.Create(DrawLegendItemPt.x, DrawLegendItemPt.y, DrawLegendItemPt.x+10, DrawLegendItemPt.y, 2,
// ord(psSolid), AColor, 0, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
//PCad.AddCustomFigure(LayerNum, Line, false);
s := ord(psSolid);
c := AColor;
abrs := ord(bsClear);
abrc := clBlack;
if AFill then
begin
s := ord(psSolid);
c := clBlack;
abrs := ord(psSolid);
abrc := AColor;
end;
Rect := TRectangle.Create(DrawLegendItemPt.x, DrawLegendItemPt.y, DrawLegendItemPt.x+10, DrawLegendItemPt.y+4, 2,
s,c,abrs,abrc, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
PCad.AddCustomFigure(LayerNum, Rect, false);
TextObject := TRichText.Create(DrawLegendItemPt.x+12, DrawLegendItemPt.y, DrawLegendItemPt.x+100, DrawLegendItemPt.y+4,
1, ord(psSolid), clBlack, ord(bsClear), clNone, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
TextObject.re.Lines.Clear;
TextObject.re.Lines.Add(FastReplace(AText,#13#10,' '));
PCad.AddCustomFigure(LayerNum, TextObject, False);
DrawLegendItemPt.y := DrawLegendItemPt.y+5
end;
function GetConn2DPt(APath: TNetPath; A3DPt: PDoublePoint): PDoublePoint;
var
ConnPath: TNetPath;
OtherPt: PDoublePoint;
begin
Result := nil;
ConnPath := APath.GetConnected(A3DPt);
if ConnPath <> nil then
begin
OtherPt := ConnPath.OtherPoint(ConnPath.GetConnectedPoint(APath));
if OtherPt <> nil then
Result := GetNet2DPoint(APath.Net, OtherPt, PointsID, @Points);
end;
end;
begin
Cad := TF_CAD(GetCADFormByObj(ANet));
PCAD := APCAD;
LayerNum := 0;
if PCAD = nil then
begin
PCAD := Cad.PCad;
LayerNum := lnArch;
end;
AllSegmentsArea := 0;
AllSegmentsMatCount := 0;
SquareVent := 0;
SquareDesentVent := 0;
CoordKoef := 1000/CAD.PCad.MapScale;
CoordKoefUOM := CAD.PCad.MapScale / 1000;
MatType := AArchObj.GetPropertyValueAsInteger(pnMaterialType);
// Ïîëó÷àåì âûñîòó ìàòåðèàëà
MatHeight := 0;
if MatType = pmtTileMetal then
MatHeight := AArchObj.GetPropertyValueAsFloat(pnMaterialWidthUsable)
else
MatHeight := AArchObj.GetPropertyValueAsFloat(pnMaterialHeightUsable);
MatHeight := MatHeight * CoordKoef;
MatWidth := AArchObj.GetPropertyValueAsFloat(pnMaterialWidthUsable) * CoordKoef;
DescentSize := AArchObj.GetPropertyValueAsFloat(pnDescentSize) * CoordKoef; // Ðàçìåð ñïóñêà
VentSideSize := AArchObj.GetPropertyValueAsFloat(pnVentSideSize) * CoordKoef; // Ðàçìåð áîêîâîãî íàïóñêà
Overlapping := AArchObj.GetPropertyValueAsFloat(pnDescentSize) * CoordKoef; // Ïåðåêðûòèå
OverlappingLateral := AArchObj.GetPropertyValueAsFloat(pnDescentSize) * CoordKoef; // Ïåðåêðûòèå áîêîâîå
if Overlapping < 0 then
Overlapping := 0;
if OverlappingLateral < 0 then
OverlappingLateral := 0;
// Äëÿ ðóëëîííûõ ìàòåðèàëîâ íå ì.á.
if MatType = pmtRoller then
OverlappingLateral := 0;
IsConsiderRemains := AArchObj.GetPropertyValueAsBooleanDef(pnConsiderRemains, false);
RemainsMinUseSize := AArchObj.GetPropertyValueAsFloat(pnRemainsMinUseSize) * CoordKoef; // Ìèí. ðàçìåð îñòàòêîâ äëÿ èñïîëüçîâàíèÿ
// Ñáðîñ êîë-âà ýëåìåíòîâ äëÿ òèïîðàçìåðîâ
for i := 1 to 4 do
AArchObj.SetPropertyValueAsString('TYPE_SIZE_'+IntToStr(i)+'_EL_COUNT', '0');
//if ((MatHeight > 0) or (MatType = pmtTileMetal)) and (AArchObj.GetPropertyBySysName(pnAreaWithRemains) <> nil) then
//if MatHeight > 0 then
begin
PointsID := TList.Create;
//AShow := true;
Points := RotateNetTo2D(ANet, PointsID, AShow, PCAD);
if (Length(Points) > 3) and (MatHeight > 0) then
begin
SegmentArea := GetAreaFromPolygon(Points);
OldFigureCount := PCad.Figures.Count;
DrawEaves := false;
DrawEnd := false;
// Íàõîäèì êàðíèçíûé ñâåñ
EavesPath := GetNetPathByProp(AArchObj, ANet, pnRoofHipType, IntToStr(rhtEaves));
if EavesPath = nil then
EavesPath := GetNetPathByLowerHeight(AArchObj, ANet);
if EavesPath <> nil then
begin
EavesP1 := GetNet2DPoint(ANet, EavesPath.p1, PointsID, @Points);
EavesP2 := GetNet2DPoint(ANet, EavesPath.p2, PointsID, @Points);
if (EavesP1 <> nil) and (EavesP2 <> nil) then
begin
EavesConnP1 := GetConn2DPt(EavesPath, EavesPath.p1);
EavesConnP2 := GetConn2DPt(EavesPath, EavesPath.p2);
HipEndPoints := TList.Create;
// Îïðåäåëÿåì òî÷êè òîðöîâ, åñëè çàäàí áîêîâîé íàïóñê
if VentSideSize > 0 then
begin
for i := 0 to AArchObj.ChildReferences.Count - 1 do
begin
ChildObj := AArchObj.ChildReferences[i];
if ChildObj.GetPropertyValueAsInteger(pnRoofHipType) = rhtEnd then
begin
Path := GetNetPathByComponIDFromNet(ChildObj.ID, ANet);
if Path <> nil then
begin
Add2DPointToList(Path.p1, HipEndPoints);
Add2DPointToList(Path.p2, HipEndPoints);
end;
end;
end;
end;
SegmentsTypeSizeElemCount := TStringList.Create;
// Îïðåäåëÿåì âûñîòû èç òèïîðàçìåðîâ
SegmentHeights := TStringList.Create;
TypeSizesElemCount := TIntList.Create;
//08.07.2011
//for i := 1 to 4 do
//begin
// TypeSizeI := AArchObj.GetPropertyValueAsFloat('TYPE_SIZE_'+IntToStr(i)) * CoordKoef;
// TypeSizeRowCountI := AArchObj.GetPropertyValueAsInteger('TYPE_SIZE_'+IntToStr(i)+'_ROW_COUNT');
// if (TypeSizeI > 0) and (TypeSizeRowCountI > 0) then
// begin
// TypeSizesElemCount.Add(0); // êîëâî ëèñòîâ äëÿ òèïîðàçìåðà
// for j := 0 to TypeSizeRowCountI - 1 do
// SegmentHeights.AddObject(FloatToStr(TypeSizeI), TObject(i-1));
// end;
//end;
//08.07.2011 - Øèðèíû ëèñòîâ, êîòîðûå áóäóò íà ñåãìåíòå
SegmentWidhts := TStringList.Create;
TypeSizeColors := TIntList.Create;
TypeSizeColors.Add(clSkyBlue);
TypeSizeColors.Add(clMoneyGreen);
TypeSizeColors.Add(clOlive);
TypeSizeColors.Add(clSilver);
SegmentMinWidht := -1;
for i := 1 to 4 do
begin
TypeSizeI := AArchObj.GetPropertyValueAsFloat('TYPE_SIZE_'+IntToStr(i)) * CoordKoef;
if TypeSizeI > 0 then
begin
SegmentWidhts.AddObject(FloatToStr(TypeSizeI), TObject(i-1));
end;
if (SegmentMinWidht = -1) or (SegmentMinWidht > TypeSizeI) then
SegmentMinWidht := TypeSizeI;
TypeSizesElemCount.Add(0); // êîëâî ëèñòîâ äëÿ òèïîðàçìåðà
end;
// Íàõîäèì ñàìóþ îòäàëåííóþ òî÷êó
FarPt := nil;
LastFarPtLength := 0;
for i := 1 to Length(Points) - 1 do
begin
if (@Points[i] <> EavesP1) and (@Points[i] <> EavesP2) then
begin
TempPt := Points[i];
//PointToLine(EavesP1^, EavesP2^, TempPt.x, TempPt.y);
PointToLineByAngle(EavesP1^, EavesP2^, TempPt);
LengthToPt := GetLineLenght(TempPt, Points[i]);
if LengthToPt > LastFarPtLength then
begin
LastFarPtLength := LengthToPt;
FarPt := @Points[i];
end;
end;
end;
if FarPt <> nil then
begin
// Îïðåäåëÿåì Íàðïàâëåíèå â êîòîðîì äåëàòü ñåãìåíòàöèþ - âåðòåêàëüíî
GetParallelPoints(EavesP1^, EavesP2^, TempPt1, TempPt2, 100);
DistPlus := GetDistToLine(TempPt1, TempPt2, FarPt^);
GetParallelPoints(EavesP1^, EavesP2^, TempPt1, TempPt2, -100);
DistMinus := GetDistToLine(TempPt1, TempPt2, FarPt^);
DirectionVKoef := 1;
if DistMinus < DistPlus then
DirectionVKoef := -1;
//MatHeight := DirectionVKoef*MatHeight;
// Îïðåäåëÿåì Íàðïàâëåíèå â êîòîðîì äåëàòü ñåãìåíòàöèþ â ïðåäåëàõ ñåãìåíòà - ãîðèçîíòàëüíî
GetParallelPoints(EavesP1^, EavesP2^, PrevPt1, PrevPt2, 3); // îïðåäåëÿåì òî÷êè áîêîâóøåê
GetParallelPoints(EavesP1^, PrevPt1, TempPt1, TempPt2, 3);
DistPlus := GetDistToLine(TempPt1, TempPt2, EavesP2^);
GetParallelPoints(EavesP1^, PrevPt1, TempPt1, TempPt2, -3);
DistMinus := GetDistToLine(TempPt1, TempPt2, EavesP2^);
DirectionHKoef := 1;
if DistMinus < DistPlus then
DirectionHKoef := -1;
MeetEaves := true;
PrevPt1 := EavesP1^;
PrevPt2 := EavesP2^;
DescentPt1 := DoublePoint(0,0,0); // Êðàéíèå òî÷êè ñïóñêà îò êàðíèçíîãî ñâåñà
DescentPt2 := DoublePoint(0,0,0); // Êðàéíèå òî÷êè ñïóñêà îò êàðíèçíîãî ñâåñà
// Ó÷èòûâàåì ðàçìåð ñïóñêà
if DescentSize > 0 then
begin
MeetEaves := false;
GetParallelPoints(EavesP1^, EavesP2^, TempPt1, TempPt2, -1 * DirectionVKoef * DescentSize);
PrevPt1 := TempPt1;
PrevPt2 := TempPt2;
DescentPt1 := TempPt1; // Êðàéíèå òî÷êè ñïóñêà îò êàðíèçíîãî ñâåñà
DescentPt2 := TempPt2; // Êðàéíèå òî÷êè ñïóñêà îò êàðíèçíîãî ñâåñà
// ïëîùàäü íàïóñêîâ è ñïóñêîâ - äîáàâëÿåì êàðíèçíûé ñâåñ DescentSize * ÄËÈÍÀ ÊÀÐÍÈÇÀ
SquareDesentVent := SquareDesentVent + DescentSize * GetLineLenght(EavesP1^, EavesP2^);
end;
PrevAddVentSide1Size := false;
PrevAddVentSide2Size := false;
SegmentIndex := 0;
TextOffset := 0;
TextOffsetStep := 1;
while true do
begin
SegmentHeightIdx := -1;
TypeSizeIdx := -1;
// Îïðåäåëÿåì âûñîòó ìàòåðèàëà
SegMatHeight := MatHeight;
if SegmentHeights.Count > 0 then
begin
if SegmentIndex < SegmentHeights.Count then
SegmentHeightIdx := SegmentIndex
else
SegmentHeightIdx := SegmentHeights.Count-1;
if SegmentHeightIdx <> -1 then
begin
SegMatHeight := StrToFloat_My(SegmentHeights[SegmentHeightIdx]);
// Íîìåð òèïîðàçìåðà
TypeSizeIdx := Integer(SegmentHeights.Objects[SegmentHeightIdx]);
end;
end;
//if DistMinus < DistPlus then
SegMatHeight := DirectionVKoef * SegMatHeight;
SegMatEffectHeight := Abs(SegMatHeight);
// Èùåì ëèíèþ âûøå íà øàã ïî âûñîòå ðàçìåðà ìàòåðèàëà
GetParallelPoints(PrevPt1, PrevPt2, TempPt1, TempPt2, SegMatHeight);
// Íàõîäèì òî÷êè äëÿ ïîëíîãî ðàçìåðà à íå ýôôåêòèâíîãî
if Overlapping > 0 then
begin
GetParallelPoints(PrevPt1, PrevPt2, FullSizePt1, FullSizePt2, SegMatHeight + Overlapping);
end
else
begin
FullSizePt1 := TempPt1;
FullSizePt2 := TempPt2;
end;
//d1 := GetLineLenght(PrevPt1, TempPt1);
//d2 := GetLineLenght(PrevPt2, TempPt2);
//AddVentSideSize := false;
AddVentSide1Size := false;
AddVentSide2Size := false;
// Ïðîâåðÿåì
if Not MeetEaves then
begin
// Åñëè èç ñïóñêà ïåðåøëè êàðíèçíûé ñâåñ
if GetInterSectionPoint(DescentPt1, TempPt1, EavesP1^, EavesP2^, TempPt, false, true) then
MeetEaves := true;
if VentSideSize > 0 then
begin
AddVentSide1Size := true; // åñëè ïåðåìåùàåìñÿ ñî ñïóñêà ê êàðíèçó, òî ïðèáàâëÿåì áîêîâîé íàïóñê
AddVentSide2Size := true;
end;
end;
//NextPt1 := DoublePoint(0,0,0);
//NextPt2 := DoublePoint(0,0,0);
NextPt1 := TempPt1;
NextPt2 := TempPt2;
NextPt1Exists := false;
NextPt2Exists := false;
if MeetEaves then
begin
// Ðåáðî 1, êîòîðîå ïåðåñåêàåò ñåãìåíò ïî ìàòåðèàëó
Hip1Pt1 := nil;
Hip1Pt2 := nil;
// Ðåáðî 2, êîòîðîå ïåðåñåêàåò ñåãìåíò ïî ìàòåðèàëó
Hip2Pt1 := nil;
Hip2Pt2 := nil;
// Èùåì ïåðåñåêàþùèåñÿ ëèíèè ñ TempPt1, TempPt2 - ëèíèåé ïîäíÿòîé âûøå
for i := 1 to Length(Points) - 1 do
begin
if GetInterSectionPoint(TempPt1, TempPt2, Points[i-1], Points[i], TempPt, false, true) then
begin
if Not NextPt1Exists and Not NextPt2Exists then
begin
// Îïðåäåëÿåì ê êàêîé òî÷êå áëèæå
if GetDistToLine(PrevPt1, TempPt1, TempPt) < GetDistToLine(PrevPt2, TempPt2, TempPt) then
begin
NextPt1 := TempPt;
NextPt1Exists := true;
Hip1Pt1 := @Points[i-1];
Hip1Pt2 := @Points[i];
end
else
begin
NextPt2 := TempPt;
NextPt2Exists := true;
Hip2Pt1 := @Points[i-1];
Hip2Pt2 := @Points[i];
end;
end
else if NextPt1Exists then
begin
NextPt2 := TempPt;
NextPt2Exists := true;
Hip2Pt1 := @Points[i-1];
Hip2Pt2 := @Points[i];
end
else if NextPt2Exists then
begin
NextPt1 := TempPt;
NextPt1Exists := true;
Hip1Pt1 := @Points[i-1];
Hip1Pt2 := @Points[i];
end;
if NextPt1Exists and NextPt2Exists then
Break; //// BREAK ////
end;
{else if IsPointInLine(Points[i-1], Points[i], TempPt1, 1, 0.1) then
begin
//TempPt := TempPt1;
//PointToLineByAngle(Points[i-1], Points[i], TempPt); //PointToLineByAngle(Points[i-1], Points[i], TempPt.x, TempPt.y);
//NextPt1 := TempPt;
//NextPt1Exists := true;
//Hip1Pt1 := @Points[i-1];
//Hip1Pt2 := @Points[i];
end
else if IsPointInLine(Points[i-1], Points[i], TempPt2, 1, 0.1) then
begin
//TempPt := TempPt2;
//PointToLineByAngle(Points[i-1], Points[i], TempPt); //PointToLineByAngle(Points[i-1], Points[i], TempPt.x, TempPt.y);
//NextPt2 := TempPt;
//NextPt2Exists := true;
//Hip2Pt1 := @Points[i-1];
//Hip2Pt2 := @Points[i];
end;}
end;
// Ó÷èòûâàåì äëÿ ñëó÷àÿ åñëè ñåãìåíòàöèÿ èäåò îò ìåíüøåé ëèíèè ê áîëüøåé
if Not NextPt1Exists and (EavesConnP1 <> nil) then
begin
TempPt := TempPt1;
//PointToLineByAngle(EavesP1^, EavesConnP1^, TempPt); //PointToLineByAngle(EavesP1^, EavesConnP1^, TempPt.x, TempPt.y);
if GetInterSectionPoint(TempPt1, TempPt2, EavesP1^, EavesConnP1^, TempPt, true, true) then
if IsPointInLine(EavesP1^, EavesConnP1^, TempPt, 1, 0.1) then
//if GetInterSectionPoint(TempPt1, TempPt2, EavesP1^, EavesConnP1^, TempPt, true, true) then
if Not EQDP(TempPt, TempPt1) and Not EQDP(TempPt, TempPt2) and
IsPointInLine(TempPt, TempPt2, TempPt1, 1, 0.1) then // íàõîäèòñÿ ëè TempPt1 ìåæäó TempPt-TempPt2
begin
//MovePoint(PrevPt1, TempPt.x - TempPt1.x, TempPt.y - TempPt1.y);
//TempPt1 := TempPt;
GetParallelPoints(PrevPt1, TempPt1, PrevPt1, TempPt1, -1 * DirectionHKoef * GetLineLenght(TempPt, TempPt1));
NextPt1 := TempPt;
NextPt1Exists := true;
Hip1Pt1 := EavesP1;
Hip1Pt2 := EavesConnP1;
end;
end;
if Not NextPt2Exists and (EavesConnP2 <> nil) then
begin
TempPt := TempPt2;
//PointToLineByAngle(EavesP2^, EavesConnP2^, TempPt); //PointToLineByAngle(EavesP2^, EavesConnP2^, TempPt.x, TempPt.y);
if GetInterSectionPoint(TempPt1, TempPt2, EavesP2^, EavesConnP2^, TempPt, true, true) then
if IsPointInLine(EavesP2^, EavesConnP2^, TempPt, 1, 0.1) then
//if GetInterSectionPoint(TempPt1, TempPt2, EavesP2^, EavesConnP2^, TempPt, true, true) then
if Not EQDP(TempPt, TempPt2) and Not EQDP(TempPt, TempPt1) and
IsPointInLine(TempPt1, TempPt, TempPt2, 1, 0.1) then // íàõîäèòñÿ ëè TempPt2 ìåæäó TempPt1-TempPt
begin
//MovePoint(PrevPt2, TempPt.x - TempPt2.x, TempPt.y - TempPt2.y);
//TempPt2 := TempPt;
GetParallelPoints(PrevPt2, TempPt2, PrevPt2, TempPt2, DirectionHKoef * GetLineLenght(TempPt, TempPt2));
NextPt2 := TempPt;
NextPt2Exists := true;
Hip2Pt1 := EavesP2;
Hip2Pt2 := EavesConnP2;
end;
end;
// Ðàçìåð áîêîâîãî íàïóñêà, ó÷èòûâàåì åñëè ñåãìåíò ïåðåñåê òîðåö êðûøè
if Not AddVentSide1Size and Not AddVentSide1Size and (VentSideSize > 0) then
begin
if NextPt1Exists and
(HipEndPoints.IndexOf(Hip1Pt1) <> -1) and (HipEndPoints.IndexOf(Hip1Pt2) <> -1) then
AddVentSide1Size := true;
if NextPt2Exists and
(HipEndPoints.IndexOf(Hip2Pt1) <> -1) and (HipEndPoints.IndexOf(Hip2Pt2) <> -1) then
AddVentSide2Size := true;
end;
end
else
begin
NextPt1 := TempPt1;
NextPt2 := TempPt2;
NextPt1Exists := true;
NextPt2Exists := true;
end;
SetLength(Polygon, 5);
Polygon[0] := FullSizePt1; //29.08.2011 }TempPt1;
Polygon[1] := FullSizePt2; //29.08.2011 }TempPt2;
Polygon[2] := PrevPt2;
Polygon[3] := PrevPt1;
//Polygon[4] := Polygon[0]; //29.08.2011 TempPt1;
{SetLength(Polygon, 5);
Polygon[0] := NextPt1;
Polygon[1] := NextPt2;
Polygon[2] := PrevPt2;
Polygon[3] := PrevPt1;
Polygon[4] := NextPt1;}
for i := 0 to Length(Polygon) - 2 do
begin
Polygon[i].x := Round3(Polygon[i].x);
Polygon[i].y := Round3(Polygon[i].y);
end;
Polygon[4] := Polygon[0];
IsTopSegment := false;
IsTopRemainSegment := false;
if Not (NextPt1Exists and NextPt2Exists) then
if IsPtInPolygon(FarPt^, Polygon, false, true, 0) then
//if IsPtInPolygon(FarPt^, Polygon, false, false, 0) or
// IsPointInLine(Polygon[0], Polygon[1], FarPt^, 1, 1) or //åñëè îêîëî ëèíèè TempPt
// IsPointInLine(Polygon[2], Polygon[3], FarPt^, 1, 1) //åñëè îêîëî ëèíèè PrevPt
// then
begin
// Îïðåäåëÿåì çàþçàíóþ âûñîòó
MatHeightUsed := GetDistToLine(PrevPt1, PrevPt2, FarPt^);
// è îñòàòî÷íóþ âûñîòó
MatHeightFree := MatHeight - MatHeightUsed;
IsTopSegment := true;
IsTopRemainSegment := true;
// Åñëè çàþçàíàÿ âûñîòà ìåíüøå 1%(5% ïðè íàëè÷èè ñïóñêà) îò âûñîòû ìàòåðèàëà, òî íå ó÷èòûâàåì
if DescentSize > 0 then
begin
if MatHeightUsed < MatHeight * 0.05 then
IsTopRemainSegment := false;
end
else if MatHeightUsed < MatHeight * 0.01 then
IsTopRemainSegment := false;
AddVentSide1Size := PrevAddVentSide1Size;
AddVentSide2Size := PrevAddVentSide2Size;
//26.08.2011 - Åñëè ó÷èòûâàåì îñòàòêè, òî ñ÷èòàåì ïëîùàòü ïî èñïîëüçîâàåìîé âûñîòå
if IsTopRemainSegment then
SegMatEffectHeight := MatHeightUsed;
end;
// Åñëè íå ïîñëåäíèé ñåãìåíò, òî áóäåì ðèñîâàòü ïî ýôôåêòèâíîé âûñîòå, à íå ïîëíîé
if Not IsTopSegment then
begin
Polygon[0] := TempPt1;
Polygon[1] := TempPt2;
Polygon[4] := Polygon[0];
end;
SegmentLen := 0;
VentSideSize1 := 0;
VentSideSize2 := 0;
// Åñëè çàäàí áîêîâîé íàïóñê, òî ïðèáàâëÿåì ïëîùàäü
if AddVentSide1Size then
VentSideSize1 := VentSideSize; //AllSegmentsArea := AllSegmentsArea + (SegMatHeight * VentSideSize);
if AddVentSide2Size then
VentSideSize2 := VentSideSize; //AllSegmentsArea := AllSegmentsArea + (SegMatHeight * VentSideSize);
SegmentLen := SegmentLen + VentSideSize1 + VentSideSize2;
if NextPt1Exists and NextPt2Exists or IsTopRemainSegment then
//if NextPt1Exists and NextPt2Exists or IsPtInPolygon(FarPt^, Polygon, true) then
//if NextPt1Exists and NextPt2Exists or PointInPolyRect(FarPt^, PrevPt1, PrevPt2, TempPt1, TempPt2) then
begin
//SegmentArea := GetLineLenght(PrevPt1, PrevPt2) * Abs(SegMatHeight);
LineLen := GetLineLenght(PrevPt1, PrevPt2);
SegmentLen := SegmentLen + LineLen;
SegmentLenOverlap := SegmentLen;
if OverlappingLateral > 0 then
SegmentLenOverlap := SegmentLenOverlap - OverlappingLateral;
SegMatWidth := MatWidth;
if SegMatWidth = 0 then // Íà ñëó÷àé åñëè ìàòåðèàë ðóëîííûé, òî åìó íå óêàçûâàåòñÿ øèðèíà è áåðåì ïî äëèíå ñåãìåíòà
SegMatWidth := SegmentLenOverlap; //29.08.2011 SegmentLen;
SegmentMatCount := 0;
SegmentArea := 0;
SegTypeSizeElemCount := nil;
// Äëÿ ìåòàëëî÷åðåïèöè ó÷èòûâàåì òèïî-ðàçìåðû ïî øèðèíå
if (SegmentWidhts.Count > 0) and (SegmentMinWidht > 0) then
begin
SegmentSettedWidth := 0;
SegmentWidhtIdx := 0;
SegTypeSizeElemCount := TIntList.Create;
SegmentsTypeSizeElemCount.AddObject('', SegTypeSizeElemCount);
for i := 0 to SegmentWidhts.Count - 1 do
SegTypeSizeElemCount.Add(0);
while SegmentSettedWidth <= SegmentLenOverlap do
begin
TypeSizeI := StrToFloat_My(SegmentWidhts[SegmentWidhtIdx]);
// Åñëè âûøëè çà äëèíó ñåãìåíòà ñ ó÷åòîì íàïóñêîâ, òî èùåì áîëåå ìåëêèå êóñêè
if (SegmentSettedWidth + TypeSizeI) > SegmentLenOverlap then
for i := SegmentWidhtIdx+1 to SegmentWidhts.Count - 1 do
begin
SegmentWidhtIdx := i;
TypeSizeI := StrToFloat_My(SegmentWidhts[i]);
//if (SegmentSettedWidth + TypeSizeI) <= SegmentLenOverlap then
// Break; //// BREAK ////
if ( (SegmentSettedWidth+TypeSizeI)<=SegmentLenOverlap ) or
( ((SegmentSettedWidth+TypeSizeI)-SegmentLenOverlap)<SegmentMinWidht ) then
Break; //// BREAK ////
end;
TypeSizeI := StrToFloat_My(SegmentWidhts[SegmentWidhtIdx]);
SegmentSettedWidth := SegmentSettedWidth + TypeSizeI;
SegmentMatCount := SegmentMatCount + 1;
SegmentArea := SegmentArea + (SegMatEffectHeight * TypeSizeI); //26.08.2011
// Çàïîìèíàåì ñêîëüêî ýëåìåíòîâ äëÿ êàæäîãî òèïîðàçìåðà âçÿòî
SegTypeSizeElemCount[SegmentWidhtIdx] := SegTypeSizeElemCount[SegmentWidhtIdx] + 1;
TypeSizesElemCount[SegmentWidhtIdx] := TypeSizesElemCount[SegmentWidhtIdx] + 1;
end;
SegmentLen := SegmentSettedWidth;
end
else
begin
SegmentMatCount := RoundUp(SegmentLenOverlap / SegMatWidth);
SegmentArea := (SegMatEffectHeight * SegMatWidth) * SegmentMatCount; //26.08.2011
end;
//26.08.2011 SegmentArea := SegmentLen * Abs(SegMatHeight);
// Ó÷èòûâåì îñòàòêè åñëè ñåãìåíò âûøåë çà ïðåäåëû äàëüíåé òî÷êè -
// òîåñòü ëèíèèÿ ïîäíÿòàÿ âûøå (TempPt1, TempPt2)
if IsConsiderRemains and GArchEngine.FIsExporting then
if IsTopRemainSegment then //if Not(NextPt1Exists and NextPt2Exists) then
begin
GArchEngine.FExport.FScaleKoeff := CoordKoef;
// Âûòÿãèâàåì èç îñòàòêîâ
SegmentMatRemainsCount := GArchEngine.FExport.RemoveMaterialFromRemains(MatType, SegMatWidth, MatHeightFree, RemainsMinUseSize, SegmentMatCount);
SegmentMatCount := SegmentMatCount - SegmentMatRemainsCount;
// Åñëè îñòàòîê áîëüùå ïðîöåíòà âûñîòû ìàòåðèàëà, òî ó÷èòûâàåì åãî äëÿ äðóãèõ ñåãìåíòîâ êðûø
//if MatHeightFree >= (MatHeight * (GArchEngine.FExport.GetHeightPersentToRemains(MatHeight) /100) ) then
//if GArchEngine.FExport.CanUseRemainByPercent(MatHeightFree, MatHeight) then
begin
// Åñëè ïðåäûäóùèõ îñòàòêîâ íåòó, èëè íå õâàòèëî, òî îòêëàäûâàåì îñòàòêè öåëîãî ìàòåðèàëà
if SegmentMatCount > 0 then
GArchEngine.FExport.AddMaterialToRemains(MatType, SegMatWidth, MatHeightFree, RemainsMinUseSize, SegmentMatCount);
end;
end;
AllSegmentsMatCount := AllSegmentsMatCount + SegmentMatCount;
// Çàïîìèíàåì ñêîëüêî ëèñòîâ òåêóùåãî òèïîðàçìåðà
//if (TypeSizeIdx <> -1) and (MatWidth > 0) then
// TypeSizesElemCount[TypeSizeIdx] := TypeSizesElemCount[TypeSizeIdx] + RoundUp(SegmentLen / MatWidth);
//SegmentArea := GetAreaFromPolygon(Polygon);
//PartArea: Double;
AllSegmentsArea := AllSegmentsArea + SegmentArea;
// ïëîùàäü íàïóñêîâ è ñïóñêîâ - äîáàâëÿåì áîêîâûå íàïóñêà
SquareVent := (VentSideSize1 + VentSideSize2) * SegMatEffectHeight; //29.08.2011 SquareVent := SquareVent + (SegmentLen - LineLen) * MatHeight;
SquareDesentVent := SquareDesentVent + SquareVent;
if AShow then
begin
// Âûâåñòè òèïîðàçìåðû
if SegTypeSizeElemCount <> nil then
begin
SideStartPt1 := PrevPt1;
SideStartPt2 := {NextPt1; //}TempPt1;
if VentSideSize1 > 0 then
GetParallelPoints(PrevPt1, TempPt1, SideStartPt1, SideStartPt2, -1 * DirectionHKoef * VentSideSize1);
//GetParallelPoints(PrevPt1, NextPt1, SideStartPt1, SideStartPt2, -1 * DirectionHKoef * VentSideSize1);
// Íàõîäèì êîíå÷íûå ãðàíè÷íûå òî÷êè, ÷òîáû íå îòîáðàæàòü îñòàòêè
SideLimitPt1 := PrevPt2;
SideLimitPt2 := {NextPt2; //}TempPt2;
if VentSideSize2 > 0 then
GetParallelPoints(PrevPt2, TempPt2, SideLimitPt1, SideLimitPt2, DirectionHKoef * VentSideSize2);
//GetParallelPoints(PrevPt2, NextPt2, SideLimitPt1, SideLimitPt2, DirectionHKoef * VentSideSize2);
//SideEndPt1, SideEndPt2
SetLength(PolygonTypeSize, 5);
for i := 0 to SegTypeSizeElemCount.Count - 1 do
begin
for j := 0 to SegTypeSizeElemCount[i] - 1 do
begin
//GetParallelPoints(SideStartPt1, SideStartPt2, SideEndPt1, SideEndPt2, 2);
// Îïðåäåëÿåì áîêîâûå òî÷êè äëÿ äëèíû òèïîðàçìåðà ñ ó÷åòîì áîêîâîãî íàïóñêà
GetParallelPoints(SideStartPt1, SideStartPt2, SideEndPt1, SideEndPt2, DirectionHKoef * StrToFloat_My(SegmentWidhts[i]) );
// Ïðîâåðÿåì íå çàøëè ëè çà âòîðóþ ñòîðîíó
if GetInterSectionPoint(SideStartPt1, SideEndPt1, SideLimitPt1, SideLimitPt2, TempPt, false, true) then
SideEndPt1 := TempPt;
if GetInterSectionPoint(SideStartPt2, SideEndPt2, SideLimitPt1, SideLimitPt2, TempPt, false, true) then
SideEndPt2 := TempPt;
//DirectionHKoef * (StrToFloat_My(SegmentWidhts[i])-VentSideSize1) );
PolygonTypeSize[0] := SideStartPt1;
PolygonTypeSize[1] := SideEndPt1;
PolygonTypeSize[2] := SideEndPt2;
PolygonTypeSize[3] := SideStartPt2;
PolygonTypeSize[4] := SideStartPt1;
Rect := TPolyline.create(PolygonTypeSize, 1, ord(psSolid), clBlack, ord(bsSolid), TypeSizeColors[i], 0, true, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
PCad.AddCustomFigure(LayerNum, Rect, False);
SideStartPt1 := SideEndPt1;
SideStartPt2 := SideEndPt2;
end;
end;
SetLength(PolygonTypeSize, 0);
end
// âûâåñòè êîë-âî ìàòåðèàëà
else if (SegmentMatCount > 0) {and (SegMatHeight > 1)} then
begin
TextObject := TRichText.Create(0, 0, 4, 4, 1, ord(psSolid), clBlack, ord(bsClear), clNone, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
TextObject.re.Lines.Clear;
TextObject.re.Lines.Add(FloatToStr(SegmentMatCount));
TextObject.re.Font.Size := Trunc(SegMatHeight);
if TextObject.re.Font.Size < 6 then
TextObject.re.Font.Size := 6;
PCad.AddCustomFigure(LayerNum, TextObject, False);
//TextObject.Rotate(-1*GetRadOfLine(TempPt1, TempPt2));
// Åñëè ñåãìåíòàöèÿ èäåò áîëüøå âäîëü îñè X
if Abs(TempPt1.x - TempPt2.x) < Abs(TempPt1.y - TempPt2.y) then
begin
if TempPt1.y > TempPt2.y then //if GetLineLenght(TempPt1, DoublePoint(0,0)) > GetLineLenght(TempPt2, DoublePoint(0,0)) then
GetParallelPoints(TempPt1, PrevPt1, TextPt1, TextPt2, -1*(2+VentSideSize1+TextOffset) * DirectionVKoef) // ïîäàëüøå îò êðàÿ
else
GetParallelPoints(TempPt1, PrevPt1, TextPt1, TextPt2, -1*(5+VentSideSize1+TextOffset) * DirectionVKoef); // ïîäàëüøå îò êðàÿ
if TextPt1.x < TextPt2.x then //if GetLineLenght(TextPt1, DoublePoint(0,0)) < GetLineLenght(TextPt2, DoublePoint(0,0)) then
TextObject.Move(TextPt1.x, TextPt1.y)
else
TextObject.Move(TextPt2.x, TextPt2.y);
end
else
begin
if TempPt1.x > TempPt2.x then
GetParallelPoints(TempPt1, PrevPt1, TextPt1, TextPt2, -1*(2+VentSideSize1+TextOffset) * DirectionVKoef) // ïîäàëüøå îò êðàÿ
else
GetParallelPoints(TempPt1, PrevPt1, TextPt1, TextPt2, -1*(5+VentSideSize1+TextOffset) * DirectionVKoef); // ïîäàëüøå îò êðàÿ
if TextPt1.y < TextPt2.y then
TextObject.Move(TextPt1.x, TextPt1.y)
else
TextObject.Move(TextPt2.x, TextPt2.y);
end;
//TextOffset := TextOffset + Trunc(TextObject.re.Font.Size/2+0.5);
if TextOffsetStep < 0 then
TextOffset := 0
else
TextOffset := TextObject.re.Font.Size; //TextOffset := Trunc(TextObject.re.Font.Size/2+0.5);
TextOffsetStep := TextOffsetStep * -1;
{if Abs(NextPt1.x - NextPt2.x) < Abs(NextPt1.y - NextPt2.y) then
begin
if NextPt1.y > NextPt2.y then //if GetLineLenght(TempPt1, DoublePoint(0,0)) > GetLineLenght(TempPt2, DoublePoint(0,0)) then
GetParallelPoints(NextPt1, PrevPt1, TextPt1, TextPt2, -1*(2+VentSideSize1) * DirectionVKoef) // ïîäàëüøå îò êðàÿ
else
GetParallelPoints(NextPt1, PrevPt1, TextPt1, TextPt2, -1*(5+VentSideSize1) * DirectionVKoef); // ïîäàëüøå îò êðàÿ
if TextPt1.x < TextPt2.x then //if GetLineLenght(TextPt1, DoublePoint(0,0)) < GetLineLenght(TextPt2, DoublePoint(0,0)) then
TextObject.Move(TextPt1.x, TextPt1.y)
else
TextObject.Move(TextPt2.x, TextPt2.y);
end
else
begin
if NextPt1.x > NextPt2.x then
GetParallelPoints(NextPt1, PrevPt1, TextPt1, TextPt2, -1*(2+VentSideSize1) * DirectionVKoef) // ïîäàëüøå îò êðàÿ
else
GetParallelPoints(NextPt1, PrevPt1, TextPt1, TextPt2, -1*(5+VentSideSize1) * DirectionVKoef); // ïîäàëüøå îò êðàÿ
if TextPt1.y < TextPt2.y then
TextObject.Move(TextPt1.x, TextPt1.y)
else
TextObject.Move(TextPt2.x, TextPt2.y);
end;}
end;
// Âûâîäèì ñàì ñåãìåíò
RectColor := clBlack;
if SegmentIndex = 0 then // Êàðíèç
begin
DrawEaves := true;
RectColor := clLime;
end
else if Not(NextPt1Exists and NextPt2Exists) then // Êîíåê
begin
DrawEnd := true;
RectColor := clRed;
end;
Rect := TPolyline.create(Polygon, 1, ord(psSolid), RectColor, ord(bsClear), clBlack, 0, true, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
PCad.AddCustomFigure(LayerNum, Rect, False);
// Áîêîâîé íàïóñê
if AddVentSide1Size then
begin
SideStartPt1 := PrevPt1;
SideStartPt2 := TempPt1;
if IsTopSegment then
SideStartPt2 := FullSizePt1;
SetLength(PolygonTypeSize, 5);
GetParallelPoints(SideStartPt1, SideStartPt2, SideEndPt1, SideEndPt2, -1*DirectionHKoef * VentSideSize);
PolygonTypeSize[0] := SideStartPt1;
PolygonTypeSize[1] := SideEndPt1;
PolygonTypeSize[2] := SideEndPt2;
PolygonTypeSize[3] := SideStartPt2;
PolygonTypeSize[4] := SideStartPt1;
// $000080FF
Rect := TPolyline.create(PolygonTypeSize, 1, ord(psSolid), clAqua, ord(bsClear), clBlack, 0, true, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
PCad.AddCustomFigure(LayerNum, Rect, False);
SetLength(PolygonTypeSize, 0);
end;
if AddVentSide2Size then
begin
SideStartPt1 := PrevPt2;
SideStartPt2 := TempPt2;
if IsTopSegment then
SideStartPt2 := FullSizePt2;
SetLength(PolygonTypeSize, 5);
GetParallelPoints(SideStartPt1, SideStartPt2, SideEndPt1, SideEndPt2, DirectionHKoef * VentSideSize);
PolygonTypeSize[0] := SideStartPt1;
PolygonTypeSize[1] := SideEndPt1;
PolygonTypeSize[2] := SideEndPt2;
PolygonTypeSize[3] := SideStartPt2;
PolygonTypeSize[4] := SideStartPt1;
Rect := TPolyline.create(PolygonTypeSize, 1, ord(psSolid), clAqua, ord(bsClear), clBlack, 0, true, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
PCad.AddCustomFigure(LayerNum, Rect, False);
SetLength(PolygonTypeSize, 0);
end;
end;
if NextPt1Exists and NextPt2Exists then
begin
//d1 := GetLineLenght(PrevPt1, NextPt1);
//d2 := GetLineLenght(PrevPt2, NextPt2);
PrevPt1 := NextPt1;
PrevPt2 := NextPt2;
end
else
begin
PrevPt1 := TempPt1;
PrevPt2 := TempPt2;
end;
end
else
Break; //// BREAK ////
if IsTopSegment then
Break; //// BREAK ////
PrevAddVentSide1Size := AddVentSide1Size;
PrevAddVentSide2Size := AddVentSide2Size;
SegmentIndex := SegmentIndex + 1;
end;
end;
// Îòîáðàçèòü ëåãåíäó êàêîé óûåò ÷òî îçíà÷àåò
if AShow and (PCAD.Figures.Count > OldFigureCount) then
begin
NewFigures := TList.Create;
for i := OldFigureCount to PCAD.Figures.Count - 1 do
NewFigures.Add(PCAD.Figures[i]);
NewFiguresRect := PCAD.GetFigureListRect(NewFigures);
DrawLegendItemPt.x := NewFiguresRect.Left;
DrawLegendItemPt.y := NewFiguresRect.Bottom + 3;
if DrawEaves then
DrawLegendItem('Êàðíèçíûé ñâåñ, âûñîòà '+FloatInUOMStr(DescentSize*CoordKoefUOM, umM, F_ProjMan.FUOM, -1, true), clLime);
if SquareVent > 0 then
DrawLegendItem('Áîêîâîé íàïóñê, øèðèíà '+FloatInUOMStr(VentSideSize*CoordKoefUOM, umM, F_ProjMan.FUOM, -1, true), clAqua);
if DrawEnd then
DrawLegendItem('Êðîé ñ îñòàòêîì', clRed);
DrawLegendItem('Êðîé ìàòåðèàëà, øàã '+FloatInUOMStr(MatHeight*CoordKoefUOM, umM, F_ProjMan.FUOM, -1, true), clBlack);
// Öâåòà òèïîðàçìåðîâ
for i := 0 to TypeSizesElemCount.Count - 1 do
begin
if TypeSizesElemCount[i] > 0 then
DrawLegendItem('Äëèíà òèïîðàçìåðà '+IntToStr(i+1)+', '+
FloatInUOMStr(StrToFloat_My(SegmentWidhts[i])*CoordKoefUOM, umM, F_ProjMan.FUOM, -1, true)+
', '+IntToStr(TypeSizesElemCount[i])+' øò', TypeSizeColors[i], true);
end;
NewFigures.Free;
end;
// Âûâîäèì â ëîã èíôó î êîëè÷åñòâå ëèñòîâ äëÿ êàæäîãî òèïîðàçìåðà
if TypeSizesElemCount.Count > 0 then
begin
// GLog.Add('- Êîë-âî ëèñòîâ ïî òèïîðàçìåðàì äëÿ '+AArchObj.GetNameForVisible);
for i := 0 to TypeSizesElemCount.Count - 1 do
begin
if TypeSizesElemCount[i] > 0 then
begin
//GLog.Add(' - Òèïîðàçìåð '+IntToStr(i+1)+': '+ IntToStr(TypeSizesElemCount[i])+' ëèñòîâ');
AArchObj.SetPropertyValueAsString('TYPE_SIZE_'+IntToStr(i+1)+'_EL_COUNT', IntToStr(TypeSizesElemCount[i]));
end;
end;
end;
// Âûâîäèì â ëîã èíôó î êîëè÷åñòâå ëèñòîâ äëÿ êàæäîãî òèïîðàçìåðà íà êàæäîì ñåãìåíòå
if SegmentsTypeSizeElemCount.Count > 0 then
begin
GLog.Add('- Êîë-âî ëèñòîâ ïî òèïîðàçìåðàì äëÿ "'+AArchObj.GetNameForVisible+'"');
for i := 0 to SegmentsTypeSizeElemCount.Count - 1 do
begin
GLog.Add(' Ðÿä '+IntToStr(i+1));
SegTypeSizeElemCount := TIntList(SegmentsTypeSizeElemCount.Objects[i]);
for j := 0 to SegTypeSizeElemCount.Count - 1 do
begin
if SegTypeSizeElemCount[j] > 0 then
GLog.Add(' - Òèïîðàçìåð äëèíû '+IntToStr(j+1)+
' (äëèíà '+FloatInUOMStr(AArchObj.GetPropertyValueAsFloat('TYPE_SIZE_'+IntToStr(j+1)), umM, F_ProjMan.FUOM)+')'+
': '+ IntToStr(SegTypeSizeElemCount[j])+' ëèñòîâ');
end;
end;
end;
SegmentWidhts.Free;
TypeSizeColors.Free;
TypeSizesElemCount.Free;
SegmentHeights.Free;
SegmentsTypeSizeElemCount.Free;
HipEndPoints.Free;
end;
end;
end;
SetLength(Points, 0);
PointsID.Free;
end;
if AResidueSquare = -1 then
AResidueSquare := AArchObj.GetPropertyValueAsFloat(pnSquare) - AArchObj.GetPropertyValueAsFloat(pnSquareInclEmbrasures);
// Ïëîùàäü ñ îñòàòêàìè
AArchObj.SetPropertyValueAsFloat(pnAreaWithRemains, AllSegmentsArea * sqr(CoordKoefUOM) - AResidueSquare);
// Ïëîùàäü ñ ó÷åòîì ïðîåìîâ è íàïóñêîâ
//03.10.2011 AArchObj.SetPropertyValueAsFloat(pnSquareInclEmbrasuresLap, AArchObj.GetPropertyValueAsFloat(pnSquare) + (SquareDesentVent*sqr(CoordKoefUOM)-AResidueSquare) );
// Êðîé ñ ó÷åòîì îòõîäîâ, èëè êîëâî ìàòåðèàëà
AArchObj.SetPropertyValueAsFloat(pnCuttingWithRemains, AllSegmentsMatCount);
//14.05.2012 Óãîë íàêëîíà
if MatType <> pmtRoofBase then
begin
AddPropsToComponFromSprBySN(AArchObj, pnSlopeAngle);
AArchObj.SetPropertyValueAsFloat(pnSlopeAngle, GArchEngine.FLastObjTiltAngle);
end;
end;
procedure CalcAcrhRoofSegProps(AArcjObj: TSCSComponent; ANet: TNet);
var
i: Integer;
EnteringNets: TList;
EnteringNetsSquares: TStringList;
DockNet: TNet;
Net: TNet;
ArchCntnr: TSCSCatalog;
ArchObj: TSCSComponent;
ResidueSquare: Double;
ResidueNetsPerim: Double;
SquareDesentVent: Double;
AlreadyList: TIntList;
AddList: TIntList;
j: integer;
begin
EnteringNets := TList.Create;
EnteringNetsSquares := TStringList.Create;
AlreadyList := TIntList.Create;
AddList := TIntList.Create;
ResidueSquare := 0;
ResidueNetsPerim := 0;
if GetInnerOuterNets(ANet, AArcjObj, DockNet, EnteringNets, EnteringNetsSquares) then
begin
ArchCntnr := GetArchContainerByCADObj(ANet);
for i := 0 to EnteringNets.Count - 1 do
begin
Net := TNet(EnteringNets[i]);
if AlreadyList.IndexOf(Net.ID) = -1 then
AlreadyList.Add(Net.ID);
ArchObj := GetArchObjByCADObj(Net, ArchCntnr);
if ArchObj.GetPropertyValueAsBooleanDef(pnResidue, false) = true then
begin
ResidueSquare := ResidueSquare + StrToFloatDef_My(EnteringNetsSquares[i], 0);
LoadArchObjPropsFromCAD(ArchObj, Net);
ResidueNetsPerim := ResidueNetsPerim + ArchObj.GetPropertyValueAsFloat(pnPerimeter);
end;
end;
end;
EnteringNetsSquares.Free;
EnteringNets.Free;
EnteringNets := TList.Create;
EnteringNetsSquares := TStringList.Create;
try
if Assigned(AArcjObj.ChildComplects) then
begin
for i := 0 to AArcjObj.ChildComplects.Count - 1 do
begin
if Assigned(AArcjObj.ChildComplects[i].JoinedComponents) then
begin
for j := 0 to AArcjObj.ChildComplects[i].JoinedComponents.Count - 1 do
begin
if (AArcjObj.ChildComplects[i].JoinedComponents[j].ComponentType.SysName = 'ARH_ROOF_SEG') and (AArcjObj.ChildComplects[i].JoinedComponents[j].GetPropertyBySysName('RESIDUE') <> nil) then
begin
if AArcjObj.ChildComplects[i].JoinedComponents[j].GetPropertyBySysName('RESIDUE').Value = '1' then
begin
Net := TNet(GetCADObjByArchObj(AArcjObj.ChildComplects[i].JoinedComponents[j], GetCADFormBySCSObject(AArcjObj.ChildComplects[i].JoinedComponents[j])));
if AlreadyList.IndexOf(Net.ID) = -1 then
if AddList.IndexOf(Net.ID) = -1 then
begin
AddList.Add(Net.ID);
EnteringNets.Add(Net);
EnteringNetsSquares.Add(GetNetSquae(Net, AArcjObj.ChildComplects[i].JoinedComponents[j]));
end;
end;
end;
end;
end;
end;
ArchCntnr := GetArchContainerByCADObj(ANet);
for i := 0 to EnteringNets.Count - 1 do
begin
Net := TNet(EnteringNets[i]);
ArchObj := GetArchObjByCADObj(Net, ArchCntnr);
if ArchObj.GetPropertyValueAsBooleanDef(pnResidue, false) = true then
begin
ResidueSquare := ResidueSquare + StrToFloatDef_My(EnteringNetsSquares[i], 0);
LoadArchObjPropsFromCAD(ArchObj, Net);
ResidueNetsPerim := ResidueNetsPerim + ArchObj.GetPropertyValueAsFloat(pnPerimeter);
end;
end;
end;
except
end;
// òàê ëó÷øå íå äåëàòü - ïëîùàäü íîðìàëüíî íå ïîñ÷èòàåì ïîòîì...
(*
if ResidueSquare = 0 then
ResidueSquare := AArcjObj.GetPropertyValueAsFloat(pnResidue);
if ResidueNetsPerim = 0 then
ResidueNetsPerim := AArcjObj.GetPropertyValueAsFloat(pnPerimeterEmbrasures);
*)
// Ïëîùàäü ñ ó÷åòîì ïðîåìîâ
AArcjObj.SetPropertyValueAsFloat(pnSquareInclEmbrasures, AArcjObj.GetPropertyValueAsFloat(pnSquare) - ResidueSquare);
// Ïåðèìåòð ïðîåìîâ
AArcjObj.SetPropertyValueAsFloat(pnPerimeterEmbrasures, ResidueNetsPerim);
// Åñëè íå îñíîâàíèå è íå ôðîíòîí, òî ñ÷èòàåì ïëîùàäü íàïóñòîâ/ñïóñêîâ
SquareDesentVent := 0;
if Not (AArcjObj.GetPropertyValueAsInteger(pnMaterialType) in [pmtFronton, pmtRoofBase]) then
SquareDesentVent := CalcArchRoofSquareDesentVent(AArcjObj, ANet);
// Ïëîùàäü ñ ó÷åòîì ïðîåìîâ è íàïóñêîâ
AArcjObj.SetPropertyValueAsFloat(pnSquareInclEmbrasuresLap, AArcjObj.GetPropertyValueAsFloat(pnSquare) + SquareDesentVent - ResidueSquare);
CalcAcrhRoofSegAreaByMaterial(AArcjObj, ANet, ResidueSquare, false);
EnteringNetsSquares.Free;
EnteringNets.Free;
end;
function CalcArchRoofSquareDesentVent(AArchObj: TSCSComponent; ANet: TNet): Double;
var
i: Integer;
Path: TNetPath;
PathConn1: TNetPath;
PathConn2: TNetPath;
ChildObj: TSCSComponent;
ArchObjConn1: TSCSComponent;
ArchObjConn2: TSCSComponent;
PathLen: Double;
DescentSize: Double;
VentSideSize: Double;
HipType: Integer;
begin
Result := 0;
DescentSize := AArchObj.GetPropertyValueAsFloat(pnDescentSize); // Ðàçìåð ñïóñêà
VentSideSize := AArchObj.GetPropertyValueAsFloat(pnVentSideSize); // Ðàçìåð áîêîâîãî íàïóñêà
if (DescentSize > 0) or (VentSideSize > 0) then
begin
for i := 0 to AArchObj.ChildReferences.Count - 1 do
begin
ChildObj := AArchObj.ChildReferences[i];
if ChildObj.IsLine = ctArhRoofHip then
begin
HipType := ChildObj.GetPropertyValueAsInteger(pnRoofHipType);
if HipType in [rhtEaves, rhtEnd] then
begin
Path := GetNetPathByComponIDFromNet(ChildObj.ID, ANet);
if Path <> nil then
begin
// Äëèíà ðåáðà ïîëíàÿ (íå ïðîåêöèÿ)
PathLen := ChildObj.GetPropertyValueAsFloat(pnLength);
// Åñëè êàðíèçíûé ñâåñ
if HipType in [rhtEaves] then
begin
// Åñëè ñîåäèíåí ñ òîðöàìè, ó÷èòûàåì áîêîâîé íàïóñê ê äëèíå êàðíèçà
PathConn1 := Path.GetConnected(Path.p1);
PathConn2 := Path.GetConnected(Path.p2);
ArchObjConn1 := AArchObj.GetComponentFromReferences(PathConn1.FComponID); //GetArchObjByCADObj(PathConn1, ArchContainer);
ArchObjConn2 := AArchObj.GetComponentFromReferences(PathConn2.FComponID); //GetArchObjByCADObj(PathConn2, ArchContainer);
// Åñëè ïîäêëþ÷åí ê òîðöó
if Assigned(ArchObjConn1) and (ArchObjConn1.GetPropertyValueAsInteger(pnRoofHipType) = rhtEnd) then
PathLen := PathLen + VentSideSize;
// Åñëè ïîäêëþ÷åí ê òîðöó
if Assigned(ArchObjConn2) and (ArchObjConn2.GetPropertyValueAsInteger(pnRoofHipType) = rhtEnd) then
PathLen := PathLen + VentSideSize;
Result := Result + PathLen * DescentSize; // Äëèíó íà ðàçìåð ñïóñêà
end
// Åñëè òîðåö,
else if HipType in [rhtEnd] then
begin
//03.10.2011 - ïëîùàäü êóñêà ñïóñêà ñ÷èòàåòñÿ ïðè ðàññìîòðå êàðíèçà// PathLen := PathLen + DescentSize;
Result := Result + PathLen * VentSideSize; // Äëèíó íà ðàçìåð áîêîâîãî íàïóñêà
end;
end;
end;
end;
end;
end;
end;
function CalcArchRoomsFacadeArea(ACAD: TForm): Double;
var
GrpNet: TNet;
Path: TNetPath;
PathElem: TNetDoor;
ArchWall: TSCSComponent;
ChildArchObj: TSCSComponent;
Corners: TSCSComponents;
MapScaleKoeff: Double;
PWidth, PHeight: Double;
WallOutArea, PHeightA, PHeightB: Double;
i,j: Integer;
OutPath1, OutPath2: TNetPath;
//OutPath1Pt, OutPath2Pt: PDoublepoint;
OutPath1PtH, OutPath2PtH: Double;
// Âåðíåò ïîêëþ÷åííûé âíåøíèé (ôàñàä) ñåãìåíò
function GetJoinedOutPath(APath: TNetPath; APoint: PDoublePoint;
{var AOutPt: PDoublePoint;} var AOutPtH: Double): TNetPath;
var
i: Integer;
Path: TNetPath;
Wall: TSCSComponent;
begin
Result := nil;
for i := 0 to APath.Net.Paths.Count - 1 do
begin
Path := TNetPath(APath.Net.Paths[i]);
if (Path <> APath) and (Path.FComponID <> APath.FComponID) and (Path.FIsInner = false) then
begin
if Path.p1 = APoint then
begin
Result := Path;
//AOutPt := Path.p1;
AOutPtH := Path.p1H;
end
else if Path.p2 = APoint then
begin
Result := Path;
//AOutPt := Path.p2;
AOutPtH := Path.p2H;
end;
if Result <> nil then
begin
if AOutPtH = 0 then
begin
Wall := GetArchObjByCADObj(Path);
if Wall <> nil then
AOutPtH := Wall.GetPropertyValueAsFloat(pnHeight);
end;
Break; //// BREAK ////
end;
end;
end;
end;
begin
Result := 0;
GrpNet := GroupRoomNets(ACAD);
MapScaleKoeff := TF_CAD(ACAD).PCad.MapScale / 1000;
for i := 0 to GrpNet.Paths.Count - 1 do
begin
Path := TNetPath(GrpNet.Paths[i]);
ArchWall := GetArchObjByCADObj(Path);
if (ArchWall.IsLine = ctArhWall) and ArchWall.GetPropertyValueAsBooleanDef(pnBasement, false) then
begin
PWidth := Path.OutLen * MapScaleKoeff;
WallOutArea := 0;
// Åñëè íå âíóòðåííÿÿ ñòåíà
if Path.FIsInner = false then
begin
//PHeightA := 0;
//PHeightB := 0;
//Corners := GetArchCornersForWall(ArchWall);
//// Åñëè ýòîò ñåãìåíò ÿâëÿåòñÿ ÷àñòþ (îòäåëåí)
//if Path.FDivedFrom <> nil then
// EmptyProcedure;
//if Corners <> nil then
//begin
// // Ñâîéñòâî "Ïëîùàäü ñòåíû"
// PHeightA := Corners[0].GetPropertyValueAsFloat(pnHeight);
// PHeightB := Corners[1].GetPropertyValueAsFloat(pnHeight);
//end;
PHeight := ArchWall.GetPropertyValueAsFloat(pnHeight);
PHeightA := Path.p1H;
PHeightB := Path.p2H;
if (PHeightA > 0) or (PHeightB > 0) then
begin
//14.04.2011 WallOutArea := GetTrapezeArea(PHeightA, PHeightB, PWidth)
PHeightA := FloatNoZero(PHeightA, PHeight);
PHeightB := FloatNoZero(PHeightB, PHeight);
WallOutArea := GetTrapezeArea(PHeightA, PHeightB, PWidth);
end
else
WallOutArea := PHeight * PWidth;
for j := 0 to Path.Doors.Count - 1 do
begin
PathElem := TNetDoor(Path.Doors[j]);
ChildArchObj := GetArchObjByCADObj(PathElem);
LoadArchObjPropsFromCAD(ChildArchObj, PathElem);
// Ïðîåì
if ChildArchObj.IsLine in [ctArhEmbrasure, ctArhWindow, ctArhDoor, ctArhArc] then
WallOutArea := WallOutArea - ChildArchObj.GetPropertyValueAsFloat(pnSquare);
end;
end
else if (Path.p1H > 0) or (Path.p2H > 0) then
begin
// Äëÿ âíóòðåííåé ñòåíû ñìîòðèì íå ÿâëÿåòñÿ ëè åå ÷àñòü íàðóæíîé (âåðõíÿÿ ÷àñòü)
// ÷òîáû ýòî îïðåäåëèòü, èùåì ïîäêëþ÷åííûé âíåøíèé ñåãìåíò äëÿ êàæäîé åå ñòîðîíû
// è â ýòèõ âíåøíèõ ñåãìåíòàõ ñìîòðèì ÷òîáû âûñîòà áûëà ìåíüøå âûñîòû ýòîãî âíóòðåííåãî ñåãìåíòà
OutPath1 := GetJoinedOutPath(Path, Path.p1, {OutPath1Pt, }OutPath1PtH);
OutPath2 := GetJoinedOutPath(Path, Path.p2, {OutPath2Pt, }OutPath2PtH);
if (OutPath1 <> nil) and (OutPath2 <> nil) then
begin
//14.04.2011 PHeightA := Path.p1H;
//14.04.2011 PHeightB := Path.p2H;
//14.04.2011 if (PHeightA=0) and (PHeightB=0) then
//14.04.2011 begin
//14.04.2011 PHeightA := ArchWall.GetPropertyValueAsFloat(pnHeight);
//14.04.2011 PHeightB := PHeightA;
//14.04.2011 end;
PHeight := ArchWall.GetPropertyValueAsFloat(pnHeight);
PHeightA := FloatNoZero(Path.p1H, PHeight);
PHeightB := FloatNoZero(Path.p2H, PHeight);
if (OutPath1PtH <= PHeightA) and (OutPath2PtH <= PHeightB) then
begin
WallOutArea := GetTrapezeArea(PHeightA-OutPath1PtH, PHeightB-OutPath2PtH, PWidth);
end;
end;
end;
if WallOutArea > 0 then
Result := Result + WallOutArea;
end;
end;
FreeAndNil(GrpNet);
end;
procedure ChangeArchChildObjWidthDelta(AObj: TSCSComponent; AChildType: Integer; ADelta: Double);
var
ObjW: Double;
ChildObj: TSCSComponent;
ChildObjW: Double;
begin
ChildObj := GetChildComponByIsLine(AObj, AChildType);
if ChildObj <> nil then
ChildObj.AddPropertyValueAsFloat(pnWidth, ADelta);
end;
procedure ChangeArchChildObjWidthKoeff(AObj: TSCSComponent; AChildType: Integer; AKoeff: Double);
var
ObjW: Double;
ChildObj: TSCSComponent;
ChildObjW: Double;
begin
ChildObj := GetChildComponByIsLine(AObj, AChildType);
if ChildObj <> nil then
begin
ChildObjW := ChildObj.GetPropertyValueAsFloat(pnWidth);
ChildObjW := ChildObjW * AKoeff;
//ObjW := AObj.GetPropertyValueAsFloat(pnWidth);
//if ChildObjW > ObjW then
// ChildObjW := ObjW;
ChildObj.SetPropertyValueAsFloat(pnWidth, ChildObjW);
end;
end;
function CheckContureIntersectNet(AObjType: Integer; AConturePoints: PDoublePointArr; ACAD: TForm): Boolean;
var
i: Integer;
Figure: TFigure;
Net: TNet;
ArchObj: TSCSComponent;
PathList: TList;
OutConture: TDoublePointArr;
InnConture: TDoublePointArr;
isroof: boolean;
begin
Result := false;
try
if IsArchRoomComponByIsLine(AObjType) then
begin
for i := 0 to TF_CAD(ACAD).PCad.Figures.Count - 1 do
begin
Figure := TFigure(TF_CAD(ACAD).PCad.Figures[i]);
if Figure is TNet then
begin
Net := TNet(Figure);
if (Net.FComponID <> 0) then
begin
ArchObj := GetArchObjByCADObj(Net);
if IsArchRoomComponByIsLine(ArchObj.IsLine) then
begin
SetLength(OutConture, 0);
SetLength(InnConture, 0);
PathList := GetNetWallPathList(Net, nil);
// Ïîëó÷àåì êîíòóð äëÿ Net
GetPathsConturePoints(PathList, @OutConture, @InnConture, {nil, nil,} false, nil, nil, nil, nil);
PathList.Free;
isroof := iffiguraisroof(Net);
if
CheckContrureEntry(@InnConture, AConturePoints,false,false,isroof) or // âõîäèò ëè AConturePoints â InnConture
CheckContrureEntry(AConturePoints, @OutConture,false,false,isroof) // âõîäèò ëè OutConture â AConturePoints
then
begin
MessageInfo(cArchCommon_Msg05);
Result := True;
Break; //// BREAK ////
end;
//Result := CheckAnyPtInNetConture(AConturePoints, Net);
//if Not Result then
// MessageInfo(cArchCommon_Msg05);
end;
end;
end;
end;
SetLength(OutConture, 0);
SetLength(InnConture, 0);
end;
except
on E: Exception do AddExceptionToLogEx('CheckContureIntersectNet', E.Message);
end;
end;
function CheckNetRoofSegCortex(ANet: TNet; AArchObj: TSCSComponent): Boolean;
var
Points: TDoublePointArr;
begin
Result := false;
if AArchObj = nil then
AArchObj := GetArchObjByCadObj(ANet);
if (AArchObj <> nil) and (AArchObj.IsLine = ctArhRoofSeg) then
begin
Points := ANet.GetContureByPt; //ANet.GetRoomConture;
Result := IsConvexPolygon(@Points, false) <> pltConcave; // Åñëè íå âîãíóòûé
if Not Result then
Messageinfo('Ñåãìåíò äîëæåí áûòü âûïóêëûì');
end;
end;
function CheckPathInListByRelatedInCAD(APath: TNetPath; APathList: TList): Boolean;
var
//Nets: TList;
Path: TNetPath;
i: Integer;
//RelPathsCmpRes: TList;
//RelPaths: TList;
//RelPathIdx: Integer;
EqualRotate: Boolean;
p1h1, p1h2, p2h1, p2h2: Double;
begin
Result := false;
{if APathList.Count > 0 then
begin
Nets := TList.Create;
RelPathsCmpRes := TList.Create;
for i := 0 to APathList.Count - 1 do
begin
Path := TNetPath(APathList[i]);
if Nets.IndexOf(Path.Net) = -1 then
begin
RelPaths := Path.Net.GetRelatedPaths(APath, RelPathsCmpRes, true);
if RelPaths <> nil then
begin
RelPathIdx := RelPaths.IndexOf(Path);
//if RelPathsCmpRes.IndexOf(Pointer(citEqual)) <> -1 then
if (RelPathIdx <> -1) and (Integer(RelPathsCmpRes[RelPathIdx]) = citEqual) then
begin
Result := true;
Break; //// BREAK ////
end;
RelPaths.Free;
end;
Nets.Add(Path.Net);
end;
end;
RelPathsCmpRes.Free;
Nets.Free;
end;}
if APathList.Count > 0 then
begin
for i := 0 to APathList.Count - 1 do
begin
Path := TNetPath(APathList[i]);
if APath.CmpIntersectPath(Path, 2, @EqualRotate) = citEqual then
begin
// ñðàâíèâàåì âûñîòû
p1h1 := APath.GetHeightOfPt(APath.p1);
p1h2 := APath.GetHeightOfPt(APath.p2);
p2h1 := Path.GetHeightOfPt(Path.p1);
p2h2 := Path.GetHeightOfPt(Path.p2);
if Not EqualRotate then
begin
if CmpFloatByCP(p1h1, p2h1) and CmpFloatByCP(p1h2, p2h2) then
Result := true;
end
else
begin
if CmpFloatByCP(p1h1, p2h2) and CmpFloatByCP(p1h2, p2h1) then
Result := true;
end;
if Result then
Break; //// BREAK ////
end;
end;
end;
end;
function CheckWallWithBasementColumn(AWallobj: TSCSComponent): Boolean;
begin
Result := false;
if AWallobj.GetPropertyValueAsBooleanDef(pnBasement, false) and
(AWallobj.GetPropertyValueAsFloat(pnBasementColumnH) > 0) and
(AWallobj.GetPropertyValueAsFloat(pnBasementColumnW) > 0) and
(AWallobj.GetPropertyValueAsFloat(pnBasementColumnL) > 0) then
Result := true;
end;
function CmpPathsHeights(APath1, APath2: TNetPath): Boolean;
begin
Result := false;
if PointNear(APath1.p1^, APath2.p1^) then
begin
if (APath1.GetHeightOfPt(APath1.p1) = APath2.GetHeightOfPt(APath2.p1)) and
(APath1.GetHeightOfPt(APath1.p2) = APath2.GetHeightOfPt(APath2.p2)) then
Result := true;
end
else if PointNear(APath1.p1^, APath2.p2^) then
begin
if (APath1.GetHeightOfPt(APath1.p1) = APath2.GetHeightOfPt(APath2.p2)) and
(APath1.GetHeightOfPt(APath1.p2) = APath2.GetHeightOfPt(APath2.p1)) then
Result := true;
end;
end;
function GetRelBasementByIntersectType(AIntersectType: Integer; APaths, ACmpRes: TList): TSCSComponent;
var
Idx: Integer;
ArchObj: TSCSComponent;
begin
Result := nil;
Idx := ACmpRes.IndexOf(Pointer(AIntersectType));
if Idx <> -1 then
begin
ArchObj := GetArchObjByCADObj(TNetPath(APaths[Idx]));
if (ArchObj <> nil) and ArchObj.GetPropertyValueAsBooleanDef(pnBasement, false) then
Result := ArchObj;
end;
end;
function CreateArchSegmentInfo(AIsLine: Integer): TArchInfoBasic;
begin
Result := nil;
if AIsLine = ctArhWall then
Result := TArchWallInfo.Create(nil)
else if AIsLine = ctArhWallDivision then
Result := TArchWallDivInfo.Create(nil)
else if AIsLine = ctArhRoofHip then
Result := TArchRoofHipInfo.Create(nil);
end;
function CmpPoints(AP1, AP2: TDoublePoint): Boolean;
begin
Result := false;
if (abs(AP1.x-AP2.x)<0.01) and (abs(AP1.y-AP2.y)<0.01) then
Result := true;
end;
function DefineArchContainer(AList: TSCSList): TSCSCatalog;
var
i: Integer;
Child: TSCSCatalog;
NewNode: TTreeNode;
begin
Result := nil;
try
for i := 0 to AList.ChildCatalogs.Count - 1 do
begin
Child := AList.ChildCatalogs[i];
if Child.ItemType = itArhContainer then
begin
if Child.TreeViewNode = nil then
begin
NewNode := TF_Main(Child.ActiveForm).FindComponOrDirInTree(Child.ID, false);
if Child.TreeViewNode = nil then
Child.TreeViewNode := NewNode;
end;
Result := Child;
Break; //// BREAK ////
end;
end;
// Åñëè íå íàøëè êîíòåéíåð, òî ñîçäàåì åãî
if Result = nil then
begin
if AList.TreeViewNode = nil then
F_ProjMan.FindComponOrDirInTree(AList.ID, false);
if AList.TreeViewNode <> nil then
begin
NewNode := F_ProjMan.MakeDir(cfCAD, AList.TreeViewNode, cArchCommon_Msg01, itArhContainer, nil);
Child := AList.GetCatalogFromReferences(PObjectData(NewNode.Data).ObjectID);
if Child <> nil then
Result := Child;
end
else
begin
MessageInfo(cBaseCommon47);
Exit;
end;
end;
except
on E: Exception do AddExceptionToLogEx('DefineArchContainer', E.Message);
end;
end;
procedure DefineArchCornerName(ACorner: TSCSComponent; ANet: TNet=nil);
var
i: Integer;
CornerWalls: TSCSComponents;
Wall: TSCSComponent;
begin
if ACorner <> nil then
if IsArchCornerComponByIsLine(ACorner.IsLine) then //19.05.2011 if ACorner.IsLine = ctArhWallCorner then
begin
CornerWalls := GetArchWallsForCorner(ACorner, ANet);
if CornerWalls <> nil then
begin
ACorner.Name := cArchCommon_Msg03_2+' ';
for i := 0 to CornerWalls.Count - 1 do
begin
Wall := CornerWalls[i];
if i > 0 then
ACorner.Name := ACorner.Name + '/';
ACorner.Name := ACorner.Name + Wall.GetNameForVisible;
end;
CornerWalls.Free;
end
else
ACorner.Name := cArchCommon_Msg03_1;
TF_Main(ACorner.ActiveForm).RefreshNodeText(ACorner.TreeViewNode, ACorner);
end;
end;
procedure DefineArchCornersNames(ACorners: TSCSComponents);
var
i: Integer;
begin
for i := 0 to ACorners.Count - 1 do
DefineArchCornerName(ACorners[i]);
end;
procedure DefineArchNetPointsHeight(ANet: TNet);
var
ArhObj, ArhDockObj: TSCSComponent;
OutPoints, InnPoints: TDoublePointArr;
NetOutPoints, NetInnPoints: TDoublePointArr;
Figure: TFigure;
DockNet, Net: TNet;
MinPerimetr, NetPerimetr: Double;
i: Integer;
CanMergeNets: Boolean;
EnteringNets: TList; // Êîíòóðû êîòîðûå âíóòðè ANet
begin
if ANet.FComponID <> 0 then
begin
ArhObj := GetArchObjByCADObj(ANet);
if (ArhObj <> nil) and (ArhObj.IsLine = ctArhRoofSeg) then
if ArhObj.GetPropertyValueAsInteger(pnMaterialType) <> pmtRoofBase then
begin
//GetPathsConturePoints(ANet.Paths, @OutPoints, @InnPoints, {nil, nil,} false, nil, nil);
// if Length(OutPoints) > 0 then
// begin
// // Èùåì êîíòóð â êîòîðîì íàõîäèòñÿ ANet => DockNet, è êîòîðûå âíóòðè ANet => EnteringNets
// MinPerimetr := 0;
// DockNet := nil;
// EnteringNets := TList.Create;
// for i := 0 to TPowercad(ANet.Owner).Figures.Count - 1 do
// begin
// Figure := TFigure(TPowercad(ANet.Owner).Figures[i]);
// if (Figure is TNet) and (Figure <> ANet) then
// begin
// Net := TNet(Figure);
// CanMergeNets := true;
// if Assigned(ANet.FOnMergeNetsQuery) then
// ANet.FOnMergeNetsQuery(ANet, Net, CanMergeNets);
// if CanMergeNets then
// begin
// GetPathsConturePoints(Net.Paths, @NetOutPoints, @NetInnPoints, {nil, nil,} false, nil, nil);
// if CheckContrureEntry(@NetInnPoints, @OutPoints) then
// begin
// NetPerimetr := GetPerimetrFromPolygon(@NetInnPoints);
// if (MinPerimetr = 0) or (MinPerimetr > NetPerimetr) then
// begin
// NetPerimetr := MinPerimetr;
// DockNet := Net;
// end;
// end
// else
// // Åñëè ANet èìååò Net
// if CheckContrureEntry(@InnPoints, @NetOutPoints) then
// begin
// EnteringNets.Add(Net);
// end;
// SetLength(NetOutPoints, 0);
// SetLength(NetInnPoints, 0);
// end;
// end;
// end;
//
// if DockNet <> nil then
// DefineArchNetPointsHeightInDock(DockNet, ANet);
//
// for i := 0 to EnteringNets.Count - 1 do
// DefineArchNetPointsHeightInDock(ANet, TNet(EnteringNets[i]));
// EnteringNets.Free;
// end;
// SetLength(OutPoints, 0);
// SetLength(InnPoints, 0);
EnteringNets := TList.Create;
if GetInnerOuterNets(ANet, ArhObj, DockNet, EnteringNets) then
begin
if DockNet <> nil then
begin
ArhDockObj := GetArchObjByCADObj(DockNet);
if Assigned(ArhDockObj) and (ArhDockObj.GetPropertyValueAsInteger(pnMaterialType) <> pmtRoofBase) then
DefineArchNetPointsHeightInDock(DockNet, ANet, ArhDockObj, ArhObj);
end;
for i := 0 to EnteringNets.Count - 1 do
DefineArchNetPointsHeightInDock(ANet, TNet(EnteringNets[i]), ArhObj, nil);
end;
EnteringNets.Free;
end;
end;
end;
procedure DefineArchNetPointsHeightInDock(ADockSiteNet, AReceiveNet: TNet; ADockSiteObj, AReceiveObj: TSCSComponent);
var
DSObj, RNetObj: TSCSComponent;
i: Integer;
DSObjPoints, RObjPoints: TSCSComponents;
RObjPoint: TSCSComponent;
InclinedPath: TNetPath; // Íàêëîííàÿ ëèíèÿ
FlatPath:TNetPath; // ðîâíàÿ ëèíèÿ êîòîðàÿ íèæå
Path: TNetPath;
PathObj: TSCSComponent;
h1, h2: Double;
FrameAngle: Double;
FrameTgA: Double;
StartPt: PDoublePoint; // òî÷êó êîòîðàÿ íà ãîðèçîíòàëüíîé ïëîñêîñòè
EndPt:PDoublePoint;
SideA, SideB, SideC: Double; // c - ïðèëåæàùèé êàòåò, a - ïðîèòèâîïîëîæíûé êàòåò, b - ãèïîòåíóçà
StartPt90: TDoublePoint;
ProectSide: Double;
ProectPt: TDoublePoint;
begin
DSObj := ADockSiteObj;
if DSObj = nil then
DSObj := GetArchObjByCADObj(ADockSiteNet);
RNetObj := AReceiveObj;
if RNetObj = nil then
RNetObj := GetArchObjByCADObj(AReceiveNet);
if (DSObj <> nil) and (RNetObj <> nil) then
begin
DSObjPoints := GetArchCornersForNet(ADockSiteNet, DSObj);
RObjPoints := GetArchCornersForNet(AReceiveNet, RNetObj);
// Èùåì íàêëîííûé ñåãìåíò è òî÷êó êîòîðàÿ íà ãîðèçîíòàëüíîé ïëîñêîñòè
FrameAngle := 0;
FrameTgA := 0;
InclinedPath := nil;
FlatPath := nil;
StartPt := nil;
EndPt := nil;
for i := 0 to ADockSiteNet.Paths.Count - 1 do
begin
Path := TNetPath(ADockSiteNet.Paths[i]);
h1 := Path.GetHeightOfPt(Path.p1); //GetArchWallCornersProps();
h2 := Path.GetHeightOfPt(Path.p2);
if h1 <> h2 then
begin
PathObj := DSObj.GetComponentFromReferences(Path.FComponID);
LoadArchObjPropsFromCAD(PathObj, Path);
SideA := Abs(h1- h2);
//SideC := PathObj.GetPropertyValueAsFloat(pnWidth);
//SideB := SQRT(SQR(SideA) + SQR(SideC)); // Äëèíà äèàãîíàëè
//// tg(A) = a/c, A = arctan(SideA / SideC) * 180/pi
//FrameTgA := SideA / SideC;
//FrameAngle := RadToDeg(arctan(FrameTgA));
InclinedPath := Path;
StartPt := Path.p1;
EndPt := Path.p2;
if h1 > h2 then
begin
StartPt := Path.p2;
EndPt := Path.p1;
end;
Break; //// BREAK ////
end;
end;
// Èùåì ðîâíóþ ëèíèþ, êîòîðàÿ ïðèâÿçàíà ê íàêëîííîé
for i := 0 to ADockSiteNet.Paths.Count - 1 do
begin
Path := TNetPath(ADockSiteNet.Paths[i]);
if (Path.p1 = StartPt) or (Path.p2 = StartPt) then
begin
h1 := Path.GetHeightOfPt(Path.p1); //GetArchWallCornersProps();
h2 := Path.GetHeightOfPt(Path.p2);
if h1 = h2 then
begin
FlatPath := Path;
StartPt90 := EndPt^;
//PointToLine(FlatPath.p1^, FlatPath.p2^, StartPt90.x, StartPt90.y);
PointToLineByAngle(FlatPath.p1^, FlatPath.p2^, StartPt90);
SideC := GetLineLenght(StartPt90, EndPt^) * (TPowerCad(ADockSiteNet.Owner).MapScale / 1000);
// tg(A) = a/c, A = arctan(SideA / SideC) * 180/pi
//if SideA < SideC then
FrameTgA := SideA / SideC;
//else
// FrameTgA := SideC / SideA;
FrameAngle := RadToDeg(arctan(FrameTgA));
end;
end;
end;
for i := 0 to RObjPoints.Count - 1 do
begin
RObjPoint := RObjPoints[i];
RObjPoint.SetPropertyValueAsFloat(pnHeight, 0);
if FrameAngle <> 0 then
begin
ProectPt := AReceiveNet.GetPointByID(RObjPoint.ID)^;
//PointToLine(InclinedPath.p1^, InclinedPath.p2^, ProectPt.x, ProectPt.y);
//PointToLine(StartPt90, EndPt^, ProectPt.x, ProectPt.y);
PointToLineByAngle(StartPt90, EndPt^, ProectPt);
//ProectSide := GetLineLenght(StartPt^, ProectPt) * (TPowerCad(ADockSiteNet.Owner).MapScale / 1000);
ProectSide := GetLineLenght(StartPt90, ProectPt) * (TPowerCad(ADockSiteNet.Owner).MapScale / 1000);
// tg(A) = a/c; a = c * tg(A); height = ProectSide * tg(FrameAngle)
//if SideA < SideC then
RObjPoint.SetPropertyValueAsFloat(pnHeight, ProectSide * FrameTgA);
// ctg(A) = c/a; a = c/ctg(A)
//else
// RObjPoint.SetPropertyValueAsFloat(pnHeight, ProectSide / FrameTgA);
end;
end;
RObjPoints.Free;
DSObjPoints.Free;
end;
end;
procedure DefineArchObjPropsOnResize(AArchObj: TSCSComponent; ACadObj: TObject=nil);
var
i: Integer;
CadObj: TObject;
Net: TNet;
ChildObj: TSCSComponent;
ChildObjW: Double;
WallChld: TNetDoor;
WallChldW: Double;
SlopeObj: TSCSComponent;
SlopeObjW: Double;
MapScaleKoeff: Double;
ResizeKoeff: Double;
ResizeDelta: Double;
//LookedPaths: TList;
begin
CadObj := ACadObj;
if CadObj = nil then
CadObj := GetCADObjByArchObj(AArchObj);
Net := GetNetFromCADObj(CadObj);
//LookedPaths := TList.Create;
MapScaleKoeff := (TPowerCad(Net.Owner).MapScale / 1000);
// Ñâîéñòâà îòêîñîâ îêîí/äâåðåé
for i := 0 to AArchObj.ChildReferences.Count - 1 do
begin
ChildObj := AArchObj.ChildReferences[i];
if ChildObj.IsLine in [ctArhWindow, ctArhDoor, ctArhBalcony] then
begin
WallChld := TNetDoor(GetCADObjByArchObj(ChildObj));
if WallChld <> nil then
begin
//if LookedPaths.IndexOf(WallChld.FPath) = -1 then
//begin
// WallChld.FPath.DefineInOutPoints;
// LookedPaths.Add(WallChld.FPath);
//end;
//WallChld.FPath.DefineInOutPoints;
WallChldW := WallChld.Len * MapScaleKoeff; //NetPath.InnerLen * MapScaleKoeff;
ChildObjW := ChildObj.GetPropertyValueAsFloat(pnWidth);
if Not CmpFloatByCP(WallChldW, ChildObjW) then
begin
ResizeKoeff := WallChldW / ChildObjW;
ResizeDelta := WallChldW - ChildObjW;
// Âíóòðåííèå îòêîñû
ChangeArchChildObjWidthDelta(ChildObj, ctArhInnerSlope, ResizeDelta);
// Èçìåíÿåì øèðèíó äëÿ îòêîñîâ
if ChildObj.IsLine in [ctArhWindow, ctArhDoor] then
begin
// Âíåøíèå îòêîñû
ChangeArchChildObjWidthDelta(ChildObj, ctArhOuterSlope, ResizeDelta);
end
else if ChildObj.IsLine = ctArhBalcony then
begin
// Îêíî
ChangeArchChildObjWidthKoeff(ChildObj, ctArhWindow, ResizeKoeff);
// Äâåðü
ChangeArchChildObjWidthKoeff(ChildObj, ctArhDoor, ResizeKoeff);
end;
// Ñîõðàíÿåì ñâîéñòâî äëÿ ýëåìåíòà ñòåíû
ChildObj.SetPropertyValueAsFloat(pnWidth, WallChldW);
end;
end;
end;
end;
//FreeAndNil(LookedPaths);
end;
procedure DefineArchRoomCornersNamesByCadObj(ACADObj: TObject);
var
Net: TNet;
i: Integer;
RoomObject: TSCSComponent;
ArchCorner: TSCSComponent;
begin
try
Net := GetNetFromCADObj(ACADObj);
RoomObject := GetArchObjByCADObj(Net);
if RoomObject <> nil then
begin
for i := 0 to Net.FPointIDs.Count - 1 do
begin
ArchCorner := RoomObject.GetComponentFromReferences(Integer(Net.FPointIDs[i]));
if ArchCorner <> nil then
DefineArchCornerName(ArchCorner);
end;
end;
except
on E: Exception do AddExceptionToLogEx('DefineArchRoomCornersNamesByCadObj', E.Message);
end;
end;
procedure DefineArchWallCornersNamesByCadObj(ACADWallObj: TObject);
var
Net: TNet;
RoomObject: TSCSComponent;
procedure DefineCornersNameByPoint(APoint: PDoublePoint);
begin
DefineArchCornerName(RoomObject.GetComponentFromReferences(Net.GetPointID(APoint)));
end;
begin
if ACADWallObj is TNetPath then
begin
Net := GetNetFromCADObj(ACADWallObj);
RoomObject := GetArchObjByCADObj(Net);
if RoomObject <> nil then
begin
DefineCornersNameByPoint(TNetPath(ACADWallObj).p1);
DefineCornersNameByPoint(TNetPath(ACADWallObj).p2);
end;
end;
end;
procedure DefineArchWallCornersNames(AArchWall: TSCSComponent);
begin
if IsArchSegmentComponByIsLine(AArchWall.IsLine) then
DefineArchWallCornersNamesByCadObj(GetCADObjByArchObj(AArchWall));
end;
function DelArchCADObj(AObject: TObject): Boolean;
var
NetDoor: TNetDoor;
NetPath: TNetPath;
Net: TNet;
CAD: TPowerCad;
begin
Result := false;
CAD := nil;
Net := nil;
if AObject is TNetDoor then
begin
NetDoor := TNetDoor(AObject);
if Not NetDoor.FDeleting then
begin
Net := NetDoor.Net;
if NetDoor.FPath <> nil then
NetDoor.FPath.DeleteDoorObj(NetDoor);
Result := true;
end;
end
else if AObject is TNetPath then
begin
NetPath := TNetPath(AObject);
if Not NetPath.FDeleting then
begin
Net := NetPath.Net;
Net.DeletePath(NetPath);
Result := true;
end;
end
else if AObject is TNet then
begin
Net := TNet(AObject);
if Not Net.FDeleting then
begin
CAD := TPowerCad(Net.Owner);
Net.DeleteNet;
Result := true;
end;
Net := nil;
end;
if Net <> nil then
begin
if CAD = nil then
CAD := TPowerCad(Net.Owner);
Net.RefreshPaths;
end;
if Result then
begin
if CAD <> nil then
RefreshCAD(CAD);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
function DelArchObjByCADObj(ACADObject: TObject): Boolean;
var
ArchObj: TSCSComponent;
begin
Result := false;
ArchObj := GetArchObjByCADObj(ACADObject);
if ArchObj <> nil then
begin
DeleteComponInPM(ArchObj.ListID, ArchObj.ID, ArchObj);
Result := true;
end;
end;
function DelCADObjByArchObj(AObj: TSCSComponent): Boolean;
var
CADObj: TObject;
begin
Result := false;
CADObj := GetCADObjByArchObj(AObj);
if CADObj <> nil then
begin
Result := DelArchCADObj(CADObj);
end;
end;
procedure DefineBasementProps(AArchWallObj: TSCSComponent; ACanRemove: Boolean; AIsCreatingObject: Boolean);
var
PropVal: Boolean;
PropList: TStringList;
i: Integer;
IsCreated: Boolean;
Corners: TSCSComponents;
Corner: TSCSComponent;
RoomObj: TSCSComponent;
begin
PropList := TStringList.Create;
PropList.Add(pnPlinthVolume);
//PropList.Add(pnBasementVolumeunderGround);
PropList.Add(pnTrenchVolume);
PropList.Add(pnBasementVolume);
PropList.Add(pnPlinthThickness);
PropList.Add(pnBasementThickness);
PropList.Add(pnPlinthHeight);
PropList.Add(pnBasementDepth);
PropList.Add(pnBasementColumnCount);
PropList.Add(pnBasementColumnH);
PropList.Add(pnBasementColumnW);
PropList.Add(pnBasementColumnL);
PropList.Add(pnBasementColumnVBetwCorner);
PropList.Add(pnPlinthSidesSquare);
PropList.Add(pnPlinthSurfaceSquare);
PropVal := AArchWallObj.GetPropertyValueAsBooleanDef(pnBasement, false);
if PropVal then
begin
//for i := 0 to PropList.Count - 1 do
//begin
// IsCreated := false;
// if AArchWallObj.GetPropertyBySysName(PropList[i]) = nil then
// begin
// AddPropertyToComponFromSprBySysName(AArchWallObj, AArchWallObj.ProjectOwner.Spravochnik, PropList[i], '0');
// IsCreated := true;
// end;
//
// // Óñòàíàâëèâàåì çíà÷åíèå ñâîéñòâà "òîëùèíà ôóíäàìåíòà íà çåìëåé" îò òîëùèíû ôóíäàìåíòà
// if AIsCreatingObject or IsCreated then
// if PropList[i] = pnPlinthThickness then
// AArchWallObj.SetPropertyValueAsFloat(pnPlinthThickness, AArchWallObj.GetPropertyValueAsFloat(pnThickness)); // òîëùèíà ôóíäàìåíòà îò òîëùèíû ñòåíû
//end;
AddPropsToComponFromSprBySysNames(AArchWallObj, PropList, '0');
end
else
if ACanRemove then
for i := 0 to PropList.Count - 1 do
AArchWallObj.RemovePropertyBySysName(PropList[i]);
PropList.Clear;
if PropVal then
begin
// Ó÷èòûâàåì ñâîéñòâà íà óãëàõ ñòåíû
Corners := GetArchCornersForWall(AArchWallObj);
if Corners <> nil then
begin
//PropList.Add(pnPlinthHeight);
//PropList.Add(pnBasementDepth);
//PropList.Add(pnBasementTotalHeight);
PropList.Add(pnTrenchDepth); // ãëóáèíà òðàíøåè
for i := 0 to Corners.Count - 1 do
begin
Corner := Corners[i];
AddPropsToComponFromSprBySysNames(Corner, PropList, '0');
end;
end;
end;
PropList.Clear;
// Ó÷èòûâàå ñâîéñòâà íà ïîìåùåíèè
if PropVal then
begin
//PropList.Add(pnPlinthVolume);
PropList.Add(pnTrenchVolume); //PropList.Add(pnBasementVolumeunderGround);
PropList.Add(pnBasementVolume);
PropList.Add(pnWallsOutSquare);
//PropList.Add(pnBasementColumnV);
RoomObj := AArchWallObj.GetTopComponent;
AddPropsToComponFromSprBySysNames(RoomObj, PropList, '0');
end;
FreeAndNil(PropList);
end;
procedure DefinePropsByVal(AArchObj: TSCSComponent; const APropSN, AVal: String);
var
PropList: TStringList;
IntVal: Integer;
RoofObj, RoofChldObj: TSCSComponent;
i,j: Integer;
DefinedProps: TStringList;
AllAddingProps: TStringList;
procedure DefDefinedProps;
begin
if DefinedProps = nil then
DefinedProps := CreateStringListSorted;
end;
procedure HereAddPropsToComponFromSprBySN(ACompon: TSCSComponent; const APropSN: String; AValue: String='');
begin
AddPropsToComponFromSprBySN(ACompon, APropSN, AValue);
DefDefinedProps;
DefinedProps.Add(APropSN);
end;
procedure HereAddPropsToComponFromSprBySysNames(ACompon: TSCSComponent; APropSysNames: TStringList; const AValue: String);
begin
AddPropsToComponFromSprBySysNames(ACompon, APropSysNames, AValue);
DefDefinedProps;
DefinedProps.AddStrings(APropSysNames);
end;
function GetComponPropInt(ACompon: TSCSComponent; const ACompPropSN: String): Integer;
begin
Result := 0;
if (ACompon = AArchObj) and (ACompPropSN = APropSN) then
Result := StrToIntDef(AVal, 0)
else
Result := ACompon.GetPropertyValueAsInteger(ACompPropSN);
end;
procedure DefRoofHipAddProps(ASeg, AHip: TSCSComponent);
var
HipType: integer;
RemoveAll: Boolean;
begin
if Assigned(ASeg) and Assigned(AHip) and (ASeg.IsLine = ctArhRoofSeg) and (AHip.IsLine = ctArhRoofHip) then
begin
RemoveAll := false;
// Åñëè ìåòàëëî÷åðåïèöà
if GetComponPropInt(ASeg, pnMaterialType) = pmtTileMetal then
begin
HipType := GetComponPropInt(AHip, pnRoofHipType);
// Åñëè êîíåê
if HipType = rhtApex then
begin
HereAddPropsToComponFromSprBySN(AHip, pnRoofHipApexType, IntToStr(rhatLargeRound));
AHip.RemovePropertyBySysName(pnRoofHipValleyType);
end
// Åñëè åíäîâà
else if HipType = rhtValley then
begin
HereAddPropsToComponFromSprBySN(AHip, pnRoofHipValleyType, IntToStr(rhvtDeep));
AHip.RemovePropertyBySysName(pnRoofHipApexType);
end
else
RemoveAll := true;
end
else
RemoveAll := true;
if RemoveAll then
begin
AHip.RemovePropertyBySysName(pnRoofHipApexType);
AHip.RemovePropertyBySysName(pnRoofHipValleyType);
end;
end;
end;
begin
try
PropList := TStringList.Create;
DefinedProps := nil;
AllAddingProps := nil;
// Òèï ìàòåðèàëà
if APropSN = pnMaterialType then
begin
IntVal := StrToIntDef(AVal, pmtNone);
// Èíäèâèäóàëüíûå ñâîéñòâà äëÿ êàæäîãî òèïà ìàòåðèàëà
if IntVal in [pmtTileCeramic, pmtTileBitumen, pmtTileInterlocking] then
begin
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialHeightUsable, '0,3');
end
else if IntVal = pmtTileMetal then
begin
//HereAddPropsToComponFromSprBySN(AArchObj, pnTypeSize1, '3,5'); // Òèïîðàçìåð 1
//HereAddPropsToComponFromSprBySN(AArchObj, pnTypeSize2, '2,1'); // Òèïîðàçìåð 2
//HereAddPropsToComponFromSprBySN(AArchObj, pnTypeSize3, '1,05'); // Òèïîðàçìåð 3
//HereAddPropsToComponFromSprBySN(AArchObj, pnTypeSize4, '0,35'); // Òèïîðàçìåð 4
//HereAddPropsToComponFromSprBySN(AArchObj, pnRoofHipApexType); // Òèïû êîíüêà êðûøè
//HereAddPropsToComponFromSprBySN(AArchObj, pnRoofHipValleyType); // Òèïû åíäîâû êðûøè
HereAddPropsToComponFromSprBySN(AArchObj, pnTypeSize1); // Òèïîðàçìåð 1
HereAddPropsToComponFromSprBySN(AArchObj, pnTypeSize2); // Òèïîðàçìåð 2
HereAddPropsToComponFromSprBySN(AArchObj, pnTypeSize3); // Òèïîðàçìåð 3
HereAddPropsToComponFromSprBySN(AArchObj, pnTypeSize4); // Òèïîðàçìåð 4
//08.07.2011
//PropList.Add(pnTypeSize1RowCount); // Êîë-âî ðÿäîâ òèïîðàçìåðà 1
//PropList.Add(pnTypeSize2RowCount); // Êîë-âî ðÿäîâ òèïîðàçìåðà 2
//PropList.Add(pnTypeSize3RowCount); // Êîë-âî ðÿäîâ òèïîðàçìåðà 3
//PropList.Add(pnTypeSize4RowCount); // Êîë-âî ðÿäîâ òèïîðàçìåðà 4
//HereAddPropsToComponFromSprBySysNames(AArchObj, PropList, '1');
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialWidthUsable, '1,1'); // Øèðèíà ìàòåðèàëà ïîëåçíàÿ
//HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialHeightUsable, '1,1'); // Âûñîòà ìàòåðèàëà ïîëåçíàÿ
PropList.Add(pnTypeSize1ElCount); // Êîë-âî ýë-òîâ òèïîðàçìåðà 1
PropList.Add(pnTypeSize2ElCount); // Êîë-âî ýë-òîâ òèïîðàçìåðà 2
PropList.Add(pnTypeSize3ElCount); // Êîë-âî ýë-òîâ òèïîðàçìåðà 3
PropList.Add(pnTypeSize4ElCount); // Êîë-âî ýë-òîâ òèïîðàçìåðà 4
HereAddPropsToComponFromSprBySysNames(AArchObj, PropList, '0');
PropList.Clear;
end;
// Îáùèå ñâîéñòâà äëÿ òèïîâ ìàòåðèàëà
// 'Ëèñòîâîå – øèôåð'; 'Ëèñòîâîå - ñòàëü ëèñòîâàÿ';
if IntVal in [pmtSheetSlate, pmtSheetSteel] then
begin
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialWidthUsable, '1'); //22.09.2011
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialHeightUsable, '1'); //22.09.2011
//22.09.2011 PropList.Add(pnMaterialHeightUsable); // Âûñîòà ìàòåðèàëà
//22.09.2011 PropList.Add(pnMaterialWidthUsable); // Øèðèíà ìàòåðèàëà
PropList.Add(pnConsiderRemains); // Ó÷èòûâàòü îñòàòêè
end
else if IntVal in [pmtTileMetal, pmtTileCeramic, pmtTileBitumen] then
begin
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialWidthUsable, '1'); //22.09.2011
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialHeightUsable, '1'); //22.09.2011
//26.08.2011 PropList.Add(pnAreaWithRemains); // Ïëîùàòü ñ îñòàòêàìè
if IntVal = pmtTileBitumen then
PropList.Add(pnContiguityFromPerimetr); // Ïðèìûêàíèÿ - èç ïåðèìåòðà ïðîåìîâ
end
else if IntVal = pmtRoller then
begin
//PropList.Add(pnMaterialHeightUsable); // Âûñîòà ìàòåðèàëà
//HereAddPropsToComponFromSprBySysNames(AArchObj, PropList, '1');
//PropList.Clear;
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialHeightUsable, '1');
//26.08.2011 PropList.Add(pnAreaWithRemains); // Ïëîùàòü ñ îñòàòêàìè
end
else if IntVal in [pmtOndura, pmtOnduline] then
begin
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialWidthUsable, '1'); //22.09.2011
HereAddPropsToComponFromSprBySN(AArchObj, pnMaterialHeightUsable, '1'); //22.09.2011l
//22.09.2011 PropList.Add(pnMaterialHeightUsable); // Âûñîòà ìàòåðèàëà
//22.09.2011 PropList.Add(pnMaterialWidthUsable); // Øèðèíà ìàòåðèàëà
PropList.Add(pnConsiderRemains); // Ó÷èòûâàòü îñòàòêè
PropList.Add(pnCuttingWithRemains); // Êðîé ñ ó÷åòîì îòõîäîâ
end;
HereAddPropsToComponFromSprBySysNames(AArchObj, PropList, '0');
// Åñëè íå ôðîíòîí è íå îñíîâàíèå êðûøè
if Not (IntVal in [pmtFronton, pmtRoofBase]) then
begin
HereAddPropsToComponFromSprBySN(AArchObj, pnDescentSize, '0,05'); // Ðàçìåð ñïóñêà
HereAddPropsToComponFromSprBySN(AArchObj, pnVentSideSize, '0,07'); // Ðàçìåð áîêîâîãî íàïóñêà
HereAddPropsToComponFromSprBySN(AArchObj, pnOverlapping, '0,15'); // Ïåðåêðûòèå
if IntVal <> pmtRoller then
HereAddPropsToComponFromSprBySN(AArchObj, pnOverlappingLateral, '0,1'); // Ïåðåêðûòèå áîêîâîå
HereAddPropsToComponFromSprBySN(AArchObj, pnAreaWithRemains); //26.08.2011 - Ïëîùàòü ñ îñòàòêàìè
HereAddPropsToComponFromSprBySN(AArchObj, pnSquareInclEmbrasuresLap); //Ïëîùàäü ñ ó÷åòîì ïðîåìîâ/íàïóñêîâ
end;
// Åñëè íå îñíîâàíèå êðûøè
if IntVal <> pmtRoofBase then
begin
HereAddPropsToComponFromSprBySN(AArchObj, pnSquareInclEmbrasures); //Ïëîùàäü ñ ó÷åòîì ïðîåìîâ
HereAddPropsToComponFromSprBySN(AArchObj, pnPerimeterEmbrasures); // Ïåðèìåòð ïðîåìîâ
end;
//DefRelPropVal;
// Îïðåäåëèòü äîï ñâîéñòâà ðåáåð ìåòàëëî÷åðåïèöè
if AArchObj.IsLine = ctArhRoofSeg then
begin
for i := 0 to AArchObj.ChildReferences.Count - 1 do
begin
RoofChldObj := AArchObj.ChildReferences[i];
if RoofChldObj.IsLine = ctArhRoofHip then
DefRoofHipAddProps(AArchObj, RoofChldObj);
end;
end;
// Ôîðìèðóåì ìàññèâ ñî âñåìè âîçìîæíûìè äîîïðåäåëÿåìûìè ñâîéñòâàìè
if DefinedProps <> nil then
begin
AllAddingProps := TStringList.Create;
AllAddingProps.Add(pnMaterialHeightUsable);
AllAddingProps.Add(pnMaterialWidthUsable);
AllAddingProps.Add(pnTypeSize1);
AllAddingProps.Add(pnTypeSize2);
AllAddingProps.Add(pnTypeSize3);
AllAddingProps.Add(pnTypeSize4);
AllAddingProps.Add(pnTypeSize1ElCount);
AllAddingProps.Add(pnTypeSize2ElCount);
AllAddingProps.Add(pnTypeSize3ElCount);
AllAddingProps.Add(pnTypeSize4ElCount);
AllAddingProps.Add(pnConsiderRemains);
AllAddingProps.Add(pnAreaWithRemains);
AllAddingProps.Add(pnContiguityFromPerimetr);
AllAddingProps.Add(pnCuttingWithRemains);
AllAddingProps.Add(pnDescentSize); // Ðàçìåð ñïóñêà
AllAddingProps.Add(pnVentSideSize); // Ðàçìåð áîêîâîãî íàïóñêà
AllAddingProps.Add(pnOverlapping); // Ïåðåêðûòèå
AllAddingProps.Add(pnOverlappingLateral); // Ïåðåêðûòèå áîêîâîå
AllAddingProps.Add(pnSquareInclEmbrasures); //Ïëîùàäü ñ ó÷åòîì ïðîåìîâ
AllAddingProps.Add(pnSquareInclEmbrasuresLap); //Ïëîùàäü ñ ó÷åòîì ïðîåìîâ/íàïóñêîâ
AllAddingProps.Add(pnPerimeterEmbrasures); // Ïåðèìåòð ïðîåìîâ
end;
end
// Òèï ðåáðà êðûøè
else if APropSN = pnRoofHipType then
begin
// Îïðåäåëèòü äîï ñâîéñòâà ðåáåð ìåòàëëî÷åðåïèöè
DefRoofHipAddProps(GetParentComponByIsLine(AArchObj, ctArhRoofSeg), AArchObj);
// Ôîðìèðóåì ìàññèâ ñî âñåìè âîçìîæíûìè äîîïðåäåëÿåìûìè ñâîéñòâàìè
if DefinedProps <> nil then
begin
AllAddingProps := TStringList.Create;
AllAddingProps.Add(pnRoofHipApexType);
AllAddingProps.Add(pnRoofHipValleyType);
end;
end
else if APropSN = pnConsiderRemains then
begin
if AVal = IntToStr(biTrue) then
HereAddPropsToComponFromSprBySN(AArchObj, pnRemainsMinUseSize);
// Ôîðìèðóåì ìàññèâ ñî âñåìè âîçìîæíûìè äîîïðåäåëÿåìûìè ñâîéñòâàìè
DefDefinedProps;
AllAddingProps := TStringList.Create;
AllAddingProps.Add(pnRemainsMinUseSize);
end;
FreeAndNil(PropList);
// Óäàëÿåì ëèøíèå ñâîéñòâà - äëÿ ñëó÷àÿ åñëè çíà÷åíèå ñâîéñòâà ïîìåíëîñü è ñ ïðåäûäóùåãî çíà÷åíèÿ íå íóæíû
if DefinedProps <> nil then
begin
if AllAddingProps <> nil then
begin
for i := 0 to AllAddingProps.Count - 1 do
begin
// åñëè ñâîéñòâà íåòó ñðåäè îïðåäåëÿåìûõ, òî êèëÿåì åãî íàõ..
if DefinedProps.IndexOf(AllAddingProps[i]) = -1 then
begin
AArchObj.RemovePropertyBySysName(AllAddingProps[i]);
if AllAddingProps[i] = pnConsiderRemains then
AArchObj.RemovePropertyBySysName(pnRemainsMinUseSize);
end;
end;
AllAddingProps.Free;
end;
DefinedProps.Free;
end;
except
on E: Exception do AddExceptionToLogEx('DefinePropsByVal', E.Message);
end;
end;
procedure DeleteArchObjDefaultParams(AObjectType: Integer);
begin
//F_ProjMan.GSCSBase.CurrProject.DeleteObjFromObjectsBlob(tiArchDefObjs, AObjectType, 0);
F_ProjMan.GSCSBase.CurrProject.DeleteObjectsBlobByParams(tiArchDefObjs, AObjectType, 0, nil);
end;
procedure ExpArchObjPropToGrpObject(AArchObj: TSCSComponent; AObjPropExp: TArchObjPropExp; aAllowEmptyVal: Boolean=false);
var
i, j: Integer;
CurrGrpObject: TStringList;
GrpObject: TStringList;
//GroupPropsSN: TStringList;
PropName: String;
GrpPropVal: Variant;
GrpPropIdx: Integer;
GrpPropValStr: String;
GrpPropValFloat: Double;
ObjPropValFloat: Double;
ObjProp: PProperty;
IsNeedAllProps: Boolean; // Ïðè ãðóïïèðîâêè îáÿçàòåëüíîå íàëè÷èå âñåõ ñâîéñòâ
begin
//GroupPropsSN := GetStringsFromStr(AGroupPropsSN, ';', false);
// Èùåì îáúåêò ñ ïîäõîäÿùèìè ñâîéñòâàìè
GrpObject := nil;
IsNeedAllProps := Not aAllowEmptyVal;
for i := 0 to AObjPropExp.FGroupedObjects.Count - 1 do
begin
CurrGrpObject := TStringList(AObjPropExp.FGroupedObjects[i]);
GrpObject := CurrGrpObject;
for j := 0 to AObjPropExp.FGroupPropsSN.Count - 1 do
begin
PropName := AObjPropExp.FGroupPropsSN[j];
// ñðàâíèâàåì ñâîéñòâà, ïî êîòîðûì èäåò ãðóïïèðîâêà
GrpPropIdx := CurrGrpObject.IndexOf(PropName);
GrpPropVal := GetGUIDFromStrings(CurrGrpObject, GrpPropIdx); //GrpPropVal := GetGUIDFromStrings(CurrGrpObject, AObjPropExp.FGroupPropsSN[j]);
ObjProp := GetArchObjPropVal(AArchObj, PropName);
//if (ObjProp <> nil) then
if (ObjProp <> nil) and (GrpPropIdx <> -1) then
begin
case ObjProp^.IDDataType of
dtString:
begin
if AnsiCompareText(ObjProp^.Value, GrpPropVal) <> 0 then
GrpObject := nil;
end;
dtFloat, dtInteger:
begin
//if StrToFloatU(ObjProp^.Value) <> GrpPropVal then
//25.01.2011 if ObjProp^.Value <> GrpPropVal then
if Not CmpFloatByPrecision(StrToFloatU(PropValToStr(ObjProp)), StrToFloatU(GrpPropVal), 3) then
GrpObject := nil;
end;
else
GrpObject := nil;
end;
end
else
begin
if IsNeedAllProps then
GrpObject := nil
else
// Åñëè â îäíîãî îáúåêòà ñâîéñòâî åñòü, à â äðóãîãî åãî íåòó
if Not ((ObjProp = nil) and (GrpPropIdx = -1)) then
GrpObject := nil;
end;
if GrpObject = nil then //18.07.2011
Break; //// BREAK ////
end;
//if GrpObject <> nil then
//begin
// // Åñëè îáúåì ôóíäàìåíòà, òî ó÷èòûâàåì íàëè÷èå öîêîëÿ (ñìîòðèì íà íàëè÷èå îáúåìà)
// if AObjPropExp.FPropsSN.IndexOf(pnBasementVolume) <> -1 then
// begin
// GrpPropVal := GetGUIDFromStrings(CurrGrpObject, pnPlinthVolume);
// ObjProp := GetArchObjPropVal(AArchObj, pnPlinthVolume);
// if (GrpPropVal <> '') and (ObjProp <> nil) and (ObjProp^.Value <> '') then
// begin
// ObjPropValFloat := StrToFloatU(ObjProp^.Value);
// if ((GrpPropVal > 0) and (ObjPropValFloat = 0)) or ((GrpPropVal = 0) and (ObjPropValFloat > 0)) then
// GrpObject := nil;
// end
// else
// GrpObject := nil;
// end;
//end;
if GrpObject <> nil then
Break; //// BREAK ////
end;
// Åñëè ãðóïïîâîé îáúåêò íå íàéäåí, òî ñîçäàåì åãî
if GrpObject = nil then
begin
// Ñîçäàåì åñëè ñâîéñòâî èç êîòîðîãî îí ñîçäàåòñÿ íå ïóñòîå
ObjProp := GetArchObjPropVal(AArchObj, AObjPropExp.FPropsSN[0]);
if (ObjProp <> nil) and (aAllowEmptyVal or Not IsEmptyVal(ObjProp^.Value)) then
begin
GrpObject := TStringList.Create;
// Äîáàâëÿåì ñâîéñòâî ïî êîòîðîìó ñîçäàåòñÿ îáúåêò
for i := 0 to AObjPropExp.FPropsSN.Count - 1 do
AddGUIDIDToStrings(AObjPropExp.FPropsSN[i], '0', 0, GrpObject);
// Äîáàâëÿåì ñâîéñòâà ïî êîòîðûì èäåò ãðóïïèðîâêà
for i := 0 to AObjPropExp.FGroupPropsSN.Count - 1 do
begin
ObjProp := GetArchObjPropVal(AArchObj, AObjPropExp.FGroupPropsSN[i]);
if ObjProp <> nil then
begin
AddGUIDIDToStrings(AObjPropExp.FGroupPropsSN[i], PropValToStr(ObjProp), 0, GrpObject);
end
// èíà÷å åñëè ñâîéñòâà íå õâàòàåò, òî îòìåíÿåì ñîçäàíèå îá¿åêòà
else if Not aAllowEmptyVal then
begin
RemoveGUIDIDFromStrings(GrpObject);
FreeAndNil(GrpObject);
Break; //// BREAK ////
end;
end;
// Äîáàâëÿåì äðóãèå èíôîðìàöèîííûå ñâîéñòâà
for i := 0 to AObjPropExp.FObjectPropsSN.Count - 1 do
begin
ObjProp := GetArchObjPropVal(AArchObj, AObjPropExp.FGroupPropsSN[i]);
if ObjProp <> nil then
AddGUIDIDToStrings(AObjPropExp.FObjectPropsSN[i], PropValToStr(ObjProp), 0, GrpObject);
end;
if GrpObject <> nil then
AObjPropExp.FGroupedObjects.Add(GrpObject);
end;
end;
// Ïðèáàâëÿåì çíà÷åíèå ñâîéñòâà
if GrpObject <> nil then
begin
for i := 0 to AObjPropExp.FPropsSN.Count - 1 do
begin
GrpPropValStr := GetGUIDFromStrings(GrpObject, AObjPropExp.FPropsSN[i]);
// Åñëè íåòó ñâîéñòâà, òî äîáàâèòü
if (GrpPropValStr = '') and (GrpObject.IndexOf(AObjPropExp.FPropsSN[i]) = -1) then
begin
GrpPropValStr := '0';
AddGUIDIDToStrings(AObjPropExp.FPropsSN[i], GrpPropValStr, 0, GrpObject);
end;
ObjProp := GetArchObjPropVal(AArchObj, AObjPropExp.FPropsSN[i]);
if (ObjProp <> nil) and (ObjProp^.IDDataType in [dtFloat, dtInteger]) then
begin
//if GrpPropValStr = '' then
// GrpPropValStr := '0';
GrpPropValFloat := StrToFloatU(GrpPropValStr) + StrToFloatU(ObjProp^.Value);
SetGUIDToStrings(GrpObject, FloatToStrU(GrpPropValFloat), AObjPropExp.FPropsSN[i]);
end;
end;
end;
//GroupPropsSN.Free;
end;
procedure Exp3DToSCBuilding(AProject: TSCSProject; ASCBuilding: TASCBuilding);
var
CadForm: TF_CAD;
CadMapScale: Double;
SCObject: TASCObject;
SCFacade: TASCObject;
ArchContainer: TSCSCatalog;
ArchObject: TSCSComponent;
i: Integer;
MT: TKbmMemTable;
Model3D: T3DModel;
Model3DOuterSideList: TList;
Obj3D: TObject;
Room3D: T3DRoom;
Room3DInnerSideList: TList;
Room3DOuterSideList: TList;
procedure GetRoom3DSides(ARoom3D: T3DRoom; AInnerSideList, AOuterSideList: TList);
var
i, j: Integer;
xWall: T3DWall;
xSide: T3DSide;
begin
AInnerSideList.Clear;
AOuterSideList.Clear;
for i := 0 to ARoom3D.FWalls.Count - 1 do
begin
xWall := T3DWall(ARoom3D.FWalls[i]);
for j := 0 to xWall.FSides.Count - 1 do
begin
xSide := T3DSide(xWall.FSides[j]);
if (xSide.FFaceType = ftNetPath) and
(xSide.FSideType in [wstLeft, wstRight]) then
begin
if xSide.FWallType = fwtInner then
AInnerSideList.Add(xSide)
else if xSide.FWallType = fwtOuter then
AOuterSideList.Add(xSide);
end;
end;
end;
end;
// Îòêëþ÷åíà ëè ãðàíü
function IsOffSide(ASide: T3DSide): Boolean;
begin
Result := false;
// Åñëè ãðàíü ñ ïðèçíàêîì empty, çíà÷èò îòêëþ÷åíà
if (ASide.FDescription.Count > 0) and (AnsiUpperCase(ASide.FDescription[0]) = 'EMPTY') then
Result := true;
end;
// Íàçíà÷åíî ëè ãðàíè îïèñàíèå
function GetSideType(ASide: T3DSide): String;
begin
Result := '';
if (ASide.FDescription.Count > 0) then
Result := Trim(ASide.FDescription[0]);
end;
procedure AddSideAreaToGrp(ASide: T3DSide; AGrpObjs: TArchObjPropExp; var Area: Double);
var
SideType: String;
begin
SideType := GetSideType(ASide);
if SideType <> '' then
AGrpObjs.AddPropValToGrp(fnDescription, SideType, pnSquare, Area);
end;
procedure GetSide3DAreas(ASide: T3DSide; var ASideArea, ATotalArea, ATotalNamedArea: Double);
begin
ASideArea := ASide.GetArea;
ASideArea := ASideArea * sqr(CADMapScale / 1000);
// Âñÿ ïëîùàäü
ATotalArea := ATotalArea + ASideArea;
// Âñÿ ïëîùàäü ñ îïèñàíèåì
if GetSideType(ASide) <> '' then
ATotalNamedArea := ATotalNamedArea + ASideArea;
end;
function CreateGrpPropsObj(const AObjectSN, AObjectPropSN: String; const ACaption: String=''): TArchObjPropExp;
begin
Result := TArchObjPropExp.Create;
Result.FObjectSN := AObjectSN;
Result.FCaption := ACaption;
//Result.AddGrpPropObj(pnSquare);
Result.FPropsSN.Add(pnSquare);
Result.FGroupPropsSN.Add(fnDescription);
Result.AddPropCorrespond(pnSquare, AObjectPropSN);
//Result.AddPropCorrespond(fnDescription, 'ÒÎËÙÈÍÀ_#ÑÒÅÍ#');
Result.DefineAllProps;
end;
procedure DefineObjectsFrom3D(ADestSCObject: TASCObject; ASideList: TList; const AObjectsPropSN: String);
var
SidesArea: TArchObjPropExp;
//SubSidesArea: TArchObjPropExp;
FreeArea: TArchObjPropExp;
xSide: T3DSide;
xSubSide: T3DSide;
SideArea: Double;
SideName: String;
TotalArea, TotalNamedArea: Double;
i, j: Integer;
begin
TotalArea := 0;
TotalNamedArea := 0;
SidesArea := CreateGrpPropsObj(ADestSCObject.SysName, AObjectsPropSN, cArchParams_Msg22);
//SubSidesArea := CreateGrpPropsObj;
FreeArea := CreateGrpPropsObj(ADestSCObject.SysName, AObjectsPropSN, cArchParams_Msg23);
for i := 0 to ASideList.Count - 1 do
begin
xSide := T3DSide(ASideList[i]);
if xSide.FSubSides.Count = 0 then
begin
if Not IsOffSide(xSide) then
begin
GetSide3DAreas(xSide, SideArea, TotalArea, TotalNamedArea);
AddSideAreaToGrp(xSide, SidesArea, SideArea);
end;
end
else
begin
for j := 0 to xSide.FSubSides.Count - 1 do
begin
xSubSide := T3DSide(xSide.FSubSides[j]);
if Not IsOffSide(xSubSide) then
begin
GetSide3DAreas(xSubSide, SideArea, TotalArea, TotalNamedArea);
//AddSideAreaToGrp(xSubSide, SubSidesArea, SideArea);
AddSideAreaToGrp(xSubSide, SidesArea, SideArea);
end;
end;
end;
end;
// Äîáàâëÿåì ïëîùàäü è ïëîùàäü áåç îïèñàíèÿ, åñëè åñòü ïëîùàäü ñ îïèñàíèåì
if TotalNamedArea > 0 then
begin
if TotalArea > TotalNamedArea then
FreeArea.AddPropValToGrp(fnDescription, '', pnSquare, TotalArea - TotalNamedArea);
//ADestSCObject.
ExpProjToStroyCalcGrpPropsToObjs(AProject, SidesArea, ADestSCObject.Objects, false, MT);
//ExpProjToStroyCalcGrpPropsToObjs(AProject, SubSidesArea, ADestSCObjectList, false, MT);
ExpProjToStroyCalcGrpPropsToObjs(AProject, FreeArea, ADestSCObject.Objects, false, MT);
end;
SidesArea.Free;
//SubSidesArea.Free;
FreeArea.Free;
end;
begin
CadForm := TF_CAD(GetCADFormBySCSObject(ASCBuilding.FSrcObj));
Model3D := nil;
ArchContainer := DefineArchContainer(TSCSList(ASCBuilding.FSrcObj));
// Ìîäåëü 3Ä ïåðåäàåì åñëè åñòü êîìíàòû íà ëèñòå
if ArchContainer <> nil then
// Ïðîâåðÿåì åñòü ëè êîìíàòû íà ëèñòå
for i := 0 to ArchContainer.ComponentReferences.Count - 1 do
begin
if IsArchRoomComponByIsLine(ArchContainer.ComponentReferences[i].IsLine) then
begin
Model3D := T3DModel(CadForm.Get3DModel);
Break; //// BREAK ////
end;
end;
if Model3D <> nil then
begin
CadMapScale := CadForm.PCad.MapScale;
MT := ExpProjToStroyCalcCreateMT;
Model3DOuterSideList := TList.Create;
SCFacade := nil;
for i := 0 to ASCBuilding.Objects.Count - 1 do
begin
SCObject := TASCObject(ASCBuilding.Objects[i]);
if ((SCObject.SysName = osnRoom) or (SCObject.SysName = osnRoom)) and (SCObject.FSrcObj <> nil) and (SCObject.FSrcObj is TSCSComponent) then
begin
//ArchContainer := DefineArchContainer(TSCSList(SCObject.FSrcObj));
ArchObject := TSCSComponent(SCObject.FSrcObj);
if ArchObject.IsLine = ctArhRoom then
begin
Obj3D := Model3D.GetObjectBySCSCompon(ArchObject);
if Obj3D is T3DRoom then
begin
Room3D := T3DRoom(Obj3D);
Room3DInnerSideList := TList.Create;
Room3DOuterSideList := TList.Create;
GetRoom3DSides(Room3D, Room3DInnerSideList, Room3DOuterSideList);
DefineObjectsFrom3D(SCObject, Room3DInnerSideList, 'ÏË_ÑÒ_ÁÅÇ_ÏÐ_#ÊÎÌÍ#');
// Âíåøíèå ãðàíè ñ ýòîé êîìíàòû äëÿ âñåé ìîäåëè
Model3DOuterSideList.Assign(Room3DOuterSideList, laOr);
Room3DInnerSideList.Free;
Room3DOuterSideList.Free;
end;
end;
end
else if SCObject.SysName = osnFacade then
SCFacade := SCObject;
end;
if SCFacade <> nil then
DefineObjectsFrom3D(SCFacade, Model3DOuterSideList, 'ÏË_#ÔÀÑÀÄ#');
Model3DOuterSideList.Free;
MT.Free;
end;
end;
procedure ExpRoofToSCBuilding(AList: TSCSList; ASCBuilding: TASCBuilding);
var
i, j, k: Integer;
ArchContainer: TSCSCatalog;
ArchObj, ArchObjConn1, ArchObjConn2: TSCSComponent;
Corner1H, Corner2H: Double;
SegList: TSCSComponents;
GrpPropList: TStringList;
GropedSegs, ExtGropedSegs: TObjectList;
GroupCompons, ExtGroupCompons: TSCSComponents;
Compon, ChildCompon: TSCSComponent;
TempCompon: TSCSComponent;
MatType: Integer;
MatTypeSCSysNameIdx: Integer;
MatTypeSCSysNames: TStringList; // Èìåíà òèïîâ ìàòåðèàëîâ â ÑÊ
HipTypeSCLenSysNames: TStringList; // Èìåíà òèïîâ ðåáåð â ÑÊ
HipTypeSCLenSysNameIdx: Integer;
HipApexTypeSCLenSysNames: TStringList; // Èìåíà òèïîâ êîíüêîâ â ÑÊ
HipApexTypeSCLenSysNameIdx: Integer;
HipValleyTypeSCLenSysNames: TStringList; // Èìåíà òèïîâ åíäîâ â ÑÊ
HipValleyTypeSCLenSysNameIdx: Integer;
DescentSize: Double;
VentSideSize: Double;
HipType: Integer; // Òèï ðåáðà êðûøè
HipApexType: Integer; // Òèï êîíüêà
HipValleyType: Integer; // Òèï åíäîâû
IsConnToRoofEnd: Boolean;
ObjLists: TObjectList;
ObjPropExp: TArchObjPropExp;
CAD: TForm;
Path: TNetPath;
PathConn1, PathConn2: TNetPath;
PathLen: Double;
LookedHips: TSCSComponents;
LookedPaths: TList;
begin
try
ArchContainer := DefineArchContainer(AList);
// Ñîçäàåì ñïèñîê ñåãìåíòîâ êðûø
SegList := TSCSComponents.Create(false);
for i := 0 to ArchContainer.SCSComponents.Count - 1 do
begin
ArchObj := ArchContainer.SCSComponents[i];
// Åñëè ñåãìåíò êðûøè
if ArchObj.IsLine = ctArhRoofSeg then
SegList.Add(ArchObj);
end;
// Ãðóïïèðóåì ïî ñâîéñòâàì "Òèï ìàòåðèàëà" è "Ãðóïïà"
GrpPropList := TStringList.Create;
GrpPropList.Add(pnMaterialType);
GrpPropList.Add(pnGroupName);
GropedSegs := GroupComponsByProps(SegList, GrpPropList);
GrpPropList.Free;
if GropedSegs <> nil then
begin
{i := 0;
while i <= GropedSegs.Count - 1 do
begin
GroupCompons := TSCSComponents(GropedSegs[i]);
Compon := GroupCompons[0];
MatType := Compon.GetPropertyValueAsInteger(pnMaterialType);
// Äëÿ Ìåòàëëî÷åðåïèöè äåëàåì ðàçãðóïïèðîâêó ïî ïîëåçíîé øèðèíå ìàòåðèàëà
if MatType = pmtTileMetal then
begin
GrpPropList := TStringList.Create;
GrpPropList.Add(pnMaterialWidthUsable);
ExtGropedSegs := GroupComponsByProps(GroupCompons, GrpPropList);
GrpPropList.Free;
// Åñëè ðàçáèëè íà íåñêîëüêî ãðóïï, òî çàìåíÿåì òåêóùóþ íà ýè íåñêîëüêî
if (ExtGropedSegs <> nil) and (ExtGropedSegs.Count > 1) then
begin
GropedSegs.Delete(i);
ExtGropedSegs.OwnsObjects := false;
for j := 0 to ExtGropedSegs.Count - 1 do
begin
ExtGroupCompons := TSCSComponents(GropedSegs[j]);
GropedSegs.Insert(i+j, ExtGroupCompons);
end;
i := i + ExtGropedSegs.Count - 1; // ×òîáû íà ñëåäóþùåé èòåðàöèè ïðîïóñòèü äîáàâëåííûå ãðóïïû
end;
ExtGropedSegs.Free;
end;
Inc(i);
end;}
ObjLists := TObjectList.Create;
LookedHips := TSCSComponents.Create(false);
LookedPaths := TList.Create;
TempCompon := TSCSComponent.Create(F_ProjMan);
CAD := GetCADFormBySCSObject(AList);
// Ñèñò. èìåíà îáúåêòîâ ïî òèïó ìàòåðèàëà
MatTypeSCSysNames := TStringList.Create;
MatTypeSCSysNames.Sorted := true;
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ÍÅÎÏÐÅÄ', TObject(pmtNone)); // Íå çàäàíà
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ËÈÑÒÎÂÀß', TObject(pmtSheetSlate)); //'Ëèñòîâîå – øèôåð';
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ËÈÑÒÎÂÀß_ÑÒ', TObject(pmtSheetSteel)); //'Ëèñòîâîå - ñòàëü ëèñòîâàÿ';
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ÐÓËÎÍÍ', TObject(pmtRoller)); //'Ðóëîííûå';
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ÌÅÒ_×ÅÐ', TObject(pmtTileMetal)); //'Ìåòàëî÷åðåïèöà';
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ÊÅÐ_×ÅÐ', TObject(pmtTileCeramic)); //'×åðåïèöà êåðàìè÷åñêàÿ';
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ÁÈÒ_×ÅÐ', TObject(pmtTileBitumen)); //'×åðåïèöà áèòóìíàÿ';
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ÏÀÇ_×ÅÐ', TObject(pmtTileInterlocking)); //'×åðåïèöà ïàçîâàÿ ëåíòî÷íàÿ';
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ÎÍÄÓÐÀ', TObject(pmtOndura)); //'Îíäóðà';
MatTypeSCSysNames.AddObject('ÊÐÎÂËß_ÎÍÄÓËÈÍ', TObject(pmtOnduline)); //'Îíäóëèí';
MatTypeSCSysNames.AddObject('ÔÐÎÍÒÎÍÛ', TObject(pmtFronton)); //'Ôðîíòîí';
MatTypeSCSysNames.AddObject('ÎÑÍ_ÊÐÛØÈ', TObject(pmtRoofBase)); //'Îñíîâàíèå';
HipTypeSCLenSysNames := TStringList.Create;
HipTypeSCLenSysNames.Sorted := true;
//HipTypeSCLenSysNames.AddObject('ÄËÈÍÀ_ÐÅÁÅÐ', TObject(rhtNone));
HipTypeSCLenSysNames.AddObject('ÄËÈÍÀ_ÊÎÍÜÊÎÂ', TObject(rhtApex));
HipTypeSCLenSysNames.AddObject('ÄËÈÍÀ_ÒÎÐÖÎÂ', TObject(rhtEnd));
HipTypeSCLenSysNames.AddObject('ÄËÈÍÀ_ÊÀÐÍÈÇÎÂ', TObject(rhtEaves));
HipTypeSCLenSysNames.AddObject('ÄËÈÍÀ_ÅÍÄÎÂ', TObject(rhtValley));
HipTypeSCLenSysNames.AddObject('ÄËÈÍÀ_ÏÐÈÌ', TObject(rhtJunction));
HipTypeSCLenSysNames.AddObject('ÄËÈÍÀ_ÐÅÁÅÐ', TObject(rhtRoofHip));
// Äëèíû êîíüêîâ ðàçíûõ òèïîâ
HipApexTypeSCLenSysNames := TStringList.Create;
HipApexTypeSCLenSysNames.Sorted := true;
// Êîíåê êðóãëûé áîëüøîé (îáùàÿ äëèíà)
HipApexTypeSCLenSysNames.AddObject('Ì×_ÊÎÍ_ÊÐÁ_ÄËÈÍÀ', TObject(rhatLargeRound));
// Êîíåê êðóãëûé ìàëûé (îáùàÿ äëèíà)
HipApexTypeSCLenSysNames.AddObject('Ì×_ÊÎÍ_ÊÐÌ_ÄËÈÍÀ', TObject(rhatSmallRound));
// Êîíåê òðàïåöåâèäíûé (îáùàÿ äëèíà)
HipApexTypeSCLenSysNames.AddObject('Ì×_ÊÎÍ_ÒÐÀÏ_ÄËÈÍÀ', TObject(rhatTrapezoidal));
// Êîíåê òðåóãîëüíûé ïðÿìîé (îáùàÿ äëèíà)
HipApexTypeSCLenSysNames.AddObject('Ì×_ÊÎÍ_ÒÐÃÏ_ÄËÈÍÀ', TObject(rhatTriangularStraight));
// Êîíåê ïðÿìîé (îáùàÿ äëèíà)
HipApexTypeSCLenSysNames.AddObject('Ì×_ÊÎÍ_ÏÐßÌ_ÄËÈÍÀ', TObject(rhatStraight));
// Äëèíû åíäîâû ðàçíûõ òèïîâ
HipValleyTypeSCLenSysNames := TStringList.Create;
HipValleyTypeSCLenSysNames.Sorted := true;
// Åíäîâà ãëóáîêàÿ (îáùàÿ äëèíà)
HipValleyTypeSCLenSysNames.AddObject('Ì×_ÅÍÄ_ÃËÓÁ_ÄËÈÍÀ', TObject(rhvtDeep));
// Åíäîâà äåêîðàòèâíàÿ (îáùàÿ äëèíà)
HipValleyTypeSCLenSysNames.AddObject('Ì×_ÅÍÄ_ÄÅÊÎÐ_ÄËÈÍÀ', TObject(rhvtDecorative));
// Åíäîâà áîëüøàÿ (îáùàÿ äëèíà)
HipValleyTypeSCLenSysNames.AddObject('Ì×_ÅÍÄ_ÁÎËØ_ÄËÈÍÀ', TObject(rhvtLarge));
// Èç ãðóïï ñîçäàåì îáúåêòû
for i := 0 to GropedSegs.Count - 1 do
begin
GroupCompons := TSCSComponents(GropedSegs[i]);
Compon := GroupCompons[0];
MatType := Compon.GetPropertyValueAsInteger(pnMaterialType);
MatTypeSCSysNameIdx := MatTypeSCSysNames.IndexOfObject(TObject(MatType));
//if MatTypeSCSysNameIdx <> -1 then
begin
ObjPropExp := TArchObjPropExp.Create;
ObjPropExp.FCaption := PropValueToCaption(IntToStr(MatType), pnMaterialType, '', dtPlaneMaterialType, 0, false); //'Ôóíäàìåíò (öîêîëü)';
if MatTypeSCSysNameIdx <> -1 then
ObjPropExp.FObjectSN := MatTypeSCSysNames[MatTypeSCSysNameIdx];
if MatType = pmtFronton then
begin
//ObjPropExp.FPropsSN.Add(pnSquare); // ÏËÎÙ
//ObjPropExp.AddPropCorrespond(pnSquare, 'ÏËÎÙ_ÔÐÎÍÒÎÍÎÂ');
ObjPropExp.FPropsSN.Add(pnSquareInclEmbrasures); // ÏËÎÙ
ObjPropExp.AddPropCorrespond(pnSquareInclEmbrasures, 'ÏËÎÙ_ÔÐÎÍÒÎÍÎÂ');
end
else if MatType = pmtRoofBase then
begin
ObjPropExp.FPropsSN.Add(pnSquare); // ÏËÎÙ
ObjPropExp.AddPropCorrespond(pnSquare, 'ÏËÎÙ_ÎÑÍÎÂÀÍÈß');
end;
// Ñóììàðíàÿ äëèíà ïåðèìåòðîâ âñåõ ïðîåìîâ âñåõ ñåãìåíòîâ ãðóïïû
ObjPropExp.FPropsSN.Add(pnPerimeterEmbrasures); // ÏÅÐÈÌ_ÏÐÎÅÌÎÂ
// ó÷åòîì äîáàâëåííûõ ñïóñêîâ è íàïóñêîâ è çà èñêëþ÷åíèåì ïðîåìîâ â ì2.
ObjPropExp.FPropsSN.Add(pnSquareInclEmbrasuresLap); // ÏËÎÙ_ÑÅÃÌÅÍÒÎÂ
// Ñóììàðíàÿ ïëîùàäü ñãðóïïèðîâàííûõ ñåãìåíòîâ ðàçðåçàííûõ íà ïðÿìîóãîëüíèêè ïî âûñîòå ìàòåðèàëà
// ñ ó÷åòîì äîáàâëåííûõ ñïóñêîâ è íàïóñêîâ è çà èñêëþ÷åíèåì ïðîåìîâ â ì2.
ObjPropExp.FPropsSN.Add(pnAreaWithRemains); // ÏËÎÙ_ÌÀÒÅÐ_ÑÅÃÌÅÍÒÎÂ
//ObjPropExp.FPropsSN.Add(pnPerimeterEmbrasures); //
ObjPropExp.FGroupPropsSN.Add(pnGroupName);
ObjPropExp.AddPropCorrespond(pnPerimeterEmbrasures, 'ÏÅÐÈÌ_ÏÐÎÅÌÎÂ');
ObjPropExp.AddPropCorrespond(pnSquareInclEmbrasuresLap, 'ÏËÎÙ_ÑÅÃÌÅÍÒÎÂ');
ObjPropExp.AddPropCorrespond(pnAreaWithRemains, 'ÏËÎÙ_ÌÀÒÅÐ_ÑÅÃÌÅÍÒÎÂ');
// Ìåòàëëî÷åðåïèöà
if MatType = pmtTileMetal then
begin
ObjPropExp.FGroupPropsSN.Add(pnMaterialWidthUsable);
ObjPropExp.AddPropCorrespond(pnMaterialWidthUsable, 'Ì×_ÏÎËÅÇÍ_ØÈÐÈÍÀ');
// Äëÿ ìåòàëëî ÷åðåïèöè ãðóïïèðóåì åùå ïî òèïîðàçìåðàì è óêàçûâàåì ÷òî ñóììèðîâàòü â ObjPropExp.FPropsSN
for k := 1 to 4 do
begin
//ObjPropExp.FGroupPropsSN.Add('Ì×_ÏÎËÅÇÍÀß_ÄËÈÍÀ_'+IntToStr(k));
//ObjPropExp.FPropsSN.Add('Ì×_ÊÎË_ËÈÑÒÎÂ_'+IntToStr(k));
//ObjPropExp.FPropsSN.Add('Ì×_ÏÎËÅÇÍÀß_ÄËÈÍÀ_'+IntToStr(k));
ObjPropExp.FGroupPropsSN.Add('TYPE_SIZE_'+IntToStr(k)); // Ì×_ÏÎËÅÇÍÀß_ÄËÈÍÀ_
ObjPropExp.FPropsSN.Add('TYPE_SIZE_'+IntToStr(k)+'_EL_COUNT'); // Ì×_ÊÎË_ËÈÑÒÎÂ_
ObjPropExp.AddPropCorrespond('TYPE_SIZE_'+IntToStr(k), 'Ì×_ÏÎËÅÇÍÀß_ÄËÈÍÀ_'+IntToStr(k));
ObjPropExp.AddPropCorrespond('TYPE_SIZE_'+IntToStr(k)+'_EL_COUNT', 'Ì×_ÊÎË_ËÈÑÒÎÂ_'+IntToStr(k));
end;
for j := 0 to HipApexTypeSCLenSysNames.Count - 1 do
ObjPropExp.FPropsSN.Add(HipApexTypeSCLenSysNames[j]);
for j := 0 to HipValleyTypeSCLenSysNames.Count - 1 do
ObjPropExp.FPropsSN.Add(HipValleyTypeSCLenSysNames[j]);
end
// Îíäóðà
else if MatType = pmtOndura then
begin
ObjPropExp.FPropsSN.Add(pnCuttingWithRemains);
ObjPropExp.FGroupPropsSN.Add(pnMaterialWidthUsable);
ObjPropExp.AddPropCorrespond(pnCuttingWithRemains, 'ÎÍÄÓÐÀ_ÊÎË');
ObjPropExp.AddPropCorrespond(pnMaterialWidthUsable, 'ÏÎËÅÇÍ_ØÈÐÈÍÀ');
end
// Îíäóëèí
else if MatType = pmtOnduline then
begin
ObjPropExp.FPropsSN.Add(pnCuttingWithRemains);
ObjPropExp.FGroupPropsSN.Add(pnMaterialWidthUsable);
ObjPropExp.AddPropCorrespond(pnCuttingWithRemains, 'ÎÍÄÓËÈÍ_ÊÎË');
ObjPropExp.AddPropCorrespond(pnMaterialWidthUsable, 'ÏÎËÅÇÍ_ØÈÐÈÍÀ');
end
else
begin
//ObjPropExp.AddPropCorrespond(pnMaterialWidthUsable, 'Ì×_ÏÎËÅÇÍ_ØÈÐÈÍÀ');
// Äëÿ îñòàëüíûõ ïðîñòî êîë-âî ìàòåðèàëà
ObjPropExp.FPropsSN.Add(pnCuttingWithRemains);
ObjPropExp.AddPropCorrespond(pnCuttingWithRemains, 'ÊÎËÂÎ_ÌÀÒ');
end;
//ObjPropExp.FPropsSN.Add('ÏËÎÙ_ÑÅÃÌÅÍÒÎÂ');
for j := 0 to HipTypeSCLenSysNames.Count - 1 do
begin
ObjPropExp.FPropsSN.Add(HipTypeSCLenSysNames[j]);
//ObjPropExp.AddPropCorrespond(HipTypeSCLenSysNames[i], HipTypeSCLenSysNames[i]);
end;
ObjPropExp.DefineAllProps;
ObjLists.Add(ObjPropExp);
GArchEngine.FExport.Clear;
DescentSize := Compon.GetPropertyValueAsFloat(pnDescentSize); // Ðàçìåð ñïóñêà
VentSideSize := Compon.GetPropertyValueAsFloat(pnVentSideSize); // Ðàçìåð áîêîâîãî íàïóñêà
for j := 0 to GroupCompons.Count - 1 do
begin
Compon := GroupCompons[j];
LoadArchObjPropsFromCAD(Compon);
TempCompon.Clear;
TempCompon.AssignOnlyComponent(Compon);
TempCompon.AssignProperties(Compon.Properties);
//ObjPropExp.AddPropValToGrp('', '', pnGroupName, Compon.GetPropertyValueAsFloat(pnPerimeterEmbrasures));
// Ñóììàðíàÿ äëèíà ïåðèìåòðîâ âñåõ ïðîåìîâ âñåõ ñåãìåíòîâ ãðóïïû
//ObjPropExp.AddPropValToGrp('', '', 'ÏÅÐÈÌ_ÏÐÎÅÌÎÂ', Compon.GetPropertyValueAsFloat(pnPerimeterEmbrasures));
// Ñóììàðíàÿ ïëîùàäü ñãðóïïèðîâàííûõ ñåãìåíòîâ ñ
// ó÷åòîì äîáàâëåííûõ ñïóñêîâ è íàïóñêîâ è çà èñêëþ÷åíèåì ïðîåìîâ â ì2.
//ObjPropExp.AddPropValToGrp('', '', 'ÏËÎÙ_ÑÅÃÌÅÍÒÎÂ', Compon.GetPropertyValueAsFloat(pnSquareInclEmbrasuresLap));
// Ñóììàðíàÿ ïëîùàäü ñãðóïïèðîâàííûõ ñåãìåíòîâ ðàçðåçàííûõ íà ïðÿìîóãîëüíèêè ïî âûñîòå ìàòåðèàëà
// ñ ó÷åòîì äîáàâëåííûõ ñïóñêîâ è íàïóñêîâ è çà èñêëþ÷åíèåì ïðîåìîâ â ì2.
//ObjPropExp.AddPropValToGrp('', '', 'ÏËÎÙ_ÌÀÒÅÐ_ÑÅÃÌÅÍÒÎÂ', Compon.GetPropertyValueAsFloat(pnAreaWithRemains));
for k := 0 to Compon.ChildReferences.Count - 1 do
begin
ChildCompon := Compon.ChildReferences[k];
if ChildCompon.IsLine = ctArhRoofHip then
begin
HipType := ChildCompon.GetPropertyValueAsInteger(pnRoofHipType);
if HipType <> rhtNone then
begin //26.08.2011 - Åñëè HipType = 0, òî ðàññìàòðèâàåì êàê ïðèìûêàíèå
Path := TNetPath(GetCADObjByArchObj(ChildCompon, CAD));
// Åñëè ýòî ðåáðî (èëè ñâÿçàííîå) åùå íå ó÷òåíî
if Not CheckPathInListByRelatedInCAD(Path, LookedPaths) then
begin
// Äëèíà ðåáðà ïîëíàÿ (íå ïðîåêöèÿ)
PathLen := ChildCompon.GetPropertyValueAsFloat(pnLength); //29.09.2011 ChildCompon.GetPropertyValueAsFloat(pnWidth);
//Corner1H := Path.GetHeightOfPt(Path.p1);
//Corner2H := Path.GetHeightOfPt(Path.p2);
//if Corner1H <> Corner2H then
// PathLen := SQRT(SQR(Abs(Corner1H-Corner2H)) + SQR(PathLen)); // Äëèíà äèàãîíàëè SideB := SQRT(SQR(SideA) + SQR(SideC))
PathConn1 := Path.GetConnected(Path.p1);
PathConn2 := Path.GetConnected(Path.p2);
ArchObjConn1 := GetArchObjByCADObj(PathConn1, ArchContainer);
ArchObjConn2 := GetArchObjByCADObj(PathConn2, ArchContainer);
IsConnToRoofEnd := false; //03.10.2011 - Åñòü ëè ïîäêëþ÷åíèå ê òîðöó
// Åñëè êîíåê/êàðíèçíûé ñâåñ ñîåäèíåí ñ òîðöàìè, ó÷èòûàåì áîêîâîé íàïóñê
//if HipType in [rhtApex, rhtEaves] then
begin
// Åñëè ïîäêëþ÷åí ê òîðöó
if Assigned(ArchObjConn1) and (ArchObjConn1.GetPropertyValueAsInteger(pnRoofHipType) = rhtEnd) then
begin
PathLen := PathLen + VentSideSize;
IsConnToRoofEnd := true;
end;
// Åñëè ïîäêëþ÷åí ê òîðöó
if Assigned(ArchObjConn2) and (ArchObjConn2.GetPropertyValueAsInteger(pnRoofHipType) = rhtEnd) then
begin
PathLen := PathLen + VentSideSize;
IsConnToRoofEnd := true;
end;
end;
//03.10.2011 // Åñëè åíäîâà èëè òîðåö, ó÷èòûàåì êàðíèçíûé ñâåñ
//03.10.2011 else if HipType in [rhtValley, rhtEnd] then
//03.10.2011 PathLen := PathLen + DescentSize;
if Not IsConnToRoofEnd then
begin
// Åñëè ðåáðî ñîåäèíåíî ñ êàðíèçíûì ñâåñîì
if (Assigned(ArchObjConn1) and (ArchObjConn1.GetPropertyValueAsInteger(pnRoofHipType) = rhtEaves)) or
(Assigned(ArchObjConn2) and (ArchObjConn2.GetPropertyValueAsInteger(pnRoofHipType) = rhtEaves)) then
PathLen := PathLen + DescentSize;
end;
// Òèï ðåáðà
HipTypeSCLenSysNameIdx := HipTypeSCLenSysNames.IndexOfObject(TObject(HipType));
if HipTypeSCLenSysNameIdx <> -1 then
begin
//TempCompon.AddProperty(0, '', dtFloat, biFalse, biFalse, biFalse, FloatToStr(PathLen), '', HipTypeSCLenSysNames[HipTypeSCLenSysNameIdx]);
//ObjPropExp.AddPropValToGrp('', '', HipTypeSCLenSysNames[HipTypeSCLenSysNameIdx], PathLen);
TempCompon.AddPropertyValueAsFloat(HipTypeSCLenSysNames[HipTypeSCLenSysNameIdx], PathLen, true);
end;
// Äëèíà ïî òèïó êîíüêîâ
if HipType = rhtApex then
begin
HipApexType := ChildCompon.GetPropertyValueAsInteger(pnRoofHipApexType);
HipApexTypeSCLenSysNameIdx := HipApexTypeSCLenSysNames.IndexOfObject(TObject(HipApexType));
if HipApexTypeSCLenSysNameIdx <> -1 then
//TempCompon.AddProperty(0, '', dtFloat, biFalse, biFalse, biFalse, FloatToStr(PathLen), '', HipApexTypeSCLenSysNames[HipApexTypeSCLenSysNameIdx]);
TempCompon.AddPropertyValueAsFloat(HipApexTypeSCLenSysNames[HipApexTypeSCLenSysNameIdx], PathLen, true);
end
// Äëèíà ïî òèïàì åíäîâ
else if HipType = rhtValley then
begin
HipValleyType := ChildCompon.GetPropertyValueAsInteger(pnRoofHipValleyType);
HipValleyTypeSCLenSysNameIdx := HipValleyTypeSCLenSysNames.IndexOfObject(TObject(HipValleyType));
if HipValleyTypeSCLenSysNameIdx <> -1 then
//TempCompon.AddProperty(0, '', dtFloat, biFalse, biFalse, biFalse, FloatToStr(PathLen), '', HipValleyTypeSCLenSysNames[HipValleyTypeSCLenSysNameIdx]);
TempCompon.AddPropertyValueAsFloat(HipValleyTypeSCLenSysNames[HipValleyTypeSCLenSysNameIdx], PathLen, true);
end;
end;
LookedPaths.Add(Path);
LookedHips.Add(ChildCompon);
end;
end;
end;
// Åñëè ìåòàëëî÷åðåïèöà, òî äîáàâëÿåì ñâîéñòâà äëÿ íåå
if MatType = pmtTileMetal then
begin
//ObjPropExp.AddPropValToGrp('', '', pnMaterialWidthUsable, Compon.GetPropertyValueAsFloat(pnMaterialWidthUsable));
//for k := 1 to 4 do
// ObjPropExp.AddPropValToGrp('', '', 'Ì×_ÏÎËÅÇÍÀß_ÄËÈÍÀ_'+IntToStr(k), Compon.GetPropertyValueAsFloat('TYPE_SIZE_'+IntToStr(k)));
//for k := 1 to 4 do
// ObjPropExp.AddPropValToGrp('', '', 'Ì×_ÊÎË_ËÈÑÒÎÂ_'+IntToStr(k), Compon.GetPropertyValueAsFloat('TYPE_SIZE_'+IntToStr(k)+'_EL_COUNT'));
end;
ExpArchObjPropToGrpObject(TempCompon, ObjPropExp, true);
end;
ExpProjToStroyCalcGrpPropsToObjs(AList.GetProject, ObjPropExp, ASCBuilding.Objects, true, nil);
//FreeAndNil(ObjPropExp);
end;
end;
HipValleyTypeSCLenSysNames.Free;
HipApexTypeSCLenSysNames.Free;
HipTypeSCLenSysNames.Free;
MatTypeSCSysNames.Free;
LookedPaths.Free;
LookedHips.Free;
ObjLists.Free;
TempCompon.Free;
end;
SegList.Free;
except
on E: Exception do AddExceptionToLogExt('', 'ExpRoofToSCBuilding', E.Message);
end;
end;
procedure ExpProjToStroyCalcAddPropToMT(AMT: TkbmMemTable; const AMTSysName, AValue: String);
begin
// Âíîñèò èìÿ ñâîéñòâà è çíà÷åíèå â memtable
AMT.Append;
AMT.FieldByName(fnSysName).AsString := AMTSysName;
AMT.FieldByName(fnValue).AsString := AValue;
AMT.Post;
end;
function ExpProjToStroyCalcCreateMT: TkbmMemTable;
begin
Result := TkbmMemTable.Create(nil);
Result.FieldDefs.Add(fnSysName, ftString, 255);
Result.FieldDefs.Add(fnValue, ftString, 255);
Result.Active := true;
end;
procedure ExpProjToStroyCalcGrpPropsToObjs(AProject: TSCSProject; AGrpObjs: TArchObjPropExp; ADestObj: TCollection;
APropNameToCaption: Boolean=true; AMT: TkbmMemTable=nil);
var
MT: TkbmMemTable;
i, j: Integer;
GrpObject: TStringList;
SCObject: TASCObject;
PropSN, PropValStr: String;
SprProp: TNBProperty;
PropCorrespondIdx: Integer;
begin
MT := AMT;
if MT = nil then
MT := ExpProjToStroyCalcCreateMT;
for i := 0 to AGrpObjs.FGroupedObjects.Count - 1 do
begin
GrpObject := TStringList(AGrpObjs.FGroupedObjects[i]);
// Ñîçäàåì SC îáúåêò, è âêèäûâàåì òóäà ñâîéñòâà
MT.Active := false;
MT.Active := true;
SCObject := TASCObject.Create(ADestObj);
SCObject.Caption := '';
for j := 0 to AGrpObjs.FAllObjectPropsSN.Count - 1 do
begin
PropSN := AGrpObjs.FAllObjectPropsSN[j];
PropValStr := GetGUIDFromStrings(GrpObject, PropSN);
// Åñëè ýòî ñâî-âî èñïîëüçóåòñÿ äëÿ ãðóïïèðîâêè, òî èñïîëüçóåì åãî â èìåíè îáúåêòà
if (PropValStr <> '') and (AGrpObjs.FGroupPropsSN.IndexOf(PropSN) <> -1) then
begin
if SCObject.Caption <> '' then
SCObject.Caption := SCObject.Caption + ', ';
if APropNameToCaption then
begin
SprProp := AProject.Spravochnik.GetPropertyBySysName(PropSN);
if SprProp <> nil then
begin
SCObject.Caption := SCObject.Caption + GetArchObjPropShortName(SprProp.PropertyData.Name, PropSN) +' ';
end;
end;
SCObject.Caption := SCObject.Caption + PropValStr;
end;
// Çàíîñèì ñâîéòâî â MemTable
PropCorrespondIdx := AGrpObjs.FPropsCorrespond.IndexOf(PropSN);
if PropCorrespondIdx <> -1 then
ExpProjToStroyCalcAddPropToMT(MT, GetStrFromStringsByIdx(AGrpObjs.FPropsCorrespond, PropCorrespondIdx), PropValStr)
else
ExpProjToStroyCalcAddPropToMT(MT, PropSN, PropValStr)
end;
if AGrpObjs.FCaption <> '' then
begin
if SCObject.Caption <> '' then
SCObject.Caption := AGrpObjs.FCaption +'_'+ SCObject.Caption
else
SCObject.Caption := AGrpObjs.FCaption;
end;
SCObject.SysName := AGrpObjs.FObjectSN;
SCObject.LoadDumpFromMemTable(MT);
end;
if AMT = nil then
MT.Free;
end;
procedure ExpProjToStroyCalcFile(AProject: TSCSProject; const AFileName: string);
var
Stream: TFileStream;
begin
Stream := TFileStream.Create(AFileName, fmCreate);
try
ExpProjToStroyCalcStream(AProject, Stream);
finally
Stream.Free;
end;
end;
procedure ExpProjToStroyCalcStream(AProject: TSCSProject; AStream: TStream);
var
i, j, k: Integer;
ASCProject: TASCProject;
ASCBuilding: TASCBuilding;
ASCObject: TASCObject;
SCSList: TSCSList;
ListCADForm: TForm;
ArchContainer: TSCSCatalog;
ArchRoom: TSCSComponent;
ArchChild: TSCSComponent;
CADWallChildsObjects: TList;
procedure AddArchPropToMemTable(AMT: TkbmMemTable; AArchObj: TSCSComponent;
const AMTSysName, AArchObjPropSysName: String; aKoeff: Integer=0);
var
Val: String;
begin
if AArchObj.GetPropertyBySysName(AArchObjPropSysName) <> nil then
begin
Val := AArchObj.GetPropertyValueBySysName(AArchObjPropSysName);
if aKoeff <> 0 then
try
Val := FloatToStrU(StrToFloatU(Val) * aKoeff);
except
on E: Exception do AddExceptionToLogEx('ExpProjToStroyCalcStream', E.Message);
end;
ExpProjToStroyCalcAddPropToMT(AMT, AMTSysName, Val);
end;
end;
// Äîáàâëÿåò ñòðîêè â ñòðèíã ëèñòû
procedure AddPropParamsToLists(AStrList1, AStrList2: TStringList; AObjPropLocation: TintList; const AStr1, AStr2: String; APropLocation: Integer);
begin
AStrList1.Add(AStr1);
AStrList2.Add(AStr2);
AObjPropLocation.Add(APropLocation);
end;
// Ýêñïîðòèðóåò â MemTable îäíîòèïíûå îáúåêòû êîìíàòû (äâåðè, îêíà)
procedure ExpObjectsOfRoom(AMT: TkbmMemTable; ARoom: TSCSComponent; AObjType: Integer;
const APropNameCount: string; AMTPropSysName, AArchObjPropSysName: TStringList; AArchObjPropLocation: TIntList);
var
i, j: Integer;
ArchObjects: TSCSComponents;
ArchObj: TSCSComponent;
ArchObjForProp: TSCSComponent;
ArchParentObj: TSCSComponent;
MTPropName: String;
WallChildsIntersect: TSCSComponents;
begin
if AMTPropSysName.Count <> AArchObjPropSysName.Count then
Exception.Create('Arh. object and memory table have different prop count!');
ArchObjects := TSCSComponents.Create(false);
for i := 0 to ARoom.ChildReferences.Count - 1 do
begin
ArchObj := ARoom.ChildReferences[i];
if ArchObj.IsLine = AObjType then
begin
ArchParentObj := ArchObj.GetParentComponent;
// Ñ êîìíàòû ñìîòðèì òîëüêî ñòåíû, à ïåðåãîðîäêà îòäåëüíî
if ((ARoom.IsLine = ctArhRoom) and (ArchParentObj.IsLine = ctArhWall)) or
(ARoom.IsLine = ctArhWallDivision) then
//if (ArchParentObj <> nil) and (ArchParentObj.IsLine = ctArhWall) then
begin
ArchObjects.Add(ArchObj);
end;
end
// Åñëè ñòåíà, èùåì îáúåêòû ñî ñìåæíûõ ñòåí
else if ArchObj.IsLine = ctArhWall then //else if IsArchWallComponByIsLine(ArchObj.IsLine) then
begin
WallChildsIntersect := GetWallArchChildsFromIntersectWall(ArchObj, nil, CADWallChildsObjects);
for j := 0 to WallChildsIntersect.Count - 1 do
begin
if WallChildsIntersect[j].IsLine = AObjType then
ArchObjects.Add(WallChildsIntersect[j]);
end;
//ArchObjects.AddItems(WallChildsIntersect);
FreeAndNil(WallChildsIntersect);
end;
end;
if ArchObjects.Count > 0 then
begin
// Çàíîñèì êîëè÷åñòâî îáúåêòîâ
if APropNameCount <> '' then
ExpProjToStroyCalcAddPropToMT(AMT, APropNameCount, IntToStr(ArchObjects.Count));
// Âíîñèì ñâîéñòâà îáúåêòîâ
for i := 0 to ArchObjects.Count - 1 do
begin
ArchObj := ArchObjects[i];
for j := 0 to AMTPropSysName.Count - 1 do
begin
ArchObjForProp := nil;
if AArchObjPropLocation[j] = -1 then
ArchObjForProp := ArchObj
else
ArchObjForProp := ArchObj.ChildReferences.GetComponByIsLine(AArchObjPropLocation[j]);
if ArchObjForProp <> nil then
begin
MTPropName := AMTPropSysName[j]+'_'+DecToABC(i+1);
AddArchPropToMemTable(AMT, ArchObjForProp, MTPropName, AArchObjPropSysName[j]);
end;
end;
end;
end;
ArchObjects.Free;
end;
procedure ExpArchObject(AArchObject: TSCSComponent; AStroyCalcObject: TASCObject);
var
MT: TkbmMemTable;
//StrStream: TStringStream;
MTPropSysName: TStringList;
ArchObjPropSysName: TStringList;
ArchObjPropLocation: TIntList; // â êàêîì òèïå äî÷åðíåíî îáúåêòà ñèäèò ñâîéñòâî - íàïðèìåð âûñîòà íèøè
ArchChild: TSCSComponent;
CADObj: TObject;
figHeight, figWidth: Double;
TempVal: Double;
TempVal1: Double;
begin
LoadArchObjPropsFromCAD(AArchObject);
AStroyCalcObject.Caption := AArchObject.GetNameForVisible;
//AStroyCalcObject.Length := AArchObject.GetPropertyValueAsFloat(pnLength);
//AStroyCalcObject.Width := AArchObject.GetPropertyValueAsFloat(pnWidth);
//AStroyCalcObject.Height := AArchObject.GetPropertyValueAsFloat(pnHeightWalls);
AStroyCalcObject.SysName := '';
MTPropSysName := TStringList.Create;
ArchObjPropSysName := TStringList.Create;
ArchObjPropLocation := TIntList.Create;
//MT := TkbmMemTable.Create(nil);
//MT.FieldDefs.Add(fnSysName, ftString, 255);
//MT.FieldDefs.Add(fnValue, ftString, 255);
//.Active := true;
MT := ExpProjToStroyCalcCreateMT;
case AArchObject.IsLine of
ctArhRoom:
begin
CADObj := GetCADObjByArchObj(AArchObject);
AStroyCalcObject.SysName := osnRoom;
//AddArchPropToMemTable(MT, AArchObject, 'ÄËÈÍÀ_#ÊÎÌÍ#', pnLength); // Äëèíà êîìíàòû
//AddArchPropToMemTable(MT, AArchObject, 'ØÈÐÈÍÀ_#ÊÎÌÍ#', pnWidth); // Øèðèíà êîìíàòû
// äëèíà è øèðèíà - ïåðåäàåì ïóñòûå çíà÷åíèÿ, òàê êàê îíè íå ðàñ÷èòûâàþòñÿ ïîêà
if CADObj <> nil then
if CADObj is TNet then
if TNet(CADObj).IsRectangle then
begin
TNet(CADObj).GetSize(sltInner, figHeight, figWidth);
figHeight := TPowerCad(TNet(CADObj).Owner).GetLengthM(figHeight);
figWidth := TPowerCad(TNet(CADObj).Owner).GetLengthM(figWidth);
ExpProjToStroyCalcAddPropToMT(MT, 'ÄËÈÍÀ_#ÊÎÌÍ#', FloatToStr(RoundCP(figHeight)));
ExpProjToStroyCalcAddPropToMT(MT, 'ØÈÐÈÍÀ_#ÊÎÌÍ#', FloatToStr(RoundCP(figWidth)));
end;
AddArchPropToMemTable(MT, AArchObject, 'ÂÛÑÎÒÀ_#ÊÎÌÍ#', pnHeightWalls); // Âûñîòà êîìíàòû
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÏÎÒÎË_#ÊÎÌÍ#', pnSquareCeil); //Ïëîùàäü ïîòîëêà êîìíàòû
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÏÎË_#ÊÎÌÍ#', pnSquareFloor); // Ïëîùàäü ïîëà êîìíàòû
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÎÁÙ_#ÊÎÌÍ#', pnWallSquareEmbrasureLess); // Îáùàÿ ïëîùàäü ñòåí êîìíàòû
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÁÅÇ_ÏÐ_#ÊÎÌÍ#', pnWallSquareExceptEmbrasureSlopeLess); // Ïëîùàäü ñòåí êîìíàòû çà âû÷åòîì ïðîåìîâ
AddArchPropToMemTable(MT, AArchObject, 'ÏÅÐÈÌÅÒÐ_ÏÎËÀ_#ÊÎÌÍ#', pnPerimeterFloor); // Ïåðèìåòð ïîìåùåíèÿ ïîëà
AddArchPropToMemTable(MT, AArchObject, 'ÏÅÐÈÌÅÒÐ_ÏÎËÍ_ÏÎËÀ_#ÊÎÌÍ#', pnPerimeterFloorFull); // Ïîëíûé ïåðèìåòð ïîëà
AddArchPropToMemTable(MT, AArchObject, 'ÏÅÐÈÌÅÒÐ_ÏÎÒÎËÊÀ_#ÊÎÌÍ#', pnPerimeterCeil); // Ïåðèìåòð ïîìåùåíèÿ ïîòîëêà
AddArchPropToMemTable(MT, AArchObject, 'ÎÁÚÅÌ_ÑÒÅÍ_#ÊÎÌÍ#', pnWallsVolume); // Îáúåì ñòåí
end;
ctArhBrickWall:
begin
AStroyCalcObject.SysName := osnBrickWall;
AddArchPropToMemTable(MT, AArchObject, 'ÄËÈÍÀ_#ÊÈÐÑÒÅÍÀ#', pnPerimeterOut); // Ñóììàðíàÿ äëèíà ñòåí
// òîëùèíó êèð.ñòåíû áåðåì èç ïåðâîé ñòåíû
ArchChild := GetChildComponByIsLine(AArchObject, ctArhWall);
if ArchChild <> nil then
AddArchPropToMemTable(MT, ArchChild, 'ÒÎËÙÈÍÀ_#ÊÈÐÑÒÅÍÀ#', pnThickness); // Øèðèíà ñòåíû
AddArchPropToMemTable(MT, AArchObject, 'ÂÛÑÎÒÀ_#ÊÈÐÑÒÅÍÀ#', pnHeightWalls); // Âûñîòà ñòåíû
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÏÎÒÎË_#ÊÈÐÑÒÅÍÀ#', pnSquareCeil); //Ïëîùàäü ïîòîëêà êîìíàòû
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÏÎË_#ÊÈÐÑÒÅÍÀ#', pnSquareFloor); // Ïëîùàäü ïîëà êîìíàòû
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÎÁÙ_#ÊÈÐÑÒÅÍÀ#', pnWallSquareEmbrasureLess); // Îáùàÿ ïëîùàäü ñòåí êîìíàòû
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÁÅÇ_ÏÐ_#ÊÈÐÑÒÅÍÀ#', pnWallSquareExceptEmbrasureSlopeLess); // Ïëîùàäü ñòåí êîìíàòû çà âû÷åòîì ïðîåìîâ
AddArchPropToMemTable(MT, AArchObject, 'ÏÅÐÈÌÅÒÐ_ÏÎËÀ_#ÊÈÐÑÒÅÍÀ#', pnPerimeterFloor); // Ïåðèìåòð ïîìåùåíèÿ ïîëà
AddArchPropToMemTable(MT, AArchObject, 'ÏÅÐÈÌÅÒÐ_ÏÎÒÎËÊÀ_#ÊÈÐÑÒÅÍÀ#', pnPerimeterCeil); // Ïåðèìåòð ïîìåùåíèÿ ïîòîëêà
AddArchPropToMemTable(MT, AArchObject, 'ÎÁÚÅÌ_ÑÒÅÍ_#ÊÈÐÑÒÅÍÀ#', pnWallsVolume); // Îáúåì ñòåí
///AddArchPropToMemTable(MT, AArchObject, 'ÎÁÚÅÌ_ÔÓÍÄ_ÍÀÄÇ_#ÊÈÐÑÒÅÍÀ#', pnPlinthVolume); // Îáúåì ôóíäàìåíòà íàä çåìëåé (öîêîëÿ)
//AddArchPropToMemTable(MT, AArchObject, 'ÎÁÚÅÌ_ÔÓÍÄ_ÏÎÄÇ_#ÊÈÐÑÒÅÍÀ#', pnBasementVolumeUnderGround); // Îáúåì ôóíäàìåíòà ïîä çåìëåé
//AddArchPropToMemTable(MT, AArchObject, 'ÎÁÚÅÌ_ÔÓÍÄ_#ÊÈÐÑÒÅÍÀ#', pnBasementVolume); // Îáúåì ôóíäàìåíòà îáùèé
end;
ctArhWallDivision:
begin
AStroyCalcObject.SysName := osnWallDivision;
//28.02.2012 AddArchPropToMemTable(MT, AArchObject, 'ÄËÈÍÀ_#ÏÅÐÅÃ#', pnLength); // Äëèíà ïåðåãîðîäêè
AddArchPropToMemTable(MT, AArchObject, 'ÄËÈÍÀ_#ÏÅÐÅÃ#', pnWidth); // Äëèíà ïåðåãîðîäêè
AddArchPropToMemTable(MT, AArchObject, 'ØÈÐÈÍÀ_#ÏÅÐÅÃ#', pnThickness); // Øèðèíà ïåðåãîðîäêè
AddArchPropToMemTable(MT, AArchObject, 'ÂÛÑÎÒÀ_#ÏÅÐÅÃ#', pnHeight); // Âûñîòà ïåðåãîðîäêè
//27.04.2012 - Ïëîùàäü ñòåí ïåðåãîðîäêè çà âû÷åòîì ïðîåìîâ
//AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÁÅÇ_ÏÐ_#ÏÅÐÅÃ#', pnSQUAREEXCEPTEMBRASURESLOPELESS, 2);
//21.10.2013 - Òàê ïðàâèëüíåå áóäåò:
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÁÅÇ_ÏÐ_#ÏÅÐÅÃ#', pnSQUAREEXCEPTEMBRASURESLOPELESS, 1);
//02.08.2012 - Äëÿ íîðì â ÊÑ
//AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÁÅÇ_ÏÐ_#ÊÎÌÍ#', pnSQUAREEXCEPTEMBRASURESLOPELESS, 2);
//21.10.2013 - Òàê ïðàâèëüíåå áóäåò:
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÁÅÇ_ÏÐ_#ÊÎÌÍ#', pnSQUAREOUT, 2);
//27.04.2012 - Îáùàÿ ïëîùàäü ñòåí ïåðåãîðîäêè
//AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÎÁÙ_#ÏÅÐÅÃ#', pnSQUAREEMBRASURELESS, 2);
//21.10.2013 - Òàê ïðàâèëüíåå áóäåò:
AddArchPropToMemTable(MT, AArchObject, 'ÏË_ÑÒ_ÎÁÙ_#ÏÅÐÅÃ#', pnSQUAREEMBRASURELESS, 1);
AddArchPropToMemTable(MT, AArchObject, 'ÎÁÚÅÌ_#ÏÅÐÅÃ#', pnVolume); // Îáúåì ïåðåãîðîäêè
end;
end;
// Äâåðíûå ïðîåìû
MTPropSysName.Clear;
ArchObjPropSysName.Clear;
ArchObjPropLocation.Clear;
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÄÂ@_ÏÐ_ØÈÐ', pnWidth, -1); // Øèðèíà äâåðíîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÄÂ@_ÏÐ_ÂÛÑ', pnHeight, -1); // Âûñîòà äâåðíîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÄÂ@_ÏÐ_ÏËÎÙ', pnSquare, -1); // Ïëîùàäü äâåðíîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÄÂ@_ÎÒÊ_ØÈÐ', pnWidth, ctArhInnerSlope); // Øèðèíà äâåðíîãî îòêîñà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÄÂ@_ÎÒÊ_ÂÛÑ', pnHeight, ctArhInnerSlope); // Âûñîòà äâåðíîãî îòêîñà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÄÂ@_ÎÒÊ_ÃËÓÁ', pnDepth, ctArhInnerSlope); // Ãëóáèíà äâåðíîãî îòêîñà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÄÂ@_ÎÒÊ_ÏÅÐÈÌ', pnPerimeter, ctArhInnerSlope); // Ïåðèìåòð äâåðíîãî îòêîñà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÄÂ@_ÎÒÊ_ÏËÎÙ', pnSquare, ctArhInnerSlope); // Ïëîùàäü äâåðíûõ îòêîñîâ
ExpObjectsOfRoom(MT, AArchObject, ctArhDoor, '$ÊÎË$_@ÄÂ@', MTPropSysName, ArchObjPropSysName, ArchObjPropLocation);
// Îêîííûå ïðîåìû
MTPropSysName.Clear;
ArchObjPropSysName.Clear;
ArchObjPropLocation.Clear;
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÎÊ@_ÏÐ_ØÈÐ', pnWidth, -1); // Øèðèíà îêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÎÊ@_ÏÐ_ÂÛÑ', pnHeight, -1); // Âûñîòà îêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÎÊ@_ÏÐ_ÏËÎÙ', pnSquare, -1); // Ïëîùàäü îêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÎÊ@_ÎÒÊ_ÂÛÑ', pnHeight, ctArhInnerSlope); // Âûñîòà îêîííîãî îòêîñà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÎÊ@_ÎÒÊ_ØÈÐ', pnWidth, ctArhInnerSlope); // Øèðèíà îêîííîãî îòêîñà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÎÊ@_ÎÒÊ_ÃËÓÁ', pnDepth, ctArhInnerSlope); // Ãëóáèíà îêîííîãî îòêîñà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÎÊ@_ÎÒÊ_ÏÅÐÈÌ', pnPerimeter, ctArhInnerSlope); // Ïåðèìåòð îêîííîãî îòêîñà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÎÊ@_ÎÒÊ_ÏËÎÙ', pnSquare, ctArhInnerSlope); // Ïëîùàäü îêîííûõ îòêîñîâ
ExpObjectsOfRoom(MT, AArchObject, ctArhWindow, '$ÊÎË$_@ÎÊ@', MTPropSysName, ArchObjPropSysName, ArchObjPropLocation);
// Áàëêîííûå ïðîåìû
MTPropSysName.Clear;
ArchObjPropSysName.Clear;
ArchObjPropLocation.Clear;
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ÂÛÑ_ÎÊ', pnHeight, ctArhWindow); // Âûñîòà îêíà áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ØÈÐ_ÎÊ', pnWidth, ctArhWindow); // Øèðèíà îêíà áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ÂÛÑ_ÄÂ', pnHeight, ctArhDoor); // Âûñîòà äâåðè áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ØÈÐ_ÄÂ', pnWidth, ctArhDoor); // Øèðèíà äâåðè áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ÎÒÊ_ÂÛÑ', pnHeight, ctArhInnerSlope); // Âûñîòà îòêîñà áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ÎÒÊ_ØÈÐ', pnWidth, ctArhInnerSlope); // Øèðèíà îòêîñà áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ÎÒÊ_ÃËÓÁ', pnDepth, ctArhInnerSlope); // Ãëóáèíà îòêîñà áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ÏÐ_ÏËÎÙ', pnSquare, -1); // Ïëîùàäü áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ÎÒÊ_ÏÅÐÈÌ', pnPerimeterSlope, -1); // Ïåðèìåòð îòêîñîâ áàëêîííîãî ïðîåìà
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÁÏÐ@_ÎÒÊ_ÏËÎÙ', pnSquareSlope, -1); // Ïëîùàäü îòêîñîâ áàëêîííîãî ïðîåìà
ExpObjectsOfRoom(MT, AArchObject, ctArhBalcony, '$ÊÎË$_@ÁÏÐ@', MTPropSysName, ArchObjPropSysName, ArchObjPropLocation);
// Àðêè
MTPropSysName.Clear;
ArchObjPropSysName.Clear;
ArchObjPropLocation.Clear;
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÀÐÊ@_ÂÛÑ', pnHeight, -1); // Âûñîòà àðêè
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÀÐÊ@_ØÈÐ', pnWidth, -1); // Øèðèíà àðêè
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÀÐÊ@_ÃËÓÁ', pnDepth, -1); // Ãëóáèíà àðêè
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÀÐÊ@_ÏÐ_ÏËÎÙ', pnSquare, -1); // Ïëîùàäü ïðîåìà àðêè - @ÀÐÊ@_ÂÛÑ * @ÀÐÊ@_ØÈÐ
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÀÐÊ@_ÏÅÐÈÌ', pnPerimeter, -1); // Ïåðèìåòð àðêè - @ÀÐÊ@_ÂÛÑ * 2 + @ÀÐÊ@_ØÈÐ
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÀÐÊ@_ÏË_ÏÅÐÈÌ', pnWallsSquare, -1); // Ïëîùàäü ñòåí àðêè - (@ÀÐÊ@_ÂÛÑ * 2 + @ÀÐÊ@_ØÈÐ) * @ÀÐÊ@_ÃËÓÁ
ExpObjectsOfRoom(MT, AArchObject, ctArhArc, '$ÊÎË$_@ÀÐÊ@', MTPropSysName, ArchObjPropSysName, ArchObjPropLocation);
// Íèøè
MTPropSysName.Clear;
ArchObjPropSysName.Clear;
ArchObjPropLocation.Clear;
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÍÈØ@_ÂÛÑ', pnHeight, -1); // Âûñîòà íèøè
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÍÈØ@_ØÈÐ', pnWidth, -1); // Øèðèíà íèøè
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÍÈØ@_ÃËÓÁ', pnDepth, -1); // Ãëóáèíà íèøè
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÍÈØ@_ÏÅÐÈÌ', pnPerimeter, -1); // Ïåðèìåòð íèøè
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÍÈØ@_ÏË_ÏÅÐÈÌ_ÃÈÏÑ', pnSquarePlasterboardPerimetr, -1); // Ïëîùàäü ïåðèìåòðà ãèïñîêàðòîíà - ( [@ÍÈØ@_ÂÛÑ] * 2 + [@ÍÈØ@_ØÈÐ] ) * [@ÍÈØ@_ÃËÓÁ]
AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '@ÍÈØ@_ÏË_ÑÒ', pnWallSquare, -1); // Ïëîùàäü ñòåíû íèøè - @ÍÈØ@_ÂÛÑ * @ÍÈØ@_ØÈÐ
ExpObjectsOfRoom(MT, AArchObject, ctArhNiche, '$ÊÎË$_@ÍÈØ@', MTPropSysName, ArchObjPropSysName, ArchObjPropLocation);
//AddPropParamsToLists(MTPropSysName, ArchObjPropSysName, ArchObjPropLocation, '', '', -1);
//ExpObjectsOfRoom(MT, AArchObject, 0, '', MTPropSysName, ArchObjPropSysName, ArchObjPropLocation);
// Ñêèäûâàåì MemTable â îáúåêò
AStroyCalcObject.LoadDumpFromMemTable(MT);
MTPropSysName.Free;
ArchObjPropSysName.Free;
ArchObjPropLocation.Free;
MT.Free;
end;
//function PropValToStr(AProp: PProperty): String;
//begin
// Result := AProp^.Value;
// if AProp^.IDDataType = dtFloat then
// Result := FloatToStrU(Round3(StrToFloatU(AProp^.Value)));
//end;
{procedure ExpArchWallPropToGrpObject(AArchWall: TSCSComponent; AObjPropExp: TArchObjPropExp);
var
i, j: Integer;
CurrGrpObject: TStringList;
GrpObject: TStringList;
//GroupPropsSN: TStringList;
GrpPropVal: Variant;
GrpPropValStr: String;
GrpPropValFloat: Double;
ObjPropValFloat: Double;
ObjProp: PProperty;
begin
//GroupPropsSN := GetStringsFromStr(AGroupPropsSN, ';', false);
// Èùåì îáúåêò ñ ïîäõîäÿùèìè ñâîéñòâàìè
GrpObject := nil;
for i := 0 to AObjPropExp.FGroupedObjects.Count - 1 do
begin
CurrGrpObject := TStringList(AObjPropExp.FGroupedObjects[i]);
GrpObject := CurrGrpObject;
for j := 0 to AObjPropExp.FGroupPropsSN.Count - 1 do
begin
// ñðàâíèâàåì ñâîéñòâà, ïî êîòîðûì èäåò ãðóïïèðîâêà
GrpPropVal := GetGUIDFromStrings(CurrGrpObject, AObjPropExp.FGroupPropsSN[j]);
ObjProp := GetArchObjPropVal(AArchWall, AObjPropExp.FGroupPropsSN[j]);
if ObjProp <> nil then
begin
case ObjProp^.IDDataType of
dtString:
begin
if AnsiCompareText(ObjProp^.Value, GrpPropVal) <> 0 then
GrpObject := nil;
end;
dtFloat, dtInteger:
begin
//if StrToFloatU(ObjProp^.Value) <> GrpPropVal then
//25.01.2011 if ObjProp^.Value <> GrpPropVal then
if Not CmpFloatByPrecision(StrToFloatU(PropValToStr(ObjProp)), StrToFloatU(GrpPropVal), 3) then
GrpObject := nil;
end;
else
GrpObject := nil;
end;
end
else
GrpObject := nil;
end;
//if GrpObject <> nil then
//begin
// // Åñëè îáúåì ôóíäàìåíòà, òî ó÷èòûâàåì íàëè÷èå öîêîëÿ (ñìîòðèì íà íàëè÷èå îáúåìà)
// if AObjPropExp.FPropsSN.IndexOf(pnBasementVolume) <> -1 then
// begin
// GrpPropVal := GetGUIDFromStrings(CurrGrpObject, pnPlinthVolume);
// ObjProp := GetArchObjPropVal(AArchWall, pnPlinthVolume);
// if (GrpPropVal <> '') and (ObjProp <> nil) and (ObjProp^.Value <> '') then
// begin
// ObjPropValFloat := StrToFloatU(ObjProp^.Value);
// if ((GrpPropVal > 0) and (ObjPropValFloat = 0)) or ((GrpPropVal = 0) and (ObjPropValFloat > 0)) then
// GrpObject := nil;
// end
// else
// GrpObject := nil;
// end;
//end;
if GrpObject <> nil then
Break; //// BREAK ////
end;
// Åñëè ãðóïïîâîé îáúåêò íå íàéäåí, òî ñîçäàåì åãî
if GrpObject = nil then
begin
// Ñîçäàåì åñëè ñâîéñòâî èç êîòîðîãî îí ñîçäàåòñÿ íå ïóñòîå
ObjProp := GetArchObjPropVal(AArchWall, AObjPropExp.FPropsSN[0]);
if (ObjProp <> nil) and Not IsEmptyVal(ObjProp^.Value) then
begin
GrpObject := TStringList.Create;
// Äîáàâëÿåì ñâîéñòâî ïî êîòîðîìó ñîçäàåòñÿ îáúåêò
for i := 0 to AObjPropExp.FPropsSN.Count - 1 do
AddGUIDIDToStrings(AObjPropExp.FPropsSN[i], '0', 0, GrpObject);
// Äîáàâëÿåì ñâîéñòâà ïî êîòîðûì èäåò ãðóïïèðîâêà
for i := 0 to AObjPropExp.FGroupPropsSN.Count - 1 do
begin
ObjProp := GetArchObjPropVal(AArchWall, AObjPropExp.FGroupPropsSN[i]);
if ObjProp <> nil then
begin
AddGUIDIDToStrings(AObjPropExp.FGroupPropsSN[i], PropValToStr(ObjProp), 0, GrpObject);
end
// èíà÷å åñëè ñâîéñòâà íå õâàòàåò, òî îòìåíÿåì ñîçäàíèå îá¿åêòà
else
begin
RemoveGUIDIDFromStrings(GrpObject);
FreeAndNil(GrpObject);
Break; //// BREAK ////
end;
end;
// Äîáàâëÿåì äðóãèå èíôîðìàöèîííûå ñâîéñòâà
for i := 0 to AObjPropExp.FObjectPropsSN.Count - 1 do
begin
ObjProp := GetArchObjPropVal(AArchWall, AObjPropExp.FGroupPropsSN[i]);
if ObjProp <> nil then
AddGUIDIDToStrings(AObjPropExp.FObjectPropsSN[i], PropValToStr(ObjProp), 0, GrpObject);
end;
if GrpObject <> nil then
AObjPropExp.FGroupedObjects.Add(GrpObject);
end;
end;
// Ïðèáàâëÿåì çíà÷åíèå ñâîéñòâà
if GrpObject <> nil then
begin
for i := 0 to AObjPropExp.FPropsSN.Count - 1 do
begin
GrpPropValStr := GetGUIDFromStrings(GrpObject, AObjPropExp.FPropsSN[i]);
// Åñëè íåòó ñâîéñòâà, òî äîáàâèòü
if (GrpPropValStr = '') and (GrpObject.IndexOf(AObjPropExp.FPropsSN[i]) = -1) then
begin
GrpPropValStr := '0';
AddGUIDIDToStrings(AObjPropExp.FPropsSN[i], GrpPropValStr, 0, GrpObject);
end;
ObjProp := GetArchObjPropVal(AArchWall, AObjPropExp.FPropsSN[i]);
if (ObjProp <> nil) and (ObjProp^.IDDataType in [dtFloat, dtInteger]) then
begin
//if GrpPropValStr = '' then
// GrpPropValStr := '0';
GrpPropValFloat := StrToFloatU(GrpPropValStr) + StrToFloatU(ObjProp^.Value);
SetGUIDToStrings(GrpObject, FloatToStrU(GrpPropValFloat), AObjPropExp.FPropsSN[i]);
end;
end;
end;
//GroupPropsSN.Free;
end;}
// Âåðíåò îáúåì ñòîëáà ôóíäàìåíòà äëÿ óãëà
function GetBasementColumnCornerVol(AObjsBasementColumnV: TArchObjPropExp; AWallObj: TSCSComponent; APath: TNetPath;
APoint: PDoublePoint; ARelPaths, ARelPathsCmpRes, ASkipPoints: TList; AColumnCount: PInteger): Double;
var
i: Integer;
ResWallObj: TSCSComponent;
ResPath: TNetPath;
ResPoint: PDoublePoint;
ResColumnW: Double;
RelObj: TSCSComponent;
IntersectType: integer;
RelPath: TNetPath;
RelPaths: TList;
RelPathsTypes: TList;
RelPoint: PDoublePoint;
RelColumnW: Double;
begin
Result := 0;
if ASkipPoints.IndexOf(APoint) = -1 then
begin
ResWallObj := AWallObj;
ResPath := APath;
ResPoint := APoint;
ResColumnW := AWallObj.GetPropertyValueAsFloat(pnBasementColumnW);
ASkipPoints.Add(ResPoint);
RelPaths := TList.Create;
RelPathsTypes := TList.Create;
if ARelPaths <> nil then
begin
RelPaths.Assign(ARelPaths);
RelPathsTypes.Assign(ARelPathsCmpRes);
end;
//  ñïèñîê äëÿ ïîèñêà äîáàëÿåì ïîäêëþ÷åííûé ñåãìåíò ê òî÷êè
for i := 0 to APath.Net.Paths.Count - 1 do
begin
RelPath := TNetPath(APath.Net.Paths[i]);
if (RelPath <> APath) and ((RelPath.p1 = APoint) or (RelPath.p2 = APoint)) then
begin
RelPaths.Add(RelPath);
RelPathsTypes.Add(Pointer(citSide));
end;
end;
// Åñëè ñâÿçàííûå ñåãìåíòû ïîäêëþ÷åíû ñòîðîíîé
for i := 0 to RelPathsTypes.Count - 1 do
begin
//IntersectType := Integer(RelPathsTypes[i]);
//if (IntersectType = citSide) then
begin
RelPath := RelPaths[i];
RelObj := GetArchObjByCADObj(TNetPath(RelPath));
// Çàäàíû ëè ïàðàìåòðû äëÿ ñòîëáöîâ
if CheckWallWithBasementColumn(RelObj) then
begin
RelPoint := nil;
if PointNear(APoint^, RelPath.p1^) then
RelPoint := RelPath.p1
else if PointNear(APoint^, RelPath.p2^) then
RelPoint := RelPath.p2
else
// èíà÷å åñëè òî÷êà íà áîëåå òîëùåì ñåãìåíòå, áåðåì ýòó òîëùèíó
if isPointInLine(RelPath.p1^,RelPath.p2^, APoint^,1) then
RelPoint := APoint;
// íå íàõîäèòñÿ ëè ñâÿçàííàÿ òî÷êà â ñïèñêå ïðîñìîòðåííûõ, èëè îáúåêò ñ ðàññìàòðèâàåìîé òî÷êîé
if (RelPoint <> nil) and ((ASkipPoints.IndexOf(RelPoint) = -1) or (RelPoint = APoint)) then
begin
// âûáèðàåì äëÿ óãëà APoint ñåãìåíò êîòîðûé øèðå
RelColumnW := RelObj.GetPropertyValueAsFloat(pnBasementColumnW);
if RelColumnW > ResColumnW then
begin
//ASkipPoints.Add(ResPoint); // ÷òîáû ýòó ñâÿçàííóþ òî÷êó (ïî êîîðäèíàòàì, èëè ñâÿçàííóþ ñ APoint) áîëüøå íå ðàññìàòðèâàòü
ResWallObj := RelObj;
ResPath := RelPath;
ResPoint := RelPoint;
ResColumnW := RelColumnW;
end;
ASkipPoints.Add(RelPoint); // ÷òîáû ýòó ñâÿçàííóþ òî÷êó (ïî êîîðäèíàòàì, èëè ñâÿçàííóþ ñ APoint) áîëüøå íå ðàññìàòðèâàòü
end;
end;
end;
end;
if ResWallObj <> nil then
begin
Result := ResWallObj.GetPropertyValueAsFloat(pnBasementColumnH)*
ResColumnW * //ResWallObj.GetPropertyValueAsFloat(pnBasementColumnW)*
ResWallObj.GetPropertyValueAsFloat(pnBasementColumnL);
//ASkipPoints.Add(ResPoint);
if AColumnCount <> nil then
begin
AColumnCount^ := AColumnCount^ + 1;
//27.01.2011 - çàêîììåíòèðîâàíî äîáàâëåíèå "êîë-âî ñòîëáîâ ìåæäó óãëàìè" òàê êàê ýòî ñâîéñòâî óæå ó÷òåíî
//27.01.2011 â îáùåé ãðóïïèðîâêå - ExpArchWallPropToGrpObject
//27.01.2011 AColumnCount^ := AColumnCount^ + ResWallObj.GetPropertyValueAsInteger(pnBasementColumnCount); // êîëè÷åñòâî êîëîí ìåæäó óãëàìè
end;
end;
RelPaths.Free;
RelPathsTypes.Free;
end;
end;
procedure ExpArchWallPropaAsObjects(ASCBuilding: TASCBuilding);
//procedure ExpArchWallPropaAsObjects(AArchRoomObject: TSCSComponent; AStroyCalcObject: TASCObject; ASCBuilding: TASCBuilding);
var
//ObjLists: TStringList;
//ObjsWallVolumes: TObjectList;
//ObjsBasementVolumes: TObjectList;
//ObjsPlinthVolumes: TObjectList;
//ObjsTrenchVolumes: TObjectList;
ObjLists: TObjectList;
ObjsWallVolumes: TArchObjPropExp;
ObjsBasementVolumes: TArchObjPropExp;
ObjsPlinthVolumes: TArchObjPropExp;
//ObjsTrenchVolumes: TArchObjPropExp;
ObjsTrenchVolumes: TArchObjPropExp;
ObjsBasementColumnV: TArchObjPropExp;
ObjsFacade: TArchObjPropExp;
ObjPropExp: TArchObjPropExp;
i, j, k, l: Integer;
ArchContainer: TSCSCatalog;
ArchObject: TSCSComponent;
SCObject: TASCObject;
SkipObjects: TList;
SkipPoints: TList;
WallObj: TSCSComponent;
//BasementWallObj: TSCSComponent; // Ñòåíà ñ êîòîðîé áóäóò áðàòüñÿ òîëùèíà è äð. ñâîéñòâà äëÿ ôóíäàìåíòà
GrpObject: TStringList;
SprProp: TNBProperty;
PropSN: String;
PropVal: Double;
PropValStr: String;
PropCorrespondIdx: Integer;
MT: TkbmMemTable;
CanExpCompon: Boolean;
Net: TNet;
Path: TNetPath;
RelPaths: TList;
RelPathsCmpRes: TList;
IntersectType: Integer;
RelObj: TSCSComponent;
BasementColumnCornerVol: Double;
BasementColumnCount: Integer;
BasementColumnTrenchVol: Double;
Vol1, Vol2: Double;
begin
//ObjLists := TStringList.Create;
//ObjsWallVolumes := TObjectList.Create(false);
//ObjsBasementVolumes := TObjectList.Create(false);
//ObjsPlinthVolumes := TObjectList.Create(false);
//ObjsTrenchVolumes := TObjectList.Create(false);
//ObjLists.AddObject(pnVolume, ObjsWallVolumes);
//ObjLists.AddObject(pnBasementVolume, ObjsBasementVolumes);
//ObjLists.AddObject(pnPlinthVolume, ObjsPlinthVolumes);
//ObjLists.AddObject(pnTrenchVolume, ObjsTrenchVolumes);
//for i := 0 to AArchRoomObject.ChildComplects.Count - 1 do
//begin
// WallObj := AArchRoomObject.ChildComplects[i];
// if WallObj.IsLine = ctArhWall then
// begin
// // Åñëè óñòàíîâëåíî ñâîéñòâî "ôóíäàìåíò"
// if WallObj.GetPropertyValueAsBooleanDef(pnBasement, false) then
// begin
// // Îáúåìû ñòåí - ãðóïïèðóåì ïî ãðóïïå/òîëùèíå ñåãìåíòà
// ExpArchWallPropToGrpObject(WallObj, ObjsWallVolumes, pnVolume, pnGroupName+';'+pnThickness);
// // Îáúåìû ôóíäàìåíòîâ - ãðóïïèðóåì ïî ãðóïïå/òîëùèíå ôóíäàìåíòà
// ExpArchWallPropToGrpObject(WallObj, ObjsBasementVolumes, pnBasementVolume, pnGroupName+';'+pnBasementThickness);
// // Îáúåìû öîêîëÿ - ãðóïïèðóåì ïî ãðóïïå/òîëùèíå öîêîëÿ
// ExpArchWallPropToGrpObject(WallObj, ObjsPlinthVolumes, pnPlinthVolume, pnGroupName+';'+pnPlinthThickness);
// // Îáúåìû òðàíøåé - ãðóïïèðóåì ïî ãðóïïå/òîëùèíå ôóíäàìåíòà
// ExpArchWallPropToGrpObject(WallObj, ObjsTrenchVolumes, pnTrenchVolume, pnGroupName+';'+pnBasementThickness);
// end;
// end;
//end;
//ExpArchWallPropAsObject
//ObjsBasementVolumes.OwnsObjects := true;
//ObjsBasementVolumes.Free;
//ObjsWallVolumes.OwnsObjects := true;
//ObjsWallVolumes.Free;
ObjLists := TObjectList.Create(true);
// Îáúåìû ñòåí - ãðóïïèðóåì ïî ãðóïïå/òîëùèíå ñåãìåíòà
ObjsWallVolumes := TArchObjPropExp.Create;
ObjsWallVolumes.FCaption := 'Îáúåì ñòåí';
ObjsWallVolumes.FObjectSN := osnWallVolume;
ObjsWallVolumes.FPropsSN.Add(pnVolume);
//ObjsWallVolumes.FPropsSN.Add(pnSquareOut); // Ïëîùàäü ñòåí ñíàðóæè
ObjsWallVolumes.FGroupPropsSN.Add(pnGroupName);
ObjsWallVolumes.FGroupPropsSN.Add(pnThickness);
ObjsWallVolumes.AddPropCorrespond(pnVolume, 'ÎÁÚÅÌ_#ÑÒÅÍ#');
ObjsWallVolumes.AddPropCorrespond(pnThickness, 'ÒÎËÙÈÍÀ_#ÑÒÅÍ#');
//ObjsWallVolumes.AddPropCorrespond(pnSquareOut, 'ÏË_ÑÒ_ÁÅÇ_ÏÐ_#ÑÒÅÍ#');
ObjLists.Add(ObjsWallVolumes);
// Îáúåìû ôóíäàìåíòîâ - ãðóïïèðóåì ïî ãðóïïå/òîëùèíå ôóíäàìåíòà
ObjsBasementVolumes := TArchObjPropExp.Create;
ObjsBasementVolumes.FCaption := 'Ôóíäàìåíò';
ObjsBasementVolumes.FObjectSN := osnBasement;
ObjsBasementVolumes.FPropsSN.Add(pnBasementVolume);
ObjsBasementVolumes.FPropsSN.Add(pnBasementArea);
ObjsBasementVolumes.FPropsSN.Add(pnTrenchVolume);
ObjsBasementVolumes.FGroupPropsSN.Add(pnGroupName);
ObjsBasementVolumes.FGroupPropsSN.Add(pnBasementThickness);
ObjsBasementVolumes.AddPropCorrespond(pnBasementVolume, 'ÎÁÚÅÌ_#ÔÓÍÄ#');
ObjsBasementVolumes.AddPropCorrespond(pnBasementArea, 'ÏËÎÙ_ÎÑÍ_#ÔÓÍÄ#');
ObjsBasementVolumes.AddPropCorrespond(pnBasementThickness, 'ÒÎËÙÈÍÀ_#ÔÓÍÄ#');
ObjsBasementVolumes.AddPropCorrespond(pnTrenchVolume, 'ÎÁÚÅÌ_#ÒÐÀÍØ#');
ObjLists.Add(ObjsBasementVolumes);
// Îáúåìû öîêîëÿ - ãðóïïèðóåì ïî ãðóïïå/òîëùèíå öîêîëÿ
ObjsPlinthVolumes := TArchObjPropExp.Create;
ObjsPlinthVolumes.FCaption := 'Ôóíäàìåíò (öîêîëü)';
ObjsPlinthVolumes.FObjectSN := osnBasement;
ObjsPlinthVolumes.FPropsSN.Add(pnPlinthSidesSquare);
ObjsPlinthVolumes.FPropsSN.Add(pnPlinthSurfaceSquare);
ObjsPlinthVolumes.FPropsSN.Add(pnPlinthVolume);
ObjsPlinthVolumes.FGroupPropsSN.Add(pnGroupName);
ObjsPlinthVolumes.FGroupPropsSN.Add(pnPlinthThickness);
ObjsPlinthVolumes.AddPropCorrespond(pnPlinthSidesSquare, 'ÁÎÊÎÂ_ÏËÎÙ_#ÔÓÍÄ#');
ObjsPlinthVolumes.AddPropCorrespond(pnPlinthSurfaceSquare, 'ÏËÎÙ_ÏÎÂÅÐÕ_#ÔÓÍÄ#');
ObjsPlinthVolumes.AddPropCorrespond(pnPlinthVolume, 'ÎÁÚÅÌ_#ÔÓÍÄ#');
ObjsPlinthVolumes.AddPropCorrespond(pnPlinthThickness, 'ÒÎËÙÈÍÀ_#ÔÓÍÄ#');
ObjLists.Add(ObjsPlinthVolumes);
// Îáúåìû òðàíøåé - ãðóïïèðóåì ïî ãðóïïå/òîëùèíå ôóíäàìåíòà
//ObjsTrenchVolumes := TArchObjPropExp.Create;
//ObjsTrenchVolumes.FCaption := 'Îáúåì òðàíøåé';
//ObjsTrenchVolumes.FPropSN := pnTrenchVolume;
//ObjsTrenchVolumes.FGroupPropsSN.Add(pnGroupName);
//ObjsTrenchVolumes.FGroupPropsSN.Add(pnBasementThickness);
// Ñòîëáû ôóíäàìåíòîâ - âûãðåáàåì âñå
ObjsBasementColumnV := TArchObjPropExp.Create;
ObjsBasementColumnV.FCaption := 'Ñòîëáû ôóíäàìåíòà';
ObjsBasementColumnV.FObjectSN := osnBasementColumn;
ObjsBasementColumnV.FPropsSN.Add(pnBasementColumnVBetwCorner);
ObjsBasementColumnV.FPropsSN.Add(pnBasementColumnCount);
//ObjsBasementColumnV.FPropsSN.Add(pnBasementVolume); //27.01.2011 Îáúåì òðàíøåè äëÿ ñòîëáîâ ïî îáúåìó ôóíäàìåíòà
//14.12.2010 ObjsBasementColumnV.AddPropCorrespond(pnBasementColumnVBetwCorner, 'ÎÁÚÅÌ_#ÑÒÎËÁ_ÔÓÍÄ#');
ObjsBasementColumnV.AddPropCorrespond(pnBasementColumnVBetwCorner, 'ÎÁÚÅÌ_#ÔÓÍÄ#');
ObjsBasementColumnV.AddPropCorrespond(pnBasementColumnCount, 'ÊÎË_ÑÒÎËÁÎÂ');
//ObjsBasementColumnV.AddPropCorrespond(pnBasementVolume, 'ÎÁÚÅÌ_#ÒÐÀÍØ#'); //27.01.2011 Îáúåì òðàíøåè äëÿ ñòîëáîâ ïî îáúåìó ôóíäàìåíòà
ObjsBasementColumnV.AddPropCorrespond(pnTrenchVolume, 'ÎÁÚÅÌ_#ÒÐÀÍØ#'); //28.01.2011 Îáúåì òðàíøåè äëÿ ñòîëáîâ ïî îáúåìó ôóíäàìåíòà ñòîëáîâ pnBasementColumnVBetwCorner
ObjLists.Add(ObjsBasementColumnV);
// Ïëîùàäü ôàñàäà - âíåøíÿÿ ïëîùàäü ñòåí
ObjsFacade := TArchObjPropExp.Create;
ObjsFacade.FCaption := 'Ôàñàä';
ObjsFacade.FObjectSN := osnFacade;
ObjsFacade.FPropsSN.Add(pnWallsOutSquare);
ObjsFacade.AddPropCorrespond(pnWallsOutSquare, 'ÏË_#ÔÀÑÀÄ#');
ObjLists.Add(ObjsFacade);
BasementColumnCornerVol := 0;
BasementColumnCount := 0;
BasementColumnTrenchVol := 0;
for i := 0 to ObjLists.Count - 1 do
TArchObjPropExp(ObjLists[i]).DefineAllProps;
// Ãðóïïèðóåì ñâîéñòâà â îáúåêòû
//for i := 0 to AArchRoomObject.ChildComplects.Count - 1 do
//begin
// WallObj := AArchRoomObject.ChildComplects[i];
// if WallObj.IsLine = ctArhWall then
// begin
// // Åñëè óñòàíîâëåíî ñâîéñòâî "ôóíäàìåíò"
// if WallObj.GetPropertyValueAsBooleanDef(pnBasement, false) then
// begin
// for j := 0 to ObjLists.Count - 1 do
// begin
// ObjPropExp := TArchObjPropExp(ObjLists[j]);
// ExpArchWallPropToGrpObject(WallObj, ObjPropExp.FGroupedObjects, ObjPropExp.FPropsSN, ObjPropExp.FGroupPropsSN, ObjPropExp);
// end;
// end;
// end;
//end;
SkipObjects := TList.Create;
SkipPoints := TList.Create;
RelPathsCmpRes := TList.Create;
// Ãðóïïèðóåì ñâîéñòâà êîìíàò â îáúåêòû
//for i := 0 to ASCBuilding.Collection.Count - 1 do
//begin
// SCObject := TASCObject(ASCBuilding.Collection.Items[i]);
// if (SCObject.FSrcObj <> nil) and (SCObject.FSrcObj is TSCSList) then
// begin
// ArchContainer := DefineArchContainer(TSCSList(SCObject.FSrcObj));
ArchContainer := DefineArchContainer(TSCSList(ASCBuilding.FSrcObj));
for j := 0 to ArchContainer.SCSComponents.Count - 1 do
begin
ArchObject := ArchContainer.SCSComponents[j];
for k := 0 to ArchObject.ChildComplects.Count - 1 do
begin
WallObj := ArchObject.ChildComplects[k];
// Åñëè óñòàíîâëåíî ñâîéñòâî "ôóíäàìåíò" äëÿ ñòåíû
if (WallObj.IsLine = ctArhWall) and WallObj.GetPropertyValueAsBooleanDef(pnBasement, false) then
begin
Path := TNetPath(GetCADObjByArchObj(WallObj));
RelPaths := nil;
if Path <> nil then
RelPaths := Path.Net.GetRelatedPaths(Path, RelPathsCmpRes, true);
if (SkipObjects.IndexOf(WallObj) = -1) then
begin
// Ïðîâåðÿåì ýòîò ñåãìåíò íà ñìåæíîñòü ñ äðóãèìè
CanExpCompon := false;
if Path <> nil then
begin
CanExpCompon := true;
//RelPaths := Path.Net.GetRelatedPaths(Path, RelPathsCmpRes);
if RelPaths <> nil then
begin
// Åñëè ýòîò ñåãìåíò âõîäèò â äðóãîé, òî íå ó÷èòûâàåì åãî
if GetRelBasementByIntersectType(citEntry, RelPaths, RelPathsCmpRes) <> nil then
CanExpCompon := false
else
// Åñëè ýòîò ñåãìåíò ïîãëàùàåò äðóãèå (èëè ýêâ. ñ äðóãèìè), òî ýòè äðóãèå íå ó÷èòûâàåì ïîçæå
for l := 0 to RelPathsCmpRes.Count - 1 do
begin
IntersectType := Integer(RelPathsCmpRes[l]);
if (IntersectType = citEqual) or (IntersectType = citAbsorb) then
begin
RelObj := GetArchObjByCADObj(TNetPath(RelPaths[l]));
if RelObj.GetPropertyValueAsBooleanDef(pnBasement, false) then
SkipObjects.Add(RelObj);
end;
end;
//FreeAndNil(RelPaths);
end;
end; // Êîíåö ïðîâåðêè
if CanExpCompon then
begin
for l := 0 to ObjLists.Count - 1 do
begin
ObjPropExp := TArchObjPropExp(ObjLists[l]);
ExpArchObjPropToGrpObject(WallObj, ObjPropExp);
end;
// Áåðåì äàííûå ñ óãëîâ - îáúåì ñòîëáîâ ôóíäàìåíòà
//if CheckWallWithBasementColumn(WallObj) then
//begin
// BasementColumnCornerVol := BasementColumnCornerVol + GetBasementColumnCornerVol(nil, WallObj, Path, Path.p1, RelPaths, RelPathsCmpRes, SkipPoints);
// BasementColumnCornerVol := BasementColumnCornerVol + GetBasementColumnCornerVol(nil, WallObj, Path, Path.p2, RelPaths, RelPathsCmpRes, SkipPoints);
//end;
end;
end;
// Áåðåì äàííûå ñ óãëîâ - îáúåì ñòîëáîâ ôóíäàìåíòà
if CheckWallWithBasementColumn(WallObj) then
begin
Vol1 := GetBasementColumnCornerVol(nil, WallObj, Path, Path.p1, RelPaths, RelPathsCmpRes, SkipPoints, @BasementColumnCount);
Vol2 := GetBasementColumnCornerVol(nil, WallObj, Path, Path.p2, RelPaths, RelPathsCmpRes, SkipPoints, @BasementColumnCount);
BasementColumnCornerVol := BasementColumnCornerVol + Vol1 + Vol2;
// Ñ ôóíäàìåíòîâ ñîáèðàåì - ãðóïïèðóåì îáúåìû â îäíî ñâîéñòâî äëÿ ñòîëáîâ "ÎÁÚÅÌ ÒÐÀÍØÅÈ"
// â óñëîâèè OR ïîòîìó÷òî îäèí èç óãëîâ ìîã áûòü ó÷åñòü ðàíüøå íà ïðåäûäóùåé ñòåíå
// è åñëè îäèí èç óãëîâ > 0, òî çíà÷èò ÷òî äëÿ êîëîí óêàçàíû ïåðåìåòðû H,W,L íà äàíîì ñåãìåíòå/ñòåíå WallObj
//if (Vol1 > 0) or (Vol2 > 0) then
// BasementColumnTrenchVol := BasementColumnTrenchVol + WallObj.GetPropertyValueAsFloat(pnBasementVolume);
end;
if RelPaths <> nil then
RelPaths.Free;
end;
end;
end;
//end;
//end;
WallObj := TSCSComponent.Create(F_ProjMan);
// Ïëîùàäü ñòåí ñíàðóæè
//TF_CAD(ListCADForm).PCad.GetFacadeArea;
PropVal := CalcArchRoomsFacadeArea(ListCADForm); //TF_CAD(ListCADForm).PCad.GetFacadeArea;
AddPropertyToComponFromSprBySysName(WallObj, F_ProjMan.GSCSBase.CurrProject.Spravochnik, pnWallsOutSquare, FloatToStrU(PropVal));
ExpArchObjPropToGrpObject(WallObj, ObjsFacade);
// Ñâîéñòâî "îáúåì êîëîí"
if BasementColumnCornerVol > 0 then
begin
WallObj.Clear;
AddPropertyToComponFromSprBySysName(WallObj, F_ProjMan.GSCSBase.CurrProject.Spravochnik, pnBasementColumnVBetwCorner, FloatToStrU(BasementColumnCornerVol));
AddPropertyToComponFromSprBySysName(WallObj, F_ProjMan.GSCSBase.CurrProject.Spravochnik, pnBasementColumnCount, FloatToStrU(BasementColumnCount));
//AddPropertyToComponFromSprBySysName(WallObj, F_ProjMan.GSCSBase.CurrProject.Spravochnik, pnBasementVolume, FloatToStrU(BasementColumnTrenchVol));
//ObjsBasementColumnV.FPropsSN.Add(pnBasementVolume);
// Îáúåì òðàíøåè ñòîëáîâ ôóíäàìåíòîâ èç îáúåìà ôóíäàìåíòà ñòîëáîâ
// - ïîëó÷àåì èç îáúåìîâ óãëîâ (BasementColumnCornerVol) è îáúåìà ìåæäó óãëàìè ñ ãðóïïîâîãî ObjsBasementColumnV
//21.08.2012 BasementColumnTrenchVol := BasementColumnCornerVol + StrToIntDef(PropValStr,0);
BasementColumnTrenchVol := BasementColumnCornerVol;
if ObjsBasementColumnV.FGroupedObjects.Count > 0 then
begin
PropValStr := GetGUIDFromStrings(TStringList(ObjsBasementColumnV.FGroupedObjects[0]), pnBasementColumnVBetwCorner);
BasementColumnTrenchVol := BasementColumnTrenchVol + StrToFloatU(PropValStr);
end;
AddPropertyToComponFromSprBySysName(WallObj, F_ProjMan.GSCSBase.CurrProject.Spravochnik, pnTrenchVolume, FloatToStrU(BasementColumnTrenchVol));
ObjsBasementColumnV.FPropsSN.Add(pnTrenchVolume);
ObjsBasementColumnV.DefineAllProps;
ExpArchObjPropToGrpObject(WallObj, ObjsBasementColumnV);
end;
WallObj.Free;
FreeAndNil(RelPathsCmpRes);
FreeAndNil(SkipPoints);
FreeAndNil(SkipObjects);
MT := ExpProjToStroyCalcCreateMT;
// Èç ãðóïï ñîçäàåì SC îáúåêòû
for i := 0 to ObjLists.Count - 1 do
begin
ObjPropExp := TArchObjPropExp(ObjLists[i]);
ExpProjToStroyCalcGrpPropsToObjs(AProject, ObjPropExp, ASCBuilding.Objects, true, MT);
//for j := 0 to ObjPropExp.FGroupedObjects.Count - 1 do
// begin
// GrpObject := TStringList(ObjPropExp.FGroupedObjects[j]);
//
// // Ñîçäàåì SC îáúåêò, è âêèäûâàåì òóäà ñâîéñòâà
// MT.Active := false;
// MT.Active := true;
// SCObject := TASCObject.Create(ASCBuilding.Objects);
// SCObject.Caption := '';
// for k := 0 to ObjPropExp.FAllObjectPropsSN.Count - 1 do
// begin
// PropSN := ObjPropExp.FAllObjectPropsSN[k];
// PropValStr := GetGUIDFromStrings(GrpObject, PropSN);
//
// // Åñëè ýòî ñâî-âî èñïîëüçóåòñÿ äëÿ ãðóïïèðîâêè, òî èñïîëüçóåì åãî â èìåíè îáúåêòà
// if (PropValStr <> '') and (ObjPropExp.FGroupPropsSN.IndexOf(PropSN) <> -1) then
// begin
// SprProp := AProject.Spravochnik.GetPropertyBySysName(PropSN);
// if SprProp <> nil then
// begin
// if SCObject.Caption <> '' then
// SCObject.Caption := SCObject.Caption + ', ';
// SCObject.Caption := SCObject.Caption + GetArchObjPropShortName(SprProp.PropertyData.Name, PropSN) +' '+ PropValStr;
// end;
// end;
//
// // Çàíîñèì ñâîéòâî â MemTable
// PropCorrespondIdx := ObjPropExp.FPropsCorrespond.IndexOf(PropSN);
// if PropCorrespondIdx <> -1 then
// ExpProjToStroyCalcAddPropToMT(MT, GetStrFromStringsByIdx(ObjPropExp.FPropsCorrespond, PropCorrespondIdx), PropValStr);
// end;
// if ObjPropExp.FCaption <> '' then
// SCObject.Caption := ObjPropExp.FCaption +'_'+ SCObject.Caption;
// SCObject.SysName := ObjPropExp.FObjectSN; //ObjPropExp.FPropSN;
// SCObject.LoadDumpFromMemTable(MT);
// end;
end;
MT.Free;
ObjLists.Free;
end;
begin
GArchEngine.BeginExport;
try
try
ASCProject := TASCProject.Create(nil);
ASCProject.Caption := AProject.GetNameForVisible;
// Âêèäûâàåì ëèñòû êàê îáúåêòû ñòðéêè
for i := 0 to AProject.ProjectLists.Count - 1 do
begin
SCSList := AProject.ProjectLists[i];
ListCADForm := GetCADFormBySCSObject(SCSList);
CADWallChildsObjects := nil;
if ListCADForm <> nil then
CADWallChildsObjects := GetAllWallChildsFromCAD(ListCADForm, []);
//ASCObject := TASCObject.Create(ASCProject.Objects);
//ASCObject.Caption := SCSList.GetNameForVisible;
ASCBuilding := TASCBuilding.Create(ASCProject.Buildings);
ASCBuilding.Caption := SCSList.GetNameForVisible;
ASCBuilding.FSrcObj := SCSList;
ArchContainer := DefineArchContainer(SCSList);
for j := 0 to ArchContainer.SCSComponents.Count - 1 do
begin
ArchRoom := ArchContainer.SCSComponents[j];
if IsArchRoomComponByIsLine(ArchRoom.IsLine) then //if ArchRoom.IsLine = ctArhRoom then
begin
ASCObject := TASCObject.Create(ASCBuilding.Objects);
ASCObject.FSrcObj := ArchRoom;
ExpArchObject(ArchRoom, ASCObject);
// Ýêñïîðò ñâîéñòâ ñòåí êàê ïîäîáúåêòîâ: îáúåì ñòåíû, îáúåì ôóíäàìåíòà
//ExpArchWallPropaAsObjects(ArchRoom, ASCObject, ASCBuilding);
// Ïåðåãîðîäêè
for k := 0 to ArchRoom.ChildComplects.Count - 1 do
begin
ArchChild := ArchRoom.ChildComplects[k];
if ArchChild.IsLine = ctArhWallDivision then
begin
ASCObject := TASCObject.Create(ASCBuilding.Objects);
ExpArchObject(ArchChild, ASCObject);
end;
end;
end;
end;
try
// Ýêñïîðò ñâîéñòâ ñòåí êàê ïîäîáúåêòîâ: îáúåì ñòåíû, îáúåì ôóíäàìåíòà
ExpArchWallPropaAsObjects(ASCBuilding);
except
on E: Exception do AddExceptionToLog('ExpArchWallPropaAsObjects ' + E.Message);
end;
try
// Ýêñïîðò 3D ãðàíåé
Exp3DToSCBuilding(AProject, ASCBuilding);
except
on E: Exception do AddExceptionToLog('Exp3DToSCBuilding ' + E.Message);
end;
try
// Ýêñïîðò êðûøû ëèñòà
ExpRoofToSCBuilding(SCSList, ASCBuilding);
except
on E: Exception do AddExceptionToLog('ExpRoofToSCBuilding ' + E.Message);
end;
try
if CADWallChildsObjects <> nil then
FreeAndNil(CADWallChildsObjects);
except
on E: Exception do AddExceptionToLog('FreeAndNil(CADWallChildsObjects) ' + E.Message);
end;
end;
ASCProject.SaveToStream(AStream);
FreeAndNil(ASCProject);
except
on E: Exception do AddExceptionToLog('ExpProjToStroyCalcStream ' + E.Message);
end;
finally
GArchEngine.EndExport;
end;
end;
procedure ExpProjToStroyCalcTest;
var
//ASCProject: TASCProject;
//ASCBuilding: TASCBuilding;
//ASCObject: TASCObject;
SavedDBGMode: Boolean;
begin
try
ExpProjToStroyCalcFile(F_ProjMan.GSCSBase.CurrProject, 'C:\Temp\stroyCalcProj.scp');
//ASCProject := TASCProject.Create(nil);
//ASCProject.LoadFromFile('C:\Temp\stryCalcProj.scp');
//ASCProject.SaveToFile('C:\Temp\stryCalcProj_ret.scp');
//if ASCProject.Buildings.Count > 0 then
// ASCBuilding := ASCProject.Buildings[0];
//FreeAndNil(ASCProject);
ImportToStroyCalcTest;
SavedDBGMode := GSCDebugMode;
GSCDebugMode := true;
try
ExpProjToStroyCalcFile(F_ProjMan.GSCSBase.CurrProject, 'C:\Temp\stroyCalcProj_dbg.scp');
finally
GSCDebugMode := SavedDBGMode;
end;
except
on E: Exception do AddExceptionToLogEx('ExpProjToStroyCalcTest', E.Message);
end;
end;
function GetAllRelatedNets(aNet: TNet): TList;
var
i, j: Integer;
Path: TNetPath;
RelNets: TList;
RelNet: TNet;
CurrRelNets: TList;
LookIdx: Integer;
begin
Result := TList.Create;
CurrRelNets := aNet.GetRelatedNets;
LookIdx := 0;
while CurrRelNets.Count > 0 do
begin
for i := 0 to CurrRelNets.Count - 1 do
begin
RelNet := TNet(CurrRelNets[i]);
if (RelNet <> aNet) and (Result.IndexOf(RelNet) = -1) then
Result.Add(RelNet);
end;
CurrRelNets.Clear;
// èç òîëüêî ÷òî äîáàâëåííûõ âûøå, âûòàñêèâàåì ñâÿçàííûå
for i := LookIdx to Result.Count - 1 do
begin
RelNets := TNet(Result[i]).GetRelatedNets;
AssignListItems(RelNets, CurrRelNets);
FreeAndNil(RelNets);
end;
LookIdx := Result.Count;
end;
CurrRelNets.Free;
end;
function GetAllWallChildsFromCAD(ACAD: TForm; AFilter: TDoorObjTypes): TList;
var
CAD: TF_CAD;
Net: TNet;
Path: TNetPath;
WallChld: TNetDoor;
Figure: TFigure;
i, j, k: Integer;
begin
Result := TList.Create;
CAD := TF_CAD(ACAD);
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
Figure := TFigure(CAD.PCad.Figures[i]);
if Figure is TNet then
begin
Net := TNet(Figure);
for j := 0 to Net.Paths.Count - 1 do
begin
Path := TNetPath(Net.Paths[j]);
for k := 0 to Path.Doors.Count - 1 do
begin
WallChld := TNetDoor(Path.Doors[k]);
if (AFilter = []) or (WallChld.DoorObjType in AFilter) then
Result.Add(WallChld);
end;
end;
end;
end;
end;
function GetArchCADObjCaption(ACADObj, AChildObj: TObject; const ADefault: String=''): String;
var
ArchObj: TSCSComponent;
H, H1, H2: Double;
W: Double;
ParamsStr: String;
UOMName: String;
ChildName: String;
PathsAngle: Double;
procedure AddToParamStr(AVal: Double; const ACaption: String);
begin
if ParamsStr <> '' then
ParamsStr := ParamsStr + ', ';
ParamsStr := ParamsStr + AnsiLowerCase(ACaption)+': '+FloatInUOMStr(RoundCP(AVal),umM,F_ProjMan.FUOM)+' '+UOMName;
end;
begin
Result := ADefault;
ArchObj := GetArchObjByCADObj(ACADObj);
if ArchObj <> nil then
begin
Result := ArchObj.GetNameForVisible;
ParamsStr := '';
if ArchObj.IsLine = ctArhRoofSeg then
begin
PathsAngle := -1;
if ACADObj is TNet then
// Åñëè âûäåëåíî äâà ðåáðà êðûøè, òî îòîáðàæàåì óãîë ñïðîåöèðîâàííûé íà 2D
PathsAngle := GetNetSelPathsAngleInCAD(TNet(ACADObj), ArchObj);
if PathsAngle <> -1 then
begin
Result := 'Óãîë ' + FloatToStr(Round2(PathsAngle))+' ãðàä';
AChildObj := nil;
end
else
begin
LoadArchObjPropsFromCAD(ArchObj, ACADObj);
Result := Result + ' (óãîë íàêëîíà: '+ FloatToStr(Round2(GArchEngine.FLastObjTiltAngle))+' ãðàä)';
end;
end
else
if IsArchFrameSegmentComponByIsLine(ArchObj.IsLine) or (ArchObj.IsLine in [ctArhDoor, ctArhWindow, ctArhArc, ctArhNiche]) then
begin
LoadArchObjPropsFromCAD(ArchObj, ACADObj);
if (ArchObj.TreeViewNode <> nil) and (ArchObj.TreeViewNode.Selected) then
F_ProjMan.RefreshNode;
UOMName := GetNameUOM(F_ProjMan.FUOM, true);
H := ArchObj.GetPropertyValueAsFloat(pnHeight);
if IsArchFrameSegmentComponByIsLine(ArchObj.IsLine) then//26.04.2011 if ArchObj.IsLine = ctArhWall then
begin
//if ArchObj.IsLine = ctArhRoofHip then
// AddToParamStr(ArchObj.GetPropertyValueAsFloat(pnLength), cArchParams_Msg01);
GetArchWallCornersProps(ArchObj, pnHeight, H1, H2);
if (H1 > 0) or (H2 > 0) then
begin
H1 := RoundCP(FloatNoZero(H1, H));
H2 := RoundCP(FloatNoZero(H2, H));
ParamsStr := ParamsStr + AnsiLowerCase(cArchParams_Msg24)+': '+FloatInUOMStr(H1,umM,F_ProjMan.FUOM)+' - '+FloatInUOMStr(H2,umM,F_ProjMan.FUOM)+' '+UOMName;
end
else
AddToParamStr(H, cArchParams_Msg06);
if ArchObj.IsLine = ctArhWall then
AddToParamStr(ArchObj.GetPropertyValueAsFloat(pnThickness), cArchParams_Msg09);
end
else if ArchObj.IsLine in [ctArhDoor, ctArhWindow, ctArhArc, ctArhNiche] then
begin
AddToParamStr(ArchObj.GetPropertyValueAsFloat(pnWidth), cArchParams_Msg02);
AddToParamStr(H, cArchParams_Msg06);
if ArchObj.IsLine in [ctArhDoor, ctArhWindow, ctArhNiche] then
AddToParamStr(ArchObj.GetPropertyValueAsFloat(pnCoordZ), cArchParams_Msg05);
if ArchObj.IsLine in [ctArhNiche, ctArhArc] then
AddToParamStr(ArchObj.GetPropertyValueAsFloat(pnDepth), cArchParams_Msg07);
end;
end;
if ParamsStr <> '' then
Result := Result + ' ('+ ParamsStr + ')';
end;
if AChildObj <> nil then
begin
ChildName := GetArchCADObjCaption(AChildObj, nil, '');
if ChildName <> '' then
begin
if Result <> '' then
Result := Result + ', ';
Result := Result + ChildName;
end;
end;
end;
function GetArchCADObjLenCaption(ACADObj, AChildObj: TObject): String;
var
UOMName: String;
ArchObj: TSCSComponent;
ArchChildObj: TSCSComponent;
begin
Result := '';
ArchObj := GetArchObjByCADObj(ACADObj);
ArchChildObj := GetArchObjByCADObj(AChildObj);
if ArchChildObj <> nil then
begin
UOMName := GetNameUOM(F_ProjMan.FUOM, true);
if ArchChildObj.IsLine = ctArhRoofHip then
begin
LoadArchObjPropsFromCAD(ArchChildObj, AChildObj);
Result := AnsiLowerCase(cArchParams_Msg01)+': '+FloatInUOMStr(RoundCP(ArchChildObj.GetPropertyValueAsFloat(pnLength)),umM,F_ProjMan.FUOM)+' '+UOMName;
end;
end;
end;
function GetArchCornersForNet(ANet: TNet; AArchObj: TSCSComponent): TSCSComponents;
var
ArchObj: TSCSComponent;
PointObj: TSCSComponent;
i: integer;
begin
Result := TSCSComponents.Create(false);
ArchObj := AArchObj;
if ArchObj = nil then
ArchObj := GetArchObjByCADObj(AArchObj);
if ArchObj <> nil then
for i := 0 to ANet.Points.Count - 1 do
begin
PointObj := ArchObj.GetComponentFromReferences(Integer(ANet.FPointIDs[i]));
Result.Add(PointObj);
end;
end;
function GetAllOtherNetWallsFromCAD(ACAD: TForm; aNet: TNet): TList;
var
CAD: TF_CAD;
Net: TNet;
Path: TNetPath;
Figure: TFigure;
i, j: Integer;
begin
Result := TList.Create;
CAD := TF_CAD(ACAD);
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
Figure := TFigure(CAD.PCad.Figures[i]);
if (Figure is TNet) and (TNet(Figure) <> aNet) then
begin
Net := TNet(Figure);
for j := 0 to Net.Paths.Count - 1 do
begin
Path := TNetPath(Net.Paths[j]);
Result.Add(Path);
end;
end;
end;
end;
function GetAllOtherNetsFromCAD(ACAD: TForm; aNet: TNet): TList;
var
CAD: TF_CAD;
Net: TNet;
Figure: TFigure;
i, j: Integer;
begin
Result := TList.Create;
CAD := TF_CAD(ACAD);
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
Figure := TFigure(CAD.PCad.Figures[i]);
if (Figure is TNet) and (TNet(Figure) <> aNet) then
begin
Net := TNet(Figure);
if Net.Paths.Count > 0 then
Result.Add(Net);
end;
end;
end;
function GetArchCornersForWall(AArchWall: TSCSComponent): TSCSComponents;
var
TopObj: TSCSComponent;
NetPath: TNetPath;
procedure AddCornerByPoint(APoint: PDoublepoint);
var
Corner: TSCSComponent;
begin
Corner := TopObj.GetComponentFromReferences(NetPath.Net.GetPointID(APoint));
if Corner <> nil then
Result.Add(Corner);
end;
begin
Result := nil;
TopObj := AArchWall.GetTopComponent;
NetPath := TNetPath(GetCADObjByArchObj(AArchWall));
if Assigned(TopObj) and Assigned(NetPath) then
begin
Result := TSCSComponents.Create(false);
AddCornerByPoint(NetPath.p1);
AddCornerByPoint(NetPath.p2);
end;
end;
function GetArchCornerByPoint(ANet: TNet; p: PDoublePoint; aLookInList: Boolean=false): TSCSComponent;
var
pID: Integer;
ArchObj: TSCSComponent;
ListOwner: TSCSList;
begin
Result := nil;
pID := ANet.GetPointID(p);
if (pID = 0) and (ANet.FSrcNet <> nil) then
pID := ANet.FSrcNet.GetPointID(ANet.FSrcNet.GetPointByNear(p^));
ArchObj := GetArchObjByCADObj(ANet);
if (pID <> 0) and Assigned(ArchObj) then
begin
Result := ArchObj.GetComponentFromReferences(pID);
if (Result = nil) and aLookInList then
begin
ListOwner := ArchObj.GetListOwner;
if ListOwner <> nil then
Result := ListOwner.GetComponentFromReferences(pID);
end;
end;
end;
function GetArchCornerByPointWithJoined(ANetList: TList; p: PDoublePoint): TSCSComponent;
var
i, j: Integer;
Net: TNet;
ArchObj: TSCSComponent;
Joined: TSCSComponent;
pt: PDoublePoint;
begin
Result := nil;
for i := 0 to ANetList.Count - 1 do
begin
Net := TNet(ANetList[i]);
pt := Net.GetPointByNear(p^);
ArchObj := nil;
if pt <> nil then
ArchObj := GetArchCornerByPoint(Net, pt);
if ArchObj <> nil then
for j := 0 to ArchObj.JoinedComponents.Count - 1 do
begin
Joined := ArchObj.JoinedComponents[j];
if Joined.IsLine = ArchObj.IsLine then
begin
Result := ArchObj;
Break; //// BREAK ////
end;
end;
if Result <> nil then
Break; //// BREAK ////
end;
end;
function GetArchContainerByCADObj(ACADObj: TObject): TSCSCatalog;
var
SCSList: TSCSList;
begin
Result := nil;
SCSList := GetSCSListByCADObj(ACADObj);
if SCSList <> nil then
Result := DefineArchContainer(SCSList);
end;
function GetArchObjByCADObj(ACADObj: TObject; AArchContainer: TSCSCatalog=nil): TSCSComponent;
var
ComponId: Integer;
ArchContainer: TSCSCatalog;
//SCSList: TSCSList;
begin
Result := nil;
ComponId := 0;
if ACADObj <> nil then
begin
if ACADObj is TNet then
ComponId := TNet(ACADObj).FComponID
else if ACADObj is TNetPath then
ComponId := TNetPath(ACADObj).FComponID
else if ACADObj is TNetDoor then
ComponId := TNetDoor(ACADObj).FComponID;
//Tolik 15/06/2018 --
//if ComponId <> 0 then
//
begin
//SCSList := GetSCSListByCADObj(ACADObj);
//if SCSList <> nil then
// TF_Main(SCSList.ActiveForm).SelectComponByIDInTree(ComponId);
ArchContainer := AArchContainer;
if ArchContainer = nil then
ArchContainer := GetArchContainerByCADObj(ACADObj);
if ArchContainer <> nil then
Result := ArchContainer.GetComponentFromReferences(ComponId);
end;
end;
end;
function GetArchObjsByCADObjs(ACADObjs: TList): TSCSComponents;
var
i: Integer;
ArchObj: TSCSComponent;
begin
Result := TSCSComponents.Create(false);
for i := 0 to ACADObjs.Count - 1 do
begin
ArchObj := GetArchObjByCADObj(TObject(ACADObjs[i]));
Result.Add(ArchObj);
end;
end;
function GetArchObjPropShortName(const AName, ASysName: string): String;
begin
Result := AName;
if (AName = pnBasementThickness) or (AName = pnPlinthThickness) then
Result := cArchParams_Msg09;
end;
function GetArchObjPropVal(AArchObj: TSCSComponent; const APropSN: String): PProperty;
procedure GetDefaultProp(const AProp, ADefProp: String);
begin
if (Result <> nil) and (Result^.SysName = AProp) then
if IsEmptyVal(Result^.Value) then
Result := AArchObj.GetPropertyBySysName(ADefProp);
end;
begin
Result := AArchObj.GetPropertyBySysName(APropSN);
// òîëùèíà öîêîëÿ îò òîëùèíû ôóíäàìåíòà
GetDefaultProp(pnPlinthThickness, pnBasementThickness);
// òîëùèíà öîêîëÿ îò òîëùèíû ñåãìåíòà
GetDefaultProp(pnPlinthThickness, pnThickness);
// òîëùèíà ôóíäàìåíòà îò òîëùèíû ñåãìåíòà
GetDefaultProp(pnBasementThickness, pnThickness);
//if Result <> nil then
// if Result.IDDataType = dtFloat then
// Result.
end;
function GetArchSegByPtWithJoined(ANetList: TList; p1, p2: PDoublePoint): TSCSComponents;
var
i: Integer;
Net: TNet;
ArchObj: TSCSComponent;
path: TNetPath;
begin
Result := TSCSComponents.Create(false); //23.09.2011 Result := nil;
for i := 0 to ANetList.Count - 1 do
begin
Net := TNet(ANetList[i]);
path := Net.GetPathByNearPoints(p1, p2);
ArchObj := nil;
if path <> nil then
begin
ArchObj := GetArchObjByCADObj(path);
if (ArchObj = nil) and (path.Opath <> nil) then
ArchObj := GetArchObjByCADObj(path.Opath);
end;
if ArchObj <> nil then
if ArchObj.JoinedComponents.Count > 0 then
begin
//23.09.2011 Result := ArchObj;
//23.09.2011 Break; //// BREAK ////
Result.Add(ArchObj);
end;
end;
end;
function GetArchSegTypeForFrame(AIsLine: Integer): Integer;
begin
Result := ctNone;
case AIsLine of
ctArhRoom, ctArhBrickWall:
Result := ctArhWall;
ctArhRoofSeg:
Result := ctArhRoofHip;
end;
end;
function GetArchWallCornersHeights(AArchWall: TSCSComponent; var ARes1,ARes2: Double; ACorners: TSCSComponents=nil): Boolean;
var
h: Double;
begin
Result := false;
if GetArchWallCornersProps(AArchWall, pnHeight, ARes1,ARes2) then
begin
h := AArchWall.GetPropertyValueAsFloat(pnHeight);
ARes1 := FloatNoZero(ARes1, h);
ARes2 := FloatNoZero(ARes2, h);
Result := true;
end;
end;
function GetArchWallCornersProps(AArchWall: TSCSComponent; const APropSN: String; var ARes1,ARes2: Double;
ACorners: TSCSComponents=nil): Boolean;
var
Corners: TSCSComponents;
begin
Result := false;
ARes1 := 0;
ARes2 := 0;
Corners := ACorners;
if Corners = nil then
Corners := GetArchCornersForWall(AArchWall);
if Corners <> nil then
begin
if Corners.Count = 2 then
begin
ARes1 := Corners[0].GetPropertyValueAsFloat(APropSN);
ARes2 := Corners[1].GetPropertyValueAsFloat(APropSN);
Result := true;
end;
if ACorners = nil then
Corners.Free;
end;
end;
// Âåðíåò ñòåíû äëÿ êîìïîíåíòà "ÓÃÎË ÑÒÅÍÛ"
function GetArchWallsForCorner(ACornerObject: TSCSComponent; ANet: TNet=nil): TSCSComponents;
var
ArchTop: TSCSComponent;
ArchWall: TSCSComponent;
Net: TNet;
PointPathList: Tlist;
i: Integer;
begin
Result := nil;
if IsArchCornerComponByIsLine(ACornerObject.IsLine) then //19.05.2011 if ACornerObject.IsLine = ctArhWallCorner then
begin
ArchTop := ACornerObject.GetTopComponent;
if ArchTop <> nil then
begin
PointPathList := GetPathListForArchCorner(ACornerObject, ANet);
if PointPathList <> nil then
begin
Result := TSCSComponents.Create(false);
for i := 0 to PointPathList.Count - 1 do
begin
ArchWall := ArchTop.GetComponentFromReferences(TNetPath(PointPathList[i]).FComponID);
if ArchWall <> nil then
Result.Add(ArchWall);
end;
PointPathList.Free;
end;
end;
end;
end;
function GetArchObjDefaultParams(AObjectType: Integer): TComponent;
begin
// Ïîëó÷àåì îáúåêò èç áëîáà ïî òèïó isline
Result := F_ProjMan.GSCSBase.CurrProject.CreateObjFromObjectsBlob(GetArchInfoClassByIsLine(AObjectType), tiArchDefObjs, AObjectType, 0);
end;
function GetInnerOuterNets(ANet: TNet; AArchObj: TSCSComponent; var AOuterNet: TNet; AInnerNets: TList;
AInnerNetsSquaes: TStringList=nil): Boolean;
var
ArchObj: TSCSComponent;
OutPoints, InnPoints: TDoublePointArr;
NetOutPoints, NetInnPoints: TDoublePointArr;
Figure: TFigure;
Net: TNet;
NetSquare: Double;
MinPerimetr, NetPerimetr: Double;
i: Integer;
CanMergeNets: Boolean;
IsContureWithHeights: Boolean;
isroof: boolean;
begin
Result := false;
GetPathsConturePoints(ANet.Paths, @OutPoints, @InnPoints, {nil, nil,} false, nil, nil, nil, nil);
if Length(OutPoints) > 0 then
begin
IsContureWithHeights := false;
// Èùåì êîíòóð â êîòîðîì íàõîäèòñÿ ANet => AOuterNet, è êîòîðûå âíóòðè ANet => AInnerNets
MinPerimetr := 0;
AOuterNet := nil;
AInnerNets.Clear;
if AInnerNetsSquaes <> nil then
begin
AInnerNetsSquaes.Clear;
ArchObj := AArchObj;
if ArchObj = nil then
ArchObj := GetArchObjByCADObj(ANet);
IsContureWithHeights := (ArchObj <> nil) and IsArchSegmentIn3DByIsLine(ArchObj.IsLine);
end;
for i := 0 to TPowercad(ANet.Owner).Figures.Count - 1 do
begin
Figure := TFigure(TPowercad(ANet.Owner).Figures[i]);
if (Figure is TNet) and (Figure <> ANet) then
begin
Net := TNet(Figure);
CanMergeNets := true;
if Assigned(ANet.FOnMergeNetsQuery) then
ANet.FOnMergeNetsQuery(ANet, Net, CanMergeNets);
if CanMergeNets then
begin
GetPathsConturePoints(Net.Paths, @NetOutPoints, @NetInnPoints, {nil, nil,} IsContureWithHeights, nil, nil, nil, nil);
isroof := iffiguraisroof(Net);
// CheckContrureEntry(êóäà âõîäèò, ×òî âõîäèò, True, True);
if CheckContrureEntry(@NetInnPoints, @OutPoints, true, true,isroof) then
begin
NetPerimetr := GetPerimetrFromPolygon(@NetInnPoints);
if (MinPerimetr = 0) or (MinPerimetr > NetPerimetr) then
begin
NetPerimetr := MinPerimetr;
AOuterNet := Net;
end;
end
else
// Åñëè ANet èìååò Net
if CheckContrureEntry(@InnPoints, @NetOutPoints, true, true,isroof) then
begin
AInnerNets.Add(Net);
if AInnerNetsSquaes <> nil then
begin
NetSquare := 0;
if IsContureWithHeights then
NetSquare := GetAreaFromPolygon3D(@NetOutPoints)
else
NetSquare := GetAreaFromPolygon(@NetOutPoints);
NetSquare := NetSquare * sqr((TPowerCad(ANet.Owner).MapScale / 1000));
AInnerNetsSquaes.Add(FloatToStr(NetSquare));
end;
end;
SetLength(NetOutPoints, 0);
SetLength(NetInnPoints, 0);
end;
end;
end;
Result := Assigned(AOuterNet) or (AInnerNets.Count > 0);
end;
SetLength(OutPoints, 0);
SetLength(InnPoints, 0);
end;
function GetNetSquae(ANet: TNet; AArchObj: TSCSComponent): string;
var
ArchObj: TSCSComponent;
OutPoints, InnPoints: TDoublePointArr;
NetOutPoints, NetInnPoints: TDoublePointArr;
Figure: TFigure;
Net: TNet;
NetSquare: Double;
MinPerimetr, NetPerimetr: Double;
i: Integer;
CanMergeNets: Boolean;
IsContureWithHeights: Boolean;
begin
Result := '0';
Net := ANet;
GetPathsConturePoints(Net.Paths, @NetOutPoints, @NetInnPoints, True, nil, nil, nil, nil);
NetSquare := 0;
//if IsContureWithHeights then
NetSquare := GetAreaFromPolygon3D(@NetOutPoints);
//else
//NetSquare := GetAreaFromPolygon(@NetOutPoints);
NetSquare := NetSquare * sqr((TPowerCad(ANet.Owner).MapScale / 1000));
result := FloatToStr(NetSquare);
SetLength(NetOutPoints, 0);
SetLength(NetInnPoints, 0);
end;
function GetCADObjByArchObj(AArchObj: TObject; ACAD: TForm=nil): TObject;
var
ArchObj: TSCSComponent;
ListOwner: TSCSList;
CAD: TForm; //TF_CAD;
ChildObj: TSCSComponent;
ParentObj: TSCSComponent;
CADObj: TObject;
WallPath: TNetPath;
i: Integer;
begin
Result := nil;
ArchObj := nil;
if AArchObj is TSCSComponent then
ArchObj := TSCSComponent(AArchObj);
if ArchObj <> nil then
begin
//ListOwner := ArchObj.GetListOwner;
//if ListOwner = nil then
// ListOwner := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(ArchObj.ListID);
//
//if ListOwner <> nil then
//begin
// CAD := GetListByID(ListOwner.ListID);
//end;
CAD := ACAD;
if CAD = nil then
CAD := GetCADFormBySCSObject(ArchObj);
if CAD <> nil then
begin
//26.04.2011 case ArchObj.IsLine of
// ctArhWall, ctArhWallDivision:
// begin
// Result := GetNetPathByComponID(ArchObj.ID, CAD);
// end;
if IsArchSegmentComponByIsLine(ArchObj.IsLine) then
Result := GetNetPathByComponID(ArchObj.ID, CAD)
else
begin
if IsArchTopComponByIsLine(ArchObj.IsLine) then
begin
//ChildObj := GetChildComponByIsLine(ArchObj, ctArhWall);
//if ChildObj <> nil then
// Result := GetCADObjByArchObj(ChildObj);
Result := GetNetByComponID(ArchObj.ID, CAD);
end
else
if IsArchWallChildComponByIsLine(ArchObj.IsLine) then
begin
ParentObj := ArchObj.GetParentComponent;
if (ParentObj <> nil) and ((ParentObj.isline = ctArhWall) or (ParentObj.isline = ctArhWallDivision)) then
begin
CADObj := GetCADObjByArchObj(ParentObj);
if (CADObj <> nil) and (CADObj is TNetPath) then
begin
Result := TNetPath(CADObj).GetDoorByComponID(ArchObj.ID);
end;
end;
// Åñëè íå íàøëè â ïðåäïîëàãàåìîé ñòåíå, òîãäà ïåðåáèðàåì âñå ñòåíû è ñìîòðèì â êàæäîé
if Result = nil then
Result := GetWallChildByComponID(ArchObj.ID, CAD);
end;
end;
//end;
end;
end;
end;
function GetCADFormByObj(ACADObj: TObject): TForm;
var
Net: TNet;
begin
Result := nil;
Net := GetNetFromCADObj(ACADObj);
if Net <> nil then
Result := TForm(Net.Owner.Owner);
end;
function GetCADFormBySCSObject(ASCSObject: TObject): TForm;
var
SCSList: TSCSList;
begin
Result := nil;
SCSList := nil;
//if ASCSObject is TSCSComponent then
//begin
// SCSList := TSCSComponent(ASCSObject).GetListOwner;
// if SCSList = nil then
// SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TSCSComponent(ASCSObject).ListID);
//end
//else if ASCSObject is TSCSCatalog then
//begin
// SCSList := TSCSCatalog(ASCSObject).GetListOwner;
// if SCSList = nil then
// SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TSCSCatalog(ASCSObject).ListID);
//end;
if ASCSObject is TSCSComponCatalogClass then
begin
SCSList := TSCSComponCatalogClass(ASCSObject).GetListOwner;
if SCSList = nil then
SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TSCSComponCatalogClass(ASCSObject).ListID);
end;
if SCSList <> nil then
Result := GetListByID(SCSList.SCSID);
end;
function GetDoorObjTypeByIsLine(AIsLine: Integer): TDoorObjType;
begin
Result := dotNone;
case AIsLine of
ctArhWindow:
Result := dotWindow;
ctArhDoor:
Result := dotDoor;
ctArhNiche:
Result := dotNiche;
ctArhArc:
Result := dotArc;
ctArhBalcony:
Result := dotBalcony;
end;
end;
function GetNBArchObj(AIsLine: Integer): TSCSComponent;
begin
Result := F_NormBase.GSCSBase.GetComponByIsLine(AIsLine);
end;
function GetNet2DPoint(ANet: TNet; A3DPt: PDoublePoint; APointsID: TList; A2DPoints: PDoublePointArr): PDoublePoint;
var
TempPtID: Integer;
PtIdx: Integer;
begin
Result := nil;
TempPtID := ANet.GetPointID(A3DPt);
if TempPtID <> 0 then
begin
PtIdx := APointsID.IndexOf(Pointer(TempPtID));
if PtIdx <> -1 then
//A3DPt^ := A2DPoints^[PtIdx];
Result := @A2DPoints^[PtIdx]; //Result := @Points[PtIdx];
end;
end;
function GetNetByComponID(AComponID: Integer; ACAD: TForm): TNet;
var
i, j: Integer;
CAD: TF_CAD;
Figure, InFigure: TFigure;
Net: TNet;
begin
Result := nil;
CAD := TF_CAD(ACAD);
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
Figure := TFigure(CAD.PCad.Figures[i]);
if Figure is TNet then
begin
if TNet(Figure).FComponID = AComponID then
Result := TNet(Figure);
end
else if Figure is TFigureGrp then
begin
for j := 0 to TFigureGrp(Figure).InFigures.Count - 1 do
begin
InFigure := TFigure(TFigureGrp(Figure).InFigures[j]);
if InFigure is TNet then
if TNet(InFigure).FComponID = AComponID then
begin
Result := TNet(InFigure);
Break; //// BREAK ////
end;
end;
end;
if Result <> nil then
Break; //// BREAK ////
end;
end;
function GetNetByComponIDFromList(AComponID: Integer; ANetList: TList): TNet;
var
i: Integer;
begin
Result := nil;
for i := 0 to ANetList.Count - 1 do
begin
if TNet(ANetList[i]).FComponID = AComponID then
begin
Result := TNet(ANetList[i]);
Break; //// BREAK ////
end;
end;
end;
function GetNetFromCADObj(ACADObj: TObject): TNet;
begin
Result := nil;
if ACADObj <> nil then
begin
if ACADObj is TNet then
Result := TNet(ACADObj)
else if ACADObj is TNetPath then
Result := TNetPath(ACADObj).Net
else if ACADObj is TNetDoor then
Result := TNetDoor(ACADObj).Net;
end;
end;
function GetNetPathByComponIDFromNet(AComponID: Integer; ANet: TNet): TNetPath;
var
i, j: Integer;
Path: TNetPath;
begin
Result := nil;
for i := 0 to ANet.Paths.Count - 1 do
begin
Path := TNetPath(ANet.Paths[i]);
if (Path.FComponID = AComponID) or (Assigned(Path.Opath) and (Path.Opath.FComponID = AComponID)) then
begin
Result := Path;
Break; //// BREAK ////
end;
end;
end;
function GetNetPathByComponID(AComponID: Integer; ACAD: TForm): TNetPath;
var
i, j: Integer;
CAD: TF_CAD;
Figure, InFigure: TFigure;
Net: TNet;
begin
Result := nil;
CAD := TF_CAD(ACAD);
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
Figure := TFigure(CAD.PCad.Figures[i]);
if Figure is TNet then
begin
Result := GetNetPathByComponIDFromNet(AComponID, TNet(Figure));
end
else if Figure is TFigureGrp then
begin
for j := 0 to TFigureGrp(Figure).InFigures.Count - 1 do
begin
InFigure := TFigure(TFigureGrp(Figure).InFigures[j]);
if InFigure is TNet then
begin
Result := GetNetPathByComponIDFromNet(AComponID, TNet(InFigure));
if Result <> nil then
Break; //// BREAK ////
end;
end;
end;
if Result <> nil then
Break; //// BREAK ////
end;
end;
function GetNetPathByLowerHeight(AArchObj: TSCSComponent; ANet: TNet): TNetPath;
var
i: integer;
ChildObj: TSCSComponent;
LowerH, h1, h2: Double;
Path: TNetPath;
begin
Result := nil;
LowerH := 0;
for i := 0 to ANet.Paths.Count - 1 do
begin
Path := TNetPath(ANet.Paths[i]);
h1 := Path.GetHeightOfPt(Path.p1);
h2 := Path.GetHeightOfPt(Path.p2);
if h1 = h2 then
if Not Assigned(Result) or (h1 < LowerH) then
begin
Result := Path;
LowerH := h1;
end;
end;
end;
function GetNetPathByProp(AArchObj: TSCSComponent; ANet: TNet; const APropSN, APropVal: String): TNetPath;
var
i: integer;
ChildObj: TSCSComponent;
Prop: PProperty;
begin
Result := nil;
for i := 0 to AArchObj.ChildReferences.Count - 1 do
begin
ChildObj := AArchObj.ChildReferences[i];
if IsArchSegmentComponByIsLine(ChildObj.IsLine) then
begin
Prop := ChildObj.GetPropertyBySysName(APropSN);
if (Prop <> nil) and (Prop^.Value = APropVal) then
begin
Result := GetNetPathByComponIDFromNet(ChildObj.ID, ANet);
if Result <> nil then
Break; //// BREAK ////
end;
end;
end;
end;
function GetNetPathInnerLen(APath: TNetPath): Double;
begin
Result := 0;
//APath.
end;
procedure GetNetRegionPathPoints(ANet: TNet; ARoomObj: TSCSComponent; var AResult: TDoublePointArr);
var
WallPathList: TList;
begin;
SetLength(AResult, 0);
WallPathList := GetNetWallPathList(ANet, ARoomObj);
if WallPathList <> nil then
begin
GetPathsPoints(WallPathList, AResult);
WallPathList.Free;
end;
end;
function GetNetSelPathsAngleInCAD(ANet: TNet; AArchObj: TSCSComponent): Double;
var
CAD: TF_CAD;
Paths: TList;
i, j: Integer;
Net: TNet;
Path: TNetPath;
Path1, Path2: TNetPath;
ptCommon, pt1, pt2: PDoublePoint;
ptCommon2D, pt12D, pt22D: PDoublePoint;
Points: TDoublePointArr;
PointsID: TList;
Angle: Double;
//Msg: String;
begin
Result := -1;
CAD := TF_CAD(TPowerCad(ANet.Owner).Owner);
if (CAD.PCad.Selection.Count > 0) and (CAD.PCad.Selection.IndexOf(ANet) <> -1) then
begin
Paths := TList.Create;
if ANet.FSelection.Count = 2 then
Paths.Assign(ANet.FSelection)
else
begin
for i := 0 to CAD.PCad.Selection.Count - 1 do
begin
if TObject(CAD.PCad.Selection[i]) is TNet then
begin
Net := TNet(CAD.PCad.Selection[i]);
if Net.FSelection.Count > 0 then
Paths.Assign(Net.FSelection, laOr);
end;
end;
end;
if Paths.Count = 2 then
begin
Path1 := TNetPath(Paths[0]);
Path2 := TNetPath(Paths[1]);
// Åñëè ñåãìåíòû ñ ðàçíûõ TNet
if Path1.Net <> Path2.Net then
begin
// íà îäíîì èç íèõ èùåì ñåãìåíò ïî òàêèì êîîðäèíàòàìäàáû áûëà âîçìîæíîñòü ñïðîåöèðîâàòü â 2D
Path := Path1.Net.GetPathByNearPoints(Path2.p1, Path2.p2, 1/50);
if Path <> nil then
Path2 := Path;
end;
ptCommon2D := nil;
pt12D := nil;
pt22D := nil;
// Åñëè âñåæå ñåãìåíòû ñ ðàçíûõ TNet
if Path1.Net <> Path2.Net then
begin
if EQDP(Path1.p1^, Path2.p1^) then
begin
ptCommon2D := Path1.p1;
pt12D := Path1.p2;
pt22D := Path2.p2;
end
else if EQDP(Path1.p1^, Path2.p2^) then
begin
ptCommon2D := Path1.p1;
pt12D := Path1.p2;
pt22D := Path2.p1;
end
else if EQDP(Path1.p2^, Path2.p2^) then
begin
ptCommon2D := Path1.p2;
pt12D := Path1.p1;
pt22D := Path2.p1;
end
else if EQDP(Path1.p2^, Path2.p1^) then
begin
ptCommon2D := Path1.p2;
pt12D := Path1.p1;
pt22D := Path2.p2;
end;
end
else
begin
ptCommon := Path1.GetConnectedPoint(Path2);
if ptCommon <> nil then
begin
pt1 := nil;
pt2 := nil;
if Path1.p1 = ptCommon then
pt1 := Path1.p2
else
pt1 := Path1.p1;
if Path2.p1 = ptCommon then
pt2 := Path2.p2
else
pt2 := Path2.p1;
// ïðîåöèðóåì â 2D íàõ...
PointsID := TList.Create;
Points := RotateNetTo2D(ANet, PointsID, false);
if Length(Points) > 3 then
begin
ptCommon2D := GetNet2DPoint(ANet, ptCommon, PointsID, @Points);
pt12D := GetNet2DPoint(ANet, pt1, PointsID, @Points);
pt22D := GetNet2DPoint(ANet, pt2, PointsID, @Points);
end;
PointsID.Free;
end;
end;
if (ptCommon2D <> nil) and (pt12D <> nil) and (pt22D <> nil) then
begin
Angle := Abs(RadToDeg(GetRadOf2Lines(pt12D^, ptCommon2D^, pt22D^)));
if Angle > 180 then
Angle := 360 - Angle;
Result := Angle;
end;
SetLength(Points, 0);
end;
Paths.Free;
end;
{if ANet.FSelection.Count = 2 then
begin
//Msg := '';
// Åñëè ðåáðà ñîåäèíåíû
Path1 := TNetPath(ANet.FSelection[0]);
Path2 := TNetPath(ANet.FSelection[1]);
ptCommon := Path1.GetConnectedPoint(Path2);
if ptCommon <> nil then
begin
pt1 := nil;
pt2 := nil;
if Path1.p1 = ptCommon then
pt1 := Path1.p2
else
pt1 := Path1.p1;
if Path2.p1 = ptCommon then
pt2 := Path2.p2
else
pt2 := Path2.p1;
// ïðîåöèðóåì â 2D íàõ...
PointsID := TList.Create;
Points := RotateNetTo2D(ANet, PointsID, false);
if Length(Points) > 3 then
begin
ptCommon2D := GetNet2DPoint(ANet, ptCommon, PointsID, @Points);
pt12D := GetNet2DPoint(ANet, pt1, PointsID, @Points);
pt22D := GetNet2DPoint(ANet, pt2, PointsID, @Points);
if (ptCommon2D <> nil) and (pt12D <> nil) and (pt22D <> nil) then
begin
Angle := Abs(RadToDeg(GetRadOf2Lines(pt12D^, ptCommon2D^, pt22D^)));
if Angle > 180 then
Angle := 360 - Angle;
//Msg := 'Óãîë â ïðîñòðàíñòâå ' + FloatToStr(Round2(Angle))+' ãðàä';
Result := Angle;
end;
end;
SetLength(Points, 0);
PointsID.Free;
//TF_CAD(TPowerCad(ANet.Owner).Owner).sbView.Panels[2].Text := Msg;
end;
end;}
end;
function GetNetWallPathList(ANet: TNet; ARoomObj: TSCSComponent): TList;
var
RoomObj: TSCSComponent;
WallObj: TSCSComponent;
WallPath: TNetPath;
i: Integer;
begin;
Result := nil;
RoomObj := GetRoomObjByNet(ANet, ARoomObj);
if RoomObj <> nil then
begin
Result := TList.Create;
for i := 0 to RoomObj.ChildReferences.Count - 1 do
begin
WallObj := RoomObj.ChildReferences[i];
if IsArchFrameSegmentComponByIsLine(WallObj.IsLine) then //26.04.2011 if WallObj.IsLine = ctArhWall then
begin
WallPath := GetNetPathByComponIDFromNet(WallObj.ID, ANet); //GetNetPathByComponID(WallObj.ID, ACAD);
if WallPath <> nil then
Result.Add(WallPath);
end;
end;
end;
end;
function GetParallelPointDirectionKoeff(aLineP1, aLineP2, aPoint: TDoublePoint): Integer;
var
p1, p2: TDoublePoint;
DistPlus, DistMinus: Double;
begin
Result := 1;
GetParallelPoints(aLineP1, aLineP2, p1, p2, 100);
DistPlus := GetDistToLine(p1, p2, aPoint);
GetParallelPoints(aLineP1, aLineP2, p1, p2, -100);
DistMinus := GetDistToLine(p1, p2, aPoint);
if DistMinus < DistPlus then
Result := -1;
end;
function GetPointByArchCorner(AArchCorner: TSCSComponent): PDoublePoint;
var
TopObj: TSCSComponent;
NetObj: TNet;
begin
Result := nil;
TopObj := AArchCorner.GetTopComponent;
NetObj := TNet(GetCADObjByArchObj(TopObj));
if NetObj <> nil then
Result := NetObj.GetPointByID(AArchCorner.ID);
end;
function GetWallArchChildsFromIntersectWall(AWall: TSCSComponent; AWallPath: TNetPath; ACADWallChilds: TList): TSCSComponents;
var
CADObj: TObject;
WallPath: TNetPath;
i: Integer;
WallCADChildsIntersact: TList;
WallChild: TNetDoor;
ArchContainer: TSCSCatalog;
WallArchChild: TSCSComponent;
begin
Result := TSCSComponents.Create(false);
WallPath := AWallPath;
if WallPath = nil then
begin
CADObj := GetCADObjByArchObj(AWAll);
if CADObj is TNetPath then
WallPath := TNetPath(CADObj);
end;
if WallPath <> nil then
begin
// Îêíà, äâåðè/.. ñ ÊÀÄà
WallCADChildsIntersact := GetWallCADChildsFromIntersectWall(WallPath, ACADWallChilds, [dotDoor, dotWindow, dotArc]);
if WallCADChildsIntersact.Count > 0 then
begin
ArchContainer := GetArchContainerByCADObj(WallPath);
if ArchContainer <> nil then
begin
for i := 0 to WallCADChildsIntersact.Count - 1 do
begin
WallChild := TNetDoor(WallCADChildsIntersact[i]);
WallArchChild := GetArchObjByCADObj(WallChild, ArchContainer);
if WallArchChild <> nil then
Result.Add(WallArchChild);
end;
end;
end;
FreeAndNil(WallCADChildsIntersact);
end;
end;
function GetWallCADChildsFromIntersectWall(AWallPath: TNetPath; ACADWallChilds: TList; AFilter: TDoorObjTypes): TList;
var
i: Integer;
CAD: TF_CAD;
CADWallChilds: TList;
WallChild: TNetDoor;
WallConture: TDoublePointArr;
begin
Result := TList.Create;
CADWallChilds := ACADWallChilds;
if ACADWallChilds = nil then
begin
CAD := TF_CAD(TPowerCad(AWallPath.Net.Owner).Owner);
CADWallChilds := GetAllWallChildsFromCAD(CAD, []);
end;
if CADWallChilds.Count > 0 then
begin
AWallPath.DefineDoorsOwner;
WallConture := AWallPath.GetConturePolygon;
// Ïåðåáèðàåì âñå îáúåêòû è ñìîòðèì ïîïàäàþò ëè îíè â ñòåíó ïî êîîðäèíàòàì
for i := 0 to CADWallChilds.Count - 1 do
begin
WallChild := TNetDoor(CADWallChilds[i]);
if WallChild.FPath <> AWallPath then
if (AFilter = []) or (WallChild.DoorObjType in AFilter) then
if IsPtInPolygon(WallChild.p1, WallConture) and IsPtInPolygon(WallChild.p2, WallConture) then
Result.Add(WallChild);
end;
end;
if (CADWallChilds <> nil) and (ACADWallChilds = nil) then
begin
CADWallChilds.Free;
end;
end;
function GetWallChildByComponID(AComponID: Integer; ACAD: TForm): TNetDoor;
var
i, j: Integer;
CAD: TF_CAD;
FigureI, InFigure: TFigure;
Net: TNet;
function GetWallChildFromNet(ANet: TNet): TNetDoor;
var
NetPath: TNetPath;
WallChild: TNetDoor;
i: Integer;
begin
Result := nil;
for i := 0 to ANet.Paths.Count - 1 do
begin
NetPath := TNetPath(ANet.Paths[i]);
WallChild := NetPath.GetDoorByComponID(AComponID);
if WallChild <> nil then
begin
Result := WallChild;
Break; //// BREAK ////
end;
end;
end;
begin
Result := nil;
CAD := TF_CAD(ACAD);
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
FigureI := TFigure(CAD.PCad.Figures[i]);
if FigureI is TNet then
begin
Result := GetWallChildFromNet(TNet(FigureI));
end
else if FigureI is TFigureGrp then
begin
for j := 0 to TFigureGrp(FigureI).InFigures.Count - 1 do
begin
InFigure := TFigure(TFigureGrp(FigureI).InFigures[j]);
if InFigure is TNet then
begin
Result := GetWallChildFromNet(TNet(InFigure));
if Result <> nil then
Break; //// BREAK ////
end;
end;
end;
if Result <> nil then
Break; //// BREAK ////
end;
end;
function GetWallChildsWithIntersect(AWall: TSCSComponent; AWallPath: TNetPath; ACADWallChilds: TList): TSCSComponents;
var
WallChildsIntersect: TSCSComponents;
begin
Result := TSCSComponents.Create(false);
Result.Assign(AWall.ChildComplects);
WallChildsIntersect := GetWallArchChildsFromIntersectWall(AWall, AWallPath, ACADWallChilds);
Result.AddItems(WallChildsIntersect);
FreeAndNil(WallChildsIntersect);
end;
function GetWallNicheArea(AWallObj, ANicheObj: TSCSComponent; ATrgObjType: Integer; ALoadNicheProps: Boolean=true): Double;
var
IsValidObjType: Boolean;
PCoordZ: Double;
PHeight: Double;
PWidth: Double;
PDepth: Double;
begin
Result := 0;
if AWallObj = ANicheObj.Parent then
begin
PCoordZ := ANicheObj.GetPropertyValueAsFloat(pnCoordZ);
PHeight := ANicheObj.GetPropertyValueAsFloat(pnHeight);
PDepth := ANicheObj.GetPropertyValueAsFloat(pnDepth);
case ATrgObjType of
ctArhWall, ctArhWallDivision:
begin
Result := (2 * PHeight * PDepth);
// ïîäãðóæàåì øèðèíó íèøè
if ALoadNicheProps then
LoadArchObjPropsFromCAD(ANicheObj);
PWidth := ANicheObj.GetPropertyValueAsFloat(pnWidth);
// Åñëè ïîäúåì âûøå ïîëà, òî ó÷èòûâàåì
if PCoordZ > 0 then
Result := Result + PDepth * PWidth;
// åñëè ïîòîëîê íèøè íèæå âûñîòû ñòåíû, òî ïëîùàäü ýòîãî ïîòîëêà èäåò íà ñòåíó
if (PCoordZ + PHeight) < AWallObj.GetPropertyValueAsFloat(pnHeight) then
Result := Result + PDepth * PWidth;
end;
ctArhFloor, ctArhCeiling:
begin
IsValidObjType := false;
case ATrgObjType of
ctArhFloor:
if PCoordZ = 0 then
IsValidObjType := true;
ctArhCeiling:
if CmpFloatByCP(AWallObj.GetPropertyValueAsFloat(pnHeight), (PCoordZ + PHeight)) then
IsValidObjType := true;
end;
if IsValidObjType then
begin
// ïîäãðóæàåì øèðèíó íèøè
if ALoadNicheProps then
LoadArchObjPropsFromCAD(ANicheObj);
Result := PDepth * ANicheObj.GetPropertyValueAsFloat(pnWidth);
end;
end;
end;
end;
end;
function GetPathByPoint(ACAD: TForm; x, y: Double): TNetPath;
var
i, j: Integer;
CAD: TF_CAD;
Figure: TFigure;
Net: TNet;
Path: TNetPath;
begin
Result := nil;
CAD := TF_CAD(ACAD);
//  îáðàòíîì ïîðÿäêå ñ ó÷åòîì âåðõíåãî/íèæíåãî ïëàíà
for i := CAD.PCad.Figures.Count - 1 downto 0 do
begin
Figure := TFigure(CAD.PCad.Figures[i]);
if Figure is TNet then
begin
Result := TNet(Figure).GetPathOfPoint(x, y);
if Result <> nil then
Break; //// BREAK ////
end;
end;
end;
function GetPathListForArchCorner(ACornerObject: TSCSComponent; ANet:TNet=nil): TList;
var
ArchTop: TSCSComponent;
Net: TNet;
begin
Result := nil;
if IsArchCornerComponByIsLine(ACornerObject.IsLine) then //19.05.2011 if ACornerObject.IsLine = ctArhWallCorner then
begin
ArchTop := ACornerObject.GetTopComponent;
if ArchTop <> nil then
begin
Net := ANet;
if Net = nil then
Net := TNet(GetCADObjByArchObj(ArchTop));
if (Net <> nil) and (Net is TNet) then
begin
Result := TNet(Net).GetPathListByPointID(ACornerObject.ID);
end;
end;
end;
end;
function GetPathListForPointIn(x,y: Double): TList;
begin
Result := nil;
end;
procedure GetPathsPoints(ANetPaths: TList; var AResult: TDoublePointArr);
var
i: Integer;
Path: TNetPath;
PointCount: Integer;
begin
if (ANetPaths <> nil) and (ANetPaths.Count > 0) then
begin
SetLength(AResult, ANetPaths.Count * 2);
PointCount := 0;
for i := 0 to ANetPaths.Count - 1 do
begin
Path := TNetPath(ANetPaths[i]);
PointCount := PointCount + 2;
//SetLength(AResult, PointCount);
AResult[PointCount-2] := Path.p1^;
AResult[PointCount-1] := Path.p2^;
end;
end
else
SetLength(AResult, 0);
end;
{
procedure GetPathsConturePoints(ANetPaths: TList; AResultOuter, AResultInner: Pointer; AOutPaths, AInnPaths: TList);
var
ConturePoints1: TDoublePointArr;
ContureLen1: Double;
ConturePoints2: TDoublePointArr;
ContureLen2: Double;
ConturePointsP: TDoublePointArr;
ConturePaths: TList;
ContureLenP: Double;
PCad: TPowerCad;
Area1, Area2, AreaP: Double;
function GetPathPointByCoordType(APath: TNetPath; ACoordType: Integer): TDoublePoint;
begin
Result.x := 0;
Result.y := 0;
case ACoordType of
crtL1:
Result := APath.el1;
crtL2:
Result := APath.el2;
crtR1:
Result := APath.er1;
crtR2:
Result := APath.er2;
crtP1:
Result := APath.p1^;
crtP2:
Result := APath.p2^;
end;
end;
procedure AddPointToArray(APoint: TDoublePoint; var AArray: TDoublePointArr);
begin
SetLength(AArray, Length(AArray)+1);
AArray[Length(AArray)-1] := APoint;
end;
// òî÷êè ëåæàùèå íà ñàìîì ñåãìåíòå (äëÿ òèïà àðêà)
// ABeginPoint - íà÷àëüíàÿ òî÷êà, äîáàâëåíà ïåðåä âíóòðåííèìè
// AEndPoint - êîí÷åíàÿ òî÷êè êîòîðàÿ áóäåò äîáàâëåíà ïîñëå âíóòðåííèõ
procedure GetPathPoints(APatch: TNetPath; var AConturePoints: TDoublePointArr;
ABeginPoint, AEndPoint: TDoublePoint; AEndPointCoordType: Integer);
var
Fpoints: T2DPointArray;
Radius: Double;
a1,a2: Double;
Cnt: Integer;
i, idx: Integer;
p1, p2: TDoublePoint;
FPointsInOrder: Boolean; // Íîâûå òî÷êè äîáàâëÿòü â ïîðÿäêå êîòîðîì ïðèøëè, èëè îáðàòíîì
OldDxfMode: Boolean;
begin
if APatch.IsArc then
begin
p1 := DoublePoint(0,0,0);
p2 := DoublePoint(0,0,0);
if (AEndPointCoordType = crtL1) or (AEndPointCoordType = crtL2) then
begin
p1 := APatch.l1;
p2 := APatch.l2;
end
else if (AEndPointCoordType = crtR1) or (AEndPointCoordType = crtR2) then
begin
p1 := APatch.r1;
p2 := APatch.r2;
end;
Radius := GetLineLenght(p1, APatch.ArcCenter);
a1 := GetRadOfLine(APatch.ArcCenter, p1);
a2 := GetRadOfLine(APatch.ArcCenter, p2);
if Not APatch.Inverted then
ExchangeDouble(a1, a2);
OldDxfMode := DxfMode; // ïîâûøàåì òî÷íîñòü - êîëè÷åñòâî òî÷åê äëÿ äóãè
DxfMode := True;
try
BezierArcPoints(FPoints, APatch.ArcCenter.x, APatch.ArcCenter.y, Radius, a1, a2);
finally
DxfMode := OldDxfMode;
end;
Cnt := Length(FPoints);
if Cnt > 2 then
begin
FPointsInOrder := EQDP(ABeginPoint, DoublePoint(FPoints[0].x, FPoints[0].y));
for i := 1 to cnt - 2 do
begin
if FPointsInOrder then
idx := i
else
idx := cnt - i - 1;
AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y), AConturePoints);
end;
end;
end;
end;
function GetConnectedPathByCoordType(APath: TNetPath; APathList: TList; ACoordType: Integer; AConnCoordType: PInteger): TNetPath;
var
PathPoint: TDoublePoint;
i: Integer;
SPath: TNetPath;
ConnCoordType: Integer;
begin
Result := nil;
PathPoint := GetPathPointByCoordType(APath, ACoordType);
for i := 0 to APathList.Count - 1 do
begin
SPath := TNetPath(APathList[i]);
if SPath <> APath then
if APath.Connected(SPath) then
begin
ConnCoordType := -1;
if ACoordType in [crtL1, crtL2, crtR1, crtR2] then
begin
if CmpPoints(SPath.el1, PathPoint) then
ConnCoordType := crtL1
else if CmpPoints(SPath.el2, PathPoint) then
ConnCoordType := crtL2
else if CmpPoints(SPath.er1, PathPoint) then
ConnCoordType := crtR1
else if CmpPoints(SPath.er2, PathPoint) then
ConnCoordType := crtR2;
end
else
if ACoordType in [crtP1, crtP2] then
begin
if CmpPoints(SPath.p1^, PathPoint) then
ConnCoordType := crtP1
else if CmpPoints(SPath.P2^, PathPoint) then
ConnCoordType := crtP2;
end;
if ConnCoordType <> -1 then
begin
Result := SPath;
if AConnCoordType <> nil then
AConnCoordType^ := ConnCoordType;
Break; //// BREAK ////
end;
end;
end;
end;
procedure DefineContureFromPoint(var AConturePoints: TDoublePointArr; AStartPath: TNetPath; ACoordType: Integer);
var
NetPaths: TList;
CurrPath: TNetPath;
CurrPathCoordType: Integer;
CurrPathPoint: TDoublePoint;
CurrPathRelCoordType: Integer;
CurrPathRelPoint: TDoublePoint;
ConnPathCoordType: Integer;
begin
SetLength(AConturePoints, 0);
//DefineContureStep(AStartPath, ACoordType);
if ConturePaths <> nil then
ConturePaths.Clear;
NetPaths := TList.Create;
NetPaths.Assign(ANetPaths);
CurrPathCoordType := ACoordType;
CurrPathPoint := GetPathPointByCoordType(AStartPath, ACoordType);
CurrPath := AStartPath;
AddPointToArray(CurrPathPoint, AConturePoints);
while CurrPath <> nil do
begin
if ConturePaths <> nil then
ConturePaths.Add(CurrPath);
NetPaths.Remove(CurrPath);
// íàõîäèì âòîðóþ òî÷êó ñåãìåíòà, è äîáàâëÿåì åå â ìàññèâ
CurrPathRelCoordType := GetRelCoordType(CurrPathCoordType);
CurrPathRelPoint := GetPathPointByCoordType(CurrPath, CurrPathRelCoordType);
// Âíóòðåííèå òî÷êè
GetPathPoints(CurrPath, AConturePoints, CurrPathPoint, CurrPathRelPoint, CurrPathRelCoordType);
AddPointToArray(CurrPathRelPoint, AConturePoints);
CurrPath := GetConnectedPathByCoordType(CurrPath, NetPaths, CurrPathRelCoordType, @ConnPathCoordType);
if CurrPath <> nil then
begin
CurrPathCoordType := ConnPathCoordType; //CurrPathRelCoordType;
// Óäàëÿåì ñåãìåíò èç ñïèñêà äëÿ ïîèñêà
// AStartPath - áóäåò óäàëåí ïîñëåäíèì, åñëè êîíòóð çàìêíóòûé - ÷òîáû â êîíöå íà íåãî îïÿòü ïðèøëè
//NetPaths.Remove(CurrPath);
end;
CurrPathPoint := CurrPathRelPoint; //26.10.2010
end;
FreeAndNil(NetPaths);
end;
function IsValidConture(var AConturePoints: TDoublePointArr): Boolean;
begin
Result := false;
if Length(AConturePoints) > 2 then
if CmpPoints(AConturePoints[0], AConturePoints[length(AConturePoints)-1]) then
begin
Result := true;
end;
end;
function GetContureLen(var AConturePoints: TDoublePointArr): Double;
var
i: Integer;
begin
Result := 0;
for i := 1 to Length(AConturePoints) - 1 do
begin
Result := Result + GetLineLenght(AConturePoints[i-1], AConturePoints[i]);
end;
end;
begin
if AResultOuter <> nil then
SetLength(TDoublePointArr(AResultOuter^), 0);
if AResultInner <> nil then
SetLength(TDoublePointArr(AResultInner^), 0);
ConturePaths := nil;
if ANetPaths.Count > 0 then
begin
if Assigned(AOutPaths) or Assigned(AInnPaths) then
ConturePaths := TList.Create;
DefineContureFromPoint(ConturePoints1, TNetPath(ANetPaths[0]), crtL1);
ContureLen1 := 0;
if IsValidConture(ConturePoints1) then
begin
ContureLen1 := GetContureLen(ConturePoints1);
if AResultOuter <> nil then
TDoublePointArr(AResultOuter^) := ConturePoints1;
if AResultInner <> nil then
TDoublePointArr(AResultInner^) := ConturePoints1;
if Assigned(AOutPaths) then
AOutPaths.Assign(ConturePaths);
if Assigned(AInnPaths) then
AInnPaths.Assign(ConturePaths);
end;
DefineContureFromPoint(ConturePoints2, TNetPath(ANetPaths[0]), crtR1);
ContureLen2 := 0;
if IsValidConture(ConturePoints2) then
begin
ContureLen2 := GetContureLen(ConturePoints2);
if (AResultOuter <> nil) and (ContureLen2 > ContureLen1) then
begin
TDoublePointArr(AResultOuter^) := ConturePoints2;
if ConturePaths <> nil then
AOutPaths.Assign(ConturePaths);
end;
if (AResultInner <> nil) and (ContureLen2 < ContureLen1) then
begin
TDoublePointArr(AResultInner^) := ConturePoints2;
if ConturePaths <> nil then
AInnPaths.Assign(ConturePaths);
end;
end;
DefineContureFromPoint(ConturePointsP, TNetPath(ANetPaths[0]), crtP1);
ContureLenP := 0;
if IsValidConture(ConturePointsP) then
begin
ContureLenP := GetContureLen(ConturePointsP);
end;
PCad := TPowerCad(TNetPath(ANetPaths[0]).Net.Owner);
if PCad <> nil then
begin
Area1 := GetAreaFromPolygonM(PCad, ConturePoints1);
Area2 := GetAreaFromPolygonM(PCad, ConturePoints2);
AreaP := GetAreaFromPolygonM(PCad, ConturePointsP);
end;
if ConturePaths <> nil then
FreeAndNil(ConturePaths);
end;
end;}
function GetRoomArea(ANet: TNet; ARoomObj: TSCSComponent): Double;
var
TmpPoints: TDoublePointArr;
//TmpHeights: TDoubleArray;
begin
Result := 0;
if IsArchSegmentIn3DByIsLine(ARoomObj.IsLine) then //09.06.2011 if (ARoomObj.IsLine = ctArhRoofSeg) then
begin
GetRoomInnerConturePoints(ANet, ARoomObj, @TmpPoints, true{, @TmpHeights});
Result := GetAreaFromPolygon3D(@TmpPoints);
end
else
begin
GetRoomInnerConturePoints(ANet, ARoomObj, @TmpPoints, false{, nil});
Result := GetAreaFromPolygon(TmpPoints);
end;
Result := Result * sqr((TPowerCad(ANet.Owner).MapScale / 1000));
// Î÷èùàåì ìàññèâ òî÷åê
SetLength(TmpPoints, 0);
end;
procedure GetRoomInnerConturePoints(ANet: TNet; ARoomObj: TSCSComponent;
AResult: PDoublePointArr; AWithHeights: Boolean{; AResHeights: PDoubleArray});
var
PathList: TList;
begin
// Îïðåäåëÿåì ñïèñîê ñåãìåíòîâ ñòåí
PathList := GetNetWallPathList(ANet, ARoomObj);
if PathList <> nil then
begin
GetPathsConturePoints(PathList, nil, AResult, {nil, AResHeights,} AWithHeights, nil, nil, nil, nil);
PathList.Free;
end;
end;
function GetRoomObjByNet(ANet: TNet; ARoomObj: TSCSComponent): TSCSComponent;
var
ArchContainer: TSCSCatalog;
begin
Result := nil;
if (ARoomObj <> nil) and (ARoomObj.ID = ANet.FComponID) then
Result := ARoomObj
else
begin
ArchContainer := GetArchContainerByCADObj(ANet);
if ArchContainer <> nil then
Result := ArchContainer.GetComponentFromReferences(ANet.FComponID);
end;
end;
function GetRoomNetByPoint(APoint: TDoublePoint; ACAD: TForm): TNet;
var
SCSList: TSCSList;
RoomObj: TSCSComponent;
NetObj: TNet;
begin
Result := nil;
SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(ACAD).FCADListID);
RoomObj := GetRoomObjByPoint(SCSList, APoint, ACAD, @NetObj);
//if RoomObj <> nil then
// Result := GetNetByComponID(RoomObj.ID, ACAD);
if NetObj <> nil then
Result := NetObj;
end;
function GetRoomObjByPoint(AList: TSCSList; APoint: TDoublePoint; ACAD: TForm; ARelNet: Pointer=nil): TSCSComponent;
var
i, j: Integer;
ArchContainer: TSCSCatalog;
RoomObj: TSCSComponent;
RoomNet: TNet;
//WallObj: TSCSComponent;
//WallPath: TNetPath;
PolygonPathPoints: TDoublePointArr;
//PointCount: Integer;
begin
Result := nil;
if ARelNet <> nil then
TObject(ARelNet^) := nil;
ArchContainer := DefineArchContainer(AList);
for i := 0 to ArchContainer.ComponentReferences.Count - 1 do
begin
RoomObj := ArchContainer.ComponentReferences[i];
if IsArchTopComponByIsLine(RoomObj.IsLine) then //if RoomObj.IsLine = ctArhRoom then
begin
RoomNet := GetNetByComponID(RoomObj.ID, ACAD);
//PointCount := 0;
//SetLength(PolygonPathPoints, PointCount);
//WallPath := nil;
//for j := 0 to RoomObj.ChildReferences.Count - 1 do
//begin
// WallObj := RoomObj.ChildReferences[j];
// if WallObj.IsLine = ctArhWall then
// begin
// WallPath := GetNetPathByComponID(WallObj.ID, ACAD);
// if WallPath <> nil then
// begin
// PointCount := PointCount + 2;
// SetLength(PolygonPathPoints, PointCount);
// PolygonPathPoints[PointCount-2] := WallPath.p1^;
// PolygonPathPoints[PointCount-1] := WallPath.p2^;
// end;
// end;
//end;
GetNetRegionPathPoints(RoomNet, RoomObj, PolygonPathPoints);
if IsPtInPolygon(APoint, PolygonPathPoints) or
RoomNet.IsPointIn(APoint.x, APoint.y) //10.04.2012
then
begin
Result := RoomObj;
if ARelNet <> nil then
TObject(ARelNet^) := RoomNet;
Break; //// BREAK ////
end;
end;
end;
end;
function GetSCSComponByCADObj(ACADObj: TObject): TSCSComponent;
var
FigureID: Integer;
Catalog: TSCSCatalog;
begin
Result := nil;
FigureID := 0;
if ACADObj is TOrthoLine then
FigureID := TOrthoLine(ACADObj).ID
else
if ACADObj is TConnectorObject then
FigureID := TConnectorObject(ACADObj).ID;
if FigureID <> 0 then
begin
Catalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(FigureID);
// Tolik -- 05/04/2017 -- åñëè ïðîåêò áèòûé, òî êàòàëîãà ìîæåò è íå áûòü, òàê ÷òî ïðîâåðêà ÍÓÆÍÀ!!!
If Catalog <> nil then
begin
if Catalog.SCSComponents.Count > 0 then
Result := Catalog.SCSComponents[0];
end;
end;
end;
function GetSCSListByCAD(ACAD: TForm): TSCSList;
begin
Result := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(ACAD).FCADListID);
end;
function GetSCSListByCADObj(ACADObj: TObject): TSCSList;
var
Net: TNet;
begin
Result := nil;
Net := GetNetFromCADObj(ACADObj);
if Net <> nil then
Result := GetSCSListByCAD(TF_CAD(Net.Owner.Owner));
end;
function GetTopArchCorners(AArchContainer: TSCSCatalog; AHeight: PDouble=nil): TSCSComponents;
var
i: Integer;
ArchObj: TSCSComponent;
CornerH: Double;
TopH: Double;
begin
Result := TSCSComponents.Create(false);
TopH := 0;
for i := 0 to AArchContainer.ComponentReferences.Count - 1 do
begin
ArchObj := AArchContainer.ComponentReferences[i];
if IsArchCornerComponByIsLine(ArchObj.IsLine) then
begin
CornerH := ArchObj.GetPropertyValueAsFloat(pnHeight);
if CornerH > 0 then
Result.Add(ArchObj);
if CornerH > TopH then
TopH := CornerH;
end;
end;
if AHeight <> nil then
AHeight^ := TopH;
end;
function GetWallByPoint(ACAD: TForm; x, y: Double): TNetPath;
begin
Result := GetPathByPoint(ACAD, x, y);
if Result <> nil then
if Result.WType <> wtWall then
Result := nil;
end;
function GroupRoomNets(ACAD: TForm; aNetList: TList = nil; AShowTest: Boolean=false): TNet;
var
CAD: TF_CAD;
FigureI: TFigure;
Net: TNet;
NetList: TList;
NetPath, TmpNetPath: TNetPath;
NewPath, TestPath: TNetPath;
NewPathAuto: TNetPath;
NewPathsWithElems: TList;
PathElem: TNetDoor;
NewPathElem: TNetDoor;
PathsElems: TList;
AddedElems: TList;
PathsWithPointInfo: TList;
CountBeforeMake: Integer;
i,j,k,l: Integer;
WalPoints: TDoublePointArr;
Polygon: TDoublePointArr;
FComponID: Integer;
ArchContainer: TSCSCatalog;
ArchRoom: TSCSComponent;
Corner1: TSCSComponent;
Corner2: TSCSComponent;
Corner1H, Corner2H: Double;
TmpWall: TSCSComponent;
CanPath: Boolean;
IntersectType: Integer;
p1, p2: PDoublePoint;
h1, h2: PDouble;
PHeight: Double;
NewPathP1, NewPathP2: TDoublePoint;
TmpPt: TDoublePoint;
IsAlignedPt: Boolean;
NearPoints: TList;
NetPaths: TList;
NoAddedPaths: TList;
PathsPassNum: Integer;
procedure AssignPointInfo(ASrcPoint: PDoublePoint; ASrcPath, ADestPath: TNetPath);
var
DestPoint: PDoublePoint;
begin
DestPoint := nil;
if PointNear(ASrcPoint^, ADestPath.p1^) then
DestPoint := ADestPath.p1
else
if PointNear(ASrcPoint^, ADestPath.p2^) then
DestPoint := ADestPath.p2;
if (DestPoint <> nil) and (ADestPath.Net.GetPointID(DestPoint) = 0) then
ADestPath.Net.SetPointID(DestPoint, ASrcPath.Net.GetPointID(ASrcPoint));
end;
function CheckCornerWithHeight(ACorner: TSCSComponent): Boolean;
begin
Result := false;
if (ACorner <> nil) and (ACorner.GetPropertyValueAsFloat(pnHeight)>0) then
Result := true;
end;
function CalcPointHeight(p1, p2, Point: PDoublePoint; p1h, p2h: Double): Double;
var
x, y: Double;
p: TDoublePoint;
begin
Result := 0;
// Êîîðäèíàòó Ó áóäåì ðàññìàòðèâàòü êàê Z
// ÷òîáû íîðìàëèçèðîâàòü Y (òîåñòü äëÿ p1, p2 áûë îäèíàêîâûé), áóäåì ñ÷èòàòü îò íîëÿ, ñ÷èòàÿ îñòàïëüíûå êîîðäèíàòû ïî äëèíàì
x := GetLineLenght(p1^, Point^);
p := LineIntersect(DoublePoint(0, p1h), DoublePoint(GetLineLenght(p1^, p2^), p2h), DoublePoint(x,0), DoublePoint(x,1000));
//x := GetLineLenght(p1^, Point^)+1;
//y := 1;
//PointToLine(DoublePoint(1, p1h+1), DoublePoint(GetLineLenght(p1^, p2^)+1, p2h+1), x, y);
//Result := y;
Result := p.y;
end;
// Èùåò âûñîòó òî÷êè èç ñâÿçàííûõ ñåãìåíòîâ íà èñõîäíûõ TNet
function LoadHeightFromRelated(ANewPath: TNetPath; APt: PDoublePoint; var AHeight: Double): Boolean;
var
i, j: Integer;
Net: TNet;
NetPath: TNetPath;
NetWall: TSCSComponent;
isPt1, IsPt2: Boolean;
h1, h2: Double;
begin
Result := false;
for i := 0 to NetList.Count - 1 do
begin
Net := TNet(NetList[i]);
for j := 0 to Net.Paths.Count - 1 do
begin
// èç ïðèâÿçàíîãî ñåãìåíòà îïðåäåëÿåì âûñîòó
NetPath := TNetPath(Net.Paths[j]);
if ANewPath.FSrcPaths.IndexOf(NetPath) = -1 then
begin
isPt1 := false;
IsPt2 := false;
if PointNear(APt^, NetPath.p1^) then
isPt1 := true
else
if PointNear(APt^, NetPath.p2^) then
isPt2 := true;
if isPt1 or isPt2 then
begin
NetWall := GetArchObjByCADObj(NetPath);
if NetWall <> nil then
begin
if GetArchWallCornersProps(NetWall, pnHeight, h1,h2) then
begin
if isPt1 and (h1 <> 0) then
begin
AHeight := h1;
Result := true;
end
else if isPt2 and (h2 <> 0) then
begin
AHeight := h2;
Result := true;
end;
end;
if Not Result then
begin
AHeight := NetWall.GetPropertyValueAsFloat(pnHeight);
Result := true;
end;
end;
if Result then
Break; //// BREAK ////
end;
end;
end;
if Result then
Break; //// BREAK ////
end;
end;
//30.05.2012 - Ñìåùàåò òî÷êó íîâîãî ñåãìåíòà, ÷òîáû ñåãìåíò áûë ðîâíûì îòíîñèòåëüíî èñõîäíûõ òî÷åê
procedure AlignNewPathPt(aNewPath, aSrcPath: TNetPath; aPt, aStaticPt, aSrcPt, aSrcStaticPt: PDoublePoint);
begin
if EQDP(aPt^, aSrcPt^) and Not EQDP(aStaticPt^, aSrcStaticPt^) then
if GetLineLenght(aStaticPt^, aSrcStaticPt^) <= (aNewPath.Width / 2) then
begin
aPt^.x := aPt^.x + (aStaticPt^.x - aSrcStaticPt^.x);
aPt^.y := aPt^.y + (aStaticPt^.y - aSrcStaticPt^.y);
// Ñäâèãàåì èñõîäíûå òî÷êè
//aSrcPt^.x := aPt^.x;
//aSrcPt^.y := aPt^.y;
//aSrcStaticPt^.x := aSrcStaticPt^.x + (aStaticPt^.x - aSrcStaticPt^.x);
//aSrcStaticPt^.y := aSrcStaticPt^.y + (aStaticPt^.y - aSrcStaticPt^.y);
//aSrcPath.DefineInOutPoints;
//IsAlignedPt := true;
end;
//if Not EQDP(aPt^, aSrcPt^) and EQDP(aStaticPt^, aSrcStaticPt^) then
// if GetLineLenght(aPt^, aSrcPt^) <= (aPath.Width / 2) then
// begin
// aPt^ := aSrcPt^;
// end;
end;
//Tolik 23/12/2021 - -
function CheckisPath(aNet: TNet; aPath: TNetpath): Boolean;
var i: integer;
begin
Result := False;
for i := 0 to aNet.Paths.count - 1 do
begin
Result := (((CompareValue(aPath.p1.x, TNetPath(aNet.Paths[i]).p1.x) = 0) and
(CompareValue(aPath.p1.y, TNetPath(aNet.Paths[i]).p1.y) = 0)) and
((CompareValue(aPath.p2.x, TNetPath(aNet.Paths[i]).p2.x) = 0) and
(CompareValue(aPath.p2.y, TNetPath(aNet.Paths[i]).p2.y) = 0)))
or
(((CompareValue(aPath.p2.x, TNetPath(aNet.Paths[i]).p1.x) = 0) and
(CompareValue(aPath.p2.y, TNetPath(aNet.Paths[i]).p1.y) = 0)) and
((CompareValue(aPath.p1.x, TNetPath(aNet.Paths[i]).p2.x) = 0) and
(CompareValue(aPath.p1.y, TNetPath(aNet.Paths[i]).p2.y) = 0)));
if Result then
exit;
end;
end;
//
begin
CAD := TF_CAD(ACAD);
SetLength(WalPoints, 2);
NetList := TList.Create;
NewPathsWithElems := TList.Create;
PathsElems := TList.Create;
PathsWithPointInfo := TList.Create;
Result := TNet.create(8, mydsNormal, CAD.PCad);
Result.FIsGroup := true;
Result.FCmpPointPrecision := 1;
Result.FAllowDelPathOnMake := false;
//Result.FDisableMergePaths
Result.FAllowAddPathWithSamePoints := false;
GArchEngine.FGroupingMode := true;
//Tolik -- 17/07/2018 --
if aNetList <> nil then
NetList.Assign(aNetList);
//
try
FComponID := 0;
ArchContainer := DefineArchContainer(GetSCSListByCAD(ACAD));
NearPoints := TList.Create;
NetPaths := TList.Create;
NoAddedPaths := TList.Create;
{$if Defined(ES_GRAPH_SC)} // Tolik 17/07/2018 -- îòâÿçàòü îò êîìïîíåíòà, åñëè íå ãðàôìîäóëü
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
FigureI := TFigure(CAD.PCad.Figures[i]);
// Tolik 15/06/2018 --
//if (FigureI is TNet) and (TNet(FigureI).FComponID <> 0) then
if (FigureI is TNet) then
//
begin
Net := TNet(FigureI);
if FComponID = 0 then
FComponID := Net.FComponID;
NetList.Add(Net);
ArchRoom := GetArchObjByCADObj(Net, ArchContainer);
{for j := 0 to Net.Points.Count - 1 do
begin
p1 := Net.Points[j];
NearPoints.Clear;
if Result.GetPoint(p1^.x, p1^.y, NearPoints) = nil then
begin
p2 := Result.AddPoint(p1^);
// Ìàëåíüêèé âèðòóàëüíûé ñåãìåíò
if NearPoints.Count > 0 then
Result.AddPath(PDoublePoint(NearPoints[NearPoints.Count - 1]), p2, true);
end;
end;}
//22.06.2012 - Ïåðâûé ïðîõîä
PathsPassNum := 0;
NetPaths.Assign(Net.Paths);
NoAddedPaths.Clear;
IsAlignedPt := false;
while PathsPassNum < 2 do
begin
//Result.FDisableMergePaths := true; //30.05.2012
for j := 0 to NetPaths.Count - 1 do
begin
NetPath := TNetPath(NetPaths[j]);
NetPath.DefineInOutPoints; //29.05.2012 ÷òîáû îïðåäåëèëñÿ FIsConture è FIsInner, òàê êàê èñõîäíûå ñåãìåíòû èñïîëüçóþòñÿ äëÿ ïðîâåðîê íà 3D
//if (GetLineLength(NetPath.p1^, NetPath.p2^) <= (NetPath.Width / 2)) then
// Continue; //// CONTINUE ////
//NewPath := Result.AddPath(NetPath.p1, NetPath.p2, true);
WalPoints[0] := NetPath.p1^;
WalPoints[1] := NetPath.p2^;
CountBeforeMake := Result.Paths.Count;
NewPath := Result.MakePath(WalPoints, true); //25.01.2011} Result.MakePath(WalPoints, false);
//22.06.2012 Åñëè íà âòîðîì ïðîõîäå íå óäàëîñü äîáàâèòü, èùåì ïðèáëèçèòåëüíûå òî÷êè íà ãðóïïîâîì, è äîáàâëÿåì ïî íèì
if (NewPath = nil) and (PathsPassNum = 1) then
begin
p1 := Result.CheckForPoints(NetPath.p1^);
p2 := Result.CheckForPoints(NetPath.p2^);
if (p1 <> nil) and (p1 <> nil) then
begin
WalPoints[0] := p1^;
WalPoints[1] := p2^;
NewPath := Result.MakePath(WalPoints, true);
if (NewPath = nil) and (p1 <> p2) then
NewPath := Result.AddPath(p1, p2, false);
end;
{p1 := Result.CheckForPoints(NetPath.p1^);
if p1 = nil then
p1 := Result.AddPoint(NetPath.p1^);
p2 := Result.CheckForPoints(NetPath.p2^);
if p2 = nil then
p2 := Result.AddPoint(NetPath.p2^);
if (p1 <> nil) and (p1 <> nil) then
NewPath := Result.AddPath(p1, p2, false);}
end;
if NewPath <> nil then
begin
if EQDP(NewPath.p1^, NewPath.p2^) then
begin
//EmptyProcedure;
Result.Paths.Remove(NewPath);
FreeAndNil(NewPath);
end
else
begin
NewPath.Opath := NetPath;
NewPath.FSrcPaths.Add(NetPath);
NewPath.CopyFrom(NetPath, false);
//30.05.2012 Åñëè îäíà òî÷êà íåìíîãî ñìåùåíà â ðåçóëüòàòå íàõîæäåíèÿ ñóùåñòâóþùåé, òî íîâóþ ñäâèãàåì ÷òîáû ñîáëþäàëàñü îðòîãîíàëüíîñòü
//AlignNewPathPt(NewPath, NetPath, NewPath.p1, NewPath.p2, @WalPoints[0], @WalPoints[1]);
//AlignNewPathPt(NewPath, NetPath, NewPath.p1, NewPath.p2, @WalPoints[1], @WalPoints[0]);
//AlignNewPathPt(NewPath, NetPath, NewPath.p2, NewPath.p1, @WalPoints[0], @WalPoints[1]);
//AlignNewPathPt(NewPath, NetPath, NewPath.p2, NewPath.p1, @WalPoints[1], @WalPoints[0]);
if GArch3DAllowAlignPoint then
begin
AlignNewPathPt(NewPath, NetPath, NewPath.p1,NewPath.p2, NetPath.p1,NetPath.p2);
AlignNewPathPt(NewPath, NetPath, NewPath.p1,NewPath.p2, NetPath.p2,NetPath.p1);
AlignNewPathPt(NewPath, NetPath, NewPath.p2,NewPath.p1, NetPath.p1,NetPath.p2);
AlignNewPathPt(NewPath, NetPath, NewPath.p2,NewPath.p1, NetPath.p2,NetPath.p1);
end;
//20.06.2012 - âûêèäûâàåì ñåãìåíòû ñ íóëåâîé äëèíîé, îò íèõ ïîòîì îäíè òðàáëû
for l := Result.Paths.Count - 1 downto 0 do
begin
NewPathAuto := TNetPath(Result.Paths[l]);
if EQDP(NewPathAuto.p1^, NewPathAuto.p2^) then
begin
//Result.Paths.Remove(NewPathAuto);
//FreeAndNil(NewPathAuto);
end;
end;
try
Result.RefreshPaths(true); //25.01.2011
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
//07.06.2012 Åñëè åñòü ïåðïåíäèêóëÿðíûå òî÷êè, ïðîâåðÿåì íå íóæíî ëè ïåðåâåðíóòü ñåãìåíò
if NetPath.ExistsPerpendPt and NewPath.ExistsPerpendPt then
begin
//TmpPt := MPoint(NewPath.r1, NewPath.l1);
SetLength(Polygon, 4);
Polygon[0] := NetPath.r1;
Polygon[1] := NetPath.r2;
Polygon[2] := NetPath.l2;
Polygon[3] := NetPath.l1;
//if Not NetPath.IsPointIn(TmpPt.x, TmpPt.y, false) then
if Not IsPtInPolygon(NewPath.r1, Polygon, false, true, 0) or Not IsPtInPolygon(NewPath.l1, Polygon, false, true, 0) then
NewPath.InvertPerpendSide(false);
SetLength(Polygon, 0);
end;
//NewPath.FComponID := NetPath.FComponID;
// Îïðåäåëÿåì èíôîðìàöèîííûå ñâîéñòâà ìîä-ïîèíòîâ
AssignPointInfo(NetPath.p1, NetPath, NewPath);
AssignPointInfo(NetPath.p2, NetPath, NewPath);
// Î÷èùàåì ñîáûòèÿ, ÷òîáû íå óäàëèëñÿ èñõîäíûé
//NewPath.FOnAfterDiv := nil;
//NewPath.FOnBeforeDiv := nil;
//NewPath.FOnDelete := nil;
//NewPath.FOnMove := nil;
//NewPath.FOnSelect := nil;
if NetPath.Doors.Count > 0 then
NewPathsWithElems.Add(NewPath);
// Åñëè äîáàâëåíî íåñêîëüêî ñåãìåíòîâ çà îäíî ñîçäàíèå, äîáàâëÿåì ïðèçíàê êîìïîíåíòà
//if Result.Paths.Count > (CountBeforeMake + 1) then
// for l := CountBeforeMake to Result.Paths.Count - 1 do
// begin
// NewPathAuto := TNetPath(Result.Paths[l]);
// //NewPathAuto.FComponID := NewPath.FComponID;
// //NewPathAuto.Opath := NetPath;
// if NetPath.Doors.Count > 0 then
// NewPathsWithElems.Add(NewPathAuto);
// end;
// íà Result.MakePath ÷àñòî ïðîèñõîäèò óäàëåíèå+äîáàâëåíèå
// àâòîìàòîì äîáàâëåííûì óêàçûâàåì èç êàêîãî ñåãìåíòà ïðèøëè
for l := 0 to Result.Paths.Count - 1 do
begin
NewPathAuto := TNetPath(Result.Paths[l]);
if NewPathAuto.Opath = nil then
begin
NewPathAuto.Opath := NetPath;
if NewPathAuto.FSrcPaths.IndexOf(NetPath) = -1 then
NewPathAuto.FSrcPaths.Add(NetPath);
//NewPathAuto.FDivedFrom := ;
if (NetPath.Doors.Count > 0) and (NewPathsWithElems.IndexOf(NewPathAuto)=-1) then
NewPathsWithElems.Add(NewPathAuto);
end;
end;
end;
end
else
begin
// Åñëè ñìåæíûå ñåãìåíòû, òî â ãðóïïîâîì äîëæíû áûòü ñâÿçè ñî âñåìè
//18.02.2011 TmpNetPath := Result.GetPathByPointsIn(NetPath.p1^, NetPath.p2^);
//18.02.2011 if TmpNetPath <> nil then
//18.02.2011 if TmpNetPath.FSrcPaths.IndexOf(NetPath) = -1 then
//18.02.2011 TmpNetPath.FSrcPaths.Add(NetPath);
if PathsPassNum = 0 then
NoAddedPaths.Add(NetPath);
end;
// Îêíà/äâåðè â ñïèñîê íà ñîçäàíèå
for k := 0 to NetPath.Doors.Count - 1 do
begin
PathElem := TNetDoor(NetPath.Doors[k]);
PathElem.FPath := NetPath;
PathsElems.Add(PathElem);
end;
// Åñëè òî÷êè ñ âûñîòàìè, äîáàâëÿåì ñåãìåíò â ñïèñîê äëÿ îïðåäåëåíèÿ âûñîò
{$if Defined(ES_GRAPH_SC)} // Tolik 17/06/2018 - -
Corner1 := ArchRoom.ChildReferences.GetComponenByID(Net.GetPointID(NetPath.p1));
Corner2 := ArchRoom.ChildReferences.GetComponenByID(Net.GetPointID(NetPath.p2));
if CheckCornerWithHeight(Corner1) or CheckCornerWithHeight(Corner2) then
begin
CanPath := true;
// Åñëè ïî òî÷êàì ýòîò ñåãìåíò íå âõîäèò â äðóãîé
for k := PathsWithPointInfo.Count - 1 downto 0 do
begin
TmpNetPath := TNetPath(PathsWithPointInfo[k]);
IntersectType := TmpNetPath.CmpIntersectPath(NetPath);
// TmpNetPath ýêâèâàë. èëè ïîãëàùàåò NetPath
if IntersectType in [citEqual, citAbsorb] then
begin
CanPath := false;
Break; //// BREAK ////
end
else if IntersectType = citEntry then // TmpNetPath âõîäèò â NetPath, òî óäàëÿåì ýòîò TmpNetPath
PathsWithPointInfo.Delete(k);
end;
if CanPath then
PathsWithPointInfo.Add(NetPath);
end;
{$else}
CanPath := true;
// Åñëè ïî òî÷êàì ýòîò ñåãìåíò íå âõîäèò â äðóãîé
for k := PathsWithPointInfo.Count - 1 downto 0 do
begin
TmpNetPath := TNetPath(PathsWithPointInfo[k]);
IntersectType := TmpNetPath.CmpIntersectPath(NetPath);
// TmpNetPath ýêâèâàë. èëè ïîãëàùàåò NetPath
if IntersectType in [citEqual, citAbsorb] then
begin
CanPath := false;
Break; //// BREAK ////
end
else if IntersectType = citEntry then // TmpNetPath âõîäèò â NetPath, òî óäàëÿåì ýòîò TmpNetPath
PathsWithPointInfo.Delete(k);
end;
if CanPath then
PathsWithPointInfo.Add(NetPath);
{$ifend} // Tolik 17/06/2018 - -
end;
if PathsPassNum = 0 then
NetPaths.Assign(NoAddedPaths);
Inc(PathsPassNum);
end;
if IsAlignedPt then
Net.RefreshPaths;
end;
end;
{$else}
for i := 0 to NetList.Count - 1 do
begin
Net := TNet(NetList[i]);
ArchRoom := GetArchObjByCADObj(Net, ArchContainer);
//22.06.2012 - Ïåðâûé ïðîõîä
PathsPassNum := 0;
NetPaths.Assign(Net.Paths);
NoAddedPaths.Clear;
IsAlignedPt := false;
while PathsPassNum < 2 do
begin
for j := 0 to NetPaths.Count - 1 do
begin
NetPath := TNetPath(Net.Paths[j]);
if CheckisPath(Result, NetPath) then
Continue;
// NetPath.DefineInOutPoints; //29.05.2012 ÷òîáû îïðåäåëèëñÿ FIsConture è FIsInner, òàê êàê èñõîäíûå ñåãìåíòû èñïîëüçóþòñÿ äëÿ ïðîâåðîê íà 3D
WalPoints[0] := NetPath.p1^;
WalPoints[1] := NetPath.p2^;
CountBeforeMake := Result.Paths.Count;
NewPath := Result.MakePath(WalPoints, true); //25.01.2011} Result.MakePath(WalPoints, false);
// Tolik 27/08/2018 --
{$if not Defined(ES_GRAPH_SC)}
if NewPath <> nil then
begin
NewPath.FisConture := NetPath.FisConture;
NewPath.p1H := NetPath.p1H;
NewPath.p2H := NetPath.p2H;
end;
{$ifEnd}
//
//22.06.2012 Åñëè íà âòîðîì ïðîõîäå íå óäàëîñü äîáàâèòü, èùåì ïðèáëèçèòåëüíûå òî÷êè íà ãðóïïîâîì, è äîáàâëÿåì ïî íèì
if (NewPath = nil) and (PathsPassNum = 1) then
begin
p1 := Result.CheckForPoints(NetPath.p1^);
p2 := Result.CheckForPoints(NetPath.p2^);
if (p1 <> nil) and (p1 <> nil) then
begin
WalPoints[0] := p1^;
WalPoints[1] := p2^;
NewPath := Result.MakePath(WalPoints, true);
if (NewPath = nil) and (p1 <> p2) then
begin
NewPath := Result.AddPath(p1, p2, false);
// Tolik 27/08/2018 --
{$if not Defined(ES_GRAPH_SC)}
if NewPath <> nil then
begin
NewPath.FisConture := NetPath.FisConture;
NewPath.p1H := NetPath.p1H;
NewPath.p2H := NetPath.p2H;
end;
{$ifEnd}
end;
end;
end;
if NewPath <> nil then
begin
if EQDP(NewPath.p1^, NewPath.p2^) then
begin
Result.Paths.Remove(NewPath);
FreeAndNil(NewPath);
end
else
begin
NewPath.Opath := NetPath;
NewPath.FSrcPaths.Add(NetPath);
NewPath.CopyFrom(NetPath, false);
// Tolik 04/09/2018 --
NewPath.p1H := NetPath.p1H;
NewPath.p2H := NetPath.p2H;
//
if GArch3DAllowAlignPoint then
begin
AlignNewPathPt(NewPath, NetPath, NewPath.p1,NewPath.p2, NetPath.p1,NetPath.p2);
AlignNewPathPt(NewPath, NetPath, NewPath.p1,NewPath.p2, NetPath.p2,NetPath.p1);
AlignNewPathPt(NewPath, NetPath, NewPath.p2,NewPath.p1, NetPath.p1,NetPath.p2);
AlignNewPathPt(NewPath, NetPath, NewPath.p2,NewPath.p1, NetPath.p2,NetPath.p1);
end;
try
Result.RefreshPaths(true); //25.01.2011
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
//07.06.2012 Åñëè åñòü ïåðïåíäèêóëÿðíûå òî÷êè, ïðîâåðÿåì íå íóæíî ëè ïåðåâåðíóòü ñåãìåíò
if NetPath.ExistsPerpendPt and NewPath.ExistsPerpendPt then
begin
//TmpPt := MPoint(NewPath.r1, NewPath.l1);
SetLength(Polygon, 4);
Polygon[0] := NetPath.r1;
Polygon[1] := NetPath.r2;
Polygon[2] := NetPath.l2;
Polygon[3] := NetPath.l1;
//if Not NetPath.IsPointIn(TmpPt.x, TmpPt.y, false) then
if Not IsPtInPolygon(NewPath.r1, Polygon, false, true, 0) or Not IsPtInPolygon(NewPath.l1, Polygon, false, true, 0) then
NewPath.InvertPerpendSide(false);
SetLength(Polygon, 0);
end;
//NewPath.FComponID := NetPath.FComponID;
// Îïðåäåëÿåì èíôîðìàöèîííûå ñâîéñòâà ìîä-ïîèíòîâ
AssignPointInfo(NetPath.p1, NetPath, NewPath);
AssignPointInfo(NetPath.p2, NetPath, NewPath);
if NetPath.Doors.Count > 0 then
NewPathsWithElems.Add(NewPath);
// íà Result.MakePath ÷àñòî ïðîèñõîäèò óäàëåíèå+äîáàâëåíèå
// àâòîìàòîì äîáàâëåííûì óêàçûâàåì èç êàêîãî ñåãìåíòà ïðèøëè
for l := 0 to Result.Paths.Count - 1 do
begin
NewPathAuto := TNetPath(Result.Paths[l]);
if NewPathAuto.Opath = nil then
begin
NewPathAuto.Opath := NetPath;
if NewPathAuto.FSrcPaths.IndexOf(NetPath) = -1 then
NewPathAuto.FSrcPaths.Add(NetPath);
//NewPathAuto.FDivedFrom := ;
if (NetPath.Doors.Count > 0) and (NewPathsWithElems.IndexOf(NewPathAuto)=-1) then
NewPathsWithElems.Add(NewPathAuto);
end;
end;
end;
end
else
begin
// Åñëè ñìåæíûå ñåãìåíòû, òî â ãðóïïîâîì äîëæíû áûòü ñâÿçè ñî âñåìè
if PathsPassNum = 0 then
NoAddedPaths.Add(NetPath);
end;
// Îêíà/äâåðè â ñïèñîê íà ñîçäàíèå
for k := 0 to NetPath.Doors.Count - 1 do
begin
PathElem := TNetDoor(NetPath.Doors[k]);
if PathsElems.IndexOf(PathElem) = -1 then
begin
PathElem.FPath := NetPath;
PathsElems.Add(PathElem);
end;
end;
// Åñëè òî÷êè ñ âûñîòàìè, äîáàâëÿåì ñåãìåíò â ñïèñîê äëÿ îïðåäåëåíèÿ âûñîò
CanPath := true;
// Åñëè ïî òî÷êàì ýòîò ñåãìåíò íå âõîäèò â äðóãîé
for k := PathsWithPointInfo.Count - 1 downto 0 do
begin
TmpNetPath := TNetPath(PathsWithPointInfo[k]);
IntersectType := TmpNetPath.CmpIntersectPath(NetPath);
// TmpNetPath ýêâèâàë. èëè ïîãëàùàåò NetPath
if IntersectType in [citEqual, citAbsorb] then
begin
CanPath := false;
Break; //// BREAK ////
end
else if IntersectType = citEntry then // TmpNetPath âõîäèò â NetPath, òî óäàëÿåì ýòîò TmpNetPath
PathsWithPointInfo.Delete(k);
end;
if CanPath then
PathsWithPointInfo.Add(NetPath);
end;
if PathsPassNum = 0 then
NetPaths.Assign(NoAddedPaths);
Inc(PathsPassNum);
if IsAlignedPt then
//Net.RefreshPaths;
NetPath.Net.RefreshPaths;
end;
end;
{$ifend}
FreeAndNil(NoAddedPaths);
FreeAndNil(NetPaths);
FreeAndNil(NearPoints);
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
try
//21.02.2011 - Êîððåêòèðîâêà òî÷åê
Result.RefreshPaths;
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
//20.06.2012 - Åñëè åñòü ïåðïåíäèêóëÿðíûå òî÷êè, ïðîâåðÿåì íå íóæíî ëè ïåðåâåðíóòü ñåãìåíò
{for i := 0 to Result.Paths.Count - 1 do
begin
NewPath := TNetPath(Result.Paths[i]);
for j := 0 to do
begin
end;
end;}
try
// Óñòàíàâëèâàåì îêíà, äâåðè è ò.ä.
for i := 0 to PathsElems.Count - 1 do
begin
PathElem := TNetDoor(PathsElems[i]);
//Tolik 07/09/2018 --
if PathElem.Height > 0 then // âûêèíóòü äâåðè/îêíà ñ íóëåâîé âûñîòîé (íà äóðàêà)
begin
//
NewPath := Result.GetPathOfPoint(PathElem.p1.x, PathElem.p1.y);
if NewPath = nil then
NewPath := FindVirtualNetPathByReal(Result, PathElem.FPath);
if (NewPath <> nil) {and (NewPath.Opath <> nil)} then
begin
//if isPointInLine(NewPath.p1^,NewPath.p2^, PathElem.p1,1) then
//begin
NewPathElem := TnetDoor.Create(PathElem.Start,PathElem.Width,PathElem.Len,PathElem.DoorObjType, NewPath.net);
NewPathElem.FPath := NewPath;
NewPathElem.DoorType := PathElem.DoorType;
NewPathElem.DoorObjType := PathElem.DoorObjType;
NewPathElem.FComponID := PathElem.FComponID;
// Tolik --06/09/2018 --
NewPathElem.Height := PathElem.Height; // âûñîòà
NewPathElem.WndPlacementHeight := PathElem.WndPlacementHeight; // âûñîòà ðàçìåùåíèÿ
//
NewPath.doors.Add(NewPathElem);
NewPathP1 := {MPoint(NewPath.er1, NewPath.el1); //}NewPath.p1^;
NewPathP2 := {MPoint(NewPath.er2, NewPath.el2); //}NewPath.p2^;
// Îïðåäåëÿåì êîîðäèíàòû â íîâîì ñåãìåíòå
//NewPathElem.CalculatePoints(NewPath.p1^, NewPath.p2^);
NewPathElem.Start := GetLineLenght(NewPathP1, PathElem.p1);
//NewPathElem.Start := GetLineLenght(DoublePoint(NewPathP1.x + NewPath.FPerpendDX, NewPathP1.y+NewPath.FPerpendDY), PathElem.p1);
NewPathElem.CalculatePoints(NewPathP1, NewPathP2);
Result.RefreshPaths; //05.06.2012 - ÷òîáû ó÷ëèñü êîîðäèíàòû òî÷åê ïî FPointsOffset
// Åñëè âòîðàÿ òî÷êà íîâîãî ñåãìåíòà áëèæå ê ïåðâîé òî÷êå èñõîäíîãî, òîãäà ìåíÿåì ïîçèöèþ Start îòíîñèòåëüíî ïåðâîé òî÷êè ñåãìåíòà
//if GetLineLenght(NewPath.p1^, NewPath.Opath.p1^) > GetLineLenght(NewPath.p1^, NewPath.Opath.p2^) then
// NewPathElem.Start := NewPathElem.Start - NewPathElem.Len;
//if GetLineLenght(NewPath.p1^, PathElem.FPath.p1^) > GetLineLenght(NewPath.p1^, PathElem.FPath.p2^) then
// NewPathElem.Start := NewPathElem.Start - NewPathElem.Len;
if Not ((PointNear(NewPathElem.p1, PathElem.p1) and PointNear(NewPathElem.p2, PathElem.p2)) or (PointNear(NewPathElem.p1, PathElem.p2) and PointNear(NewPathElem.p2, PathElem.p1))) then
begin
//NewPathElem.Start := NewPathElem.Start - NewPathElem.Len;
NewPathElem.Start := GetLineLenght(NewPathP1, PathElem.p1) - NewPathElem.Len;
NewPathElem.CalculatePoints(NewPathP1, NewPathP2);
Result.RefreshPaths; //05.06.2012 - ÷òîáû ó÷ëèñü êîîðäèíàòû òî÷åê ïî FPointsOffset
end;
//end
//else
// EmptyProcedure;
end
else
EmptyProcedure;
end;
end;
RefreshNet(Result); //21.02.2011 RefreshNet(Net);
//// Óñòàíàâëèâàåì îêíà, äâåðè è ò.ä.
// if NewPathsWithElems.Count > 0 then
// begin
// AddedElems := TList.Create;
// for i := 0 to NewPathsWithElems.Count - 1 do
// begin
// NewPath := TNetPath(NewPathsWithElems[i]);
// if NewPath.Opath <> nil then
// for j := 0 to NewPath.Opath.Doors.Count - 1 do
// begin
// PathElem := TNetDoor(NewPath.Opath.Doors[j]);
// if AddedElems.IndexOf(PathElem) = -1 then
// if isPointInLine(NewPath.p1^,NewPath.p2^, PathElem.p1,1) then
// begin
// NewPathElem := TnetDoor.Create(PathElem.Start,PathElem.Width,PathElem.Len,PathElem.DoorObjType, NewPath.net);
// NewPathElem.FPath := NewPath;
// NewPathElem.DoorType := PathElem.DoorType;
// NewPathElem.DoorObjType := PathElem.DoorObjType;
// NewPathElem.FComponID := PathElem.FComponID;
// NewPath.doors.Add(NewPathElem);
// AddedElems.IndexOf(PathElem);
//
// // Îïðåäåëÿåì êîîðäèíàòû â íîâîì ñåãìåíòå
// //NewPathElem.CalculatePoints(NewPath.p1^, NewPath.p2^);
// NewPathElem.Start := GetLineLenght(NewPath.p1^, PathElem.p1);
// // Åñëè âòîðàÿ òî÷êà íîâîãî ñåãìåíòà áëèæå ê ïåðâîé òî÷êå èñõîäíîãî, òîãäà ìåíÿåì ïîçèöèþ Start îòíîñèòåëüíî ïåðâîé òî÷êè ñåãìåíòà
// if GetLineLenght(NewPath.p1^, NewPath.Opath.p1^) > GetLineLenght(NewPath.p1^, NewPath.Opath.p2^) then
// //if GetLineLenght(NewPath.p2^, PathElem.p1) < NewPathElem.Start then
// NewPathElem.Start := NewPathElem.Start - NewPathElem.Len;
// end;
// end;
// end;
// AddedElems.Free;
// end;
// RefreshNet(Net);
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
try
// Tolik --18/06/2018 --
Corner1H := 0;
Corner2H := 0;
//
// Îïðåäåëÿåì âûñîòû òî÷åê ñåãìåíòîâ
for i := 0 to Result.Paths.Count - 1 do
begin
NewPath := TNetPath(Result.Paths[i]);
{$if Defined(ES_GRAPH_SC)} // Tolik 18/06/2018 - -
NewPath.p1H := 0;
NewPath.p2H := 0;
{$ifEnd}
for j := 0 to PathsWithPointInfo.Count - 1 do
begin
TmpNetPath := TNetPath(PathsWithPointInfo[j]);
{$if Defined(ES_GRAPH_SC)} // Tolik 18/06/2018 - -
Corner1 := ArchContainer.ComponentReferences.GetComponenByID(TmpNetPath.Net.GetPointID(TmpNetPath.p1));
Corner2 := ArchContainer.ComponentReferences.GetComponenByID(TmpNetPath.Net.GetPointID(TmpNetPath.p2));
Corner1H := Corner1.GetPropertyValueAsFloat(pnHeight);
Corner2H := Corner2.GetPropertyValueAsFloat(pnHeight);
TmpWall := GetArchObjByCADObj(TmpNetPath, ArchContainer);
PHeight := 0;
if TmpWall <> nil then
PHeight := TmpWall.GetPropertyValueAsFloat(pnHeight);
IntersectType := TmpNetPath.CmpIntersectPath(NewPath);
if IntersectType = citEqual then
begin
if PointNear(NewPath.p1^, TmpNetPath.p1^) and PointNear(NewPath.p2^, TmpNetPath.p2^) then
begin
NewPath.p1H := Corner1H;
NewPath.p2H := Corner2H;
end
else if PointNear(NewPath.p1^, TmpNetPath.p2^) and PointNear(NewPath.p2^, TmpNetPath.p1^) then
begin
NewPath.p1H := Corner2H;
NewPath.p2H := Corner1H;
end;
end
// Åñëè èñõîäíûé ñåãìåíò TmpNetPath ïîãëàùàåò íîâûé NewPath
else if IntersectType = citAbsorb then
begin
//if GetLineLenght(TmpNetPath.p1^, NewPath.p1^) < GetLineLenght(TmpNetPath.p1^, NewPath.p2^) then
//else
// Åñëè íà ñòîðîíàõ çàäàíà âûñîòà
if (Corner1H <> 0) or (Corner2H <> 0) then
begin
// p1H
if PointNear(NewPath.p1^, TmpNetPath.p1^) then
NewPath.p1H := Corner1H
else
if PointNear(NewPath.p1^, TmpNetPath.p2^) then
NewPath.p1H := Corner2H
else
if Not LoadHeightFromRelated(NewPath, NewPath.p1, NewPath.p1H) then
NewPath.p1H := CalcPointHeight(TmpNetPath.p1, TmpNetPath.p2, NewPath.p1, Corner1H, Corner2H);
// p2H
if PointNear(NewPath.p2^, TmpNetPath.p1^) then
NewPath.p2H := Corner1H
else
if PointNear(NewPath.p2^, TmpNetPath.p2^) then
NewPath.p2H := Corner2H
else
if Not LoadHeightFromRelated(NewPath, NewPath.p2, NewPath.p2H) then
NewPath.p2H := CalcPointHeight(TmpNetPath.p1, TmpNetPath.p2, NewPath.p2, Corner1H, Corner2H);
end;
if NewPath.p1H = 0 then
NewPath.p1H := PHeight;
if NewPath.p2H = 0 then
NewPath.p2H := PHeight;
end;
{$else}
// Tolik 25/06/2018 --
{Corner1H := 0;
Corner1H := Get3DWallHeight * FScaleDelta;}
//
(* PHeight := Get3DWallHeight * FScaleDelta;
TmpWall := GetArchObjByCADObj(TmpNetPath, ArchContainer);
IntersectType := TmpNetPath.CmpIntersectPath(NewPath);
if IntersectType = citEqual then
begin
if PointNear(NewPath.p1^, TmpNetPath.p1^) and PointNear(NewPath.p2^, TmpNetPath.p2^) then
begin
NewPath.p1H := Corner1H;
NewPath.p2H := Corner2H;
end
else if PointNear(NewPath.p1^, TmpNetPath.p2^) and PointNear(NewPath.p2^, TmpNetPath.p1^) then
begin
NewPath.p1H := Corner2H;
NewPath.p2H := Corner1H;
end;
end
// Åñëè èñõîäíûé ñåãìåíò TmpNetPath ïîãëàùàåò íîâûé NewPath
else if IntersectType = citAbsorb then
begin
//if GetLineLenght(TmpNetPath.p1^, NewPath.p1^) < GetLineLenght(TmpNetPath.p1^, NewPath.p2^) then
//else
// Åñëè íà ñòîðîíàõ çàäàíà âûñîòà
if (Corner1H <> 0) or (Corner2H <> 0) then
begin
// p1H
if PointNear(NewPath.p1^, TmpNetPath.p1^) then
NewPath.p1H := Corner1H
else
if PointNear(NewPath.p1^, TmpNetPath.p2^) then
NewPath.p1H := Corner2H
else
if Not LoadHeightFromRelated(NewPath, NewPath.p1, NewPath.p1H) then
NewPath.p1H := CalcPointHeight(TmpNetPath.p1, TmpNetPath.p2, NewPath.p1, Corner1H, Corner2H);
// p2H
if PointNear(NewPath.p2^, TmpNetPath.p1^) then
NewPath.p2H := Corner1H
else
if PointNear(NewPath.p2^, TmpNetPath.p2^) then
NewPath.p2H := Corner2H
else
if Not LoadHeightFromRelated(NewPath, NewPath.p2, NewPath.p2H) then
NewPath.p2H := CalcPointHeight(TmpNetPath.p1, TmpNetPath.p2, NewPath.p2, Corner1H, Corner2H);
end;
if NewPath.p1H = 0 then
NewPath.p1H := PHeight;
if NewPath.p2H = 0 then
NewPath.p2H := PHeight;
end;
*)
{$ifend}
end;
// Äîîïðåäåäåëÿåì èñõîäíûå ñåãìåíòû - 18.02.2011
for j := 0 to NetList.Count - 1 do
begin
Net := TNet(NetList[j]);
for k := 0 to Net.Paths.Count - 1 do
begin
NetPath := TNetPath(Net.Paths[k]);
if NewPath.FSrcPaths.IndexOf(NetPath) = -1 then
begin
IntersectType := NetPath.CmpIntersectPath(NewPath);
// Åñëè ñåãìåíòû ýêâèâàëåíòíû èëè íîâûé íàõîäèòñÿ â ïðåäåëàõ NetPath
if (IntersectType = citEqual) or (IntersectType = citAbsorb) then
NewPath.FSrcPaths.Add(NetPath);
end;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
try
{Result.FComponID := FComponID;
for i := 0 to Result.Paths.Count - 1 do
begin
NewPath := TNetPath(Result.Paths[i]);
// Îïðåäåëÿåì âíåøíèå/âíòóðåííèå òî÷êè ñåãìåíòîâ
NewPath.DefineInOutPoints;
if NewPath.Opath <> nil then
NewPath.FComponID := NewPath.Opath.FComponID;
end;}
//12.04.2012 - Îïðåäåëÿåì øèðèíû íà ìàêñ. èç èñõîäíûõ
for i := 0 to Result.Paths.Count - 1 do
begin
NewPath := TNetPath(Result.Paths[i]);
NewPath.Width := 0; //07.06.2012 - èíîãäà øèðèíà ïðèõîäèò áîëüøàÿ ÷åì ìàêñèìàëüíàÿ íà èñõîäíûõ, ïîýòîìó äåëàåòñÿ ñáðîñ
for j := 0 to NewPath.FSrcPaths.Count - 1 do
begin
NetPath := TNetPath(NewPath.FSrcPaths[j]);
if NewPath.Width < NetPath.Width then
NewPath.Width := NetPath.Width;
end;
end;
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
try
//23.04.2012 - ïîäîãíàòü êîîðäèíàòû òî÷åê, åñëè ðàñõîäÿòñÿ íà xexenm - 1.1
for i := 0 to Result.Points.Count - 1 do
begin
p1 := Result.Points[i];
for j := i+1 to Result.Points.Count - 1 do
begin
p2 := Result.Points[j];
if Abs(p1.x - p2.x) <= ctCoordNearDelta then
p2.x := p1.x;
if Abs(p1.y - p2.y) <= ctCoordNearDelta then
p2.y := p1.y;
end;
end;
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
try
Result.FComponID := FComponID;
RefreshNet(Result);
for i := 0 to Result.Paths.Count - 1 do
begin
NewPath := TNetPath(Result.Paths[i]);
// Îïðåäåëÿåì âíåøíèå/âíòóðåííèå òî÷êè ñåãìåíòîâ
NewPath.DefineInOutPoints;
//{$if Defined(ES_GRAPH_SC)} // Tolik 18/06/2018 - -
if NewPath.Opath <> nil then
begin
NewPath.FComponID := NewPath.Opath.FComponID;
//27.08.2012 - Åñëè ïåðåãîðîäêà, òî äåëàåì êàê âíóòðåííþþ
//TmpWall := ArchRoom.GetComponentFromReferences(NewPath.Opath.FComponID);
TmpWall := nil;
// 01/02/2017 -- Èãîðü + Òîëèê -- êîìíàòà îïðåäåëåíà áûëà íåïðàâèëüíî (âñå âðåìÿ îäíà è òà æå),
// âñëåäñòâèå ÷åãî - íåïðàâèëüíîå îòîáðàæåíèå ïåðåãîðîäîê íà 3ä ìîäåëè
ArchRoom := GetArchObjByCADObj(NewPath.Opath.Net, ArchContainer);
if (ArchRoom <> nil) then
//
TmpWall := ArchRoom.GetComponentFromReferences(NewPath.Opath.FComponID);
if TmpWall <> nil then
if TmpWall.IsLine = ctArhWallDivision then
begin
NewPath.FIsInner := true;
NewPath.Opath.FIsInner := true;
NewPath.FIsConture := true;
NewPath.Opath.FIsConture := true;
end;
end;
//{$ifEnd}
end;
RefreshNet(Result);
if AShowTest then
CAD.PCad.AddCustomFigure(lnArch, Result, False);
PathsWithPointInfo.Free;
PathsElems.Free;
NewPathsWithElems.Free;
NetList.Free;
except
on E: Exception do AddExceptionToLogEx('GroupRoomNets', E.Message);
end;
GArchEngine.FGroupingMode := false;
end;
function IsAllRelatedNetsInList(aNet: TNet; aList: TList; aCheckCounts: Boolean=true): Boolean;
var
i: integer;
RelNets: TList;
begin
Result := false;
RelNets := GetAllRelatedNets(aNet);
RelNets.Add(aNet);
if Not aCheckCounts or (RelNets.Count = aList.Count) then
if RelNets.Count > 0 then
begin
Result := true;
for i := 0 to RelNets.Count - 1 do
begin
if aList.IndexOf(RelNets[i]) = -1 then
begin
Result := false;
Break; //// BREAK ////
end;
end;
end;
end;
function LoadArchObjDefaultParams(AObj: TComponent; AObjectType: Integer): TComponent;
var
DefObject: TComponent;
ArchInfoBasicClass: TArchInfoBasicClass;
begin
Result := nil;
if AObjectType <> -1 then
begin
DefObject := GetArchObjDefaultParams(AObjectType);
if DefObject <> nil then
begin
if AObj = nil then
begin
//ArchInfoBasicClass := GetArchInfoClassByIsLine(AObjectType);
//AObj := ArchInfoBasicClass.Create(nil);
AObj := DefObject;
end
else
begin
AObj.Assign(DefObject);
DefObject.Free;
end;
Result := AObj;
end;
end;
end;
procedure LoadArchObjPropsFromCAD(AArchObj: TSCSComponent; ACADObj: TObject=nil);
var
ChildArchObj: TSCSComponent;
RoomArchObj: TSCSComponent;
WallArchObj: TSCSComponent;
WallChildObj: TSCSComponent;
NicheArchObj: TSCSComponent;
WndArchObj: TSCSComponent;
DoorArchObj: TSCSComponent;
SlopeArchObj: TSCSComponent;
i, j: integer;
CADObj: TObject;
MapScaleKoeff: Double;
NetPath: TNetPath;
NetDoor: TNetDoor;
PCoordZ: Double;
PWidth: Double;
PWidthInner: Double;
PWidthOut: Double; // Âíåøíÿÿ øèðèíà ñòåíû
PWidthProper: Double; // Øèðèíà áåç óãëîâ
PLength: Double;
PHeight, PHeightA, PHeightB, PHeightChild: Double;
PDepth: Double;
PPerimeterCeil: Double;
PPerimeterFloor: Double;
PPerimeterFloorFull: Double;
PPerimeterOut: Double; // Âíåøíèé ïåðèìåòð
PSquare: Double;
PSquareCeil: Double;
PSquareFloor: Double;
PSquareTmp: Double;
PSquareSlope: Double;
PSquareEmbrasureLess: Double;
PSquareExceptEmbrasureSlopeLess: Double;
PSquareInclEmbrasureSlope: Double;
PSquarePlasterboardPerimetr: Double; // Ïëîùàäü ïåðèìåòðà ãèïñîêàðòîíà (Äëÿ íèøè)
PEmbrasureSquare: Double; // Ïëîùàäü ïðîåìîâ ñòåíû
PEmbrasureVolume: Double; // Îáúåì ïðîåìîâ/íèø ñòåíû
PThickness: Double;
PVolume: Double;
//PBasementVolumeAboveGround: Double;
//PBasementVolumeUnderGround: Double;
PBasementVolume: Double;
//PBasementColumnVolume: Double;
PTrenchVolume: Double;
WallChilds: TSCSComponents;
PNamePerimetr: String;
PNameSquare: String;
WallList: TList;
TmpPoints: TDoublePointArr;
function DefineCADObjByArchObj(Obj: TObject): TObject;
begin
Result := ACADObj;
if Result = nil then
Result := GetCADObjByArchObj(Obj);
end;
// Ïðîâåðèòü çàöåïàåò ëè âûñîòà îáúåêòà âûñîòó ñòåíû
function CheckHeightIntersectWallHeight(AObjH, AWallH, AWallHA, AWallHB: Double): Boolean;
begin
Result := (((AWallHA > 0) or (AWallHB > 0)) and (AObjH >= Min(AWallHA, AWallHB)) or (AObjH >= AWallH));
end;
begin
// Åñëè íå ïîòîëîê è íå ïîë
//if (AArchObj.isLine <> ctArhFloor) and (AArchObj.isLine <> ctArhCeiling) then
//begin
// Åñëè ïîòîëîê èëè ïîë
if (AArchObj.isLine = ctArhFloor) or (AArchObj.isLine = ctArhCeiling) then
begin
RoomArchObj := TSCSComponent(AArchObj.Parent);
if RoomArchObj <> nil then
begin
LoadArchObjPropsFromCAD(RoomArchObj);
PNamePerimetr := '';
PNameSquare := '';
case AArchObj.isLine of
ctArhFloor:
begin
PNamePerimetr := pnPerimeterFloor;
PNameSquare := pnSquareFloor;
end;
ctArhCeiling:
begin
PNamePerimetr := pnPerimeterCeil;
PNameSquare := pnSquareCeil;
end;
end;
AArchObj.SetPropertyValueAsFloat(pnPerimeter, RoomArchObj.GetPropertyValueAsFloat(PNamePerimetr));
AArchObj.SetPropertyValueAsFloat(pnSquare, RoomArchObj.GetPropertyValueAsFloat(PNameSquare));
end;
end
// Îòêîñû
else if IsSlopeComponByIsLine(AArchObj.isLine) then
begin
PHeight := AArchObj.GetPropertyValueAsFloat(pnHeight);
PWidth := AArchObj.GetPropertyValueAsFloat(pnWidth);
PDepth := AArchObj.GetPropertyValueAsFloat(pnDepth);
AArchObj.SetPropertyValueAsFloat(pnSquare, PHeight*2*PDepth + PWidth*PDepth);
AArchObj.SetPropertyValueAsFloat(pnPerimeter, PHeight*2 + PWidth);
// Ïåðèìåòð äâåðíîãî îòêîñà - @ÄÂ@_ÎÒÊ_ÂÛÑ * 2 + @ÄÂ@_ÎÒÊ_ØÈÐ
// Ïëîùàäü äâåðíûõ îòêîñîâ - ( [@ÄÂ@_ÎÒÊ_ÂÛÑ] * 2 + [@ÄÂ@_ÎÒÊ_ØÈÐ] ) * [@ÄÂ@_ÎÒÊ_ÃËÓÁ]
// Ïåðèìåòð îêîííîãî îòêîñà - @ÎÊ@_ÎÒÊ_ÂÛÑ * 2 + @ÎÊ@_ÎÒÊ_ØÈÐ
// Ïëîùàäü îêîííûõ îòêîñîâ - ( [@ÎÊ@_ÎÒÊ_ÂÛÑ] * 2 + [@ÎÊ@_ÎÒÊ_ØÈÐ] ) * [@ÎÊ@_ÎÒÊ_ÃËÓÁ]
end
else if IsArchCornerComponByIsLine(AArchObj.IsLine) then //19.05.2011 else if AArchObj.IsLine = ctArhWallCorner then
begin
// Îáùàÿ âûñîòà ôóíäàìåíòà = Âûñîòà öîêîëÿ îò çåìëè + Ãëóáèíà ôóíäàìåíòà îòíîñèòåëüíî çåìëè
AArchObj.SetPropertyValueAsFloat(pnBasementTotalHeight,
AArchObj.GetPropertyValueAsFloat(pnPlinthHeight) +
AArchObj.GetPropertyValueAsFloat(pnBasementDepth));
end
// Îêíî, äâåðü, àðêà, íèøà, áàëêîí
else if IsArchWallChildComponByIsLine(AArchObj.isLine) then
begin
PWidth := 0;
CADObj := DefineCADObjByArchObj(AArchObj);
if (CADObj <> nil) and (CADObj is TNetDoor) then
begin
NetDoor := TNetDoor(CADObj);
NetPath := NetDoor.FPath;
if (NetDoor <> nil) and (NetPath <> nil) then
begin
MapScaleKoeff := (TPowerCad(NetPath.Net.Owner).MapScale / 1000);
PWidth := NetDoor.Len * MapScaleKoeff;
end;
end
else
PWidth := AArchObj.GetPropertyValueAsFloat(pnWidth);
PHeight := AArchObj.GetPropertyValueAsFloat(pnHeight);
if AArchObj.IsLine in [ctArhWindow, ctArhDoor] then
//if AArchObj.IsLine <> ctArhNiche then
begin
PSquareSlope := 0; // ïëîùàäü îòêîñîâ
// Îòêîñû
for i := 0 to AArchObj.ChildComplects.Count - 1 do
begin
ChildArchObj := AArchObj.ChildComplects[i];
// Åñëè âíóòðåííèé îòêîñ
if ChildArchObj.IsLine = ctArhInnerSlope then
begin
LoadArchObjPropsFromCAD(ChildArchObj);
PSquareSlope := PSquareSlope + ChildArchObj.GetPropertyValueAsFloat(pnSquare);
end;
end;
AArchObj.SetPropertyValueAsFloat(pnSquare, PWidth*PHeight, false);
AArchObj.SetPropertyValueAsFloat(pnSquareSlope, PSquareSlope, false);
end;
AArchObj.SetPropertyValueAsFloat(pnWidth, PWidth, false);
// Íèøà
if AArchObj.IsLine = ctArhNiche then
begin
WallArchObj := TSCSComponent(AArchObj.Parent);
// Ïëîùàäü ïåðèìåòðà ãèïñîêàðòîíà
PSquare := GetWallNicheArea(WallArchObj, AArchObj, WallArchObj.IsLine, false);
AArchObj.SetPropertyValueAsFloat(pnSquarePlasterboardPerimetr, PSquare, false);
// Ïåðèìåòð íèøè - @ÍÈØ@_ÂÛÑ * 2 + @ÍÈØ@_ØÈÐ
AArchObj.SetPropertyValueAsFloat(pnPerimeter, PHeight*2 + PWidth, false);
// Ïëîùàäü ñòåíû íèøè - @ÍÈØ@_ÂÛÑ * @ÍÈØ@_ØÈÐ
AArchObj.SetPropertyValueAsFloat(pnWallSquare, PHeight*PWidth, false);
end
// Àðêà
else if AArchObj.IsLine = ctArhArc then
begin
PDepth := AArchObj.GetPropertyValueAsFloat(pnDepth);
// Ïëîùàäü ïðîåìà àðêè - @ÀÐÊ@_ÂÛÑ * @ÀÐÊ@_ØÈÐ
PSquare := PWidth * PHeight;
AArchObj.SetPropertyValueAsFloat(pnSquare, PSquare, false);
// Ïåðèìåòð àðêè - @ÀÐÊ@_ÂÛÑ * 2 + @ÀÐÊ@_ØÈÐ
AArchObj.SetPropertyValueAsFloat(pnPerimeter, PHeight * 2 + PWidth);
// Ïëîùàäü ñòåí àðêè - (@ÀÐÊ@_ÂÛÑ * 2 + @ÀÐÊ@_ØÈÐ) * @ÀÐÊ@_ÃËÓÁ
AArchObj.SetPropertyValueAsFloat(pnWallsSquare, (PHeight * 2 + PWidth) * PDepth);
end
// Áàëêîí
else if AArchObj.IsLine = ctArhBalcony then
begin
WndArchObj := GetChildComponByIsLine(AArchObj, ctArhWindow);
DoorArchObj := GetChildComponByIsLine(AArchObj, ctArhDoor);
SlopeArchObj := GetChildComponByIsLine(AArchObj, ctArhInnerSlope);
if (WndArchObj <> nil) and (DoorArchObj <> nil) then
begin
LoadArchObjPropsFromCAD(WndArchObj);
LoadArchObjPropsFromCAD(DoorArchObj);
// Ïëîùàäü áàëêîííîãî ïðîåìà
// @ÁÏÐ@_ÏÐ_ÏËÎÙ = ( [@ÁÏÐ@_ÂÛÑ_ÎÊ] * [@ÁÏÐ@_ØÈÐ_ÎÊ] ) + ( [@ÁÏÐ@_ÂÛÑ_ÄÂ] * [@ÁÏÐ@_ØÈÐ_ÄÂ] )
PSquare := WndArchObj.GetPropertyValueAsFloat(pnSquare) + DoorArchObj.GetPropertyValueAsFloat(pnSquare);
AArchObj.SetPropertyValueAsFloat(pnSquare, PSquare);
// Øèðèíà
PWidth := WndArchObj.GetPropertyValueAsFloat(pnWidth) + DoorArchObj.GetPropertyValueAsFloat(pnWidth);
AArchObj.SetPropertyValueAsFloat(pnWidth, PWidth);
end;
// Ïàðàìåòðû îòêîñîâ
if SlopeArchObj <> nil then
begin
LoadArchObjPropsFromCAD(SlopeArchObj);
// Ïåðèìåòð îòêîñîâ áàëêîííîãî ïðîåìà
// @ÁÏÐ@_ÎÒÊ_ÏÅÐÈÌ = @ÁÏÐ@_ÎÒÊ_ÂÛÑ * 2 + @ÁÏÐ@_ÎÒÊ_ØÈÐ
AArchObj.SetPropertyValueAsFloat(pnPerimeterSlope, SlopeArchObj.GetPropertyValueAsFloat(pnPerimeter));
// Ïëîùàäü îòêîñîâ áàëêîííîãî ïðîåìà
// @ÁÏÐ@_ÎÒÊ_ÏËÎÙ = ( ( [@ÁÏÐ@_ÎÒÊ_ÂÛÑ] * 2 ) + [@ÁÏÐ@_ÎÒÊ_ØÈÐ] ) * [@ÁÏÐ@_ÎÒÊ_ÃËÓÁ]
AArchObj.SetPropertyValueAsFloat(pnSquareSlope, SlopeArchObj.GetPropertyValueAsFloat(pnSquare));
end;
end;
end
else
begin
CADObj := DefineCADObjByArchObj(AArchObj);
if CADObj <> nil then
begin
// Êîìíàòà
if CADObj is TNet then
begin
PPerimeterCeil := 0; // Ïåðèìåòð ïîòîëêà ñ ó÷åòîì íàêëîíà ñòåí è ñ ó÷åòîì ïðîåìîâ è ãëóáèíû íèø
PPerimeterFloor := 0; // Ïåðèìåòð ïîëà ñ ó÷åòîì ïðîåìîâ è íèø
PPerimeterFloorFull := 0; // Ïîëíûé ïåðèìåòð ïîëà - áåç ó÷åò ïðîåìîâ è ãëóáèíû íèø
PPerimeterOut := 0; // Âíåøíèé ïåðèìåòð
PSquare := GetRoomArea(TNet(CADObj), AArchObj);
PSquareCeil := PSquare; // Ïëîùàäü ïîòîëêà
PSquareFloor := PSquare; // Ïëîùàäü ïîëà
// Ïëîùàäè ñòåí
PSquareEmbrasureLess := 0;
PSquareExceptEmbrasureSlopeLess := 0;
PSquareInclEmbrasureSlope := 0;
// Îáúåìû
PVolume := 0; // Îáúåì ñòåí
//PBasementVolumeAboveGround := 0; // Îáúåì ôóíäàìåíòà íàä çåìëåé (öîêîëÿ)
//PBasementVolumeUnderGround := 0; // Îáúåì ôóíäàìåíòà ïîä çåìëåé
PBasementVolume := 0; // Îáúåì ôóíäàìåíòà
//PBasementColumnVolume := 0;
PTrenchVolume := 0; // Îáúåì òðàíøåé
// Ó÷èòûâàåì ïëîùàäè íèø
for i := 0 to AArchObj.ChildComplects.Count - 1 do
begin
ChildArchObj := AArchObj.ChildComplects[i];
// Åñëè ñòåíà, ñìîòðèì åå íèøè
if ChildArchObj.IsLine = ctArhWall then//29.09.2011 if IsArchFrameSegmentComponByIsLine(ChildArchObj.IsLine) then //10.05.2011 if ChildArchObj.IsLine = ctArhWall then
begin
LoadArchObjPropsFromCAD(ChildArchObj);
// Îïðåäåëÿåì âûñîòû ñòîðîí
GetArchWallCornersProps(ChildArchObj, pnHeight, PHeightA, PHeightB);
PHeight := ChildArchObj.GetPropertyValueAsFloat(pnHeight);
PWidthInner := ChildArchObj.GetPropertyValueAsFloat(pnWidth);
//PPerimeter := PPerimeter + ChildArchObj.GetPropertyValueAsFloat(pnWidth);
PPerimeterFloor := PPerimeterFloor + PWidthInner;
PPerimeterFloorFull := PPerimeterFloorFull + PWidthInner;
PPerimeterOut := PPerimeterOut + ChildArchObj.GetPropertyValueAsFloat(pnWidthOut);
// Ïåðèìåòð ïîòîëêà
if (PHeightA > 0) or (PHeightB > 0) then // Åñëè ïîä íàêëîíîì
begin
PHeightA := FloatNoZero(PHeightA, PHeight);
PHeightB := FloatNoZero(PHeightB, PHeight);
PPerimeterCeil := PPerimeterCeil + GetLineLength(DoublePoint(0,PHeightA), DoublePoint(PWidthInner,PHeightB))
end
else
PPerimeterCeil := PPerimeterCeil + PWidthInner;
PSquareEmbrasureLess := PSquareEmbrasureLess + ChildArchObj.GetPropertyValueAsFloat(pnSquareEmbrasureLess);
PSquareExceptEmbrasureSlopeLess := PSquareExceptEmbrasureSlopeLess + ChildArchObj.GetPropertyValueAsFloat(pnSquareExceptEmbrasureSlopeLess);
PSquareInclEmbrasureSlope := PSquareInclEmbrasureSlope + ChildArchObj.GetPropertyValueAsFloat(pnSquareInclEmbrasureSlope);
// Åñëè åñòü ïðèçíàê ôóíäàìåíòà
if ChildArchObj.GetPropertyValueAsBooleanDef(pnBasement, false) then
begin
// Îáúåì ñòåí
PVolume := PVolume + ChildArchObj.GetPropertyValueAsFloat(pnVolume);
// Îáúåì ôóíäàìåíòà íàä çåìëåé (öîêîëÿ)
//PBasementVolumeAboveGround := PBasementVolumeAboveGround + ChildArchObj.GetPropertyValueAsFloat(pnPlinthVolume);
//// Îáúåì ôóíäàìåíòà ïîä çåìëåé
//PBasementVolumeUnderGround := PBasementVolumeUnderGround + ChildArchObj.GetPropertyValueAsFloat(pnBasementVolumeUnderGround);
// Îáúåì ôóíäàìåíòà
PBasementVolume := PBasementVolume + ChildArchObj.GetPropertyValueAsFloat(pnPlinthVolume);
PBasementVolume := PBasementVolume + ChildArchObj.GetPropertyValueAsFloat(pnBasementVolume);
// Îáúåì êîëîí ôóíäàìåíòà
//PBasementColumnVolume := PBasementColumnVolume + ChildArchObj.GetPropertyValueAsFloat(pnBasementColumnV);
// Îáúåì òðàíøåé
PTrenchVolume := PTrenchVolume + ChildArchObj.GetPropertyValueAsFloat(pnTrenchVolume);
end;
for j := 0 to ChildArchObj.ChildComplects.Count - 1 do
begin
WallChildObj := ChildArchObj.ChildComplects[j];
if WallChildObj.IsLine = ctArhNiche then
begin
// åñëè íèøà íà÷èíàåòñÿ ñ ïîëà, èëè ñëèâàåòñÿ ñ ïîòîëêîì
PSquareCeil := PSquareCeil + GetWallNicheArea(ChildArchObj, WallChildObj, ctArhCeiling);
PSquareFloor := PSquareFloor + GetWallNicheArea(ChildArchObj, WallChildObj, ctArhFloor);
PCoordZ := WallChildObj.GetPropertyValueAsFloat(pnCoordZ);
PHeightChild := WallChildObj.GetPropertyValueAsFloat(pnHeight);
PDepth := WallChildObj.GetPropertyValueAsFloat(pnDepth);
// Ó÷èòûâàåì ãëóáèíó íèøè äëÿ ïåðèìåòðà ïîëà
if PCoordZ = 0 then
PPerimeterFloor := PPerimeterFloor + (PDepth*2);
// Ó÷èòûâàåì ãëóáèíó íèøè äëÿ ïåðèìåòðà ïîòîëêà
if CheckHeightIntersectWallHeight(PCoordZ+PHeightChild, PHeight, PHeightA, PHeightB) then
PPerimeterCeil := PPerimeterCeil + (PDepth*2);
end
else if WallChildObj.IsLine in [ctArhDoor, ctArhArc] then
begin
PCoordZ := WallChildObj.GetPropertyValueAsFloat(pnCoordZ);
PHeightChild := WallChildObj.GetPropertyValueAsFloat(pnHeight);
// Øèðèíó ïðîåìà âû÷èòûâàåì èç ïåðèìåòðà ïîëà
if PCoordZ = 0 then
PPerimeterFloor := PPerimeterFloor - WallChildObj.GetPropertyValueAsFloat(pnWidth);
// Øèðèíó ïðîåìà âû÷èòûâàåì èç ïåðèìåòðà ïîòîëêà
if CheckHeightIntersectWallHeight(PCoordZ+PHeightChild, PHeight, PHeightA, PHeightB) then
PPerimeterCeil := PPerimeterCeil - WallChildObj.GetPropertyValueAsFloat(pnWidth);
end
else if WallChildObj.IsLine = ctArhBalcony then
begin
DoorArchObj := GetChildComponByIsLine(WallChildObj, ctArhDoor);
if DoorArchObj <> nil then
begin
// Øèðèíó äâåðíîãî ïðîåìà âû÷èòûâàåì èç ïåðèìåòðà ïîëà
PPerimeterFloor := PPerimeterFloor - DoorArchObj.GetPropertyValueAsFloat(pnWidth);
end;
end;
end;
end
else if ChildArchObj.IsLine = ctArhRoofHip then
begin
LoadArchObjPropsFromCAD(ChildArchObj);
PPerimeterCeil := PPerimeterCeil + ChildArchObj.GetPropertyValueAsFloat(pnLength);
end;
end;
if AArchObj.IsLine = ctArhRoofSeg then
PSquareEmbrasureLess := PSquare;
AArchObj.SetPropertyValueAsFloat(pnPerimeterCeil, Max(0,PPerimeterCeil), false);
AArchObj.SetPropertyValueAsFloat(pnPerimeterFloor, Max(0,PPerimeterFloor), false);
AArchObj.SetPropertyValueAsFloat(pnPerimeterFloorFull, Max(0,PPerimeterFloorFull), false);
AArchObj.SetPropertyValueAsFloat(pnPerimeterOut, PPerimeterOut);
AArchObj.SetPropertyValueAsFloat(pnPerimeter, PPerimeterCeil);//10.05.2011
AArchObj.SetPropertyValueAsFloat(pnSquareCeil, PSquareCeil, false);
AArchObj.SetPropertyValueAsFloat(pnSquareFloor, PSquareFloor, false);
AArchObj.SetPropertyValueAsFloat(pnSquare, PSquare, false); //10.05.2011
//AArchObj.SetPropertyValueAsFloat(pnWallDivSquareExceptEmbrasureSlopeLess, 0, false);
AArchObj.SetPropertyValueAsFloat(pnWallSquareEmbrasureLess, PSquareEmbrasureLess, false);
AArchObj.SetPropertyValueAsFloat(pnWallSquareExceptEmbrasureSlopeLess, PSquareExceptEmbrasureSlopeLess, false);
AArchObj.SetPropertyValueAsFloat(pnWallSquareInclEmbrasureSlope, PSquareInclEmbrasureSlope, false);
AArchObj.SetPropertyValueAsFloat(pnSquareEmbrasureLess, PSquareEmbrasureLess, false); //31.05.2011
AArchObj.SetPropertyValueAsFloat(pnWallsVolume, PVolume); // Îáúåì ñòåí
//AArchObj.SetPropertyValueAsFloat(pnPlinthVolume, PBasementVolumeAboveGround); // Îáúåì ôóíäàìåíòà íàä çåìëåé (öîêîëÿ)
//AArchObj.SetPropertyValueAsFloat(pnBasementVolumeUnderGround, PBasementVolumeUnderGround); // Îáúåì ôóíäàìåíòà ïîä çåìëåé
AArchObj.SetPropertyValueAsFloat(pnTrenchVolume, PTrenchVolume); // Îáúåì òðàíøåé
//AArchObj.SetPropertyValueAsFloat(pnBasementVolume, PBasementVolumeAboveGround+PBasementVolumeUnderGround); // Îáúåì ôóíäàìåíòà îáùèé
AArchObj.SetPropertyValueAsFloat(pnBasementVolume, PBasementVolume); // Îáúåì ôóíäàìåíòà (âìåñòå ñ öîêîëÿìè)
//AArchObj.SetPropertyValueAsFloat(pnBasementColumnV, PBasementColumnVolume); // Îáúåì êîëîí ôóíäàìåíòà
//CalcArchRoomCorners(AArchObj, TNet(CADObj));
if AArchObj.IsLine = ctArhRoofSeg then
CalcAcrhRoofSegProps(AArchObj, TNet(CADObj));
end
// Ñòåíà/ïåðåñòåíîê
else if CADObj is TNetPath then
begin
NetPath := TNetPath(CADObj);
MapScaleKoeff := (TPowerCad(NetPath.Net.Owner).MapScale / 1000);
NetPath.DefineInOutPoints;
PWidth := 0;
PWidthInner := NetPath.InnerLen * MapScaleKoeff;
// Äëÿ ñòåíû áåðåì âíóòðåííèþ äëèíó
if IsArchFrameSegmentComponByIsLine(AArchObj.IsLine) then //06.05.2011 if AArchObj.IsLine = ctArhWall then
PWidth := PWidthInner
// Äëÿ ñòåíû áåðåì äëèíó ïî ñðåäèíå
else if AArchObj.IsLine = ctArhWallDivision then
PWidth := NetPath.Len;
PWidthOut := NetPath.OutLen * MapScaleKoeff;
PWidthProper := NetPath.ProperLen * MapScaleKoeff;
PThickness := NetPath.Width * MapScaleKoeff;
AArchObj.SetPropertyValueAsFloat(pnThickness, PThickness, false);
if AArchObj.IsLine = ctArhRoofHip then
begin
AArchObj.SetPropertyValueAsFloat(pnLengthProj, PWidth, false);
// Äèíà ïðîåêöèè
PLength := PWidth;
GetArchWallCornersProps(AArchObj, pnHeight, PHeightA, PHeightB);
PHeight := AArchObj.GetPropertyValueAsFloat(pnHeight);
if (PHeightA > 0) or (PHeightB > 0) then // Åñëè ïîä íàêëîíîì
begin
PHeightA := FloatNoZero(PHeightA, PHeight);
PHeightB := FloatNoZero(PHeightB, PHeight);
PLength := GetLineLength(DoublePoint(0,PHeightA), DoublePoint(PLength,PHeightB));
end;
AArchObj.SetPropertyValueAsFloat(pnLength, PLength, false);
end
else
begin
AArchObj.SetPropertyValueAsFloat(pnWidth, PWidth, false);
AArchObj.SetPropertyValueAsFloat(pnWidthOut, PWidthOut, false);
end;
PHeight := AArchObj.GetPropertyValueAsFloat(pnHeight);
CalcArchWallProps(AArchObj, NetPath, PWidthProper, PWidthOut, @PSquare);
//PSquare := PWidth*PHeight;
PSquareEmbrasureLess := PSquare;
PSquareExceptEmbrasureSlopeLess := PSquare;
PSquareInclEmbrasureSlope := PSquare;
PEmbrasureSquare := 0; //24.01.2011
PEmbrasureVolume := 0;
WallChilds := GetWallChildsWithIntersect(AArchObj, NetPath, nil);
// Âû÷èòàåì ïëîùàäè îêîí, äâåðåé, ïðîåìîâ
for i := 0 to WallChilds.Count - 1 do
//for i := 0 to AArchObj.ChildComplects.Count - 1 do
begin
ChildArchObj := WallChilds[i];
LoadArchObjPropsFromCAD(ChildArchObj);
// Ïðîåì
if ChildArchObj.IsLine in [ctArhEmbrasure, ctArhWindow, ctArhDoor, ctArhArc, ctArhBalcony] then
begin
//LoadArchObjPropsFromCAD(ChildArchObj); //28.05.2010
//PSquare := PSquare - ChildArchObj.GetPropertyValueAsFloat(pnSquare);
PSquareTmp := ChildArchObj.GetPropertyValueAsFloat(pnSquare);
// Ïëîùàäü çà èñêëþ÷åíèåì ïðîåìîâ áåç îòêîñîâ
PSquareExceptEmbrasureSlopeLess := PSquareExceptEmbrasureSlopeLess - PSquareTmp;
// Ïëîùàäü ñ ó÷åòîì ïðîåìîâ è îòêîñîâ
PSquareInclEmbrasureSlope := PSquareInclEmbrasureSlope - PSquareTmp +
ChildArchObj.GetPropertyValueAsFloat(pnSquareSlope);
// Ïëîùàäü ïðîåìà
PEmbrasureSquare := PEmbrasureSquare + PSquareTmp;
// Îáúåì ïðîåìà
PEmbrasureVolume := PEmbrasureVolume + (PSquareTmp*PThickness);
end
// Íèøà
else if ChildArchObj.IsLine = ctArhNiche then
begin
NetDoor := NetPath.GetDoorByComponID(ChildArchObj.ID);
if NetDoor <> nil then
//07.05.2012 - ïðîâåðÿåì, íàõîäèòñÿ ëè íèøà âíóòðè êîìíàòû - òî÷êè ïðîåìà äîëæíû áûòü íà âíóòðåííèõ òî÷êàõ ñåãìåíòà
//if IsPointInLine(NetPath.ip1^, NetPath.ip2^, NetDoor.ClearP1, 1, 0.1) and
// IsPointInLine(NetPath.ip1^, NetPath.ip2^, NetDoor.ClearP2, 1, 0.1) then
if NetPath.IsInnerNiche(NetDoor) then
begin
// ïðèáàâëÿåì ïëîùàäè âïàäèí íèøè
//PSquare := PSquare + (2 * ChildArchObj.GetPropertyValueAsFloat(pnDepth) * ChildArchObj.GetPropertyValueAsFloat(pnHeight));
//PSquare := PSquare + GetWallNicheArea(AArchObj, ChildArchObj, AArchObj.IsLine);
// Ïëîùàäü ñ ó÷åòîì ïðîåìîâ è îòêîñîâ
PSquareInclEmbrasureSlope := PSquareInclEmbrasureSlope +
GetWallNicheArea(AArchObj, ChildArchObj, AArchObj.IsLine);
// Ïëîùàäü çà èñêëþ÷åíèåì ïðîåìîâ áåç îòêîñîâ - Ïëîùàäü ñòåí êîìíàòû çà âû÷åòîì ïðîåìîâ
PSquareExceptEmbrasureSlopeLess := PSquareExceptEmbrasureSlopeLess -
ChildArchObj.GetPropertyValueAsFloat(pnWallSquare);
// Îáúåì ïðîåìà - ïóñòîòà íèøè = ïëîùàäü ñòåíû * ãëóáèíà
PEmbrasureVolume := PEmbrasureVolume +
(ChildArchObj.GetPropertyValueAsFloat(pnWallSquare)*
ChildArchObj.GetPropertyValueAsFloat(pnDepth));
end;
end;
end;
if PSquare < 0 then
PSquare := 0;
//AArchObj.SetPropertyValueAsFloat(pnSquare, PSquare, false);
AArchObj.SetPropertyValueAsFloat(pnSquareEmbrasureLess, PSquareEmbrasureLess, false);
AArchObj.SetPropertyValueAsFloat(pnSquareExceptEmbrasureSlopeLess, PSquareExceptEmbrasureSlopeLess, false);
AArchObj.SetPropertyValueAsFloat(pnSquareInclEmbrasureSlope, PSquareInclEmbrasureSlope, false);
// Èç âíåøíåé ïëîùàäè âû÷èòûâàåì ïëîùàäè ïðîåìîâ
AArchObj.AddPropertyValueAsFloat(pnSquareOut, 0-PEmbrasureSquare);
// Èç îáúåìà âû÷èòûâàåì îáúåìû ïðîåìîâ
AArchObj.SetPropertyValueAsFloat(pnVolume, AArchObj.GetPropertyValueAsFloat(pnVolume) - PEmbrasureVolume);
FreeAndNil(WallChilds);
end
// Ïðîåì
else if CADObj is TNetDoor then
begin
//NetDoor := TNetDoor(CADObj);
// NetPath := NetDoor.FPath;
// if (NetDoor <> nil) and (NetPath <> nil) then
// begin
// MapScaleKoeff := (TPowerCad(NetPath.Net.Owner).MapScale / 1000);
// PWidth := NetDoor.Len * MapScaleKoeff;
// PHeight := AArchObj.GetPropertyValueAsFloat(pnHeight);
//
// if AArchObj.IsLine in [ctArhWindow, ctArhDoor] then
// //if AArchObj.IsLine <> ctArhNiche then
// begin
// PSquareSlope := 0; // ïëîùàäü îòêîñîâ
// // Îòêîñû
// for i := 0 to AArchObj.ChildComplects.Count - 1 do
// begin
// ChildArchObj := AArchObj.ChildComplects[i];
// // Åñëè âíóòðåííèé îòêîñ
// if ChildArchObj.IsLine = ctArhInnerSlope then
// begin
// LoadArchObjPropsFromCAD(ChildArchObj);
// PSquareSlope := PSquareSlope + ChildArchObj.GetPropertyValueAsFloat(pnSquare);
// end;
// end;
// AArchObj.SetPropertyValueAsFloat(pnSquare, PWidth*PHeight, false);
// AArchObj.SetPropertyValueAsFloat(pnSquareSlope, PSquareSlope, false);
// end;
// AArchObj.SetPropertyValueAsFloat(pnWidth, PWidth, false);
//
// if AArchObj.IsLine = ctArhNiche then
// begin
// WallArchObj := TSCSComponent(AArchObj.Parent);
// // Ïëîùàäü ïåðèìåòðà ãèïñîêàðòîíà
// PSquare := GetWallNicheArea(WallArchObj, AArchObj, WallArchObj.IsLine, false);
// AArchObj.SetPropertyValueAsFloat(pnSquarePlasterboardPerimetr, PSquare, false);
// // Ïåðèìåòð íèøè - @ÍÈØ@_ÂÛÑ * 2 + @ÍÈØ@_ØÈÐ
// AArchObj.SetPropertyValueAsFloat(pnPerimeter, PHeight*2 + PWidth, false);
// // Ïëîùàäü ñòåíû íèøè - @ÍÈØ@_ÂÛÑ * @ÍÈØ@_ØÈÐ
// AArchObj.SetPropertyValueAsFloat(pnWallSquare, PHeight*PWidth, false);
// end
// else if AArchObj.IsLine = ctArhArc then
// begin
// PDepth := AArchObj.GetPropertyValueAsFloat(pnDepth);
// // Ïëîùàäü ïðîåìà àðêè - @ÀÐÊ@_ÂÛÑ * @ÀÐÊ@_ØÈÐ
// PSquare := PWidth * PHeight;
// AArchObj.SetPropertyValueAsFloat(pnSquare, PSquare, false);
// // Ïåðèìåòð àðêè - @ÀÐÊ@_ÂÛÑ * 2 + @ÀÐÊ@_ØÈÐ
// AArchObj.SetPropertyValueAsFloat(pnPerimeter, PHeight * 2 + PWidth);
// // Ïëîùàäü ñòåí àðêè - (@ÀÐÊ@_ÂÛÑ * 2 + @ÀÐÊ@_ØÈÐ) * @ÀÐÊ@_ÃËÓÁ
// AArchObj.SetPropertyValueAsFloat(pnWallsSquare, (PHeight * 2 + PWidth) * PDepth);
// end;
// end;
end;
end;
end;
// end
// else
// begin
//RoomArchObj := TSCSComponent(AArchObj.Parent);
// CADObj := GetCADObjByArchObj(RoomArchObj);
// if CADObj is TNetPath then
// begin
// PPerimeter := 0;
// PSquare := GetRoomArea(TNetPath(CADObj).Net, RoomArchObj);
//
// // Ó÷èòûâàåì ïëîùàäè íèø
// for i := 0 to RoomArchObj.ChildComplects.Count - 1 do
// begin
// ChildArchObj := RoomArchObj.ChildComplects[i];
// // Åñëè ñòåíà, ñìîòðèì åå íèøè
// if ChildArchObj.IsLine = ctArhWall then
// begin
// LoadArchObjPropsFromCAD(ChildArchObj);
// PPerimeter := PPerimeter + ChildArchObj.GetPropertyValueAsFloat(pnSquareSlope);
//
// for j := 0 to ChildArchObj.ChildComplects.Count - 1 do
// begin
// NicheArchObj := ChildArchObj.ChildComplects[j];
// if NicheArchObj.IsLine = ctArhNiche then
// begin
// // åñëè íèøà íà÷èíàåòñÿ ñ ïîëà, èëè ñëèâàåòñÿ ñ ïîòîëêîì
// PSquare := PSquare + GetWallNicheArea(ChildArchObj, NicheArchObj, AArchObj.IsLine);
// end;
// end;
// end;
// end;
// AArchObj.SetPropertyValueAsFloat(pnPerimeter, PPerimeter, false);
// AArchObj.SetPropertyValueAsFloat(pnSquare, PSquare, false);
// end;
// end;
end;
procedure LoadArchObjPropsToCAD(AArchObj: TSCSComponent);
var
CADObj: TObject;
NetPath: TNetPath;
NetPathChild: TNetDoor;
Net: TNet;
MapScaleKoeff: Double;
FloatVal: Double;
NetLenInner, LenInner: Double;
NetLenOuter, LenOuter: Double;
OldP1, OldP2: TDoublePoint;
i: Integer;
//RelNets: TList;
//RelNet: TNet;
RelPaths: TList;
RelPath: TNetPath;
NetsToRefresh: TList;
(*procedure SetNetPathChildsWidth(APathArchObj: TSCSComponent; APath: TNetPath; AWidth: Double);
var
i: Integer;
PathChild: TNetDoor;
ArchChild: TSCSComponent;
begin
APath.Width := AWidth;
if APathArchObj = nil then
APathArchObj := GetArchObjByCADObj(APath);
if APathArchObj <> nil then
begin
// Óñòàíàâëèâàåì øèðèíó îêîí, äâåðåé (âñå êðîìå íèø)
for i := 0 to APath.Doors.Count - 1 do
begin
PathChild := TNetDoor(APath.Doors[i]);
ArchChild := APathArchObj.GetComponentFromReferences(PathChild.FComponID);
if (ArchChild <> nil) {and (ArchChild.IsLine <> ctArhNiche)} then
PathChild.Width := AWidth;
end;
end;
end;*)
procedure AddNetToRefresh(ANet: TNet);
begin
if NetsToRefresh.IndexOf(ANet) = -1 then
NetsToRefresh.Add(ANet);
end;
begin
CADObj := GetCADObjByArchObj(AArchObj);
if CADObj <> nil then
begin
NetsToRefresh := TList.Create;
Net := nil;
if CADObj is TNetPath then
begin
NetPath := TNetPath(CADObj);
OldP1 := NetPath.p1^;
OldP2 := NetPath.p2^;
MapScaleKoeff := (1000/ TPowerCad(NetPath.Net.Owner).MapScale);
// Òîëùèíà ñåãìåíòà
FloatVal := AArchObj.GetPropertyValueAsFloat(pnThickness) * MapScaleKoeff;
if Not CmpFloatByPrecision(NetPath.Width, FloatVal, 2) then
begin
//NetPath.Width := FloatVal;
SetNetPathChildsWidth(AArchObj, NetPath, FloatVal);
Net := NetPath.Net;
end;
if Not NetPath.IsArc then
begin
//RelNets := NetPath.Net.GetRelatedNetsByPoints(NetPath.p1, NetPath.p2);
RelPaths := NetPath.Net.GetRelatedPaths(NetPath);
// Òîëùèíà ñåãìåíòà
//FloatVal := AArchObj.GetPropertyValueAsFloat(pnThickness) * MapScaleKoeff;
//if Not CmpFloatByPrecision(NetPath.Width, FloatVal, 2) then
//begin
// //NetPath.Width := FloatVal;
// SetNetPathChildsWidth(AArchObj, NetPath, FloatVal);
// Net := NetPath.Net;
//end;
if IsArchFrameSegmentComponByIsLine(AArchObj.IsLine) then //06.05.2011 if AArchObj.IsLine = ctArhWall then
begin
LenInner := 0;
LenOuter := 0;
if AArchObj.IsLine = ctArhWall then
begin
// Äëèíà ñåãìåíòà âíóòðåííåé ÷àñòè ïîìåùåíèÿ (= ñâîéñòâà ñòåíû "øèðèíà")
LenInner := AArchObj.GetPropertyValueAsFloat(pnWidth) * MapScaleKoeff;
// Äëèíà ñåãìåíòà âíåøíåé ÷àñòè ïîìåùåíèÿ (= ñâîéñòâà ñòåíû "øèðèíà ñíàðóæè")
LenOuter := AArchObj.GetPropertyValueAsFloat(pnWidthOut) * MapScaleKoeff;
if (LenOuter = 0) and (NetPath.WStyle = wsLine) then
LenOuter := LenInner;
end
else if AArchObj.IsLine = ctArhRoofHip then
begin
LenInner := AArchObj.GetPropertyValueAsFloat(pnLengthProj) * MapScaleKoeff;
LenOuter := LenInner;
end;
NetLenInner := NetPath.InnerLen;
NetLenOuter := NetPath.OutLen;
//24.04.2012 - Ñìîòðèì èçìåíèëàñü ëè äëèíà
if (Abs(NetLenInner - LenInner) > 0.01) or (Abs(NetLenOuter - LenOuter) > 0.01) then
begin
// Ìåíÿåì òó äëèíó êîòîðàÿ áîëüøå èçìåíèëàñü
if Abs(NetLenInner - LenInner) > Abs(NetLenOuter - LenOuter) then
begin
NetPath.SetInnerLen(LenInner);
Net := NetPath.Net;
end
else
begin
NetPath.SetOutLen(LenOuter);
Net := NetPath.Net;
end;
if Net <> nil then
AddNetToRefresh(Net);
// Ïðèìåíÿåì ïàðàìåòðû äëÿ ñìåæíûõ ñåãìåíòîâ
if RelPaths <> nil then
begin
for i := 0 to RelPaths.Count - 1 do
begin
RelPath := TNetPath(RelPaths[i]);
SetNetPathChildsWidth(nil, RelPath, NetPath.Width);
{//08.05.2012
if PointNear(OldP1, RelPath.p1^) and PointNear(OldP2, RelPath.p2^) then
begin
RelPath.p1^ := NetPath.p1^;
RelPath.p2^ := NetPath.p2^;
end
else
if PointNear(OldP1, RelPath.p2^) and PointNear(OldP2, RelPath.p1^) then
begin
RelPath.p1^ := NetPath.p2^;
RelPath.p2^ := NetPath.p1^;
end;}
if PointNear(OldP1, RelPath.p1^) then
RelPath.p1^ := NetPath.p1^;
if PointNear(OldP2, RelPath.p2^) then
RelPath.p2^ := NetPath.p2^;
if PointNear(OldP1, RelPath.p2^) then
RelPath.p1^ := NetPath.p2^;
if PointNear(OldP2, RelPath.p1^) then
RelPath.p2^ := NetPath.p1^;
AddNetToRefresh(RelPath.Net);
end;
RelPaths.Free;
end;
end;
end;
//// Ïðèìåíÿåì òîëùèíó äëÿ ñìåæíûõ ñåãìåíòîâ
// if RelNets <> nil then
// begin
// for i := 0 to RelNets.Count - 1 do
// begin
// RelNet := TNet(RelNets[i]);
// if (RelNet.FRelatedObject <> nil) and (RelNet.FRelatedObject is TNetPath) then
// begin
// RelPath := TNetPath(RelNet.FRelatedObject);
// RelPath.Width := NetPath.Width;
// SetNetPathChildsWidth(nil, RelPath, NetPath.Width);
//
// if PointNear(OldP1, RelPath.p1^) and PointNear(OldP2, RelPath.p2^) then
// begin
// RelPath.p1^ := NetPath.p1^;
// RelPath.p2^ := NetPath.p2^;
// end
// else
// if PointNear(OldP1, RelPath.p2^) and PointNear(OldP2, RelPath.p1^) then
// begin
// RelPath.p1^ := NetPath.p2^;
// RelPath.p2^ := NetPath.p1^;
// end;
// end;
// RefreshNet(RelNet);
// end;
// RelNets.Free;
// end;
//// Äëèíà ñåãìåíòà âíóòðåííåé ÷àñòè ïîìåùåíèÿ (= ñâîéñòâà ñòåíû "øèðèíà")
// FloatVal := AArchObj.GetPropertyValueAsFloat(pnWidth) * MapScaleKoeff;
// if Not CmpFloatByPrecision(NetPath.InnerLen, FloatVal, 2) then
// begin
// NetPath.SetInnerLen(FloatVal);
// Net := NetPath.Net;
// end
// else
// begin
// // Äëèíà ñåãìåíòà âíåøíåé ÷àñòè ïîìåùåíèÿ (= ñâîéñòâà ñòåíû "øèðèíà ñíàðóæè")
// FloatVal := AArchObj.GetPropertyValueAsFloat(pnWidthOut) * MapScaleKoeff;
// if Not CmpFloatByPrecision(NetPath.OutLen, FloatVal, 2) then
// begin
// NetPath.SetOutLen(FloatVal);
// Net := NetPath.Net;
// end;
// end;
end;
SetNetPathColorByObj(NetPath, AArchObj);
end
else if CADObj is TNetDoor then
begin
NetPathChild := TNetDoor(CADObj);
FloatVal := AArchObj.GetPropertyValueAsFloat(pnWidth) *
(1000/ TPowerCad(NetPathChild.FPath.Net.Owner).MapScale);
if NetPathChild.Len <> FloatVal then
begin
NetPathChild.Len := FloatVal;
Net := NetPathChild.FPath.Net;
NetPathChild.DoResize;
AddNetToRefresh(Net);
end;
end;
//if Net <> nil then
//begin
// RefreshNet(Net);
// RefreshCAD_T(TPowerCad(Net.Owner));
//end;
for i := 0 to NetsToRefresh.Count - 1 do
begin
Net := TNet(NetsToRefresh[i]);
RefreshNet(Net);
RefreshCAD_T(TPowerCad(Net.Owner));
end;
NetsToRefresh.Free;
end;
end;
procedure OnSetArchObjProp(AProperty, AOldProperty: PProperty; AObj: TSCSComponent; aCallIdx:Integer=0);
var
PropValFroat: Double;
PointPathList: TList;
Path: TNetPath;
pt: PDoublePoint;
Net: TNet;
CAD: TForm;
ArchContainer: TSCSCatalog;
TopCompon: TSCSComponent;
PathTopCompon: TSCSComponent;
ParentObj: TSCSComponent;
PointID: Integer;
SecondCorner: TSCSComponent;
Corners: TSCSComponents;
CornerP: PDoublePoint;
CornerObj: TSCSComponent;
ResizeKoeff: Double;
ResizeDelta: Double;
i: Integer;
Wnd, Door: TSCSComponent;
SegObj: TSCSComponent;
PropList: TStringList;
PrevpointCnt: Integer;
HalfWidth: Double;
RelPointIDs: TList;
RelPoints: TList;
RelPaths: TList;
RelPathsCmpRes: TList;
RelPath: TNetPath;
RelNets: TList;
RelNet: TNet;
RelArchObj: TSCSComponent;
AltDown: Boolean;
procedure ChangeChildObjHeight(AObj: TSCSComponent; AChildType: Integer; AHeight: Double);
var
ChildObj: TSCSComponent;
begin
ChildObj := GetChildComponByIsLine(AObj, AChildType);
if ChildObj <> nil then
ChildObj.setPropertyValueAsFloat(pnHeight, AHeight);
end;
// Ïðîâåðÿåì ìîæíî ëè ïðèìåíÿòü ñâîéñòâî äëÿ äðóãîãî ñåãìåíòà TNet
function CanApplyPathProp(APath, ARelPath: TNetPath; AObj, ARelObj: TSCSComponent): Boolean;
begin
Result := true;
if (AObj.IsLine = ctArhRoofHip) and (AObj.IsLine = ARelObj.IsLine) then
begin
// Åñëè ðàçíûé òèï ðåáðà òî íå ðàçðåøàåì
if AProperty^.SysName <> pnRoofHipType then
begin
if AObj.GetPropertyValueAsInteger(pnRoofHipType) <> ARelObj.GetPropertyValueAsInteger(pnRoofHipType) then
Result := false;
end
else
begin
// Åñëè ìåíÿåì òèï ðåáðà êðûøè, òî ïîñâîëÿåì åñëè âñå íà îäíîé âûñîòå
Result := CmpPathsHeights(APath, ARelPath);
end;
end;
end;
// Ïðîâåðÿåì ìîæíî ëè ïðèìåíÿòü ñâîéñòâî äëÿ äðóãîé òî÷êè TNet
function CanApplyPointProp(ANet, ARelNet: TNet; APt, ARelPt: PDoublePoint; AObj, ARelObj: TSCSComponent): Boolean;
var
Paths: TList;
RelPaths: TList;
PathsObj: TSCSComponents;
RelPathsObj: TSCSComponents;
i, j: Integer;
WasSame: Boolean;
ObjHeight: Double;
begin
Result := true;
if (AObj.IsLine = ctArhRoofHipCorner) and (AObj.IsLine = ARelObj.IsLine) then
begin
ObjHeight := 0;
if AProperty.SysName = pnHeight then
ObjHeight := StrToFloatU(AOldProperty.Value)
else
ObjHeight := AObj.GetPropertyValueAsFloat(pnHeight);
if Abs(ObjHeight - ARelObj.GetPropertyValueAsFloat(pnHeight)) > 0.1 then
Result := false;
{//15.05.2012
// ïðîâåðÿåì îäíîãî ëè òèïà ðåáðà êðûø
Paths := ANet.GetPathListByPoint(APt);
RelPaths := ARelNet.GetPathListByPoint(ARelPt);
if (Paths <> nil) and (RelPaths <> nil) then
begin
PathsObj := GetArchObjsByCADObjs(Paths);
RelPathsObj := GetArchObjsByCADObjs(RelPaths);
// Âûêèäàåì ñî ñïèñêîâ ðåáðà îäèíàêîâûå ïî òèïó
for i := PathsObj.Count - 1 downto 0 do
begin
WasSame := false;
for j := RelPathsObj.Count - 1 downto 0 do
begin
if PathsObj[i].GetPropertyValueAsInteger(pnRoofHipType) = RelPathsObj[j].GetPropertyValueAsInteger(pnRoofHipType) then
begin
WasSame := true;
RelPathsObj.Delete(j);
end;
end;
if WasSame then
PathsObj.Delete(i);
end;
// Ïðîâåðÿåì åñòü ëè íå ñîâïàäàþùèå
for i := 0 to PathsObj.Count - 1 do
begin
for j := 0 to RelPathsObj.Count - 1 do
begin
if PathsObj[i].GetPropertyValueAsInteger(pnRoofHipType) <> RelPathsObj[j].GetPropertyValueAsInteger(pnRoofHipType) then
begin
Result := false;
Break; //// BREAK ////
end;
end;
if Not Result then
Break; //// BREAK ////
end;
PathsObj.Free;
RelPathsObj.Free;
end;
if Paths <> nil then
Paths.Free;
if RelPaths <> nil then
RelPaths.Free;}
end;
end;
function CanDivPathByPt(ANet: TNet; ANetObj: TSCSComponent): Boolean;
begin
Result := (aCallIdx = 0) and (ANetObj.IsLine <> ctArhRoofSeg);
end;
procedure SetSegsHeightByPt(APtObj: TSCSComponent);
var
TopCompon: TSCSComponent;
PointPathList: TList;
i: Integer;
PointID: Integer;
Path: TNetPath;
SecondCorner, SegObj: TSCSComponent;
SegPropVal: Double;
begin
TopCompon := APtObj.GetTopComponent;
// Èùåì ñâÿçàííûå ñòåíû/ñåãìåíòû
PointPathList := GetPathListForArchCorner(APtObj);
if PointPathList <> nil then
begin
for i := 0 to PointPathList.Count - 1 do
begin
Path := TNetPath(PointPathList[i]);
// èùåì âòîðîé óãîë, è åñëè ó íåãî âûñîòà ñîâïàäàåò ñ âûñîòîé ýòîãî óãëà,
// òîãäà ñòàâèì ýòó âûñîòó ñåãìåíòó, èíà÷å ñåãìåíòó ñòàâèì 0
SecondCorner := nil;
PointID := Path.Net.GetPointID(Path.p1);
if PointID <> APtObj.ID then
SecondCorner := TopCompon.GetComponentFromReferences(PointID)
else
begin
PointID := Path.Net.GetPointID(Path.p2);
if PointID <> APtObj.ID then
SecondCorner := TopCompon.GetComponentFromReferences(PointID);
end;
if SecondCorner <> nil then
begin
SegObj := TopCompon.GetComponentFromReferences(Path.FComponID);
if SegObj <> nil then
begin
SegPropVal := SegObj.GetPropertyValueAsFloat(AProperty.SysName);
// Åñëè àðêà, íà âòîðîé óãîë ñòàâèì òàêóþ æå âûñîòó
if Path.IsArc then
SecondCorner.SetPropertyValueAsString(AProperty.SysName, AProperty.Value);
// Åñëè íà÷àëüíàÿ è êîíå÷íàÿ òî÷êè íà îäèíàêîâûõ âûñîòàõ, òî ñòàâèì òàêóþ íà ñåãìåíò/ðåáðî
if CmpFloatByPrecision(PropValFroat, SecondCorner.GetPropertyValueAsFloat(AProperty.SysName), 3) then
SegObj.SetPropertyValueAsString(AProperty.SysName, AProperty.Value)
else // èíà÷å åñëè âûñîòà òî÷êè íå ñîâïàäàåò ñ âûñîòîé ñåãìåíòà/ðåáðà, òî ñáðàñûâàåì âûñîòó ðåáðà
if Not CmpFloatByCP(SegPropVal, PropValFroat) then
SegObj.SetPropertyValueAsString(AProperty.SysName, '0');
end;
end;
end;
PointPathList.Free;
end;
end;
procedure SetCornersHeightBySeg(ASegObj: TSCSComponent; aAllowOnSetArchObjProp: Boolean=false);
var
i: integer;
Corners: TSCSComponents;
Corner: TSCSComponent;
Prop: PProperty;
OldProp: TProperty;
OldValues: TStringList;
begin
Corners := GetArchCornersForWall(ASegObj);
if Corners <> nil then
begin
OldValues := TStringList.Create;
for i := 0 to Corners.Count - 1 do
begin
Corner := Corners[i];
Prop := Corner.GetPropertyBySysName(pnHeight);
if Prop <> nil then
begin
OldProp := Prop^;
OldValues.Add(Prop^.Value);
end
else
OldValues.Add('');
Corner.SetPropertyValueAsString(pnHeight, AProperty^.Value);
//02.07.2012 if aAllowOnSetArchObjProp and (Prop <> nil) then
//02.07.2012 begin
//02.07.2012 OnSetArchObjProp(AProperty, @OldProp, Corner, aCallIdx+1);
//02.07.2012 end;
end;
//02.07.2012
if aAllowOnSetArchObjProp then
begin
for i := 0 to Corners.Count - 1 do
begin
Corner := Corners[i];
Prop := Corner.GetPropertyBySysName(pnHeight);
if (Prop <> nil) then
begin
OldProp := Prop^;
OldProp.Value := OldValues[i];
OnSetArchObjProp(AProperty, @OldProp, Corner, aCallIdx+1);
end;
end;
end;
Corners.Free;
OldValues.Free;
end;
end;
begin
if AProperty <> nil then
begin
AltDown :=(IsKeyDown(VK_LMENU) or IsKeyDown(VK_RMENU));
TopCompon := AObj.GetTopComponent;
Net := TNet(GetCADObjByArchObj(TopCompon));
ParentObj := AObj.GetParentComponent;
if (AProperty.SysName = pnHeight) then
begin
CAD := GetCADFormByObj(Net);
PropValFroat := AObj.GetPropertyValueAsFloat(AProperty^.SysName);
// Åñëè âûñîòà óãëà ñòåíû, ãäå ñòåíà äóãîé
if IsArchCornerComponByIsLine(AObj.IsLine) then //19.05.2011 if AObj.IsLine = ctArhWallCorner then
begin
//if aCallIdx = 0 then
SetSegsHeightByPt(AObj);
(* //28.09.2011
// Èùåì ñâÿçàííûå ñòåíû/ñåãìåíòû
PointPathList := GetPathListForArchCorner(AObj);
if PointPathList <> nil then
begin
for i := 0 to PointPathList.Count - 1 do
begin
Path := TNetPath(PointPathList[i]);
// èùåì âòîðîé óãîë, è åñëè ó íåãî âûñîòà ñîâïàäàåò ñ âûñîòîé ýòîãî óãëà,
// òîãäà ñòàâèì ýòó âûñîòó ñåãìåíòó, èíà÷å ñåãìåíòó ñòàâèì 0
SecondCorner := nil;
PointID := Path.Net.GetPointID(Path.p1);
if PointID <> AObj.ID then
SecondCorner := TopCompon.GetComponentFromReferences(PointID)
else
begin
PointID := Path.Net.GetPointID(Path.p2);
if PointID <> AObj.ID then
SecondCorner := TopCompon.GetComponentFromReferences(PointID);
end;
if SecondCorner <> nil then
begin
SegObj := TopCompon.GetComponentFromReferences(Path.FComponID);
if SegObj <> nil then
begin
// Åñëè àðêà, íà âòîðîé óãîë ñòàâèì òàêóþ æå âûñîòó
if Path.IsArc then
SecondCorner.SetPropertyValueAsString(AProperty.SysName, AProperty.Value);
if CmpFloatByPrecision(
PropValFroat, SecondCorner.GetPropertyValueAsFloat(AProperty.SysName), 3) then
SegObj.SetPropertyValueAsString(AProperty.SysName, AProperty.Value)
else
SegObj.SetPropertyValueAsString(AProperty.SysName, '0');
end;
end;
{//28.09.2011
// Åñëè àðêà, èùåì âòîðîé óãîë
if Path.IsArc then
begin
SecondCorner := nil;
PointID := Path.Net.GetPointID(Path.p1);
if PointID <> AObj.ID then
SecondCorner := TopCompon.GetComponentFromReferences(PointID)
else
begin
PointID := Path.Net.GetPointID(Path.p2);
if PointID <> AObj.ID then
SecondCorner := TopCompon.GetComponentFromReferences(PointID);
end;
if SecondCorner <> nil then
SecondCorner.SetPropertyValueAsString(AProperty.SysName, AProperty.Value);
end;}
end;
PointPathList.Free;
end; *)
// Ðàçáèâàåì äðóãèå ñåãìåíòû â ýòîì ìåñòå
if CanDivPathByPt(Net, TopCompon) then
begin
pt := GetPointByArchCorner(AObj);
if pt <> nil then
begin
PointPathList := GetAllOtherNetWallsFromCAD(CAD, Net);
for i := 0 to PointPathList.Count - 1 do
begin
Path := TNetPath(PointPathList[i]);
if (Net.FRelatedNets.IndexOf(Path.Net) = -1) and Not PointNear(Path.p1^, pt^) and Not PointNear(Path.p2^, pt^) then
if Path.IsPointIn(pt^.x, pt^.y) then
begin
//16.05.2012 - Åñëè íå íàõîäèìñÿ ðÿäîì ñ òî÷êîé ñåãìåíòà
HalfWidth := (Path.width / 3) * 2;
if (GetLineLength(Path.p1^, pt^) > HalfWidth) and (GetLineLength(Path.p2^, pt^) > HalfWidth) then
begin
PathTopCompon := GetArchObjByCADObj(Path.Net);
if Assigned(PathTopCompon) and (PathTopCompon.IsLine = TopCompon.IsLine) then
begin
PrevpointCnt := Path.Net.FPointIDs.Count;
Path.Net.DivPath(Path, pt^);
if Path.Net.FPointIDs.Count > PrevpointCnt then
begin
CornerObj := AObj.ProjectOwner.GetComponentFromReferences(Integer(Path.Net.FPointIDs[PrevpointCnt]));
if CornerObj <> nil then
CornerObj.SetPropertyValueAsString(AProperty.SysName, AProperty.Value);
end;
end;
end;
end;
end;
PointPathList.Free;
end;
end;
end
else
// Åñëè íà ñòåíå èçìåíèëàñü âûñîòà, ñáðàñûâàåì âûñîòó íà óãëàõ
if IsArchFrameSegmentComponByIsLine(AObj.IsLine) then //26.04.2011 AObj.IsLine = ctArhWall then
begin
if (AProperty <> nil) and (AOldProperty <> nil) and (AProperty^.Value <> AOldProperty^.Value) then
begin
//28.09.2011
//Corners := GetArchCornersForWall(AObj);
// if Corners <> nil then
// begin
// for i := 0 to Corners.Count - 1 do
// Corners[i].SetPropertyValueAsString(pnHeight, AProperty^.Value); //28.09.2011 Corners[i].SetPropertyValueAsFloat(pnHeight, 0);
// Corners.Free;
// end;
//02.07.2012 SetCornersHeightBySeg(AObj);
SetCornersHeightBySeg(AObj, true);
end;
end;
// Åñëè îêíî/äâåðü/áàëêîí, ìåíÿåì âûñîòó îòêîñà
if AObj.IsLine in [ctArhWindow, ctArhDoor] then
begin
if (ParentObj <> nil) and (ParentObj.IsLine = ctArhBalcony) then
begin
if AObj.IsLine = ctArhDoor then
// Âûñîòó äâåðè áàëêîíà ïðèìåíÿåì äëÿ îòêîñà áàëêîíà
ChangeChildObjHeight(ParentObj, ctArhInnerSlope, AObj.GetPropertyValueAsFloat(pnHeight))
else if AObj.IsLine = ctArhWindow then
begin
Door := GetChildComponByIsLine(ParentObj, ctArhDoor);
// Åñëè âûñîòà îêíà áîëüøå äâåðè
if (Door <> nil) and (AObj.GetPropertyValueAsFloat(pnHeight) > Door.GetPropertyValueAsFloat(pnHeight)) then
begin
Door.SetPropertyValueAsFloat(pnHeight, AObj.GetPropertyValueAsFloat(pnHeight));
//OnSetArchObjProp(Door.GetPropertyBySysName(pnHeight), nil, Door);
// Âûñîòó äâåðè áàëêîíà ïðèìåíÿåì äëÿ îòêîñà áàëêîíà
ChangeChildObjHeight(ParentObj, ctArhInnerSlope, AObj.GetPropertyValueAsFloat(pnHeight))
end;
end;
end
else
begin
ChangeChildObjHeight(AObj, ctArhInnerSlope, AObj.GetPropertyValueAsFloat(pnHeight));
ChangeChildObjHeight(AObj, ctArhOuterSlope, AObj.GetPropertyValueAsFloat(pnHeight));
end;
end;
if TopCompon.IsLine = ctArhRoofSeg then
GArchEngine.AddNetToDefHeights(Net);
end
else if (AProperty.SysName = pnWidth) then
begin
// Åñëè îêíî/äâåðü/áàëêîí, ìåíÿåì øèðèíó îòêîñà
if (AObj.IsLine in [ctArhWindow, ctArhDoor, ctArhBalcony]) then
begin
ResizeKoeff := StrToFloatU(AProperty^.Value) / StrToFloatU(AOldProperty^.Value);
ResizeDelta := StrToFloatU(AProperty^.Value) - StrToFloatU(AOldProperty^.Value);
ChangeArchChildObjWidthDelta(AObj, ctArhInnerSlope, ResizeDelta);
if AObj.IsLine <> ctArhBalcony then
ChangeArchChildObjWidthDelta(AObj, ctArhOuterSlope, ResizeDelta)
else
begin
// Îêíî
ChangeArchChildObjWidthKoeff(AObj, ctArhWindow, ResizeKoeff);
// Äâåðü
ChangeArchChildObjWidthKoeff(AObj, ctArhDoor, ResizeKoeff);
end;
if (ParentObj <> nil) and (ParentObj.IsLine = ctArhBalcony) then
begin
Door := GetChildComponByIsLine(ParentObj, ctArhDoor);
Wnd := GetChildComponByIsLine(ParentObj, ctArhWindow);
// Øèðèíà áàëêîíà îò øèðèíû äâåðè+îêíà
if Assigned(Door) and Assigned(Wnd) then
begin
ParentObj.SetPropertyValueAsFloat(pnWidth, Door.GetPropertyValueAsFloat(pnWidth) + Wnd.GetPropertyValueAsFloat(pnWidth));
LoadArchObjPropsToCAD(ParentObj);
end;
end;
end;
end
// Åñëè "Íåñóùàÿ ñòåíà"
else if (AProperty.SysName = pnBasement) and (AObj.IsLine = ctArhWall) then
begin
DefineBasementProps(AObj, false, false);
end
else if (AProperty.SysName = pnSlopeAngle) then
begin
PropValFroat := AObj.GetPropertyValueAsFloat(AProperty^.SysName);
RotateNetByAngle(Net, PropValFroat);
end;
DefinePropsByVal(AObj, AProperty.SysName, AProperty.Value);
//if aCallIdx = 0 then
begin
// Ïðèìåíÿåì ñâîéñòâà äëÿ ñìåæíûõ ñòåí //28.12.2010
if IsArchFrameSegmentComponByIsLine(AObj.IsLine) then //06.05.2011 if (AObj.IsLine = ctArhWall) then
begin
PropList := TStringList.Create;
PropList.Add(pnHeight);
PropList.Add(pnThickness);
PropList.Add(pnBasement);
PropList.Add(pnBasementThickness);
PropList.Add(pnBasementDepth);
PropList.Add(pnPlinthThickness);
PropList.Add(pnPlinthHeight);
PropList.Add(pnBasementColumnCount);
PropList.Add(pnBasementColumnH);
PropList.Add(pnBasementColumnW);
PropList.Add(pnBasementColumnL);
PropList.Add(pnGroupName);
PropList.Add(pnRoofHipType); // Òèï ðåáðà êðûøè
//17.08.2011 PropList.Add(pnRoofHipApexType);
//17.08.2011 PropList.Add(pnRoofHipValleyType);
Path := TNetPath(GetCADObjByArchObj(AObj));
ArchContainer := DefineArchContainer(AObj.GetListOwner);
if (Path <> nil) and (ArchContainer <> nil) and (PropList.IndexOf(AProperty.SysName) <> -1) then
begin
RelPathsCmpRes := TList.Create;
//11.05.2012 RelPaths := Path.Net.GetRelatedPaths(Path, RelPathsCmpRes);
RelPaths := Path.Net.GetRelatedPaths(Path, RelPathsCmpRes, true);
if RelPaths <> nil then
begin
for i := 0 to RelPaths.Count - 1 do
begin
// Åñëè òåêóùàÿ ñòåíà ýêâ.èëè ïîãëàùàåò äðóãóþ
if Integer(RelPathsCmpRes[i]) in [citEqual, citAbsorb] then
begin
RelPath := TNetPath(RelPaths[i]);
RelArchObj := GetArchObjByCADObj(RelPath, ArchContainer);
if RelArchObj <> nil then
if CanApplyPathProp(Path, RelPath, AObj, RelArchObj) then
begin
RelArchObj.SetPropertyValueAsString(AProperty.SysName, AProperty.Value);
DefinePropsByVal(RelArchObj, AProperty.SysName, AProperty.Value);
if AProperty^.SysName = pnRoofHipType then
SetNetPathColorByObj(RelPath, RelArchObj)
else if AProperty^.SysName = pnHeight then
SetCornersHeightBySeg(RelArchObj, true);
end;
end;
end;
RelPaths.Free;
end;
RelPathsCmpRes.Free;
end;
PropList.Free;
end
// Ïðèìåíÿåì ñâîéñòâà äëÿ ñìåæíûõ òî÷åê //28.12.2010
else if IsArchCornerComponByIsLine(AObj.IsLine) then //19.05.2011 else if (AObj.IsLine = ctArhWallCorner) then
begin
PropList := TStringList.Create;
PropList.Add(pnHeight);
PropList.Add(pnTrenchDepth);
if PropList.IndexOf(AProperty.SysName) <> -1 then
begin
TopCompon := AObj.GetTopComponent;
Net := TNet(GetCADObjByArchObj(TopCompon));
ArchContainer := DefineArchContainer(AObj.GetListOwner);
if (Net <> nil) and (ArchContainer <> nil) then
begin
CornerP := Net.GetPointByID(AObj.ID);
if (CornerP <> nil)and(not AltDown) then
begin
RelPoints := TList.Create;
RelNets := TList.Create;
RelPointIDs := Net.GetRelatedPoints(CornerP, RelPoints, RelNets);
if RelPointIDs <> nil then
begin
for i := 0 to RelPointIDs.Count - 1 do
begin
RelNet := TNet(RelNets[i]);
CornerObj := ArchContainer.GetComponentFromReferences(Integer(RelPointIDs[i]));
if CornerObj <> nil then
if (CanApplyPointProp(Net, RelNet, CornerP, PDoublePoint(RelPoints[i]), AObj, CornerObj))then
begin
CornerObj.SetPropertyValueAsString(AProperty.SysName, AProperty.Value);
DefinePropsByVal(CornerObj, AProperty.SysName, AProperty.Value);
if AProperty.SysName = pnHeight then
//if aCallIdx = 0 then
SetSegsHeightByPt(CornerObj);
end;
end;
RelPointIDs.Free;
end;
RelNets.Free;
RelPoints.Free;
end;
end;
end;
PropList.Free;
end;
end;
end;
end;
procedure RefreshArchObjNode(ACADObj: TObject);
var
ArchContainer: TSCSCatalog;
begin
ArchContainer := GetArchContainerByCADObj(ACADObj);
if ArchContainer <> nil then
TF_Main(ArchContainer.ActiveForm).RefreshNode(true);
end;
procedure RefreshNet(ANet: TNet);
begin
ANet.RefreshPaths;
ANet.SetModified; //03.02.2012 ANet.ResetRegion;
end;
procedure RotateNetByAngle(aNet: TNet; aAngle: Double);
var
ArchObj: TSCSComponent;
i, j: Integer;
SideA, SideB, SideC: Double; // c - ïðèëåæàùèé êàòåò, a - ïðîèòèâîïîëîæíûé êàòåò, b - ãèïîòåíóçà
NewSideA: Double;
dHeight: Double; // Ðàçíèöà âûñîò
OutPoints, InnPoints: TDoublePointArr;
OutPointIDs: TList;
LookedCorners: TList;
Corner: TSCSComponent;
CAD: TF_CAD;
Prop: PProperty;
OldProp: TProperty;
//TempNet: TNet;
WalPoints: TDoublePointArr;
MinPt, MaxPt, HeightPt: PDoublePoint;
TempPt: TDoublePoint;
TempLen: Double;
FlatLen: Double;
FlatPt1, FlatPt2: PDoublePoint;
FlatMPt: TDoublePoint;
FrameAngle: Double;
FrameTgA: Double;
FrameSinA: Double;
FrameCosA: Double;
DockNet, Net: TNet;
NetOutPoints, NetInnPoints: TDoublePointArr;
EnteringNets: TList;
ptOnLine: Boolean;
Sq: Double;
begin
OutPointIDs := TList.Create;
GetPathsConturePoints(ANet.Paths, @OutPoints, @InnPoints, true, nil, nil, OutPointIDs, nil);
if Length(OutPoints) >= 3 then
begin
//Sq := GetAreaFromPolygon(OutPoints);
MinPt := nil; //DoublePoint(0,0,0);
MaxPt := nil;
HeightPt := nil;
FlatLen := 0;
FlatPt1 := nil; //DoublePoint(0,0,0);
FlatPt2 := nil; //DoublePoint(0,0,0);
// Èùåì ðîâíóþ ëèíèþ è ñàìóþ íèçêóþ è âûñîêóþ òî÷êè
for i := 0 to Length(OutPoints) - 1 do
begin
if (MinPt = nil) or (OutPoints[i].z < MinPt^.z) then
MinPt := @OutPoints[i];
if (MaxPt = nil) or (OutPoints[i].z > MaxPt^.z) then
MaxPt := @OutPoints[i];
if (i > 0) and (FlatPt1 = nil) and (FlatPt2 = nil) then
if OutPoints[i-1].z = OutPoints[i].z then
begin
FlatPt1 := @OutPoints[i-1];
FlatPt2 := @OutPoints[i];
end;
end;
if (FlatPt1 = nil) and (FlatPt2 = nil) then
if OutPoints[0].z = OutPoints[Length(OutPoints)-1].z then
begin
FlatPt1 := @OutPoints[0];
FlatPt2 := @OutPoints[Length(OutPoints)-1];
end;
if (FlatPt1 <> nil) and (FlatPt2 <> nil) and (MinPt <> nil) and (MaxPt <> nil) then
if Abs(MaxPt.z - MinPt.z) > 0.1 then
begin
// Åñëè ñàìàÿ íèçøàÿ òî÷êà ñîâïàäàåò ïî âûñîòå ñ ðîâíîé ëèíèåé, òîãäà áåðåì ñàìóþ âûñîêóþ òî÷êó
if MinPt^.z <> FlatPt2^.z then
HeightPt := MinPt
else if MaxPt^.z <> FlatPt2^.z then
HeightPt := MaxPt;
if HeightPt <> nil then
begin
// Íàõîäèì òî÷êó ïåðåñå÷åíèÿ ëèíèè èç òî÷êè HeightPt ê ðîâíîé ëèíèè
FlatMPt := HeightPt^;
//PointToLine(FlatPt1^, FlatPt2^, FlatMPt.x, FlatMPt.y);
PointToLineByAngle(FlatPt2^, FlatPt1^, FlatMPt);
ptOnLine := isPointinLine(FlatPt1^, FlatPt2^, DoublePoint(FlatMPt.x, FlatMPt.y), 1, 0.1);
// Íàõîäèì óãîë íàêëîíà ñåãìåíòà
SideC := GetLineLenght(FlatMPt, HeightPt^); // Ïðèëåæàùèé êàòåò
SideA := Abs(FlatPt2^.z - HeightPt^.z); // Ïðîòèâîïîëîæíûé êàòåò (âûñîòà)
SideB := SQRT(SQR(SideA) + SQR(SideC)); // Äëèíà äèàãîíàëè
FrameTgA := tan(DegToRad(aAngle));
NewSideA := FrameTgA * SideC;
{if (SideC = 0) and (SideA > 0) then
begin
FrameAngle := 90;
FrameSinA := 1;
FrameCosA := 0;
end
else
begin
FrameTgA := SideA / SideC;
FrameAngle := RadToDeg(arctan(FrameTgA));
FrameSinA := SideA / SideB;
FrameCosA := SideC / SideB;
end;}
// Ìåíÿåì âûñîòû òî÷åê ïðèáàëÿÿ ðàçíèöó ìåæäó âûñîòàìè ïðåëåæàùèõ ëèíèé
dHeight := NewSideA - SideA;
if Abs(dHeight) > 0.01 then
begin
ArchObj := GetArchObjByCADObj(aNet);
CAD := TF_CAD(GetCADFormByObj(aNet));
if (ArchObj <> nil) and (CAD <> nil) then
begin
LookedCorners := TList.Create;
// Äëÿ êàæäîé òî÷êè êîòîðàÿ âûøå íèçæåé, âû÷èñëÿåì âûñîòó îòäåëüíî
for i := 0 to Length(OutPoints) - 1 do
begin
// Åñëè òî÷êà âûøå ñàìîé íèçêîé
if (OutPoints[i].z - MinPt.z) > 0.1 then
begin
Corner := ArchObj.GetComponentFromReferences(Integer(OutPointIDs[i]));
if Corner <> nil then
if LookedCorners.IndexOf(Corner) = -1 then
begin
LookedCorners.Add(Corner);
// Ïðîåöèðóåì íà ïðÿìóþ ëèíèþ
FlatMPt := OutPoints[i];
PointToLineByAngle(FlatPt2^, FlatPt1^, FlatMPt);
SideC := GetLineLenght(FlatMPt, OutPoints[i]); // Ïðèëåæàùèé êàòåò
SideA := OutPoints[i].z - MinPt.z;
NewSideA := FrameTgA * SideC; // Âûñîòà - ïðîòèâîïîëîæíûé êàòåò
Prop := Corner.GetPropertyBySysName(pnHeight);
if Prop <> nil then
begin
OldProp := Prop^;
Corner.AddPropertyValueAsFloat(pnHeight, CAD.PCad.GetLengthM(NewSideA - SideA));
OnSetArchObjProp(Corner.GetPropertyBySysName(pnHeight), @OldProp, Corner);
end;
end;
end;
end;
LookedCorners.Free;
RefreshCAD(CAD.PCad);
end;
GArchEngine.FLastObjTiltAngle := aAngle;
end;
end;
end;
end;
FreeAndNil(OutPointIDs);
end;
{
function RotateNetTo2D(ANet: TNet): TNet;
var
CAD: TF_CAD;
DSObj: TSCSComponent;
i: Integer;
InclinedPath: TNetPath; // Íàêëîííàÿ ëèíèÿ
FlatPath:TNetPath; // ðîâíàÿ ëèíèÿ êîòîðàÿ íèæå
Path: TNetPath;
PathObj: TSCSComponent;
h1, h2: Double;
FrameAngle: Double;
FrameTgA: Double;
RotateAngle: Double;
ptrStartPt: PDoublePoint;
ptrEndPt: PDoublePoint;
ptrPtWithFlat: PDoublePoint;
StartPt: TDoublePoint; //PDoublePoint; // òî÷êó êîòîðàÿ íà ãîðèçîíòàëüíîé ïëîñêîñòè
EndPt: TDoublePoint; //PDoublePoint;
SideA, SideB, SideC: Double; // c - ïðèëåæàùèé êàòåò, a - ïðîèòèâîïîëîæíûé êàòåò, b - ãèïîòåíóçà
StartPt90: TDoublePoint;
OutPoints, InnPoints: TDoublePointArr;
TempNet: TNet;
WalPoints: TDoublePointArr;
AxisAngle: Double;
SavedZ: Double;
begin
DSObj := GetArchObjByCADObj(ANet);
CAD := TF_CAD(GetCADFormByObj(ANet));
if (DSObj <> nil) then
begin
// Èùåì íàêëîííûé ñåãìåíò è òî÷êó êîòîðàÿ íà ãîðèçîíòàëüíîé ïëîñêîñòè
FrameAngle := 0;
FrameTgA := 0;
RotateAngle := 0;
InclinedPath := nil;
FlatPath := nil;
ptrStartPt := nil;
ptrEndPt := nil;
ptrPtWithFlat := nil;
StartPt := DoublePoint(0,0,0); //nil;
EndPt := DoublePoint(0,0,0); //nil;
for i := 0 to ANet.Paths.Count - 1 do
begin
Path := TNetPath(ANet.Paths[i]);
h1 := Path.GetHeightOfPt(Path.p1); //GetArchWallCornersProps();
h2 := Path.GetHeightOfPt(Path.p2);
if (h1 <> h2) then
begin
PathObj := DSObj.GetComponentFromReferences(Path.FComponID);
LoadArchObjPropsFromCAD(PathObj, Path);
SideA := h1 - h2; //Abs(h1 - h2);
InclinedPath := Path;
ptrStartPt := Path.p1;
ptrEndPt := Path.p2;
ptrPtWithFlat := ptrStartPt;
StartPt := Path.p1^; //Path.p1;
StartPt.z := h1 * 1000/TPowerCad(ANet.Owner).MapScale;
EndPt := Path.p2^; //Path.p2;
EndPt.z := h2 * 1000/TPowerCad(ANet.Owner).MapScale;
//if h1 < h2 then //if h1 > h2 then
// begin
// //StartPt := Path.p2;
// //EndPt := Path.p1;
//
// SideA := h2 - h1;
// ptrStartPt := Path.p2;
// ptrEndPt := Path.p1;
// ptrPtWithFlat := ptrEndPt;
// StartPt := Path.p2^; //Path.p1;
// StartPt.z := h2 * 1000/TPowerCad(ANet.Owner).MapScale;
// EndPt := Path.p1^; //Path.p2;
// EndPt.z := h1 * 1000/TPowerCad(ANet.Owner).MapScale;
// end;
Break; //// BREAK ////
end;
end;
// Èùåì ðîâíóþ ëèíèþ, êîòîðàÿ ïðèâÿçàíà ê íàêëîííîé
if ptrPtWithFlat <> nil then
for i := 0 to ANet.Paths.Count - 1 do
begin
Path := TNetPath(ANet.Paths[i]);
if (Path.p1 = ptrPtWithFlat) or (Path.p2 = ptrPtWithFlat) then //if (Path.p1 = ptrStartPt) or (Path.p2 = ptrStartPt) then
begin
h1 := Path.GetHeightOfPt(Path.p1); //GetArchWallCornersProps();
h2 := Path.GetHeightOfPt(Path.p2);
if h1 = h2 then
begin
FlatPath := Path;
StartPt90 := EndPt; //EndPt^;
PointToLine(FlatPath.p1^, FlatPath.p2^, StartPt90.x, StartPt90.y);
SideC := GetLineLenght(StartPt, EndPt) * (TPowerCad(ANet.Owner).MapScale / 1000);
SideB := SQRT(SQR(SideA) + SQR(SideC)); // Äëèíà äèàãîíàëè
SideC := GetLineLenght(StartPt90, EndPt) * (TPowerCad(ANet.Owner).MapScale / 1000);
FrameTgA := SideA / SideC;
//FrameAngle := 360 - RadToDeg(arctan(FrameTgA));
FrameAngle := RadToDeg(arctan(FrameTgA));
//if FrameAngle < 0 then
// FrameAngle := 360 + FrameAngle;
//FrameAngle := Abs(FrameAngle);
RotateAngle := DegToRad(FrameAngle);
end;
end;
end;
GetPathsConturePoints(ANet.Paths, @OutPoints, @InnPoints, true, nil, nil);
if FrameAngle <> 0 then
begin
//StartPt := ptrStartPt^;
//EndPt := ptrEndPt^;
//if ptrStartPt = FlatPath.p1 then
//begin
// if (FlatPath.p2^.x + FlatPath.p2^.y) < (FlatPath.p1^.x + FlatPath.p1^.y) then
// begin
// ptrStartPt := FlatPath.p2;
// StartPt := EndPt;
// end;
//end;
//if ptrStartPt = FlatPath.p2 then
//begin
// if (FlatPath.p2^.x + FlatPath.p2^.y) > (FlatPath.p1^.x + FlatPath.p1^.y) then
// begin
// ptrStartPt := FlatPath.p1;
// StartPt := EndPt;
// end;
//end;
// âûðîâíÿòü ñåãìåíò ïàðàëåëüíî îñè Y
AxisAngle := 0;
if (FlatPath.p2^.x + FlatPath.p2^.y) < (FlatPath.p1^.x + FlatPath.p1^.y) then
AxisAngle := GetLineAngle(FlatPath.p2^, FlatPath.p1^)
else
AxisAngle := GetLineAngle(FlatPath.p1^, FlatPath.p2^);
AxisAngle := AxisAngle - 90;
//if AxisAngle < 0 then
// AxisAngle := 360 + AxisAngle;
//AxisAngle := Abs(AxisAngle);
//if AxisAngle <> 0 then
// begin
// AxisAngle := DegToRad(AxisAngle);
// for i := 0 to Length(OutPoints) - 1 do
// begin
// SavedZ := OutPoints[i].z;
// OutPoints[i] := RotatePoint(StartPt, OutPoints[i], AxisAngle); //Rotate3DPoint(StartPt, OutPoints[i], AxisAngle, az);
// OutPoints[i].z := SavedZ;
// end;
// end;
// âûðîâíÿòü ñåãìåíò ïàðàëåëüíî ïîëà
for i := 0 to Length(OutPoints) - 1 do
begin
OutPoints[i] := Rotate3DPoint(StartPt, OutPoints[i], RotateAngle, ay);
end;
end;
TempNet := Tnet.create(8, mydsNormal, CAD.PCad);
CAD.PCad.AddCustomFigure(8, TempNet, False);
SetLength(WalPoints, 2);
for i := 1 to Length(OutPoints) - 1 do
begin
WalPoints[0] := OutPoints[i-1];
WalPoints[1] := OutPoints[i];
TempNet.MakePath(WalPoints, false);
end;
RefreshNet(TempNet);
TempNet.Modified := True;
RefreshCAD(CAD.PCad);
SetLength(OutPoints, 0);
SetLength(InnPoints, 0);
end;
end;}
function RotateNetTo2D(ANet: TNet; APointsID: TList; AShow: Boolean=false; APCAD: TPowerCad=nil): TDoublePointArr;
var
CAD: TF_CAD;
PCad: TPowerCad;
LayerNum: Integer;
DSObj: TSCSComponent;
i, j: Integer;
SideA, SideB, SideC: Double; // c - ïðèëåæàùèé êàòåò, a - ïðîèòèâîïîëîæíûé êàòåò, b - ãèïîòåíóçà
OutPoints, InnPoints: TDoublePointArr;
TempNet: TNet;
WalPoints: TDoublePointArr;
MinPt, MaxPt, HeightPt: PDoublePoint;
TempPt: TDoublePoint;
TempLen: Double;
FlatLen: Double;
FlatPt1, FlatPt2: PDoublePoint;
FlatMPt: TDoublePoint;
FrameAngle: Double;
FrameTgA: Double;
FrameSinA: Double;
FrameCosA: Double;
DockNet, Net: TNet;
NetOutPoints, NetInnPoints: TDoublePointArr;
EnteringNets: TList;
ptOnLine: Boolean;
Sq: Double;
RectColor: Integer;
Rect: TPolyline;
Line: TLine;
procedure RotatePoints(var APoints: TDoublePointArr);
var
i: integer;
//l,ratio: Double;
//p1,p2: TDoublePoint;
//Delta: Double;
ResPt: TDoublePoint;
begin
if HeightPt <> nil then
for i := 0 to Length(APoints) - 1 do
begin
if (@APoints[i] <> FlatPt1) and (@APoints[i] <> FlatPt2) then
begin
FlatMPt := APoints[i];
SideA := Abs(FlatPt2^.z - FlatMPt.z);
//PointToLine(FlatPt1^, FlatPt2^, FlatMPt.x, FlatMPt.y);
PointToLineByAngle(FlatPt1^, FlatPt2^, FlatMPt);
//15.08.2011 SideC := GetLineLenght(FlatMPt, APoints[i]);
//15.08.2011 SideB := SideC / FrameCosA; // ãèïîòåíóçà - ïðîåêöèÿ íà xy
// Íàõîäèì òî÷êó ñ ó÷åòîì íîâîé ãèïîòåíóçû
//ResPt := MPoint(FlatMPt, APoints[i], SideB);
if FrameSinA = 1 then // Åñëè óãîë 90
begin
//p1 := FlatMPt;
//p2 := APoints[i];
//Delta := SideB;
//l := SideA; //GetLineLenght(p1,p2);
//ratio := delta/l;
//ResPt := DoublePoint(p1.x+(p2.x-p1.x)*ratio,p1.y+(p2.y-p1.y)*ratio,p1.z+(p2.z-p1.z)*ratio);
//GetParallelPoints(FlatPt1^, FlatMPt, TempPt, ResPt, SideA);
//GetShrinkedPoints(FlatPt1^, FlatMPt, TempPt, ResPt, SideA);
ResPt := PointOutToLine(FlatPt1^, FlatPt2^, FlatMPt, SideA);
end
else
begin
SideB := SideA / FrameSinA; // ãèïîòåíóçà - ïðîåêöèÿ íà xy
ResPt := MPoint(FlatMPt, APoints[i], SideB, true);
end;
ResPt.z := 0;
APoints[i] := ResPt;
end;
end;
end;
begin
GArchEngine.FLastObjTiltAngle := 0;
SetLength(Result, 0);
DSObj := GetArchObjByCADObj(ANet);
CAD := TF_CAD(GetCADFormByObj(ANet));
PCad := APCAD;
LayerNum := 0;
if PCAD = nil then
begin
PCAD := Cad.PCad;
LayerNum := lnArch;
end;
if (DSObj <> nil) then
begin
// Èùåì íàêëîííûé ñåãìåíò è òî÷êó êîòîðàÿ íà ãîðèçîíòàëüíîé ïëîñêîñòè
GetPathsConturePoints(ANet.Paths, @OutPoints, @InnPoints, {nil, nil,} true, nil, nil, APointsID, nil);
if Length(OutPoints) >= 3 then
begin
Sq := GetAreaFromPolygon(OutPoints);
MinPt := nil; //DoublePoint(0,0,0);
MaxPt := nil;
HeightPt := nil;
FlatLen := 0;
FlatPt1 := nil; //DoublePoint(0,0,0);
FlatPt2 := nil; //DoublePoint(0,0,0);
// Èùåì ðîâíóþ ëèíèþ è ñàìóþ íèçêóþ òî÷êó
for i := 0 to Length(OutPoints) - 1 do
begin
if (MinPt = nil) or (OutPoints[i].z < MinPt^.z) then
MinPt := @OutPoints[i];
if (MaxPt = nil) or (OutPoints[i].z > MaxPt^.z) then
MaxPt := @OutPoints[i];
if (i > 0) and (FlatPt1 = nil) and (FlatPt2 = nil) then
if OutPoints[i-1].z = OutPoints[i].z then
begin
FlatPt1 := @OutPoints[i-1];
FlatPt2 := @OutPoints[i];
end;
//if (i > 0) then //if (i > 0) and (FlatPt1 = nil) and (FlatPt2 = nil) then
//begin
// if OutPoints[i-1].z = OutPoints[i].z then
// begin
// TempLen := GetLineLenght(OutPoints[i-1], OutPoints[i]);
// if (FlatLen = 0) or (TempLen < FlatLen) then
// begin
// FlatPt1 := @OutPoints[i-1];
// FlatPt2 := @OutPoints[i];
// FlatLen := TempLen;
// end;
// end;
//end;
end;
if (FlatPt1 = nil) and (FlatPt2 = nil) then
if OutPoints[0].z = OutPoints[Length(OutPoints)-1].z then
begin
FlatPt1 := @OutPoints[0];
FlatPt2 := @OutPoints[Length(OutPoints)-1];
end;
if (FlatPt1 <> nil) and (FlatPt2 <> nil) and (MinPt <> nil) and (MaxPt <> nil) then
begin
// Åñëè ñàìàÿ íèçøàÿ òî÷êà ñîâïàäàåò ïî âûñîòå ñ ðîâíîé ëèíèåé, òîãäà áåðåì ñàìóþ âûñîêóþ òî÷êó
if MinPt^.z <> FlatPt2^.z then
HeightPt := MinPt
else if MaxPt^.z <> FlatPt2^.z then
HeightPt := MaxPt;
if HeightPt <> nil then
begin
SideC := GetLineLenght(FlatPt2^, HeightPt^);
SideA := Abs(FlatPt2^.z - HeightPt^.z);
SideB := SQRT(SQR(SideA) + SQR(SideC)); // Äëèíà äèàãîíàëè
// Íàõîäèì òî÷êó ïåðåñå÷åíèÿ ëèíèè èç òî÷êè HeightPt ê ðîâíîé ëèíèè
FlatMPt := HeightPt^;
//PointToLine(FlatPt1^, FlatPt2^, FlatMPt.x, FlatMPt.y);
PointToLineByAngle(FlatPt2^, FlatPt1^, FlatMPt);
ptOnLine := isPointinLine(FlatPt1^, FlatPt2^, DoublePoint(FlatMPt.x, FlatMPt.y), 1, 0.1);
if AShow then
begin
//Line := TLine.create(HeightPt^.x, HeightPt^.y, FlatMPt.x, FlatMPt.y, 1, ord(psSolid), clBlack, 1, PCad.GetLayerHandle(8), mydsNormal, PCad);
//PCad.AddCustomFigure(8, Line, False);
end;
// Íàõîäèì óãîë íàêëîíà ñåãìåíòà
SideC := GetLineLenght(FlatMPt, HeightPt^);
SideA := Abs(FlatPt2^.z - HeightPt^.z);
SideB := SQRT(SQR(SideA) + SQR(SideC)); // Äëèíà äèàãîíàëè
if (SideC = 0) and (SideA > 0) then
begin
FrameAngle := 90;
FrameSinA := 1;
FrameCosA := 0;
end
else
begin
FrameTgA := SideA / SideC;
FrameAngle := RadToDeg(arctan(FrameTgA));
FrameSinA := SideA / SideB;
FrameCosA := SideC / SideB;
end;
GArchEngine.FLastObjTiltAngle := FrameAngle;
RotatePoints(OutPoints);
end;
end;
end;
if AShow then
begin
TempNet := nil;
//TempNet := Tnet.create(8, mydsNormal, CAD.PCad);
//CAD.PCad.AddCustomFigure(8, TempNet, False);
//SetLength(WalPoints, 2);
//for i := 1 to Length(OutPoints) - 1 do
//begin
// WalPoints[0] := OutPoints[i-1];
// WalPoints[1] := OutPoints[i];
// TempNet.MakePath(WalPoints, false);
//end;
RectColor := clGray;
Rect := TPolyline.create(OutPoints, 3, ord(psSolid), RectColor, ord(bsClear), clBlack, 0, true, PCad.GetLayerHandle(8), mydsNormal, PCad);
PCad.AddCustomFigure(LayerNum, Rect, False);
EnteringNets := TList.Create;
if GetInnerOuterNets(ANet, DSObj, DockNet, EnteringNets) then
begin
for i := 0 to EnteringNets.Count - 1 do
begin
Net := TNet(EnteringNets[i]);
GetPathsConturePoints(Net.Paths, @NetOutPoints, @NetInnPoints, {nil, nil,} true, nil, nil, nil, nil);
RotatePoints(NetOutPoints);
//for j := 1 to Length(NetOutPoints) - 1 do
//begin
// WalPoints[0] := NetOutPoints[j-1];
// WalPoints[1] := NetOutPoints[j];
// TempNet.MakePath(WalPoints, false);
//end;
Rect := TPolyline.create(NetOutPoints, 2, ord(psSolid), RectColor, ord(bsClear), clBlack, 0, true, PCad.GetLayerHandle(LayerNum), mydsNormal, PCad);
PCad.AddCustomFigure(LayerNum, Rect, False);
SetLength(NetOutPoints, 0);
SetLength(NetInnPoints, 0);
end;
end;
EnteringNets.Free;
if TempNet <> nil then
begin
RefreshNet(TempNet);
TempNet.Modified := True;
end;
RefreshCAD(PCad);
end;
Result := OutPoints;
SetLength(OutPoints, 0);
SetLength(InnPoints, 0);
end;
end;
procedure SelectArchObjByCADObj(ACADObj: TObject; AArchObj: TSCSComponent=nil);
var
ArchObj: TSCSComponent;
begin
ArchObj := AArchObj;
if ArchObj = nil then
ArchObj := GetArchObjByCADObj(ACADObj);
if ArchObj <> nil then
TF_Main(ArchObj.ActiveForm).SelectComponByIDInTree(ArchObj.ID);
end;
procedure SelectCADObjByArchObj(AArchObj: TObject);
var
ArchObj: TSCSComponent;
CADObj: TObject;
Net: TNet;
NetPath: TNetPath;
pt: PDoublePoint;
CornerPathList: TList;
begin
CADObj := nil;
// Åñëè âûáðàëè óãîë, èùåì ïåðâûé ñâÿçàííûé ñåãìåíò
if IsArchCornerComponByIsLine(TSCSComponent(AArchObj).IsLine) then //19.05.2011 if TSCSComponent(AArchObj).IsLine = ctArhWallCorner then
begin
CornerPathList := GetPathListForArchCorner(TSCSComponent(AArchObj));
if CornerPathList <> nil then
begin
if CornerPathList.Count > 0 then
begin
CADObj := TObject(CornerPathList[0]);
Net := TNetPath(CADObj).Net;
if Not Net.FSelectingPt then
begin
TPowerCad(TNetPath(CADObj).Net.Owner).DeselectAll(lnArch); //26.08.2011
pt := TNetPath(CADObj).Net.GetPointByID(TSCSComponent(AArchObj).ID);
if pt <> nil then
begin
Net.SelectPt(pt);
Net.Selected := true;
FigureBringToFront(Net);
RefreshCAD_T(TPowerCad(Net.Owner));
end;
end;
Net := nil;
CADObj := nil;
end;
CornerPathList.Free;
end;
end
else
CADObj := GetCADObjByArchObj(AArchObj);
if CADObj <> nil then
begin
Net := nil;
//18.08.2011 if (CADObj is TNet) and (TNet(CADObj).Paths.Count > 0) then
//18.08.2011 CADObj := TObject(TNet(CADObj).Paths[0]);
if CADObj is TNet then
begin
//TNet(CADObj).SelectAllPaths;
//Net := TNet(CADObj);
TPowerCad(TNet(CADObj).Owner).DeselectAll(lnArch);
TNet(CADObj).Selected := true;
RefreshCAD_T(TPowerCad(TNet(CADObj).Owner));
end
else
if CADObj is TNetPath then
begin
if Not TNetPath(CADObj).FSelecting then
begin
TNetPath(CADObj).Select;
TNetPath(CADObj).DoorIndex := -1;
Net := TNetPath(CADObj).Net;
end;
end
else if CADObj is TNetDoor then
begin
NetPath := TNetDoor(CADObj).FPath; //GetPath;
if NetPath <> nil then
begin
NetPath.Select;
NetPath.SelectDoor(TNetDoor(CADObj));
Net := NetPath.Net;
end;
end;
if Net <> nil then
begin
TPowerCad(Net.Owner).SelectByFigure(lnArch, Integer(Net), false);
RefreshCAD_T(TPowerCad(Net.Owner));
end;
end;
end;
procedure SetArchObjToDefaultParams(AObject: TComponent; AObjectType: Integer; ACanDelete: Boolean=false);
begin
if AObject <> nil then
F_ProjMan.GSCSBase.CurrProject.SetObjToObjectsBlob(AObject, tiArchDefObjs, AObjectType, 0)
else
if ACanDelete then
DeleteArchObjDefaultParams(AObjectType);
end;
//05.10.2010
//procedure SetCADArchObjComponID(ACADObj: TObject; AComponID: Integer);
//begin
// if ACADObj <> nil then
// begin
// if ACADObj is TNetDoor then
// TNetDoor(ACADObj).FComponID := AComponID
// else
// if ACADObj is TNetPath then
// TNetPath(ACADObj).FComponID := AComponID
// else
// if ACADObj is TNet then
// TNet(ACADObj).FComponID := AComponID;
// end;
//end;
//
//procedure SetCADArchObjComponIDByCompon(ACompon: TSCSComponent; AComponID: Integer);
//var
// CADObj: TObject;
// TopCompon: TSCSComponent;
// Net: TNet;
//begin
// if ACompon.IsLine = ctArhWallCorner then
// begin
// TopCompon := ACompon.GetTopComponent;
// //Net :=
// end;
// else
// begin
// CADObj := GetCADObjByArchObj(ACompon);
// SetCADArchObjComponID(CADObj, AComponID);
// end;
//end;
procedure SetCADArchObjectsNewID(AList: TSCSList; AOldIDs, NewIDs: TIntList);
var
CAD: TF_CAD;
Figure: TFigure;
Net: TNet;
Path: TNetPath;
PathChild: TNetDoor;
i, j, k: Integer;
function GetNewID(AOldID: Integer): Integer;
var
IDIndex: Integer;
begin
Result := 0;
if AOldID <> 0 then
begin
IDIndex := AOldIDs.IndexOf(AOldID);
if IDIndex <> -1 then
Result := NewIDs[IDIndex];
end;
end;
begin
CAD := TF_CAD(GetCADFormBySCSObject(AList));
if CAD <> nil then
begin
for i := 0 to CAD.PCad.Figures.Count - 1 do
begin
Figure := TFigure(CAD.PCad.Figures[i]);
if Figure is TNet then
begin
Net := TNet(Figure);
if Net.FComponID <> 0 then
begin
Net.FComponID := GetNewID(Net.FComponID);
for j := 0 to Net.Paths.Count - 1 do
begin
Path := TNetPath(Net.Paths[j]);
Path.FComponID := GetNewID(Path.FComponID);
for k := 0 to Path.Doors.Count - 1 do
begin
PathChild := TNetDoor(Path.Doors[k]);
PathChild.FComponID := GetNewID(PathChild.FComponID);
end;
end;
// Point IDs
for j := 0 to Net.FPointIDs.Count - 1 do
Net.FPointIDs[j] := Pointer( GetNewID(Integer(Net.FPointIDs[j])) );
end;
end;
end;
end;
end;
procedure SetLableCaptions(AForm: TForm; AUOM: Integer);
var
i: integer;
Labl: TLabel;
Compon: TComponent;
lbCaptionLen: String;
function CheckComponName(const ACheckName, AComponName: String): Boolean;
var
Position: Integer;
begin
Result := false;
Position := Pos(ACheckName, AComponName);
if (Position <> 0) and ((Position+Length(ACheckName)-1) = Length(AComponName)) then
Result := true;
end;
function GetCaptionByName(const AName: String): String;
var
AllowUOM: Boolean;
begin
Result := '';
AllowUOM := true;
if Pos('Coordz', AName) <> 0 then
Result := cArchParams_Msg05
else if Pos('WidthOut', AName) <> 0 then
Result := cArchParams_Msg11
else if Pos('Width', AName) <> 0 then
Result := cArchParams_Msg02
else if Pos('Height', AName) <> 0 then
Result := cArchParams_Msg06
else if Pos('Depth', AName) <> 0 then
Result := cArchParams_Msg07
else if Pos('Thickness', AName) <> 0 then
Result := cArchParams_Msg09
else if Pos('Length', AName) <> 0 then
Result := cArchParams_Msg10
else if Pos('Step', AName) <> 0 then
Result := cBaseCommon79
else if CheckComponName('GroupName', AName) then
begin
Result := cArchParams_Msg21; // Ãðóïïà
AllowUOM := false;
end
else if CheckComponName('Basement', AName) then
begin
Result := cArchParams_Msg20; //= 'Ôóíäàìåíò/ñòåíà'
AllowUOM := false;
end
else if CheckComponName('PlinthThickness', AName) then
Result := cArchParams_Msg12 //= 'Òîëùèíà öîêîëÿ'
else if CheckComponName('PlinthHeight', AName) then
Result := cArchParams_Msg13 //= 'Âûñîòà öîêîëÿ';
else if CheckComponName('BasementThickness', AName) then
Result := cArchParams_Msg14 //= 'Òîëùèíà ôóíäàìåíòà';
else if CheckComponName('BasementDepth', AName) then
Result := cArchParams_Msg15 //= 'Ãëóáèíà ôóíäàìåíòà';
else if CheckComponName('BasementColumnCount', AName) then
begin
Result := cArchParams_Msg16; //= 'Êîëè÷åñòâî ñòîëáîâ';
AllowUOM := false;
end
else if CheckComponName('BasementColumnH', AName) then
Result := cArchParams_Msg17 //= 'Âûñîòà ñòîëáîâ';
else if CheckComponName('BasementColumnW', AName) then
Result := cArchParams_Msg18 //= 'Øèðèíà ñòîëáîâ';
else if CheckComponName('BasementColumnL', AName) then
Result := cArchParams_Msg19; //= 'Äëèíà ñòîëáîâ';
if AllowUOM and (Result <> '') then
Result := Result +', '+ GetNameUOM(AUOM, true)
end;
begin
for i := 0 to AForm.ComponentCount - 1 do
begin
Compon := TComponent(AForm.Components[i]);
if Compon is TLabel then
begin
Labl := TLabel(Compon);
lbCaptionLen := GetCaptionByName(Labl.Name);
if lbCaptionLen <> '' then
Labl.Caption := lbCaptionLen;
end
else
if Compon is TRzCheckBox then
begin
lbCaptionLen := GetCaptionByName(TRzCheckBox(Compon).Name);
if lbCaptionLen <> '' then
TRzCheckBox(Compon).Caption := lbCaptionLen;
end;
end;
end;
procedure SetNetPathChildsWidth(APathArchObj: TSCSComponent; APath: TNetPath; AWidth: Double);
var
i: Integer;
PathChild: TNetDoor;
ArchChild: TSCSComponent;
begin
APath.Width := AWidth;
if APathArchObj = nil then
APathArchObj := GetArchObjByCADObj(APath);
if APathArchObj <> nil then
begin
// Óñòàíàâëèâàåì øèðèíó îêîí, äâåðåé (âñå êðîìå íèø)
for i := 0 to APath.Doors.Count - 1 do
begin
PathChild := TNetDoor(APath.Doors[i]);
ArchChild := APathArchObj.GetComponentFromReferences(PathChild.FComponID);
if (ArchChild <> nil) {and (ArchChild.IsLine <> ctArhNiche)} then
PathChild.Width := AWidth;
end;
end;
end;
procedure SetNetPathColorByObj(APath: TNetPath; AObj: TSCSComponent);
begin
//02.04.2013 APath.FColor := nil;
if AObj.IsLine = ctArhRoofHip then
begin
case AObj.GetPropertyValueAsInteger(pnRoofHipType) of
rhtNone:
APath.FColor := clSilver;
rhtApex:
APath.FColor := clRed;
rhtValley:
APath.FColor := $00404080; // Êîðè÷íåâûé //Pointer(clGreen);
rhtEaves:
APath.FColor := clLime;
rhtJunction:
APath.FColor := clBlue;
rhtRoofHip:
APath.FColor := clGray;
end;
end;
end;
function SetPathRoofHipType(ANetObj: TNet; APath: TNetPath; AValue: Integer): Boolean;
var
ArchPath: TSCSComponent;
//OldVal: String;
//Prop: PProperty;
begin
Result := false;
if ANetObj is TNet then
begin
ArchPath := GetArchObjByCADObj(APath);
if ArchPath <> nil then
begin
F_ProjMan.SetComponPropValue(ArchPath, pnRoofHipType, IntToStr(AValue));
{Prop := ArchPath.GetPropertyBySysName(pnRoofHipType);
if Prop <> nil then
begin
OldVal := Prop.Value;
Prop.Value := IntToStr(AValue);
F_ProjMan.OnSetPropValueForm(nil, ArchPath, Prop, OldVal, false);
F_ProjMan.RefreshNode(false);
Result := true;
end;}
end;
end;
end;
function SetSelPathRoofHipType(ANetObj: TObject; AValue: Integer): Boolean;
{var
ArchPath: TSCSComponent;
OldVal: String;
Prop: PProperty;}
begin
Result := SetPathRoofHipType(TNet(ANetObj), TNet(ANetObj).SelPath, AValue);
{Result := false;
if ANetObj is TNet then
begin
ArchPath := GetArchObjByCADObj(TNet(ANetObj).SelPath);
if ArchPath <> nil then
begin
Prop := ArchPath.GetPropertyBySysName(pnRoofHipType);
if Prop <> nil then
begin
OldVal := Prop.Value;
Prop.Value := IntToStr(AValue);
F_ProjMan.OnSetPropValueForm(nil, ArchPath, Prop, OldVal, false);
F_ProjMan.RefreshNode(false);
Result := true;
end;
end;
end;}
end;
function SetTopArchCornersHeight(AArchCorners: TSCSComponents; AOldHeight, ANewHeight: Double): TSCSComponents;
var
i: Integer;
ArchObj: TSCSComponent;
CornerH: Double;
NewH: Double;
DeltaHeight: Double;
OldProps: TList;
ptrProp: PProperty;
begin
DeltaHeight := ANewHeight - AOldHeight;
OldProps := TList.Create;
for i := 0 to AArchCorners.Count - 1 do
begin
ArchObj := AArchCorners[i];
CornerH := ArchObj.GetPropertyValueAsFloat(pnHeight);
New(ptrProp);
ptrProp^ := ArchObj.GetPropertyBySysName(pnHeight)^;
OldProps.Add(ptrProp);
NewH := CornerH + (CornerH / AOldHeight)*DeltaHeight;
ArchObj.SetPropertyValueAsFloat(pnHeight, NewH);
end;
for i := 0 to AArchCorners.Count - 1 do
begin
ArchObj := AArchCorners[i];
OnSetArchObjProp(ArchObj.GetPropertyBySysName(pnHeight), PProperty(OldProps[i]), ArchObj);
end;
FreeAndDisposeList(OldProps);
end;
procedure ShowRoofParams(aCAD: TForm; aSCSList: TSCSList; aFigures: TList=nil; aFromNet: TNet=nil);
var
RoofTopPoints: TSCSComponents;
SavedlbHeight: String;
SCSList: TSCSList;
RoofTopPointsH, NewRoofTopPointsH: Double;
Figures: TList;
begin
if TF_CAD(aCAD).CurrentLayer <> lnArch then
TF_CAD(aCAD).CurrentLayer := lnArch;
SCSList := aSCSList;
if SCSList = nil then
SCSList := GetSCSListByCAD(aCAD);
if SCSList <> nil then
begin
// Îïðåäåëÿåêì âûñîòó êðûøè
RoofTopPoints := GetTopArchCorners(DefineArchContainer(SCSList), @RoofTopPointsH);
Figures := nil;
if aFigures = nil then
begin
TF_CAD(aCAD).CurrentLayer := lnArch;
if aFromNet = nil then
TF_CAD(aCAD).PCad.SelectAll(TF_CAD(aCAD).CurrentLayer)
else if aFromNet <> nil then
begin
Figures := GetAllRelatedNets(aFromNet);
Figures.Add(aFromNet);
TF_CAD(aCAD).PCad.DeselectAll(lnArch);
TF_CAD(aCAD).PCad.SelectFigures(Figures);
RefreshCAD(TF_CAD(aCAD).PCad);
end;
end;
// Çàïðàøèâàåì ðàçìåðû
SavedlbHeight := F_BlockParams.lbHeight.Caption;
F_BlockParams.Caption := cArchParams_Msg26;
F_BlockParams.lbHeight.Caption := cCadClasses_Mes4;
F_BlockParams.pnAddition.Visible := RoofTopPointsH > 0;
F_BlockParams.lbAddition.Caption := cArchParams_Msg06;
F_BlockParams.edAddition.Value := FloatInUOM(RoofTopPointsH, umM, F_ProjMan.FUOM);
try
GPopupFigure := nil;
//24.04.2012 FSCS_Main.aBlockParams.Execute;
FSCS_Main.ShowBlockParamsForPopupFigure(false, false);
finally
F_BlockParams.Caption := F_BlockParams.FSrcCaption;
F_BlockParams.lbHeight.Caption := SavedlbHeight;
F_BlockParams.pnAddition.Visible := false;
end;
// Ìåíÿåì âûñîòó òî÷åê ïðîïîðöèîíàëüíî
NewRoofTopPointsH := FloatInUOM(F_BlockParams.edAddition.Value, F_ProjMan.FUOM, umM);
if (RoofTopPointsH > 0) and (NewRoofTopPointsH > 0) and (NewRoofTopPointsH <> RoofTopPointsH) then
SetTopArchCornersHeight(RoofTopPoints, RoofTopPointsH, NewRoofTopPointsH);
FreeAndNil(RoofTopPoints);
if Figures <> nil then
FreeAndNil(Figures);
end;
end;
{
function GetAreaFromPolygon(APolygon: TDoublePointArr): Double;
var
i, j: Integer;
HighP: Integer;
begin
Result := 0;
HighP := High(APolygon);
for i := Low(APolygon) to HighP do
begin
if i = HighP then
j := 0
else
j := i+1;
Result := Result + ((APolygon[i].x * APolygon[j].y) - (APolygon[j].x * APolygon[i].y));
end;
Result := abs(Result) / 2;
end;}
function GetAreaFromPolygonM(APCAD: TPowerCad; APolygon: TDoublePointArr): Double;
begin
Result := GetAreaFromPolygon(APolygon);
Result := Result * sqr(APCAD.MapScale / 1000);
end;
function GetTrapezeArea(AHeightA, AHeightB, AWidth: Double): Double;
var
PolygonPoints: TDoublePointArr;
begin
SetLength(PolygonPoints, 5);
// Top Left
PolygonPoints[0].x := 0;
PolygonPoints[0].y := 0;
// Top Right
PolygonPoints[1].x := AWidth;
PolygonPoints[1].y := 0;
// Bottom Right
PolygonPoints[2].x := AWidth;
PolygonPoints[2].y := AHeightB;
// Bottom Left
PolygonPoints[3].x := 0;
PolygonPoints[3].y := AHeightA;
// Top Left
PolygonPoints[4].x := 0;
PolygonPoints[4].y := 0;
Result := GetAreaFromPolygon(PolygonPoints);
SetLength(PolygonPoints, 0);
end;
function GetTriangleArea(p1,p2,p3: TDoublePoint): Double;
var
PolygonPoints: TDoublePointArr;
begin
Result := 0;
SetLength(PolygonPoints, 4);
PolygonPoints[0] := p1;
PolygonPoints[1] := p2;
PolygonPoints[2] := p3;
PolygonPoints[3] := p1;
Result := GetAreaFromPolygon(PolygonPoints);
SetLength(PolygonPoints, 0);
end;
function IsCrossExistsByPoints(APoints: TDoublePointArr): Boolean;
var
i, j: Integer;
begin
Result := false;
if Length(APoints) >= 4 then
begin
for i := 1 to Length(APoints) - 1 do
begin
for j := i+2 to Length(APoints) - 1 do
begin
// Åñëè ïåðâàÿ è ïîñëåäíÿÿ òî÷êè - íà÷àëüíàÿ - è êîíå÷íàÿ ëèíèè ñîåäèíÿþòñÿ, òî ýòî íå ñ÷èòàåì ïåðåñè÷åíèåì
if (i=1) and (j=(Length(APoints)-1)) and EQDP(APoints[i-1], APoints[j]) then
begin
EmptyProcedure;
Continue; //// CONTINUE ////
end;
//if LinesIntersect(APoints[i-1], APoints[i], APoints[j-1], APoints[j]) then
if LinesCross(APoints[i-1], APoints[i], APoints[j-1], APoints[j]) then
begin
Result := true;
Break; //// BREAK ////
end;
end;
if Result then
Break; //// BREAK ////
end;
end;
end;
{
function IsPtInPolygon(APt: TDoublePoint; APollygonPaths: TDoublePointArr): Boolean;
var
MaxX: Double;
VPoint: TDoublePoint;
i: Integer;
CrossCount: Integer;
begin
Result := false;
// Íàõîäèòñÿ ëè òî÷êà âíóòðè ìíîãîóãîëüíèêà, îïðåäåëÿåì ìåòîòîì ïîèñêà êîëè÷åñòâà ëèíèé
// êîòîðîå ïåðåñåêàåòñÿ ñ âèðòóàëüíîé ëèíèåé (îò òî÷êè â ïðàâî äî áåñêîíå÷íîñòè)
// åñëè êîë-âî ïåðåñå÷åíèå 0 èëè ÷åòíîå, òî íå âõîäèò, à åñëè íå÷åòíîå - òî âõîäèò
if Length(APollygonPaths) > 0 then
begin
// Îïðåäåëÿåì íàèáîëüøèé X
MaxX := APt.x;
for i := 0 to Length(APollygonPaths) - 1 do
begin
if APollygonPaths[i].x > MaxX then
MaxX := APollygonPaths[i].x;
end;
VPoint.x := MaxX + 1;
VPoint.y := APt.y;
CrossCount := 0;
i := 0;
while i <= (Length(APollygonPaths) - 2) do
begin
if LinesCross(APt, VPoint, APollygonPaths[i], APollygonPaths[i+1]) then
CrossCount := CrossCount + 1;
i := i + 2;
end;
Result := (CrossCount <> 0) and ((CrossCount mod 2) <> 0);
end;
end; }
{
// Ôóíêöèÿ îïðåäåëÿåò ïåðåñåêàþòñÿ ëè îòðåçêè áåç ó÷åòà ñîåäèíåíèÿ îòðåçêîâ â îäíîé òî÷êå
function LinesCross(LineAP1, LineAP2, LineBP1, LineBP2 : TDoublePoint) : boolean;
Var
diffLA, diffLB : TDoublePoint;
CompareA, CompareB : Double;
begin
Result := False;
diffLA := Subtract(LineAP2, LineAP1);
diffLB := Subtract(LineBP2, LineBP1);
CompareA := diffLA.X*LineAP1.Y - diffLA.Y*LineAP1.X;
CompareB := diffLB.X*LineBP1.Y - diffLB.Y*LineBP1.X;
if ( ((diffLA.X*LineBP1.Y - diffLA.Y*LineBP1.X) < CompareA) xor
((diffLA.X*LineBP2.Y - diffLA.Y*LineBP2.X) < CompareA) ) and
( ((diffLB.X*LineAP1.Y - diffLB.Y*LineAP1.X) < CompareB) xor
((diffLB.X*LineAP2.Y - diffLB.Y*LineAP2.X) < CompareB) ) then
Result := True;
end; }
function LinesCross(LineAP1, LineAP2, LineBP1, LineBP2 : TDoublePoint; AllowCommonPoint: Boolean=true) : boolean;
// èñòî÷íèê - http://www.sql.ru/Forum/actualthread.aspx?bid=20&tid=374747&hl=
//var
// v1,v2,v3,v4: Double;
// ax1,ay1,ax2,ay2,bx1,by1,bx2,by2: Double;
begin
Result := PCTypesUtils.Intersect(LineAP1, LineAP2, LineBP1, LineBP2);
//09.06.2011 - Åñëè òî÷êè ëèíèè íà äðóãîé ëèíèè
if Not Result and AllowCommonPoint and
(IsPointInLine(LineBP1, LineBP2, LineAP1, 1) or IsPointInLine(LineBP1, LineBP2, LineAP2, 1)) then
Result := true;
//11.03.2011 - íå êîððåêòíî ðàáîòàåò â òàêîì ñëó÷àè:
//11.03.2011 íåïåðåñåêàåìûå ëèíèè ñ êîîðäèíàòàìè íà îäíîé ëèíèè ñ÷èòàåò êàê ïåðåñåêàåìûå
//11.03.2011 íàïðèìåð äëÿ ãîðèçîíòàëüíûõ ëèíèé (90;90-197;90) - (89;90-42;90)
// ax1 := LineAP1.x;
// ay1 := LineAP1.y;
// ax2 := LineAP2.x;
// ay2 := LineAP2.y;
// bx1 := LineBP1.x;
// by1 := LineBP1.y;
// bx2 := LineBP2.x;
// by2 := LineBP2.y;
// v1:=(bx2-bx1)*(ay1-by1)-(by2-by1)*(ax1-bx1);
// v2:=(bx2-bx1)*(ay2-by1)-(by2-by1)*(ax2-bx1);
// v3:=(ax2-ax1)*(by1-ay1)-(ay2-ay1)*(bx1-ax1);
// v4:=(ax2-ax1)*(by2-ay1)-(ay2-ay1)*(bx2-ax1);
//
// if Not AllowCommonPoint then
// Result := (v1*v2<0) and (v3*v4<0) // áåç ó÷åòà îáùåé òî÷êè
// else
// Result := (v1*v2<=0) and (v3*v4<=0); // c ó÷åòîì îáùåé òî÷êè
// //and (not( ((ax1 = bx1)and(ay1 = by1))
// // or ((ax1 = bx1)and(ay1 = by1))
// // or ((ax2 = bx1)and(ay2 = by1))
// // or ((ax1 = bx2)and(ay1 = by2))
// // or ((ax2 = bx2)and(ay2 = by2))
// // ));
end;
function LineIntersect(AP1, AP2, BP1, BP2: TDoublePoint) : TDoublePoint;
var
LDetLineA, LDetLineB, LDetDivInv: Double;
LDiffLA, LDiffLB: TDoublePoint;
begin
Result.x := 0;
Result.y := 0;
Result.z := 0;
LDetLineA := AP1.X*AP2.Y - AP1.Y*AP2.X;
LDetLineB := BP1.X*BP2.Y - BP1.Y*BP2.X;
LDiffLA := VectSubtract(AP1, AP2);
LDiffLB := VectSubtract(BP1, BP2);
LDetDivInv := 1 / ((LDiffLA.X*LDiffLB.Y) - (LDiffLA.Y*LDiffLB.X));
Result.X := ((LDetLineA*LDiffLB.X) - (LDiffLA.X*LDetLineB)) * LDetDivInv;
Result.Y := ((LDetLineA*LDiffLB.Y) - (LDiffLA.Y*LDetLineB)) * LDetDivInv;
end;
function VectDot(v1,v2:TDoublePoint):Double;
begin
result:=(v1.X*v2.X + v1.Y*v2.Y);
end;
function VectMul(v1:TDoublePoint;A:Double):TDoublePoint;
begin
result.X:=v1.X*A;
result.Y:=v1.Y*A;
end;
function VectSubtract(AVec1, AVec2 : TDoublePoint): TDoublePoint;
begin
Result.X := AVec1.X - AVec2.X;
Result.Y := AVec1.Y - AVec2.Y;
end;
function VectNorm(V:TDoublePoint):TDoublePoint;
var vl:double;
begin
vl:= GetLineLenght(v, DoublePoint(0,0)); //VLength(V);
result.X:=V.X/vl;
result.Y:=V.Y/vl;
end;
function VectProject(A,B:TDoublePoint):TDoublePoint;
begin
A:=VectNorm(A); //VNorm(A);
result:=VectMul(A,VectDot(A,B));
end;
function Perpendicular(A,B:TDoublePoint; C:TDoublePoint): TDoublePoint;
var CA:TDoublePoint;
begin
CA:=VectSubtract(C,A);
result:=VectSubtract(VectProject(VectSubtract(B,A),CA),CA);
end;
function NetGetSelPath: TNetPath;
var
Figure: TFigure;
begin
Result := nil;
if GCadForm.PCad.Selection.Count > 0 then
begin
Figure := TFigure(GCadForm.PCad.Selection[0]);
if Figure is TNet then
Result := TNet(Figure).SelPath;
end;
end;
procedure NetPathToArc;
var
Figure: TFigure;
Net: TNet;
Path: TNetPath;
begin
if GCadForm.PCad.Selection.Count > 0 then
begin
Figure := TFigure(GCadForm.PCad.Selection[0]);
if Figure is TNet then
begin
Net := TNet(Figure);
Path := Net.SelPath;
if Path <> nil then
begin
if Path.Doors.Count > 0 then
MessageInfo(cArchCommon_Msg04)
else
begin
Path.isArc := true;
Path.Inverted := true;
//Path.ArcRad := 20;
Net.RefreshPaths;
// Tolik 07/05/2019 -
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
//
RefreshCAD_T(GCadForm.PCad);
end;
end;
end;
end;
end;
procedure NetArcInvert;
var
Figure: TFigure;
Net: TNet;
Path: TNetPath;
begin
if GCadForm.PCad.Selection.Count > 0 then
begin
Figure := TFigure(GCadForm.PCad.Selection[0]);
if Figure is TNet then
begin
Net := TNet(Figure);
Path := Net.SelPath;
if Path <> nil then
begin
Path.Inverted := Not Path.Inverted;
Net.RefreshPaths;
RefreshCAD_T(GCadForm.PCad);
end;
end;
end;
end;
function NetDoorRotate(aPath: TNetPath): TNetDoor;
var
Path: TNetPath;
Door: TNetDoor;
Net: TNet;
begin
Result := nil;
Path := aPath;
if Path = nil then
Path := NetGetSelPath;
if Path <> nil then
begin
Door := Path.ActiveDoor;
if Door <> nil then
begin
Door.FRotation := Door.FRotation xor 1;
Result := Door;
Net.RefreshPaths;
RefreshCAD_T(GCadForm.PCad);
F_ProjMan.RefreshNode;
end;
end;
end;
procedure NetDoorShowOutNicheMessage(aNet: TNet; const aMsg: String);
var
i,j: Integer;
Path: TNetPath;
Door: TNetDoor;
dmPoint: TDoublePoint;
scrPt: TPoint;
begin
for i := 0 to aNet.Paths.Count - 1 do
begin
Path := TNetPath(aNet.Paths[i]);
for j := 0 to Path.Doors.Count - 1 do
begin
Door := TNetDoor(Path.Doors[j]);
if Door.DoorObjType = dotNiche then
begin
if Not Path.IsInnerNiche(Door) then
begin
dmPoint := MPoint(Door.p1, Door.p2);
TPowerCad(aNet.Owner).ConvertXY(dmPoint.X, dmPoint.Y, dmPoint.Z);
GetCursorPos(scrPt);
scrPt.x := Trunc(dmPoint.X);
scrPt.Y := Trunc(dmPoint.Y);
scrPt := TPowerCad(aNet.Owner).ClientToScreen(scrPt);
Sleep(100);
Application.ProcessMessages;
//ShowHintInCursorPos(cMain_Mes135, 2000);
ShowHintRz(cMain_Mes135, 4000, @scrPt);
Path := nil;
Break; //// BREAK ////
end;
end;
end;
if Path = nil then
Break; //// BREAK ////
end;
end;
procedure NetPathPerpendSideRotate(aPath: TNetPath);
var
SelPath: TNetPath;
begin
SelPath := aPath;
if SelPath = nil then
SelPath := NetGetSelPath;
if SelPath <> nil then
begin
//SelPath.FPerpendSide := SelPath.FPerpendSide xor 1;
//SelPath.Net.RefreshPaths;
SelPath.InvertPerpendSide;
RefreshCAD_T(GCadForm.PCad);
F_ProjMan.RefreshNode;
end;
end;
procedure NetProps;
var
Figure: TFigure;
ArchObj: TSCSComponent;
begin
if GCadForm.PCad.Selection.Count > 0 then
begin
Figure := TFigure(GCadForm.PCad.Selection[0]);
if Figure is TNet then
begin
ArchObj := GetArchObjByCADObj(Figure);
if (ArchObj <> nil) and (ArchObj.IsLine = ctArhRoofSeg) then
begin
SelectArchObjByCADObj(Figure, ArchObj);
EditSelectedCADArchObj;
end;
end;
end;
end;
procedure IncDefWallType;
begin
GDefWallType := TWallType(Ord(GDefWallType)+1);
if GDefWallType > wtHalf then
GDefWallType := wtWall;
end;
procedure ServDefineNetSegsHeights;
var
i, j: integer;
List: TSCSList;
Catalog: TSCSCatalog;
Compon: TSCSComponent;
Corner1, Corner2: TSCSComponent;
Path: TNetPath;
Prop: PProperty;
SprProp: TNBProperty;
begin
for i := 0 to F_ProjMan.GSCSBase.CurrProject.ChildCatalogReferences.Count - 1 do
begin
Catalog := F_ProjMan.GSCSBase.CurrProject.ChildCatalogReferences[i];
if Catalog.ItemType = itArhContainer then
for j := 0 to Catalog.ComponentReferences.Count - 1 do
begin
Compon := Catalog.ComponentReferences[j];
if IsArchSegmentComponByIsLine(Compon.IsLine) then
begin
Path := TNetPath(GetCADObjByArchObj(Compon));
if Path <> nil then
begin
Corner1 := GetArchCornerByPoint(Path.Net, Path.p1);
Corner2 := GetArchCornerByPoint(Path.Net, Path.p2);
if Assigned(Corner1) and Assigned(Corner2) and
(Corner1.GetPropertyValueBySysName(pnHeight) = Corner2.GetPropertyValueBySysName(pnHeight)) and
(Corner1.GetPropertyValueBySysName(pnHeight) <> Compon.GetPropertyValueBySysName(pnHeight)) then
Compon.SetPropertyValueAsString(pnHeight, Corner1.GetPropertyValueBySysName(pnHeight));
if Compon.IsLine = ctArhRoofHip then
begin
// Øèðèíó ìåíÿåì íà äëèíó
Prop := Compon.GetPropertyBySysName(pnWidth);
if (Prop <> nil) and (Compon.GetPropertyBySysName(pnLength) = nil) then
begin
SprProp := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyBySysName(pnLength);
if SprProp <> nil then
begin
Compon.ProjectOwner.Spravochnik.GetPropertyWithAssign(SprProp.PropertyData.GUID, F_NormBase.GSCSBase.NBSpravochnik);
Prop.SysName := pnLength;
Prop.GUIDProperty := SprProp.PropertyData.GUID;
Prop.Name_ := SprProp.PropertyData.Name;
Prop.ID_Property := 0;
Prop.IsDefault := SprProp.PropertyData.IsStandart;
Prop.IsForWholeComponent := SprProp.PropertyData.IsForWholeComponent;
Prop.IDDataType := SprProp.PropertyData.IDDataType;
SprProp := Compon.ProjectOwner.Spravochnik.GetPropertyBySysName(pnLength);
if SprProp <> nil then
Prop.ID_Property := SprProp.PropertyData.ID;
end;
end;
// Äëèíà ïðîåêöèè
AddPropsToComponFromSprBySN(Compon, pnLengthProj);
end;
end;
end;
end;
end;
end;
initialization
GArchEngine := TArchEngine.Create();
{ Testing
LinesCross(DoublePoint(299, 120), DoublePoint(299, 78), DoublePoint(280, 120), DoublePoint(299, 120));
LinesCross(DoublePoint(299, 78), DoublePoint(299, 120), DoublePoint(280, 120), DoublePoint(299, 120));
LinesCross(DoublePoint(299, 120), DoublePoint(299, 78), DoublePoint(299, 120), DoublePoint(280, 120));
LinesCross(DoublePoint(299, 78), DoublePoint(299, 120), DoublePoint(299, 120), DoublePoint(280, 120));
LinesCross(DoublePoint(280, 120), DoublePoint(299, 120), DoublePoint(299, 120), DoublePoint(299, 78));
LinesCross(DoublePoint(299, 120), DoublePoint(280, 120), DoublePoint(299, 120), DoublePoint(299, 78));
LinesCross(DoublePoint(280, 120), DoublePoint(299, 120), DoublePoint(299, 78), DoublePoint(299, 120));
LinesCross(DoublePoint(299, 120), DoublePoint(280, 120), DoublePoint(299, 78), DoublePoint(299, 120));
// Ñ ðàçíûìè z êîîðäèíàòàìè
LinesIntersect(DoublePoint(299, 120, 1), DoublePoint(299, 78, 2), DoublePoint(280, 120, 3), DoublePoint(299, 120, 4));
LinesIntersect(DoublePoint(299, 78, 1), DoublePoint(299, 120, 2), DoublePoint(280, 120, 3), DoublePoint(299, 120, 4));
LinesIntersect(DoublePoint(299, 120, 1), DoublePoint(299, 78, 2), DoublePoint(299, 120, 3), DoublePoint(280, 120, 4));
LinesIntersect(DoublePoint(299, 78, 1), DoublePoint(299, 120, 2), DoublePoint(299, 120, 3), DoublePoint(280, 120, 4));
LinesIntersect(DoublePoint(280, 120, 1), DoublePoint(299, 120, 2), DoublePoint(299, 120, 3), DoublePoint(299, 78, 4));
LinesIntersect(DoublePoint(299, 120, 1), DoublePoint(280, 120, 2), DoublePoint(299, 120, 3), DoublePoint(299, 78, 4));
LinesIntersect(DoublePoint(280, 120, 1), DoublePoint(299, 120, 2), DoublePoint(299, 78, 3), DoublePoint(299, 120, 4));
LinesIntersect(DoublePoint(299, 120, 1), DoublePoint(280, 120, 2), DoublePoint(299, 78, 3), DoublePoint(299, 120, 4));}
finalization
FreeAndNil(GArchEngine);
end.
Reference in New Issue View Git Blame Copy Permalink