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)= (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.