unit fplan; interface uses DrawObjects,DrawEngine,PCTypesUtils,Windows, Messages, SysUtils, Classes, U_Common_Classes, Graphics,Dialogs,ComCtrls, Math,PCDrawing,Powercad,menus,rrEllipses, pCDrawBox, Types; const // Left Right coord type crtL1 = 1; crtL2 = 2; crtR1 = 3; crtR2 = 4; crtP1 = 5; crtP2 = 6; // Length Type ltInner = 1; ltOuter = 2; // Cmp Intersect type citNone = 0; // Нету citSide = 1; // одной сторной citEqual = 2; // накладываются друг на друга citEntry = 3; // Входит в сегмент citAbsorb = 4; // Поглащает сегмент cstWallLineWidth = 0.01; type TNet = class; TNetPath = class; TNetDoor = class; TPosType = (ptVertical, ptHorizontal, ptAngular); TNetSelType = (stStruct, stPath); TWallType = (wtWall, WtOpen, wtGlass, wtHalf); TWallStyle = (wsWall, wsLine); TDoorType = (dtIndoor, dtOutDoor, dtMainDoor); //Tolik 15/09/2017 -- TDoorImageType = (dtSimple, dtHalfOpened, dtFullOpened); // TDoorObjType = (dotNone, dotDoor, dotWindow, dotEmbrasure, dotNiche, dotArc, dotBalcony); TDoorObjTypes = set of TDoorObjType; // Тип отображения длины сегмента - между точками, внутренняя, внешняя TShowPathLengthType = (sltPoints, sltOuter, sltInner); TNotifyPathEvent = procedure(Sender: TObject; SrcPath, NewPath: TNetPath) of object; TDefineJoinedNetsEvent = function (Sender: TNet; ANetList, ACheckNetList, AResJoined: TList): Boolean of object; TDefineMoveObjectsEvent = function(Sender: TNet; Apt: PDoublePoint; APath: TNetPath; ANetList: TList; AllowNear: Boolean=true): Boolean of object; TDuplicateEvent = procedure(SrcObj, NewObj: TObject) of Object; TDoorChangePathQueryEvent = procedure(Sender: TNetDoor; APath, ANewPath: TNetPath; var CanChange: Boolean) of object; TMergeNetPathsQueryEvent = procedure(Sender: TNet; var CanMerge: Boolean) of object; TMergeNetsQueryEvent = procedure(ANet1, ANet2: TNet; var CanMerge: Boolean) of object; TMergePathsQueryEvent = procedure(APath1, APath2: TNetPath; var CanMerge: Boolean) of object; TMergePathsEvent = procedure(AMainPath, APath: TNetPath) of object; TPathPointEvent = function(Sender: TNet; aTrgPath: TNetPath; APoint: PDoublePoint; AID: Integer): Integer of object; TPointEvent = function(Sender: TNet; APoint: PDoublePoint; AID: Integer): Integer of object; TGetFloatEvent = function(Sender: TObject): Double of object; TGetHeightEvent = function(Sender: TObject): Double of object; TGetHeightOfPtEvent = function(Sender: TObject; pt: PDoublePoint): Double of object; TGetPathCheckOverlapMargin = procedure(Sender: TNet; Path, PathChk: TNetPath; var aMargin: Double) of object; TGetShowPathLengthTypeEvent = function(Sender: TObject): TShowPathLengthType of object; TPathsOverlapQuery = procedure(APath, ACheckPath: TNetPath; Apt: PDoublePoint; var ACanOverlap: Boolean) of object; TScaleEvent = procedure(Sender: TObject; PercentX, PercentY: Double; rPoint: PDoublePoint) of object; TSetScaleEvent = procedure(Sender: TObject; OldScale, NewScale: Double) of object; TWallPath = class(TFigure) Net: Tnet; Valid: Boolean; Refpaths: Tlist; FStarted: Boolean; CIndex : Integer; Function Closed: Boolean; Procedure SnapPoint(var x, y: Double); constructor create(p1: TDoublepoint; xNet: Tnet); procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override; Function GetLen(p1, p2: TDoublePoint): Double; virtual; class Function CreateShadow(x, y: Double): TFigure; override; Function ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; override; Function ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; override; class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override; Destructor Destroy; override; function checkNoConnectedPrevPoint:Boolean; end; TWallRect = class(TFigure) Net: Tnet; Valid: Boolean; Refpaths: Tlist; FStarted: Boolean; CIndex : Integer; xLocked: Boolean; yLocked: Boolean; Function ShadowKeyStroke(var ClickIndex, KeyCode: Integer; Shift: TShiftState; var Fnished: Boolean): Boolean; override; Procedure LockTrace; Procedure UnLockTrace; Procedure SnapPoint(var x, y: Double); constructor create(p1: TDoublepoint; xNet: Tnet); procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override; Function GetLen(p1, p2: TDoublePoint): Double; virtual; class Function CreateShadow(x, y: Double): TFigure; override; Function ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; override; Function ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; override; class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure; override; Destructor Destroy; override; end; TNetDoor = class(TMyObject) a1, a2 : TDoublePoint; b1, b2 : TDoublePoint; ca1, ca2 : TDoublePoint; cb1, cb2 : TDoublePoint; p1, p2 : TDoublePoint; ta1, ta2: TDoublePoint; tb1, tb2: TDoublePoint; ba1, ba2: TDoublePoint; bb1, bb2: TDoublePoint; Start : Double; Width : Double; Window: Boolean; //Len: Double; Height: Double; WOffset: Double; isDraw: Boolean; // Tolik 21/11/2019 -- Region: HRGN; //Region: Integer; // //Tolik 15/09/2017 -- DoorImageType: TDoorImageType; Doubled: Boolean; // двойные двери Mirrored: Boolean; // в другую сторону (откр. наружу) LeftRight: Boolean; // двосторонние двери Opened: Boolean; // открытая дверь (добавляем арочное отображение на 90 градусов ) HalfOpened: Boolean; // полуоткрытая дверь (добавляем арочное отображение на 45 градусов ) // //Tolik 05/09/2018 -- WndPlacementHeight: Double; // DoorType: TDoorType; DoorObjType: TDoorObjType; DoorNbr: Integer; Net: Tnet; InSide: Byte; FIndent: Integer; ClearP1, ClearP2: TDoublePoint; //07.05.2012 - точки ниши, где убирается линия с сегмента FComponID: Integer; FDeleting: Boolean; FOnDblClick: TNotifyEvent; FOnDoorChangePathQuery: TDoorChangePathQueryEvent; FOnDelete: TNotifyEvent; FOnResize: TNotifyEvent; FOnSelect: TNotifyEvent; FPath: TNetPath; // Preloaded Path Owner FRotation: ShortInt; //03.05.2012 - переворот объекта: 0-не перевернут, 1-180 град FSrcDoor: TNetDoor; FLen: Double; procedure DefineDoorObjType; Procedure DeleteRegion; Procedure Draw(Dengine: TPCDrawEngine; Color: TColor); Procedure DrawNiche(Dengine: TPCDrawEngine; Color: TColor; aStyle: Integer; pa1, pa2, pb1, pb2, cp1, cp2: PDoublePoint); Procedure GetOutPoints(var top1, top2, bot1, bot2: TDoublePoint; PathDir: Integer); Procedure GetInPoints(var top1, top2, bot1, bot2: TDoublePoint; PathDir: Integer); Procedure UpdateRegion(Dengine: TPCDrawEngine); Constructor Create(s, w, l:Double; aDoorObjType: TDoorObjType; xNet: Tnet); Procedure CalculatePoints(xp1, xp2: TDoublePoint); procedure SetDefParams; Procedure WriteToStream(Stream: TStream); Class Function CreateFromStream(Stream: Tstream; xPath: TNetPath): TNetDoor; Destructor Destroy;override; procedure DoClick; procedure DoDblClick; procedure DoDelete; procedure DoResize; function DoChangePathQuery(APath, ANewPath: TNetPath): Boolean; function GetPath: TNetPath; procedure TestSetVal(AValue: Double); property Len: Double read FLen write TestSetVal; end; TPathTrace = class(TFigure) Net: Tnet; Clone: TNet; FPathInClone: TNetPath; //22.04.2011 FPathInCloneInversePt: Boolean; //22.04.2011 - Не соответствуют ли точки сегмента в клона из точками Path Path : TNetPath; ShiftP: Boolean; CtrlP: Boolean; OPoint, p1, p2, op1, op2, xp1, xp2: TDoublePoint; FDrawP1, FDrawP2: TDoublePoint; NPoints1, NPoints2: TDoublePointArr; NDrawPoints1, NDrawPoints2: TDoublePointArr; WidthInner1, WidthInner2: Double; //15.04.2011 WidthOut1, WidthOut2: Double; //15.04.2011 SnappedNearPoint: Boolean; SnappedGrid: Boolean; SnappedGuide: Boolean; Relocate: Boolean; DeleteOld: Boolean; Repair: Boolean; // ArcProps //22.10.2010 IsArc: Boolean; ArcCenter: TDoublePoint; l1, l2, r1, r2: TDoublePoint; Inverted: Boolean; FMDeltaX, FMDeltaY: Double; //24.05.2011 - Move delata x y FEDeltaX, FEDeltaY: Double; //24.05.2011 - End delata x y FRelatedTraces: TList; //19.10.2010 FRelatedNets: TList; //21.10.2010 FIsRelated: Boolean; //19.10.2010 FRelatedOwner: TObject; //13.05.2011 Procedure Move(dx, dy: Double); override; Procedure MoveRelated(dx, dy: Double); //19.10.2010 Procedure EndTrace; Procedure EndTraceRelated; //19.10.2010 Constructor Create(xPath: TNetPath; xNet: TNet; Shift, ctrl: Boolean); destructor Destroy; override; //19.10.2010 Procedure Draw(DEngine:TPCDrawEngine;isGrayed:Boolean);override; procedure DrawArc(Dengine: TPCDrawEngine;Color:Tcolor; style:Integer); Procedure DrawRelated(DEngine:TPCDrawEngine;isGrayed:Boolean); //19.10.2010 function IsRelatedTo(Apt1, Apt2: PDoublePoint): Boolean; end; TDoorTrace = class(TFigure) Net: TNet; Path, oPath: TNetPath; Door: TnetDoor; OPoint: TDoublePoint; Start, NStart: Double; DrawStartOffset: Double; PathP1, PathP2: TDoublePoint; //19.04.2011 p1, p2: TDoublePoint; //11.10.2010 NLen: Double; FIsShowLen: Boolean; Procedure Locate(x, y: Double); Procedure Move(dx, dy: Double);override; Procedure EndTrace; Constructor Create(xNet: TNet; xPath: TNetPath; xDoor: TNetDoor); Procedure Draw(DEngine: TPCDrawEngine; isGrayed: Boolean); override; procedure DefineActualPoints; //11.10.2010 procedure MovePoint(APoint: TDoublePoint; x, y: Double); end; TNetStruct = class(TMyObject) Net: Tnet; // Tolik 21/11/2019 -- Region: HRGN; //Region: Integer; // Points: TList; Style: Integer; Function PathInter(p1, p2: TDoublePoint):Boolean;virtual; Function GetDistToPoint(p:TDoublePoint):Double;virtual; Function IsPointIn(x,y:Double):Boolean;virtual; Procedure DrawGuides(DEngine:TPCDrawEngine);virtual; Procedure Draw(Dengine:TPCdrawEngine;isGrayed:Boolean);virtual; Procedure DrawTrace(Dengine:TPCDrawEngine);virtual; Procedure Hatch(Dengine:TPCdrawEngine;isGrayed:Boolean);virtual; Constructor Create(xNet: TNet); Destructor Destroy; override; Function IsKnotIn(p: PDoublePoint): Integer; Function Duplicate: TNetStruct; virtual; Function DuplicateNonPoints: TNetStruct; virtual; Procedure WriteToStream(Stream: TStream); Virtual; Class Function CreateFromStream(Stream: Tstream; xNet: Tnet): TNetStruct; virtual; Procedure DoSolid(Faces:Tlist;topZ,botZ:Double); virtual; Function SnapPoints(var x,y:Double;DotsPerMil:Double):Boolean;virtual; Procedure ShowProperties;virtual; Procedure PropUpdate(PropName, PropVal: String);virtual; procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);virtual; end; TNetCol = class(TnetStruct) p1: PDoublePoint; Angle: Double; w,h: Double; Position: Byte; Function PathInter(p1,p2:TDoublePoint):Boolean;override; Function GetDistToPoint(p:TDoublePoint):Double;override; Procedure IntersectPath(Path:TnetPath); Procedure IntersectPathPipe(Path:TnetPath); Procedure _Draw(Dengine:TPCdrawEngine;xColor:TColor;Fill:Boolean); Procedure DrawGuides(DEngine:TPCDrawEngine);override; Procedure Draw(Dengine:TPCdrawEngine;isGrayed:Boolean);override; Procedure DrawTrace(Dengine:TPCDrawEngine);override; Function GetPoints(var ap1,ap2,ap3,ap4:TDoublePoint):Boolean; Function GetPipePoints(var ap1,ap2,ap3,ap4:TDoublePoint):Boolean; Constructor Create(xNet:Tnet; p: PDoublePoint); Function DuplicateNonPoints: TNetStruct;override; Procedure SetPosition; Procedure WriteToStream(Stream:TStream);override; Class Function CreateFromStream(Stream:Tstream;xNet:Tnet):TNetStruct;override; Function SnapPoints(var x,y:Double;DotsPerMil:Double):Boolean;override; procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);override; end; TNetRow = class(TnetStruct) p1,p2: PDoublePoint; Thick: Double; Height: Double; a1,a2,b1,b2: TDoublePoint; Function PathInter(p1, p2: TDoublePoint): Boolean; override; Function GetDistToPoint(p: TDoublePoint): Double;override; Function GetPipePoints(var aa1,aa2,bb1,bb2:TDoublePoint): Boolean;overload; Function GetPipePoints: Boolean;overload; Procedure DrawGuides(DEngine:TPCDrawEngine);override; Procedure IntersectPathPipe(Path:TnetPath); Procedure _Draw(Dengine:TPCdrawEngine;xColor:TColor); Function GetPoints(var ap1,ap2,ap3,ap4:TDoublePoint):Boolean; Procedure Draw(Dengine:TPCdrawEngine;isGrayed:Boolean);override; Procedure DrawTrace(Dengine:TPCDrawEngine);override; Constructor Create(xNet:Tnet; xp1,xp2: PDoublePoint); Function DuplicateNonPoints: TNetStruct;override; Function IsPointIn(x,y:Double):Boolean;override; Procedure WriteToStream(Stream: TStream);override; Class Function CreateFromStream(Stream: Tstream; xNet: Tnet): TNetStruct;override; Function SnapPoints(var x,y:Double;DotsPerMil:Double):Boolean;override; procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double);override; Procedure IntersectPath(Path:TnetPath); end; TInsertCol = class(TFigure) Net: Tnet; constructor create(p1: TDoublepoint; xNet: Tnet); class Function CreateShadow(x, y:Double): TFigure;override; Function ShadowClick(ClickIndex: Integer; x,y: Double): Boolean;override; Function ShadowTrace(ClickIndex: Integer; x,y: Double): Boolean;override; class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow:TFigure): TFigure;override; end; TInsertRow = class(TFigure) Net: Tnet; Valid: Boolean; Procedure SnapPoint(var x,y:Double); constructor create(p1: TDoublepoint;xNet:Tnet); procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override; class Function CreateShadow(x, y:Double): TFigure;override; Function ShadowClick(ClickIndex:Integer;x,y: Double): Boolean;override; Function ShadowTrace(ClickIndex:Integer;x,y: Double): Boolean;override; class function CreateFromShadow(aOwner: TComponent; LHandle: LongInt; Shadow: TFigure): TFigure;override; end; TPathDirection = (ptL12, ptL21, ptR12, ptR21); TnetPath = class(TMyObject) private procedure AfterDiv; procedure BeforeDiv; public id: Integer; // Tolik 21/12/2019 -- Border: Boolean; p1,p2: PDoublePoint; a1,a2: TDoublePoint; b1,b2: TdoublePoint; l1,l2: TDoublePoint; // Temp points for offset intersections r1,r2: TDoublePoint; // Temp points for offset intersections Angle: Double; // Temp angle for offset intersections Dir: Integer; // Temp drection for offset intersections Empty1: Boolean; Empty2: Boolean; // Tolik 21/11/2019 -- Region: HRGN; //Region: Integer; // Tag: Integer; Net: TNet; Deleted: Boolean; DeadIdx: Integer; WType: TWallType; WStyle: TWallStyle; Width: Double; isArc: Boolean; ArcAng: Double; ArcRad: Double; Inverted: Boolean; ArcCenter: TDoublePoint; ArcA1: Double; ArcA2: Double; ArcJoinA1: TDoublePoint; ArcJoinA2: TDoublePoint; ArcJoinB1: TDoublePoint; ArcJoinB2: TDoublePoint; ArcJoinA1L: TDoublePoint; ArcJoinA2L: TDoublePoint; ArcJoinB1L: TDoublePoint; ArcJoinB2L: TDoublePoint; Doors: TList; DoorIndex: Integer; Broken: Boolean; IsoTopL1: TDoublePoint; IsoTopL2: TDoublePoint; IsoBotL1: TDoublePoint; IsoBotL2: TDoublePoint; IsoTopR1: TDoublePoint; IsoTopR2: TDoublePoint; IsoBotR1: TDoublePoint; IsoBotR2: TDoublePoint; isoP1,isoP2: TDoublePoint; TopL1: T3dPoint; TopL2: T3dPoint; TopR1: T3dpoint; TopR2: T3dPoint; BotL1: T3dPoint; BotL2: T3dPoint; BotR1: T3dpoint; BotR2: T3dPoint; IsOut: Boolean; HL1,HL2,HR1,HR2: TDoublePoint; HE1,HE2: TDoublePoint; FoundCnt: Integer; isRow: boolean; Info: String; mpa,mpb: TDoublePoint; apa,apb: TDoublePoint; bpaA,bpbA: TDoublePoint; bpaB,bpbB: TDoublePoint; Style: Integer; Opath: TNetPath; // original path of trace path FShowLength: Boolean; FPathStyle: TPenstyle; FPathWidth: Integer; //FID: Integer; FBrushColor: Integer; FBrushStyle: Integer; FColor: Integer; FComponID: Integer; FDeleting: Boolean; FDivedFrom: TNetPath; //14.12.2010 От какого сегмента этот отделен FIsHidden: Boolean; //21.04.2011 FIsInner: Boolean; //10.12.2010 Признак что сегмент между двумя контурами FIsConture: Boolean; //29.05.2012 - Участвует ли сегмент в контуре FOnAfterDiv: TNotifyEvent; //06.10.2010 FOnBeforeDiv: TNotifyEvent; //06.10.2010 FOnDblClick: TNotifyEvent; FOnDelete: TNotifyEvent; FOnGetHeight: TGetHeightEvent; //12.05.2011 FOnGetHeightOfPt: TGetHeightOfPtEvent; //12.05.2011 FOnGetPathCheckOverlapMargin: TGetPathCheckOverlapMargin; //27.08.2012 - Получение отступа для проверки пеересечений сегментов //FOnGetShowPathLength: TGetFloatEvent; //15.04.2011 - Тип длины для выделенного сегмента //FOnGetShowPathTraceLength: TGetFloatEvent; //15.04.2011 - Тип длины для сегмента на onmove FOnGetShowPathLengthType: TGetShowPathLengthTypeEvent; //15.04.2011 - Тип длины для выделенного сегмента FOnGetShowPathTraceLengthType: TGetShowPathLengthTypeEvent; //15.04.2011 - Тип длины для сегмента на onmove FOnMove: TNotifyEvent; FOnSelect: TNotifyEvent; FSelecting: Boolean; FSubRegions: TList; //23.03.2013 - подрегионы - участки между окнами/дверьми/ FSrcPaths: TList; FPointsOffset: Double; FPerpendSide: ShortInt; // С какой стороны отображать, если тоньший сегмент: 1 - с другой стороны, 2 - по средине (на будущее) FPerpendDX: Double; FPerpendDY: Double; el1,el2: TDoublePoint; // Temp points for offset intersections er1,er2: TDoublePoint; // Temp points for offset intersections epl1,epl2,epr1,epr2: PDoublePoint; //18.05.2012 - Перпендикулярные точки - ссылки на el1,el2,er1,er2 связанного сегмента LR1, LR2, RL1, RL2: TDoublePoint; // Точки подведенные (опущены) с паралельной линии op1, op2: PDoublePoint; // Внешние точки из el или er ip1, ip2: PDoublePoint; // Внутренние точки из el или er p1H, p2H: Double; // Высоты точек Function GetPoint(PType: Integer): TDoublePoint; Procedure SetLen(len: Double; back: Boolean); Procedure MoveDoors(nPath: TnetPath); Procedure Refresh; procedure GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); Procedure AddCols; Function GetLeftCorner(var wp: TDoublePoint): TDoublePoint; Function GetRightCorner(var wp: TDoublePoint): TDoublePoint; Function SnapToKnots(var x,y: Double; DotsPerMil: Double; SnapLine: Boolean): Boolean; Function SnapToPipeLine(var x,y: Double; DotsPerMil: Double): Boolean; Function SnapToCorners(var x,y: Double; DotsPerMil: Double): Boolean; Function SnapToPipeCorners(var x,y: Double; DotsPerMil: Double): Boolean; Function ForceSnapToPipeCorners(var x,y,dSnap: Double): Boolean; Function ForceSnapToPipeLine(var x,y,dSnap: Double): Boolean; Procedure IsometricDraw(Dengine: TPCDrawEngine; Color: TColor); Procedure AddEndLine(var pArr:TDoublePointArr; Direction: TPathDirection); Procedure AddBezierPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean); Procedure AddWallPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean); Procedure AddArcPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean); Procedure AddOpenPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean); Procedure AddHalfPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean); Procedure AddGlassPoints(var pArr:TDoublePointArr; Direction: TPathDirection; IncFirst:Boolean); Procedure CopyFrom(sPath: TnetPath; AWithDoors: Boolean=true); Function Len: Double; Function AbsLen: Double; Function MLen: Double; function InnerLen: Double; // Inner Len to bounds Function ActiveDoor: TNetDoor; Procedure CalculateDoorPoints(dp1, dp2: PDoublePoint); //22.05.2012 Procedure CalculateExternSnaps; Procedure CalculatePoints(topZ, botZ: Double); Function NewDoor(s, len: Double; aDoorObjType: TDoorObjType): TnetDoor; Procedure SortDoors; Procedure SetShape(xArc: Boolean); Procedure SetArcAng(ang: Double); Function IsPointIn(x,y: Double; aSelect: Boolean=true): Boolean; Function isLineIntersect(xp1,xp2: TDoublePoint): Boolean; Function LineIntersect(xp1,xp2: TDoublePoint; var ip: TDoublePoint): Boolean; Function PointToWall(var p: TdoublePoint; refP: TdoublePoint): Boolean; Function IsPointOnLine(x,y: Double): Boolean; Function isKnotIn(p: PDoublePoint): Integer; Function isKnotValIn(p: TDoublePoint): Integer; Function AreYou(xp1, xp2: PDoublePoint): Boolean; overload; Function AreYou(xp1, xp2: TDoublePoint): Boolean; overload; Function Connected(path: TnetPath): Boolean; Constructor Create(xp1, xp2: PDoublePoint; xBorder: Boolean; xNet: Tnet); Procedure Initialize; // Tolik 21/12/2019 -- Procedure WriteToStream(Stream: TStream); Class Function CreateFromStream(Stream: TStream; xNet: Tnet; aOldPlan: Boolean): TnetPath; Procedure Hatch(DEngine: TPCDrawEngine; isGrayed: Boolean); Function CreateInRgn(DEngine:TPCDrawEngine): HRGN; Function CreateLinearRgn(DEngine:TPCDrawEngine): HRGN; procedure CreateLinearSubRgns(DEngine:TPCDrawEngine); Function CreateArcRgn(DEngine:TPCDrawEngine): HRGN; Procedure Move(dx, dy: Double); Procedure MoveDoor(delta: Double); Procedure DeleteDoor; Procedure DeleteDoors; Function PosType: TPosType; Function ISClosed: Boolean; Procedure Draw(Dengine:TPCDrawEngine;Color:TColor); Procedure DrawOpen(Dengine:TPCDrawEngine;Color:TColor); Procedure DrawGlass(Dengine:TPCDrawEngine;Color:TColor); Procedure DrawHalf(Dengine:TPCDrawEngine;Color:TColor); Procedure DrawWall(Dengine:TPCDrawEngine;Color:TColor); Procedure DrawGuides(DEngine:TPCDrawEngine); Procedure DrawArc(Dengine:TPCDrawEngine;Color:Tcolor; style:Integer); Procedure DrawTrace(Dengine:TPCDrawEngine); Procedure UpdateRegion(Dengine:TPCDrawEngine); Procedure DeleteRegions; Procedure DrawDoors(Dengine:TPCDrawEngine;Color:TColor); Function HasDoor: Boolean; Destructor Destroy;override; Procedure ClearDoors; Function OtherPoint(p:PDoublePoint):PDoublePoint; Procedure SetType(xType:TWallType); Function Overlaps(path: TnetPath): Boolean; Procedure DrawOuterCorners(DEngine:TPCDrawEngine;Color,Width,Style:Integer); Procedure DrawInnerCorners(DEngine:TPCDrawEngine;Color,Width,Style:Integer); // Прибавляет длину, значение ALen м.б. отрицательным function AddDoorAtPt(pt: TDoublePoint; len: Double; aDoorObjType: TDoorObjType): TnetDoor; procedure AddLen(ALen: Double); //15.10.2010 procedure AfterLoadProps; procedure ApplyStyle(Dengine:TPCDrawEngine; Color:TColor); //17.03.2013 procedure Assign(ASource: TNetPath); procedure AssignProps(APath: TNetPath); function CmpIntersectPath(APath: TNetPath; MarginDelta:Double = 2; AEqualRotate: Pointer=nil): Integer; procedure DefineDoorsOwner; procedure DefineInOutPoints; //10.12.2010 Определяет внутренние/внешние точки сегмента Procedure DeleteDoorObj(ADoor: TNetDoor); procedure DoDelete; Procedure DoClick(X, Y: Double); Procedure DoDblClick; Procedure DrawArcCenter(Dengine:TPCDrawEngine; Color:Tcolor; Style:Integer); function ExistsPerpendPt: Boolean; procedure FillArcJoinPoints(aPoints, aLPoints: TList); procedure FillArcPointsByEndPoints(var aPoints: TDoublePointArr; ap1, ap2: PDoublePoint; aDxfMode: Boolean=false); procedure FillRegions(Dengine: TPCDrawEngine; aBrushColor: TColor; aBrushStyle: Integer); function GetArcLPointByPt(apt: PDoublePoint): PDoublePoint; function GetConnected(APt: PDoublePoint): TNetPath; // Вернет первый подключенный сегмент по точке function GetConnectedPoint(APath: TNetPath): PDoublePoint; // Вернет точку к которой подключен сегмент //28.05.2012 - Какой стороной подключены к сегменту function GetConnectedSide(APath: TNetPath): Integer; function GetConturePolygon: TDoublePointArr; function GetConturePoints(aAllowEPoints: Boolean; aPointSide: Integer=0; aPathSide: Char=#0): TList; function GetDoorByComponID(AComponID: Integer): TNetDoor; //11.04.2012 - вернет полній контур сегмента - меньшая сторона подтягивается под большую function GetFullConture: TDoublePointArr; function GetHeight: Double; function GetHeightOfPt(pt: PDoublePoint): Double; // Вернет длину мужду точками, учитывает если дуга function GetLenByPoints(p1, p2: TDoublePoint): Double; //28.10.2010 // Вернет длину для показа function GetLenForShow(AShowPathLengthType: TShowPathLengthType): Double; function GetObjInPoint(x, y: Double): TObject; //17.01.2011 function GetPointByLenghType(ASideNum: Integer; aLengthType: TShowPathLengthType): PDoublePoint; //28.04.2012 //24.05.2012 - Вернет точку, которая соединяется с перпендикулярной function GetPointByPerpend(aPerpendPt: PDoublePoint): PDoublePoint; // Вернет точки по номеру стороны function GetPointsBySide(ASideNum: Integer; var L, R, LR, RL: TDoublePoint): Boolean; function GetPointBySide(ASideNum: Integer): PDoublePoint; function GetPointSide(aPoint: PDoublePoint): Integer; // Вернет точки стороны, которые описывают треугольник L, R, (LR || RL) function GetTrianglePointsBySide(ASideNum: Integer; var L, R, T: TDoublePoint): Boolean; procedure InvertPerpendSide(aUpdateRegion: Boolean=true); function IsInnerNiche(aNiche: TNetDoor; aRefreshPathPoints: Boolean=false): Boolean; // получить длину внутренней/внешней части function LenByType(AType: Integer): Double; //15.10.2010 function OutLen: Double; // Длина части сегмента за исключением углов function ProperLen: Double; // Определяет точки, проведенные с паралельных линий procedure PointToParralelLine; function SecondPoint(p: PDoublePoint): PDoublePoint; procedure SetEPoints; // Установить длину сегмента по внутренней части procedure SetInnerLen(ALen: Double); //15.10.2010 // // Установить длину сегмента по внутренней/внешней части procedure SetLenByType(ALen: Double; AType: Integer); // Установить длину сегмента по внешней части procedure SetOutLen(ALen: Double); //15.10.2010 procedure Select; procedure SelectDoor(ADoor: TNetDoor); procedure TestShowPointsInfo; Function GetRelatedPaths: TList; End; TNet = class(TFigure) Points: TList; Paths: TList; Structs: TList; SelType: TNetSelType; SelIndex: Integer; PathRgn: HRGN; XDrawEngine: TPCDrawEngine; MapScale: Double; FillWalls: Boolean; WallThick: Double; WorkHeight: Double; WorkWidth: Double; IsometricUpdate: Boolean; TopZ: Double; BotZ: Double; EndDraw: Boolean; ContextMenu: Boolean; DrawGuides: Boolean; EditMode: Boolean; DrawAsTrace: Boolean; DetDraw: Boolean; ShowPathCenters: Boolean; ShowDims: Boolean; WorldDim: Boolean; //FID: Integer; FAllowDelPathOnMake: Boolean; //FAllowCleanSamePointsInGrpPointArray: Boolean; //21.06.2012 - позволять чистить массив точек для создания сегмента FAllowAddPathWithSamePoints: Boolean; //21.06.2012 - позволять добавлять сегменты с точками на динаковые координаты FCmpPointPrecision: Double; // точность для сравнения точек FComponID: Integer; FDeleting: Boolean; FDisableMergePaths: Boolean; FDrawedPt1: TList; //13.05.2011 - отрисованные точки с одних сторон FDrawedPt2: TList; //13.05.2011 - отрисованные точки с одних сторон FFigureModification: Boolean; // Tolik 28/08/2019 -- //FLastTickTraceRefresh: Cardinal; FLastTickTraceRefresh: DWord; // FMoveAllPoints: Boolean; FOnAddPoint: TPathPointEvent; //04.10.2010 FOnAutoAddPath: TNotifyPathEvent; FOnDefineJoinedNets: TDefineJoinedNetsEvent; //26.05.2011 FOnDefineMoveObjects: TDefineMoveObjectsEvent; //23.05.2011 FOnDelete: TNotifyEvent; FOnDeletePoint: TPointEvent; //04.10.2010 FOnDuplicate: TDuplicateEvent; //16.05.2011 FOnMergePaths: TMergePathsEvent; //13.01.2011 FOnMergePathsQuery: TMergePathsQueryEvent; //21.10.2010 FOnMergeNetPathsQuery: TMergeNetPathsQueryEvent; FOnMergeNetsQuery: TMergeNetsQueryEvent; //21.10.2010 FOnMove: TNotifyEvent; //09.06.2011 FOnMoveJoinedPoints: TNotifyEvent; //09.06.2011 FOnMovePoint: TPointEvent; FOnPathsOverlapQuery: TPathsOverlapQuery; //10.05.2011 FOnResize: TNotifyEvent; FOnScale: TScaleEvent; FOnScaleAfter: TNotifyEvent; FOnScaleBefore: TNotifyEvent; FOnSetScale: TSetScaleEvent; FOnSelectPoint: TPointEvent; //05.10.2010 FPathDivision: TNetPath; //26.03.2013 FPointIDs: TList; FSelectingPt: Boolean; FSelection: TList; FSelPtIdx: Integer; FPathTracePoint: PDoublePoint; //21.10.2010 точка из PathTrace владельца FRelatedOwner: TObject; //21.10.2010 FRelatedPoints: TList; FRelatedMPoint: PDoublePoint; //19.10.2010 - Move-point по котором данный Net // (находящийся в списке FRelatedNets другого) связан по координатам со своим владельцем FRelatedMPath: TNetPath; //24.05.2011 - move trace path по которому данный Net // (находящийся в списке FRelatedNets другого) связан по координатам со своим владельцем FRelatedObject: TObject; FRelatedNets: TList; //19.10.2010 FJoinedMovePoints: TList; //23.05.2011 - Доп. точки, которые перемещаются за modpoint FJoinedMovePointsDirections: TList; //23.05.2011 - направления перемещения доп. точек FJoinedMovePointsFixedState: TList; //27.05.2011 - Зафиксированная позиция точки к подключенному сегменту FJoinedMovePaths: TList; //23.05.2011 - Доп. сегменты, которые перемещаются за pathtrace FJoinedMovePathsDirections: TList; //23.05.2011 - направления перемещения доп. сегментов FSavedPoints: TList; //24.05.2011 - Список запомненых точек FSavedScaledPoints: TList; //23.09.2011 - Список запомненых после scale FSrcNet: TNet; //21.10.2010 Объект из которого скопирован этот FIsGroup: Boolean; protected FPerpendPoints: TList; function GetAp1: TDoublePoint;override; public Function SelPath: TnetPath; function SelPt: PDoublePoint; Function SelDoor: TnetDoor; Function SelWindow: TnetDoor; Function SelCol: TnetCol; Function SelRow: TnetRow; Function SelCenter: TDoublePoint; Procedure RefreshColPositions; Function AddPoint(p: TDoublePoint; aTrgPath: TNetPath=nil): PDoublePOint; Function AddPath(p1, p2: PDoublePoint; Border: Boolean): TNetPath; Function GetNetPath(p1,p2: PDoublePoint): TnetPath; Function MakePathArc(pArr: TDoublePointArr; dontRefresh: Boolean = False): TNetPath; //22.10.2010 Function MakePath(pArr: TDoublePointArr; dontRefresh: Boolean = False): TnetPath; Function MakePathOnShadow(pArr: TDoublePointArr; dontRefresh: Boolean = False): TnetPath; Function CreatePaths(pArr: TDoublePointArr; dontRefresh: Boolean = False): TNetPath; Procedure RefreshRegions(DEngine: TPCDrawEngine); Procedure DeleteRegions; Procedure DeleteNonePaths; Procedure MarkBrokenPaths; Function FindBrokenPath(xPaths: TList): TnetPath; Function FindStartPoint(xPaths: TList): PDoublePoint; Function FindStartPath(cPaths: TList; p: PDoublePoint): TnetPath; Function FindClockPath(cPaths: TList; p: PDoublePoint; oPath: TnetPath): TnetPath; Function FindClockWPath(cPaths: TList; p: PDoublePoint; oPath: TnetPath): TnetPath; Function FindCloserPath(p: TDoublePoint): TNetPath; Function FindLenToCloserStruct(p: TDoublePoint): Double; Procedure GetPathsOfKnot(p: PDoublePoint; var xPaths: TList); overload; Procedure GetStructsOfKnot(p: PDoublePoint; var xStructs: TList); Procedure GetPathsOfKnot(p: PDoublePoint; lPaths: Tlist; var xPaths: TList);overload; Function CountPathsOfKnot(p:PDoublePoint;lPaths:Tlist): Integer; Function CountIntersectingPathsOfKnot(p:PDoublePoint;lPaths:Tlist): Integer; Function GroupPathPointsByIntersection(pArr:TDoublePointArr;var pGrp:TDoublePointGroup): Boolean; Function FindIntersections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean; //Tolik --17/10/2016-- //Function InsertKnot(p:TDoublePoint;force:Boolean=false; aPathOnKnot: Pointer=nil):PDoublePoint; Function InsertKnot(p:TDoublePoint;force:Boolean=false; aPathOnKnot: Pointer=nil; aPrevPoint: pDoublePoint = nil):PDoublePoint; // Tolik --19/10/2016-- Procedure CorrectNetPathPosbyRelatedPath(aPath: TNetPath; dx,dy: double);// поправить положение объекта после сдвига Function GetSCSRoomConture(aNet: TNet): TDoublePointArr; // Tolik 22/06/2018 -- // Function IsPOintOnWall(p: TDoublePoint): Boolean; Function PointOnPath(p:TDoublePoint): TNetPath; Function GetPathOfPoint(x,y:Double): TnetPath; Procedure FindLeftPaths(pathList:TList; ReList:TList); Procedure FindRightPaths(pathList:TList; ReList:TList); Procedure FindTopPaths(pathList:TList; ReList:TList); Procedure FindBottomPaths(pathList:TList; ReList:TList); function FindClosedRegions(pathList:TList): TList; Function GetCenterOfPaths(Paths: TList): TDoublePoint; Function FindMostSWPath(pathList: TList): TNetPath; Function FindMostSEPath(pathList: TList): TNetPath; Function FindMostEPath(pathList: TList): TNetPath; //constructor create(LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent); //04.06.2010 constructor create(LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent); Destructor Destroy;override; Procedure ClearPaths; Procedure ClearNetPoints; Procedure ClearStructs; procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean);override; Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override; procedure drawline(DEngine:TPCDrawEngine;p1,p2:TDoublePoint;Color,Width:Integer;Style:TPenStyle); Procedure RefreshPaths(aUpdateRegion: Boolean=true); Procedure CalculatePathPoints; Function SnapPoints(var x,y: Double; DotsPerMil: Double): Boolean;override; Function SnapToKnots(var x,y: Double; DotsPerMil: Double; SnapLine: Boolean): Boolean; Procedure FindClosestSnap(var x,y:Double); Procedure GetModPoints(ModList: TMyList);override; class function CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure;override; Procedure Initialize;override; Function Edit: Boolean;Override; Procedure Move(deltax, deltay: Double);override; Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);override; Procedure Mirror(Point1,Point2: TDoublePoint);override; Function FindPathOfPoints(p1,p2:TDoublePOint): TNetPath; procedure BeforeAllScale(Sender: TObject); procedure ScaleAllEvent(Sender: TObject); procedure AfterAllScale(Sender: TObject); Procedure Scale(px,py: Double; rPoint: TDoublepoint);override; Procedure Clear; function IsPointIn(x,y: Double): boolean;override; Function duplicate: TFigure; override; Procedure Drawselectionpoints(DEngine: TPCDrawEngine;isGrayed:Boolean);override; Procedure SnapModPoint(var x,y:Double; mp:TModPoint; traceNet:TNet); Procedure NormalizeKnot(p: PDoublePoint; Net: Tnet); function LocatePoint(p: PDoublePoint; x, y: Double; allowCheckValid: Boolean=true): Boolean; Procedure LocatePathPoint(p: PDoublePoint; x,y: Double); Procedure MovePath(path:TNetPath;dx,dy:Double); Procedure DoublePath(path: TNetPath; delta: Double); Procedure LocatePath(path: TNetPath; delta: Double; delOld, repair: Boolean); Procedure MovePathDoor(path: TNetPath; delta: Double); Function PathsValid(p: PDoublePOint): Boolean; Function DuplicateByBorder: TNet; Function DuplicateByKnot(p:PDoublePoint; AAllPaths: Boolean=false): Tnet; Function DuplicateByPath(p:TNetPath;Group:Boolean=False; AAllPaths: Boolean=false): Tnet; Procedure CollectBoundPoints(p:TNetPath; var BPoints1,BPoints2: TDoublePointArr; APathTrace: TPathTrace=nil); Procedure EqualTracePaths; Procedure MoveSatih(rpath: TNetPath; dx,dy: Double; Control: Boolean); Procedure GetBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override; Procedure GetSelBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override; Procedure GetPathBounds(xPaths:Tlist;var figMaxX,figMaxY,figMinX,figMinY: Double; aLengthType: TShowPathLengthType=sltPoints); procedure GetSize(aLengthType: TShowPathLengthType; var figHeight, figWidth: Double); //28.04.2012 - размеры объекта Function PointIndex(p: TDoublePoint): Integer; Function PathIndex(p1,p2: TDoublePoint): Integer; Procedure IntersectPaths(UseCols: Boolean = True); Procedure IntersectCorner(pIndex: Integer); Procedure FillColSpaces; Procedure IntersectColCorner(pIndex: Integer); Procedure IntersectColPipeCorner(pIndex: Integer); Procedure IntersectPipeCorner(pIndex: Integer); Procedure GetCornerPatch(pIndex: Integer; var pArr:TdoublePointArr); Function GetKnotCol(p:PdoublePoint):TnetCol; Procedure DeleteSelected; Procedure OpenSelPath; Procedure SetWallType(wt: TWallType); Procedure SetWallKris(val: Boolean); Procedure DoorLen(ww:Double); Procedure ArcSelPath; Procedure SetArcPath(a:Boolean); Procedure InvertSelPath; Procedure InvertSelPathValue(val: Boolean); Procedure EditArcAng; Procedure SetArcAng(val:Double); Procedure ColPosition(pos:Integer); Procedure ColAngle(ang:double); Procedure ColWidth(cw:double); Procedure ColHeight(ch:double); Procedure RowThick(th:double); Procedure DivSelPath;overload; Procedure DivSelPath(mp: TDoublePOint);overload; Procedure LocateSelPath(Delta:Double;delOld,repair:Boolean); Procedure DoubleSelPath(Delta:Double); function AddDoor(aDoorObjType: TDoorObjType=dotDoor; aLen: Double=-1): TNetDoor; function AddWindow(aLen: Double=-1): TNetDoor; Procedure AddNetCol; overload; Procedure AddCol; Function AddNetCol(p: TdoublePoint): TnetCol; overload; Function AddNetRow(xp1, xp2: TdoublePoint): TNetRow; // Tolik Function CheckDeleteInnerWalls(aCanDeleteWalls: Boolean = False): Boolean; // Function DeletePath(Path:TnetPath):Boolean; Function DeletePathSilent(Path:TnetPath):Boolean; Procedure DeleteStruct(Struct:TNetStruct); Procedure UpdateMenu(var PopMenu: TPopUpMenu;var sIndex:integer);override; Procedure MenuClicked(CommandId:integer);override; Procedure UpdatePathRegion(Dengine: TPCDrawEngine); Class Function InsideSelection: Boolean; override; procedure ResetRegion;override; procedure UpdateAllRegions(Dengine:TPCDrawEngine); Procedure AddCols; Procedure RefreshPoints; Procedure CombinePathsOfKnot(p: PDoublePoint); Procedure OpenAllWindows; Procedure WriteToStream(Stream: TStream);override; Procedure SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); override; Procedure UpdateWallThick(Value: Double); Function CreateMoveTrace: TFigure; Function CreateModification: TFigure; override; Function TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; override; Function EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; override; procedure SetModified; //03.02.2012 procedure AfterUndo(Sender: TObject); function CanMoveJoined: Boolean; Function CheckForPoints(pp: TDoublePoint; aPrevPoint: PDoublePoint = nil): PDoublePoint; function CheckIntersect(ANet: TNet): Boolean; function CheckLocatePoint(p: PDoublePoint; x, y: Double): Boolean; function CheckOtherNetModification: Boolean; function CheckPtInJoinedMove(Apt: PDoublePoint): Boolean; procedure ClearRels; //21.10.2010 procedure ClearSavedScaledPoints; procedure ClearSavedPoints; procedure ClearPointsList(AList: TList); function CmpIntersectPaths(p1,p2, ap1, ap2: PDoublePoint; MarginDelta:Double = 2; AEqualRotate: Pointer=nil): Integer; function CmpDP(p1,p2: PDoublePoint): Boolean; //18.02.2011 - сравнивает точки с учетеом точности function CreateDuplicate: TNet; procedure BeforeDelFromParent(Sender: TObject); procedure DefineInOutPoints; procedure DeleteNet; procedure DeletePoint(APoint: PDoublePoint); //#From Oleg# //04.10.2010 procedure DeSelect; override; function DivPath(APath: TNetPath; APoint: TDoublePoint): PDoublePoint; procedure DrawRelated(DEngine: TPCDrawEngine; isGrayed: Boolean); //19.10.2010 procedure DoClick(X, Y: Double); procedure DoClickPoint(APoint: PDoublePoint); procedure DoDelete; procedure DoResize; //08.05.2012 - Есть ли сегмент, лежащий на траектории перемещения другого сегмента function ExistsPathOnPathTrajectory(aPath: TNetPath; beginP1, beginP2: PDoublePoint): Boolean; function FindPathInRelatedNearPoints(Ap1, Ap2: PDoublePoint): TNetPath; //19.10.2010 function GetContureByPt: TDoublePointArr; function GetLengthForShow(ALength: Double): Double; function GetMainTraceNet: TNet; function GetObjInPoint(x, y: Double): TObject; function GetPathByMainPoint(APoint: TDoublePoint): TNetPath; function GetPathByNearPoints(APoint1, APoint2: PDoublePoint; delta: Double=1): TNetPath; //19.10.2010 function GetPathByPointsIn(p1, p2: TDoublePoint): TNetPath; function GetPathCountByPoint(aPt: PDoublePoint): Integer; // Вернет все сегменты которые сходятся в точке function GetPathListByPoint(APoint: PDoublePoint): TList; //05.10.2010 function GetPathListByPointID(APointID: Integer): TList; //05.10.2010 function GetPoint(x,y: Double; AOtherNearPoints: TList=nil): PDoublePoint; function GetPointByNear(ANearPoint: TDoublePoint; ASkipList: TList=nil): PDoublePoint; function GetPointsByNear(ANearPoint: TDoublePoint; ASkipList: TList=nil): TList; function GetPointByID(APointID: Integer): PDoublePoint; //05.10.2010 function GetPointFromList(AList: TList; ANetPt: PDoublePoint): PDoublePoint; function GetPointID(APoint: PDoublePoint): Integer; //07.10.2010 function GetPointPath(APoint: PDoublePoint): TNetPath; //21.10.2010 Вернет Path которому пренадлежит Point function GetSavedScaledPtByPoint(pt: PDoublePoint): PDoublePoint; function GetSavedPtByPoint(pt: PDoublePoint): PDoublePoint; function GetSelectedObject: TObject; function IsPathDrawed(ap1, ap2: PDoublePoint): Boolean; function IsPointInArc(p: PDoublePoint): Boolean; function IsRectangle: Boolean; Procedure ModifySelection(mm: TModifyMode; value: Integer);override; //16.03.2013 function MoveJoinedPoints(ADeltaX, ADeltaY: Double; AFromSaved: Boolean): Boolean; procedure RotateAllNiche; //procedure RestorePointsFromSaved; procedure SaveScaledPoints; procedure SavePoints; procedure SavePointsToList(AList: TList); procedure SelectAllPaths; function SelectNextPathByPt(x,y: Double): Boolean; function SelectNextPointByPt(x,y: Double): Boolean; procedure SelectPt(APt: PDoublEPoint); procedure SelectPath(AIndex: Integer; AllowMultisel: Boolean=false); procedure SetMapScale(AMapScale: Double); procedure SetPathsHidden(AHidden: Boolean); procedure SetPointID(APoint: PDoublePoint; AID: Integer); // IGOR // получить контур комнаты function GetRoomConture(aPaths: TList=nil): TDoublePointArr; function GetRoomSCSConture(aPaths: TList=nil): TDoublePointArr; // Tolik 27/06/2018 -- // получить внутренний контур комнаты function GetRoomInnerConture: TDoublePointArr; // получить внешний контур комнаты function GetRoomOuterConture: TDoublePointArr; // получить контур пола function GetFloorConture: TDoublePointArr; // получить контур потолка function GetCeilingConture: TDoublePointArr; // получить след. стену по мод поинту function GetNetPathByP1P2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath; function GetNextNetPathByP1P2(aPaths: TList; aCurNetPath: TNetPath; p: PDoublePoint; aSide: Pointer = nil): TNetPath; //24.05.2012 // 2011-05-10 function GetNetPathByR1R2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath; // найти стартовую точку для нахождения незамкнутого контура function FindStartConturePPoint(aPointPath: Pointer = nil; aSide: Pointer = nil): TDoublePoint; function FindStartConturePoint(aPaths: TList; aPointPath: Pointer = nil; aSide: Pointer = nil): PDoublePoint;//24.05.2012 // 2011-05-10 function FindStartContureRPoint: TDoublePoint; //10.05.2012 - Вернет все связанные TNet function GetRelatedNets(AllowPathCmpType: Integer=citNone; ASubRelNets: Boolean=false): TList; // Вернет связанные TNet объекты по точке function GetRelatedNetsByPoints(APoint1, APoint2: PDoublePoint; AllowPathCmpType: Integer=citNone; ASubRelNets: Boolean=false): TList; function GetRelatedPaths(APath: TNetPath; ACmpRes: TList=nil; AllowBySide: Boolean=false): TList; function GetRelatedPoints(APoint: PDoublePoint; AOutPoints: TList=nil; APointNets: TList=nil): TList; // Вернет список ID точек по координатам // Вернет выделенную дверь/окно function GetSelPathChild: TNetDoor; function PointToOrthogonal(APoint: PDoublePoint; x, y: Double; ANet: TNet; APointMoved: Pointer=nil): TDoublePoint; procedure SrvDropFComponID; end; function IfFiguraIsRoof(AFigure: TObject): boolean; function CheckContrureEntry(AOuterConture, AInnerConture: PDoublePointArr; ACheckNoInBorder: Boolean=false; ACheckNoAdjacent: Boolean=false; IsRoof: boolean=false): Boolean; function CheckConturesEqual(AConture1, AConture2: PDoublePointArr): Boolean; // Проверяет попадает ли любая точка из массива во внутренний контур объекта TNet; APoints is link to TDoublePointArr function CheckPtInNetConture(APoints: Pointer; ANet: TNet; AAnyPoint: Boolean): Boolean; procedure CleanSamePointsArr(var Arr: TDoublePointArr); procedure ClearJoinedParamsInNets(ANetList: TList); function CreatePolygonRgnByPoints(DEngine: TPCDrawEngine; p1,p2,p3,p4: PDoublePoint): HRGN; function GetAllNets(aPCad: TPowerCad): TList; function GetCoordTypeByPt(aPt: PDoublePoint; aPath: TNetPath): Integer; //07.05.2012 - Вернет список из TNet объектов, сегменты которых содаржат точки p1, p2 function GetNetsByPoints(aPCad: TPowerCad; p1, p2: PDoublePoint; aNetsPath: TList=nil): TList; function GetOtherSide(aSide: Integer): Integer; procedure GetPathsConturePoints(ANetPaths: TList; AResultOuter, AResultInner{, AOuterHeights, AInnerHeights}: Pointer; AWithHeights: Boolean; AOutPaths, AInnPaths: TList; AOutPointIDs, AInnPointIDs: TList); function GetRelCoordType(ACoordType: Integer): Integer; function GetRelCoordTypeAtSide(ACoordType: Integer): Integer; function IsPtInArray(APt: TDoublePoint; APointArray: PDoublePointArr): Boolean; //function IsPtIn function IsPtInPolygon(APt: TDoublePoint; APollygonPaths: TDoublePointArr; APointsAsLines:Boolean=true; AllowCommonPoint: Boolean=false; AMul: Integer=0): Boolean; function GetNetObjInPoint(PCAD: TPCDrawing; LayerNbr:Integer; x,y: Double; OnlyNet: Boolean=false): TObject; Function PointNear(p1,p2: TDoublePoint; delta: Double=1):Boolean; // Увеличивает/уменьшает контур с помощю TNet объекта function ScaleConturePoints(var APoints: TDoublePointArr; ASize: Double): Boolean; //Поиск координаты Z Function GetZPoint(aNet: TNet;Point: PDoublepoint): double; type TUndoProc = Procedure; var UndoProc: TUndoProc = nil; Var ActiveNet: Tnet; //FFigureModification: Boolean = false; GDefWallType: TWallType = wtWall; implementation // 2011-05-10 uses U_Common, U_Cad, U_Constants, U_BaseCommon, U_ArchCommon, U_SCSComponent, {U_Arch3D}U_Arch3DNew, U_Main; { TNet } Function GetZPointByID(aNet: TNet;ID: Integer): double; var ArchObj: TSCSComponent; Node: TTreeNode; HeightWall1,HeightWall2: Double; WallSCSCompon: TSCSComponent; begin result := 0; ArchObj := nil; ArchObj := GetArchObjByCADObj(aNet); if Assigned(ArchObj) then begin //Узнаем ноуд Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true); if Node <> nil then begin //узнаем СКС компонент WallSCSCompon := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node); if WallSCSCompon <> nil then Result := WallSCSCompon.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(aNet.Owner).MapScale); end; end; end; Function GetZPoint(aNet: TNet;Point: PDoublepoint): double; var ID: Integer; ArchObj: TSCSComponent; Node: TTreeNode; HeightWall1,HeightWall2: Double; WallSCSCompon: TSCSComponent; begin result := 0; ArchObj := nil; ArchObj := GetArchObjByCADObj(aNet); if Assigned(ArchObj) then begin ID := aNet.GetPointID(Point); //Узнаем ноуд Node := TF_Main(ArchObj.ActiveForm).FindComponOrDirInTree(ID, true); if Node <> nil then begin //узнаем СКС компонент WallSCSCompon := TF_Main(ArchObj.ActiveForm).GetComponentFromNode(Node); if WallSCSCompon <> nil then Result := WallSCSCompon.GetPropertyValueAsFloat(pnHeight) * (1000/ TPowerCad(aNet.Owner).MapScale); end; end; end; Function fToStr(Value:Double): String; begin result := ''; Value := Trunc(Value*10000); Value := Value/10000; result := floattostrf(Value,ffGeneral,8,2); end; procedure SortPathAngles(var paths: TList; iLo, iHi: Integer); var Lo, Hi: Integer; Mid: TnetPath; begin Lo := iLo; Hi := iHi; Mid := TnetPath(Paths[(Lo + Hi) div 2]); repeat while TNetPath(Paths[Lo]).Angle < Mid.Angle do Inc(Lo); while TNetPath(Paths[Hi]).Angle > Mid.Angle do Dec(Hi); if Lo <= Hi then begin Paths.Exchange(Lo,Hi); Inc(Lo); Dec(Hi); end; until Lo > Hi; if Hi > iLo then SortPathAngles(paths, iLo, Hi); if Lo < iHi then SortPathAngles(paths, Lo, iHi); end; function TNet.GetAp1: TDoublePoint; begin Result := inherited GetAp1; if Points.Count > 0 then Result := PDoublePoint(Points[0])^; end; function TNet.AddPath(p1, p2: PDoublePOint;Border:Boolean): TNetPath; var path: TNetPath; i: Integer; begin Result := nil; for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); if path.AreYou(p1, p2) then begin result := path; exit; end; end; path := TNetPath.Create(p1, p2, Border, self); paths.Add(path); result := path; RefreshColPositions; end; Function TNet.AddPoint(p: TDoublePoint; aTrgPath: TNetPath=nil): PDoublePoint; var xp: PDoublePoint; pointID: Integer; //04.10.2010 begin result := nil; New(xp); xp.x := p.x; xp.y := p.y; Points.Add(xp); ////#From Oleg# //04.10.2010 pointID := 0; if Assigned(FOnAddPoint) then pointID := FOnAddPoint(Self, aTrgPath, xp, 0); FPointIDs.Add(Pointer(pointID)); Result := xp; end; procedure TNet.ArcSelPath; var index: Integer; path: TNetPath; begin if (SelType = stPath) and (SelIndex > 0) then begin index := SelIndex-1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); Path.isArc := not path.isArc; RefreshPaths; end; end; end; procedure TNet.CalculatePathPoints; var i: Integer; path: TNetPath; begin for i := 0 to paths.Count - 1 do begin path := TnetPath(Paths[i]); Path.CalculatePoints(50,0); end; end; procedure TNet.Clear; var p: PDoublePOint; i: integer; begin try for i := 0 to Points.Count- 1 do begin p := PDoublePOint(Points[i]); Dispose(p); end; Points.Clear; for i := 0 to Paths.Count - 1 do begin TNetPath(Paths[i]).Free; end; Paths.Clear; for i := 0 to Structs.Count - 1 do begin TNetStruct(Structs[i]).Free; end; Structs.Clear; except // ShowMessage(CPowerCadMessage + 'TNet.Clear'); end; end; function TNet.CountPathsOfKnot(p: PDoublePoint; lPaths: Tlist): Integer; var i,cnt: Integer; begin result := 0; cnt := 0; for i := 0 to lPaths.Count-1 do begin if TnetPath(lPaths[i]).isKnotIn(p) > 0 then begin cnt := cnt + 1; end; end; result := cnt; end; constructor TNet.create(LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent); begin PathRgn := 0; // не проинициализировано нигде, но удаляется в некоторых местах ... может наделать бяк... // inherited Create(LHandle,aDrawStyle,aOwner); initialize; if assigned(owner) then begin MapScale := TPCDrawing(Owner).MapScale; if TPCDrawing(Owner).RulerMode = rmPage then WorldDim := False else if TPCDrawing(Owner).RulerMode = rmWorld then WorldDim := True; xDrawEngine := TPCDrawing(Owner).DEngine; WorkHeight := TPCDrawing(Owner).WorkHeight; WorkWidth := TPCDrawing(Owner).WorkWidth; end; WallThick := 4; SelType := stPath; SelIndex := 0; FillWalls := False; IsometricUpdate := False; //FID := 0; FCmpPointPrecision := -1; FComponID := 0; FDeleting := false; FDisableMergePaths := false; FFigureModification := false; //#From Oleg# FMoveAllPoints := false; FOnAddPoint := nil; FOnAutoAddPath := nil; FOnDefineJoinedNets := nil; //26.05.2011 FOnDefineMoveObjects := nil; //23.05.2011 FOnDelete := nil; FOnDeletePoint := nil; FOnDuplicate := nil; //16.05.2011 FOnMergePaths := nil; FOnMergePathsQuery := nil; //21.10.2010 FOnMergeNetPathsQuery := nil; FOnMergeNetsQuery := nil; //21.10.2010 FOnMove := nil; //09.06.2011 FOnMoveJoinedPoints := nil; //09.06.2011 FOnMovePoint := nil; //29.04.2011 FOnPathsOverlapQuery := nil; //10.05.2011 FOnResize := nil; FOnScale := nil; //27.05.2011 FOnScaleAfter := nil; //10.06.2011 FOnScaleBefore := nil; //10.06.2011 FOnSetScale := nil; //27.12.2010 FOnSelectPoint := nil; FPathDivision := nil; //26.03.2013 GArchEngine.SetHandlersToObj(Self); RefreshPaths; end; class function TNet.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var cad: TPCDrawing; begin Result := nil; cad := TPCDrawing(aOwner); Result := TNet.create(LHandle, mydsNormal, aOwner); TNet(Result).XDrawEngine := cad.DEngine; end; function TNet.CreateModification: TFigure; var Res: Tnet; pIdx: Integer; path: TnetPath; mp: PdoublePoint; cp: TDoublePoint; ap1, ap2: TDoublePoint; Door: TNetDoor; //11.10.2010 RelNets: TList; //19.10.2010 RelNet: TNet; RelDupNet: TNet; RelPt: PDoublePoint; Net: TNet; NetList: TList; i, j: integer; //19.10.2010 begin result := nil; FFigureModification := true; //#From Oleg# FLastTickTraceRefresh := 0; //24.05.2011 Self.ClearRels; //21.10.2010 {$ifndef limited} if assigned(TracePoint) then begin pIdx := TracePoint.SeqNbr; if (TracePoint.PType = ptPolyPoint) and (pIdx > -1) and (pIdx < (Points.Count)) then begin //TracePoint.FIsDrag := true; mp := PDoublePoint(Points[pIdx]); Res := DuplicateByKnot(mp, true); TracePoint.Tag := res.PointIndex(mp^); Result := res; //19.10.2010 RelNets := GetRelatedNetsByPoints(mp, nil, citNone, true); if RelNets <> nil then begin for i := 0 to RelNets.Count - 1 do begin RelNet := TNet(RelNets[i]); RelNet.FRelatedMPoint := RelNet.GetPointByNear(mp^); Self.FRelatedNets.Add(RelNet); RelDupNet := nil; if RelNet.FRelatedPoints.Count > 0 then RelDupNet := RelNet.DuplicateByKnot(PDoublePoint(RelNet.FRelatedPoints[0]), true) else if CanMoveJoined then begin RelDupNet := TNet(RelNet.duplicate); RelDupNet.SetPathsHidden(true); // пока скрываем все сегменты, так как если не найдутся связанные точки, то нету необходимости их отрисовывать end; if RelDupNet <> nil then begin RelDupNet.FRelatedMPoint := RelDupNet.GetPointByNear(mp^); RelDupNet.DrawStyle := dsTrace; RelDupNet.color := clLime; RelDupNet.Style := 1; RelDupNet.width := 1; RelDupNet.Brs := 1; RelDupNet.FRelatedOwner := Res; TNet(Res).FRelatedNets.Add(RelDupNet); for j := 0 to RelNet.FRelatedPoints.Count - 1 do begin RelPt := RelDupNet.GetPointByNear(PDoublePoint(RelNet.FRelatedPoints[j])^); if RelPt <> nil then RelDupNet.FRelatedPoints.Add(RelPt); end; end; end; RelNets.Free; end; // Определить доп. точки для перемещения if Assigned(FOnDefineMoveObjects) then begin NetList := Tlist.Create; NetList.Assign(TNet(Res).FRelatedNets); NetList.Insert(0, Res); if FOnDefineMoveObjects(Self, mp, nil, NetList) then for i := 0 to NetList.Count - 1 do begin Net := TNet(NetList[i]); Net.SetPathsHidden(false); Net.SavePoints; end; NetList.Free; end; end else if (TracePoint.PType = ptRectPoint) and (pIdx > -1) and (pIdx < Paths.Count) then begin Path := TNetPath(Paths[pIdx]); Res := DuplicateByPath(Path); TracePoint.Tag := res.PathIndex(path.p1^, path.p2^); Result := res; end else if (TracePoint.PType = ptGroupPoint) and (pIdx > -1) and (pIdx < Paths.Count) then begin Path := TnetPath(Paths[pIdx]); Res := DuplicateByPath(Path, True, True); //22.04.2011 Res := DuplicateByPath(Path, True); Res.RefreshPaths; //22.04.2011 Res.DefineInOutPoints; //22.04.2011 TracePoint.Tag := res.PathIndex(path.p1^, path.p2^); Result := res; end else //11.10.2010 if (TracePoint.PType = ptControlPoint) then begin //Path := TnetPath(Paths[pIdx]); //Res := DuplicateByPath(Path, True); //TracePoint.Tag := res.PathIndex(path.p1^, path.p2^); //Result := res; Door := GetSelPathChild; //Path.ActiveDoor; Result := TDoorTrace.Create(Self, Door.GetPath, Door); TDoorTrace(Result).FIsShowLen := true; end else //22.10.2010 if TracePoint.PType = ptArcControl then begin Path := TnetPath(Paths[pIdx]); Res := DuplicateByPath(Path, True, True); Res.RefreshPaths; Res.DefineInOutPoints; TracePoint.Tag := res.PathIndex(path.p1^, path.p2^); Result := res; end; end else begin Result := CreateMoveTrace; Tpowercad(Owner).SnapLocked := True; exit; end; if not assigned(result) then begin res := DuplicateByBorder; Result := res; end; if assigned(Result) then begin Result.DrawStyle := dsTrace; Result.color := clLime; Result.Style := 1; Result.width := 1; Result.Brs := 1; end; {$endif limited} end; Function TNet.CheckDeleteInnerWalls(aCanDeleteWalls: Boolean): Boolean; var i: Integer; CanDelPath: Boolean; PathCompon: TSCSComponent; currPath: TNetPath; NetConture: TDoublePointArr; begin Result := True; CanDelPath := True; While CanDelPath do begin CanDelPath := False; if Paths.Count > 3 then begin for i := 0 to Paths.Count - 1 do begin currPath := TNetPath(Paths[i]); if currPath.FComponID > 0 then begin PathCompon := Nil; PathCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(currPath.FComponID); if (PathCompon <> nil) and (PathCompon.IsLine = ctArhWallDivision) then begin // если перегородка оказалась вне контура -- удалить ее SetLength(NetConture,0); NetConture := Self.GetRoomConture(self.Paths); if ((not PtInPolygon(NetConture, currPath.p1^)) or (not PtInPolygon(NetConture, currPath.p2^))) then begin if not aCanDeleteWalls then Result := False else begin DeletePath(currPath); CanDelPath := True; break; end; end; SetLength(NetConture,0); end; end; end; end; end; end; Function TNet.DeletePath(Path: TnetPath):Boolean; var i: Integer; PathCompon: TSCSComponent; SCSList: TSCSList; ArchContainer: TSCSCatalog; ArchRoom: TSCSComponent; isP1, isP2: Boolean; // 02/02/2017 -- Tolik InnerWallDelete: Boolean; // procedure CheckInterSection; var i: Integer; CanDelPath: Boolean; currPath, ConnectedPath: TNetPath; begin CanDelPath := True; ConnectedPath := nil; While CanDelPath do begin CanDelPath := False; if Paths.Count > 2 then begin for i := 0 to Paths.Count - 1 do begin currPath := TNetPath(Paths[i]); if currPath.FComponID > 0 then begin PathCompon := Nil; PathCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(currPath.FComponID); if (PathCompon <> nil) and (PathCompon.IsLine = ctArhWallDivision) then begin // если перегородка оказалась вне контура -- удалить ее if ((not PtInPolygon(Self.GetRoomConture, currPath.p1^)) or (not PtInPolygon(Self.GetRoomConture, currPath.p2^))) then begin DeletePath(currPath); Break; //// BREAK ////; end; end; end; end; end; end; end; // begin result := false; InnerWallDelete := False; if assigned(UndoProc) then UndoProc; // Tolik -- 02/02/2017 -- // если удаляется перегородка -- выставить флажок if Path.FComponID > 0 then begin PathCompon := Nil; PathCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(Path.FComponID); if (PathCompon <> nil) and (PathCompon.IsLine = ctArhWallDivision) then InnerWallDelete := True; end; // path.DoDelete; //04.06.2010 Paths.Remove(path); {CombinePathsOfKnot(path.p1); CombinePathsOfKnot(path.p2);} RefreshPoints; path.free; RefreshColPositions; RefreshPaths; result := true; // Tolik -- 01/02/2017 -- // проверить перегородки комнат после объединения // те, которые вылезут за контур - удалить нафиг if not InnerWallDelete then InnerWallDelete := CheckDeleteInnerWalls(True); // end; destructor TNet.Destroy; var MethodName: String; i: Integer; RelNet: TNet; begin FDeleting := true; //25.06.2012 MethodName := 'Destroy'; try // Если это дубликат для Shadow if (FSrcNet <> nil) and (DrawStyle = dsTrace) then begin FSrcNet.FFigureModification := false; if FSrcNet.FRelatedNets.Count > 0 then FSrcNet.FRelatedNets.Clear; end; // Очищаем связанные объекты, если этот является владельцем for i := 0 to FRelatedNets.Count - 1 do begin RelNet := TNet(FRelatedNets[i]); if RelNet.FRelatedOwner = Self then RelNet.Free; end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName, E.Message); end; ClearPaths; ClearNetPoints; ClearStructs; Paths.Free; Points.Free; Structs.Free; //Tolik // DeleteObject(PathRgn); if PathRgn <> 0 then DeleteObject(PathRgn); // try FSelection.Free; //27.07.2011 // join Igor 2016-10-11 FRelatedNets.Clear; // join Igor 2016-10-11 end FPointIDs.Free; //04.10.2010 FRelatedPoints.Free; //18.10.2010 FRelatedNets.Free; //19.10.2010 FJoinedMovePoints.Free; //23.05.2011 FJoinedMovePointsDirections.Free; //23.05.2011 FJoinedMovePointsFixedState.Free; //27.05.2011 FJoinedMovePaths.Free; //24.05.2011 FJoinedMovePathsDirections.Free; //24.05.2011 FDrawedPt1.Free; //13.05.2011 FDrawedPt2.Free; //13.05.2011 ClearSavedPoints; ClearSavedScaledPoints; FSavedPoints.Free; FSavedScaledPoints.Free; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName, E.Message); end; inherited; end; procedure TNet.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var acolor,bcolor : Tcolor; i,j,sw,sh: Integer; path: TnetPath; Struct: TnetStruct; cp,xp: TDoublePOint; rgn: HRGN; tl,th: Double; iStart: Integer; xrgn: HRGN; MainNet: TNet; NetSelPath: TNetPath; CanDrawPath: Boolean; begin FDrawedPt1.Clear; FDrawedPt2.Clear; DrawRelated(DEngine, isGrayed); if not isGrayed then Self.DrawGuides := false else Self.DrawGuides := True; try iStart := 0 except exit; end; try if (DrawSTyle = mydsNormal) then begin if Modified then begin Modified := False; UpdateAllRegions(Dengine); end; end; except exit; end; if DrawStyle = dsTrace then begin // DEngine.Canvas.Pen.Mode := pmXor; end else DEngine.Canvas.Pen.Mode := pmCopy; if (DrawSTyle = mydsNormal) and (not isGrayed) and (FillWalls) then begin DEngine.Canvas.Brush.Style := bsSolid; DEngine.Canvas.Brush.Color := RGB(240, 240, 240); FillRgn(DEngine.Canvas.Handle,PathRgn,DEngine.Canvas.Brush.Handle); end; acolor := color; bColor := brc; if (aColor = -255) and (LayerHandle <> 0) then begin aColor := TLayer(LayerHandle).PenColor; end; if (bColor = -255) and (LayerHandle <> 0) then begin bColor := TLayer(LayerHandle).BrushColor; end; if (isGrayed) //or (Isometric) then begin acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor; bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor; end; if DrawStyle = mydsNormal then begin try for i := iStart to Structs.Count - 1 do begin Struct := TnetStruct(Structs[i]); if DrawAsTrace then Struct.Style := ord(psSolid) else Struct.Style := ord(psSolid); Struct.Draw(DEngine,isGrayed); end; except exit; end; rgn := 1; Sw := 0; Sh := 0; if assigned(owner) then begin Sw := TPCDrawing(Owner).SurfaceWidth; sh := TPCdrawing(Owner).SurfaceHeight; end; try NetSelPath := Self.SelPath; for i := iStart to paths.Count - 1 do begin path := TnetPath(paths[i]); if Path <> NetSelPath then begin path.Tag := i; if DrawAsTrace then path.Style := ord(psSolid) else path.Style := ord(psSolid); path.Draw(DEngine,aColor); end; end; if NetSelPath <> nil then //22.08.2011 begin NetSelPath.Tag := i; if DrawAsTrace then NetSelPath.Style := ord(psSolid) else NetSelPath.Style := ord(psSolid); NetSelPath.Draw(DEngine,aColor); end; except exit; end; end else begin try for i := iStart to paths.Count - 1 do begin path := TnetPath(Paths[i]); path.Tag := i; CanDrawPath := false; if Self.FindPathInRelatedNearPoints(path.p1, path.p2) = nil then //19.10.2010 - чтобы не прорисовать одну линию несколько раз CanDrawPath := true; {if CanDrawPath then begin if Assigned(FRelatedOwner) and (FRelatedOwner is TPathTrace) then //if (Length(TPathTrace(FRelatedOwner).NPoints1) > 0) and (Length(TPathTrace(FRelatedOwner).NPoints1) > 0) then if TPathTrace(FRelatedOwner).IsRelatedTo(path.p1, path.p2) then begin CanDrawPath := false; //for i := 0 to Length(TPathTrace(FRelatedOwner).NPoints1) - 1 do //begin // if CmpIntersectPaths(path.p1, path.p2, @TPathTrace(FRelatedOwner).NPoints1[0], @TPathTrace(FRelatedOwner).NPoints2[0]) = citEqual then // CanDrawPath := false; //end; end; end;} //if Assigned(FRelatedOwner) then //begin // if FRelatedOwner is TNet then // CanDrawPath := Not TNet(FRelatedOwner).IsPathDrawed(path.p1, path.p2) // else if FRelatedOwner is TPathTrace then // begin // if Assigned(TPathTrace(FRelatedOwner).Clone) then // CanDrawPath := Not TPathTrace(FRelatedOwner).Clone.IsPathDrawed(path.p1, path.p2) // else // EmptyProcedure; // end; //end //else // CanDrawPath := Not IsPathDrawed(path.p1, path.p2); MainNet := GetMainTraceNet; if MainNet <> nil then CanDrawPath := Not MainNet.IsPathDrawed(path.p1, path.p2); if CanDrawPath then path.DrawTrace(DEngine); end; for i := iStart to Structs.Count-1 do begin Struct := TnetStruct(Structs[i]); Struct.DrawTrace(DEngine); end; except exit; end; end; end; procedure TNet.drawselectionpoints(DEngine: TPCDrawEngine; isGrayed: Boolean); var index,i: Integer; reg: HRGN; Path, SelPath: TNetPath; begin inherited; if IsDrawingDetail then exit; if (SelType = stPath) and (SelIndex > 0) then begin index := SelIndex - 1; if index > Paths.Count - 1 then index := 0 else begin //25.03.2013 TNetPath(Paths[Index]).Hatch(Dengine,isGrayed); //25.03.2013 {if FSelection.Count > 1 then begin Path := TNetPath(Paths[Index]); for i := 0 to FSelection.Count - 1 do begin SelPath := TNetPath(FSelection[i]); if (SelPath <> path) and (Paths.IndexOf(SelPath) <> -1) then SelPath.Hatch(Dengine,isGrayed); end; end;} for i := 0 to FSelection.Count - 1 do begin SelPath := TNetPath(FSelection[i]); if Paths.IndexOf(SelPath) <> -1 then SelPath.Hatch(Dengine,isGrayed); end; end; end else if (SelType = stStruct) and (SelIndex > 0) then begin index := SelIndex - 1; if index > Structs.Count - 1 then index := 0 else TNetStruct(Structs[Index]).Hatch(Dengine,isGrayed); end; end; function TNet.duplicate: TFigure; var Res: TNet; i,k: Integer; path, xPath: TNetPath; pId: Integer; p1,p2: PDoublePoint; pt1: TnetPath; begin Result := nil; Res := Tnet.Create(LayerHandle, DrawStyle, Owner); Res.FSrcNet := Self; //21.10.2010 Res.MapScale := MapScale; Res.WorldDim := WorldDim; Res.Clear; For i := 0 to Points.Count - 1 do begin p1 := PDoublePoint(points[i]); res.AddPoint(p1^); end; for i := 0 to Paths.Count - 1 do begin p1 := nil; p2 := nil; xPath := nil; //#From Oleg# //14.09.2010 path := TNetPath(paths[i]); pId := Points.IndexOf(path.p1); if (pId > -1) and (pId < res.Points.Count) then p1 := PDoublePoint(res.Points[pId]); pId := Points.IndexOf(path.p2); if (pId > -1) and (pId < res.Points.Count) then p2 := PDoublePoint(res.Points[pId]); if assigned(p1) and assigned(p2) then xPath := res.AddPath(p1,p2,path.Border); //if assigned(xPath) then // xPath.Info := Path.Info; //if assigned(xPath) then // xPath.Width := Path.Width; if assigned(xPath) then begin xPath.Info := Path.Info; xPath.Width := Path.Width; xPath.AssignProps(Path); xPath.Opath := path; end; end; Tnet(Res).WallThick := WallThick; Tnet(Res).EndDraw := EndDraw; Tnet(Res).ContextMenu := ContextMenu; Tnet(Res).DrawGuides := DrawGuides; Tnet(Res).EditMode := EditMode; Tnet(Res).FComponID := FComponID; //23.05.2011 Result := res; end; function TNet.DuplicateByBorder: TNet; var Res: TNet; i: Integer; path: TNetPath; pList:TList; pId: Integer; p1,p2: PDoublePoint; begin Result := nil; Res := Tnet.Create(LayerHandle, DrawStyle, owner); Res.FSrcNet := Self; //21.10.2010 Res.MapScale := MapScale; Res.WorldDim := WorldDim; Res.Clear; pList := TList.Create; for i := 0 to Paths.Count - 1 do begin path := TNetPath(paths[i]); if path.Border then begin pId := pList.IndexOf(path.p1); if pId = -1 then begin pList.Add(path.p1); p1 := res.AddPoint(path.p1^); end else begin p1 := PDoublePoint(res.Points[pId]); end; pId := pList.IndexOf(path.p2); if pId = -1 then begin pList.Add(path.p2); p2 := res.AddPoint(path.p2^); end else begin p2 := PDoublePoint(res.Points[pId]); end; Res.AddPath(p1,p2,true); end; end; pList.Free; Result := res; end; function TNet.DuplicateByKnot(p: PDoublePoint; AAllPaths: Boolean=false): Tnet; var Res: TNet; i: Integer; path: TNetPath; pList: TList; pId: Integer; p1,p2,xp: PDoublePoint; Struct,dStruct: TNetStruct; k: Integer; NewPath: TNetPath; //21.10.2010 //ShowPathLengthType: TShowPathLengthType; begin Result := nil; Res := Tnet.Create(LayerHandle, DrawStyle, owner); Res.FSrcNet := Self; //21.10.2010 Res.Clear; Res.MapScale := MapScale; Res.WorldDim := WorldDim; pList := TList.Create; for i := 0 to Paths.Count - 1 do begin path := TNetPath(paths[i]); if AAllPaths or (path.isKnotIn(p) > 0) then begin pId := pList.IndexOf(path.p1); if pId = -1 then begin pList.Add(path.p1); p1 := res.AddPoint(path.p1^); end else begin p1 := PDoublePoint(res.Points[pId]); end; pId := pList.IndexOf(path.p2); if pId = -1 then begin pList.Add(path.p2); p2 := res.AddPoint(path.p2^); end else begin p2 := PDoublePoint(res.Points[pId]); end; //21.04.2011 //ShowPathLengthType := sltPoints; //if Assigned(path.FOnGetShowPathTraceLengthType) then // ShowPathLengthType := path.FOnGetShowPathTraceLengthType(path); //case ShowPathLengthType of // sltInner: // begin // path.DefineInOutPoints; // if path.p1 <> p then // begin // p1^ := path.ip1^; // PointToLine(path.p1^, path.p2^, p1^.x, p1^.y); // end; // if path.p2 <> p then // begin // p2^ := path.ip2^; // PointToLine(path.p1^, path.p2^, p2^.x, p2^.y); // end; // end; // sltOuter: // begin // path.DefineInOutPoints; // if path.p1 <> p then // begin // p1^ := path.op1^; // PointToLine(path.p1^, path.p2^, p1^.x, p1^.y); // end; // if path.p2 <> p then // begin // p2^ := path.op2^; // PointToLine(path.p1^, path.p2^, p2^.x, p2^.y) // end; // end; //end; NewPath := Res.AddPath(p1,p2,true); NewPath.FComponID := path.FComponID; //22.10.2010 NewPath.AssignProps(path); //19.04.2011 if AAllPaths then begin //NewPath.Opath := path; NewPath.FIsInner := path.FIsInner; //21.04.2011 NewPath.FIsHidden := Not (path.isKnotIn(p) > 0); end; end; end; for i := 0 to Structs.Count - 1 do begin Struct := TNetStruct(Structs[i]); if Struct.IsKnotIn(p) > -1 then begin dStruct := Struct.DuplicateNonPoints; For k := 0 to Struct.Points.Count -1 do begin xp :=PDoublePoint(Struct.Points[k]); if assigned(xp) then begin pId := pList.IndexOf(xp); if pId = -1 then begin pList.Add(xp); p1 := res.AddPoint(xp^); dStruct.Points.Add(p1); end else begin p1 := PDoublePoint(res.Points[pId]); dStruct.Points.Add(p1); end; end; end; Res.Structs.Add(dStruct); end; end; pList.Free; //21.04.2011 if AAllPaths then begin Res.RefreshPaths; // Определяем внутр/внешн точки чтобы не определять каждый раз на TraceModification Res.DefineInOutPoints; end; Res.FComponID := FComponID; //21.10.2010 Result := res; end; function TNet.DuplicateByPath(p: TNetPath; Group: Boolean = False; AAllPaths: Boolean=false): Tnet; var Res: TNet; i: Integer; path,lPath,xPath: TNetPath; pList:TList; pId: Integer; p1,p2: PDoublePoint; rad,prad: Double; xPaths,fPaths:Tlist; done,found: Boolean; Heught1,Heught2: double; begin Result := nil; Res := Tnet.Create(LayerHandle, DrawStyle, owner); Res.FSrcNet := Self; //21.10.2010 Res.Clear; Res.MapScale := MapScale; Res.WorldDim := WorldDim; pList := TList.Create; fPaths := TList.Create; if Group then begin done := false; rad := GetRadOfLine(p.p1^,p.p2^); xPaths := TList.Create; lPath := p; p1 := p.p1; repeat xPaths.Clear; GetPathsOfKnot(p1,xPaths); xPaths.Remove(lPath); found := false; for i := 0 to xPaths.Count - 1 do begin path := TNetPath(xPaths[i]); Heught1 := GetZPoint(path.Net,path.p1); Heught2 := GetZPoint(path.Net,path.p2); if (EQDP(path.p1^,path.p2^))and(Heught1 <> Heught2)and(IfFiguraIsRoof(path.Net)) then begin found := false; fPaths.Add(path); break; end else begin prad := GetRadOfLine(path.p1^,path.p2^); if not Eqd(rad,prad) then prad := GetRadOfLine(path.p2^,path.p1^); if eqd(rad,prad) then begin fPaths.Add(path); p1 := path.OtherPoint(p1); lPath := path; found := true; if fPaths.Count > 200 then begin fPaths.Clear; break; end; end else fPaths.Add(path); end; end; until (not found) or (xPaths.Count = 0); p1 := p.p2; lPath := p; repeat xPaths.Clear; GetPathsOfKnot(p1,xPaths); xPaths.Remove(lPath); found := false; for i := 0 to xPaths.Count - 1 do begin path := TNetPath(xPaths[i]); Heught1 := GetZPoint(path.Net,path.p1); Heught2 := GetZPoint(path.Net,path.p2); if (EQDP(path.p1^,path.p2^))and(Heught1 <> Heught2)and(IfFiguraIsRoof(path.Net)) then begin found := false; fPaths.Add(path); break; end else begin prad := GetRadOfLine(path.p1^,path.p2^); if not Eqd(rad,prad) then prad := GetRadOfLine(path.p2^,path.p1^); if eqd(rad,prad) then begin fPaths.Add(path); p1 := path.OtherPoint(p1); lPath := path; found := true; if fPaths.Count > 200 then begin fPaths.Clear; break; end; end else fPaths.Add(path); end; end; until (not found) or (xPaths.Count = 0); xPaths.free; end; for i := 0 to FPaths.Count - 1 do begin path := TNetPath(fpaths[i]); pId := pList.IndexOf(path.p1); if pId = -1 then begin pList.Add(path.p1); p1 := res.AddPoint(path.p1^); end else begin p1 := PDoublePoint(res.Points[pId]); end; pId := pList.IndexOf(path.p2); if pId = -1 then begin pList.Add(path.p2); p2 := res.AddPoint(path.p2^); end else begin p2 := PDoublePoint(res.Points[pId]); end; xPath := Res.AddPath(p1,p2,true); xPath.Opath := path; xPath.AssignProps(path); //22.10.2010 end; for i := 0 to Paths.Count - 1 do begin path := TNetPath(paths[i]); if AAllPaths or ((Fpaths.IndexOf(path) = -1) and path.Connected(p)) then begin pId := pList.IndexOf(path.p1); if pId = -1 then begin pList.Add(path.p1); p1 := res.AddPoint(path.p1^); end else begin p1 := PDoublePoint(res.Points[pId]); end; pId := pList.IndexOf(path.p2); if pId = -1 then begin pList.Add(path.p2); p2 := res.AddPoint(path.p2^); end else begin p2 := PDoublePoint(res.Points[pId]); end; xPath := Res.AddPath(p1,p2,true); xPath.Opath := path; xPath.AssignProps(path); //22.10.2010 //22.04.2011 if AAllPaths then begin xPath.FIsInner := path.FIsInner; xPath.FIsHidden := Not path.Connected(p); end; end; end; pList.Free; fPaths.Free; Res.FComponID := FComponID; //21.10.2010 Result := res; end; procedure TNet.EditArcAng; var index: Integer; path: TNetPath; ang: double; begin if (SelType = stPath) and (SelIndex > 0) then begin index := SelIndex-1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); if path.isArc then begin ang := Path.ArcAng*(180/pi); // Преобразование в град if InputDouble('TNet.EditArcAng','TNet.EditArcAng',ang) then begin Path.ArcAng := (ang/180)*pi; RefreshPaths; end; end; end; end; end; function TNet.EndModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; var p: PDoublePoint; dx, dy: Double; path : TNetPath; index: Integer; CanMergePaths: Boolean; StartPt: TDoublePoint; procedure NormalizePoint; var pt: TDoublePoint; begin if Not (ssShift in GGlobalShiftState) then //12.10.2010 begin pt := PointToOrthogonal(p, x, y, Self); //12.10.2010 x := pt.x; //12.10.2010 y := pt.y; //12.10.2010 end; end; begin FFigureModification := false; //#From Oleg# result := false; if not assigned(TraceFigure) then Exit; TPowerCad(Owner).SnapLocked := False; if (mp.PType = ptPolyPoint) and (mp.SeqNbr > -1) and (mp.SeqNbr < Points.Count) then begin // SnapModPoint(x, y, mp, Tnet(TraceFigure)); p := PDoublePoint(Points[mp.SeqNbr]); StartPt := p^; if TNet(TraceFigure).Paths.Count = 1 then begin //#From Oleg# CanMergePaths := true; if Assigned(FOnMergeNetPathsQuery) then FOnMergeNetPathsQuery(Self, CanMergePaths); if CanMergePaths then LocatePathPoint(p, x, y) else begin NormalizePoint; //15.10.2010 LocatePoint(p, x, y); end; end else begin NormalizePoint; //15.10.2010 LocatePoint(p, x, y); end; // Смотрим насколько была перемещена точка через PointToOrthogonal if GetLineLenght(StartPt, p^) > 1 then begin EmptyProcedure; end; // NormalizeKnot(p, Self); end else if (mp.PType = ptRectPoint) then begin index := (mp.SeqNbr); if (index > -1) and (index < Paths.Count) then begin SnapModPoint(x, y, mp, Tnet(TraceFigure)); dx := x - mp.coordx; dy := y - mp.coordy; Path := TnetPath(Paths[index]); MovePath(Path, dx, dy); end; end else if (mp.PType = ptGroupPoint) then begin index := (mp.SeqNbr); if (index > -1) and (index < Paths.Count) then begin SnapModPoint(x, y, mp, Tnet(TraceFigure)); dx := x - mp.coordx; dy := y - mp.coordy; Path := TnetPath(Paths[index]); MoveSatih(path, dx, dy, True); RefreshPaths; Path.Net.DoResize; end; end else if (mp.PType = ptControlPoint) and (mp.SeqNbr > 0) then begin TDoorTrace(TraceFigure).EndTrace; end //11.10.2010 else if (mp.PType = ptControlPoint) and (mp.SeqNbr = -3) then begin TDoorTrace(TraceFigure).EndTrace; end //22.10.2010 else if mp.PType = ptArcControl then begin Path := TnetPath(TNet(TraceFigure).Paths[mp.Tag]); Path.Opath.ArcAng := Path.ArcAng; Path.Opath.ArcCenter := Path.ArcCenter; Path.Opath.Refresh; // точку ставим перпендикулярно Path //PointToLine(Path.p1^, Path.p2^, x, y); //Path.ArcCenter := DoublePoint(x, y); //Path.ArcAng := GetRadOf2Lines(Path.p1^, Path.ArcCenter, Path.p2^); //tf.CalculatePathPoints; //CalculatePathPoints; RefreshPaths; Path.Net.DoResize; //17.12.2010 end; end; procedure TNet.SetModified; begin ResetRegion; FIsLoadedBounds := false; //03.02.2012 end; function TNet.FindBrokenPath(xPaths: TList): TnetPath; var i: Integer; Path: TnetPath; p1: pDoublePoint; p2: pDoublePoint; cnt1: Integer; cnt2: Integer; begin result := nil; for i := 0 to xPaths.Count - 1 do begin Path := TnetPath(xPaths[i]); p1 := path.p1; p2 := path.p2; cnt1 := CountIntersectingPathsOfKnot(p1,xPaths); cnt2 := CountIntersectingPathsOfKnot(p2,xPaths); if cnt1 = 1 then Path.DeadIdx := 1; if cnt2 = 1 then Path.DeadIdx := 2; if (cnt1 = 1) or (cnt2=1) then begin result := Path; end; end; end; function TNet.FindClockPath(cPaths:TList;p: PDoublePoint;oPath:TnetPath): TNetPath; var xp: pDoublePoint; xPaths: TList; i: Integer; path,xPath: TnetPath; angle: Double; mAng: Double; oAngle : Double; begin result := nil; xPaths := TList.Create; GetPathsOfKnot(p,cPaths,xpaths); xPath := nil; xp := opath.OtherPoint(p); oAngle := GetRadOfLine(p^,xp^); mAng := 0; //#From Oleg# //14.09.2010 for i := 0 to xPaths.Count - 1 do begin path := TNetPath(xPaths[i]); xp := path.OtherPoint(p); angle := GetRadOfLine(p^,xp^); angle := oAngle - Angle; if angle < 0 then angle := 2 * pi + Angle; if i = 0 then begin mAng := Angle; xPath:= path; end else begin if Angle < mAng then begin mAng := Angle; xPath:= path; end; end; end; result := xPath; xPaths.Free; end; function TNet.FindClockWPath(cPaths: TList; p: PDoublePoint; oPath: TnetPath): TnetPath; var xp: pDoublePoint; xPaths: TList; i: Integer; path,xPath: TnetPath; angle: Double; mAng: Double; oAngle : Double; begin result := nil; xPaths := TList.Create; GetPathsOfKnot(p,cPaths,xpaths); xPath := nil; xp := opath.OtherPoint(p); oAngle := GetRadOfLine(p^,xp^); mAng := 0; //#From Oleg# //14.09.2010 for i := 0 to xPaths.Count - 1 do begin path := TNetPath(xPaths[i]); xp := path.OtherPoint(p); angle := GetRadOfLine(p^,xp^); angle := oAngle - Angle; if angle < 0 then angle := 2 * pi + Angle; if i = 0 then begin mAng := Angle; xPath:= path; end else begin if Angle > mAng then begin mAng := Angle; xPath:= path; end; end; end; result := xPath; xPaths.Free; end; function TNet.FindIntersections(p1, p2: TDoublePoint; var pArr: TDoublePointArr): Boolean; var i: Integer; path: TnetPath; cnt: Integer; p: TdoublePOint; inserted: TList; begin result := false; cnt := 0; SetLength(parr,0); inserted:= TList.Create; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); if (Path.WType = wtWall) then begin if GetIntersectionPoint(p1,p2,path.p1^,path.p2^,p,false) then begin cnt := cnt + 1; SetLength(pArr,cnt); pArr[cnt - 1] := p; result := true; end else begin if (not EQDP(path.p1^,p1)) and (not EQDP(path.p1^,p2)) and isPointInLine(p1,p2,path.p1^,1) then begin if inserted.indexof(path.p1) = -1 then begin cnt := cnt +1; SetLength(pArr,cnt); pArr[cnt-1] := path.p1^; result := true; inserted.add(path.p1); end; end else if (not EQDP(path.p2^,p1)) and (not EQDP(path.p2^,p2)) and isPointInLine(p1,p2,path.p2^,1) then begin if inserted.indexof(path.p2) = -1 then begin cnt := cnt +1; SetLength(pArr,cnt); pArr[cnt-1] := path.p2^; result := true; inserted.add(path.p2); end; end; end; end; end; inserted.Free; if result then begin SortPointsOnLine(p1,p2,pArr); end; end; function TNet.FindStartPath(cPaths:TList;p:PDoublePoint): TNetPath; var xp: pDoublePoint; xPaths: TList; i: Integer; path,xPath: TnetPath; angle: Double; mAng: Double; begin Result := nil; xPaths := TList.Create; GetPathsOfKnot(p,cPaths,xpaths); xPath := nil; mAng := 0; //#From Oleg# //14.09.2010 for i := 0 to xPaths.Count - 1 do begin path := TNetPath(xPaths[i]); xp := path.OtherPoint(p); angle := GetRadOfLine(p^,xp^); if angle = 0 then angle := 2 * pi; if angle >= pi then angle := angle - pi else angle := pi + Angle; if i = 0 then begin mAng := Angle; xPath:= path; end else begin if Angle < mAng then begin mAng := Angle; xPath:= path; end; end; end; result := xPath; xPaths.Free; end; function TNet.FindStartPoint(xPaths:TList): PDoublePoint; var figMaxX, figMaxY, figMinX, figMinY: Double; xp,p: PDoublePoint; i: Integer; dist,len: double; lp: TDoublePoint; xPoints: TList; p1,p2: PDoublePoint; begin result := nil; GetPathBounds(xPaths,figMaxX, figMaxY, figMinX, figMinY); xPoints := TList.Create; for i := 0 to xPaths.Count - 1 do begin p1 := TNetPath(Xpaths[i]).p1; p2 := TNetPath(Xpaths[i]).p2; if xPoints.IndexOf(p1) = -1 then xPoints.Add(p1); if xPoints.IndexOf(p2) = -1 then xPoints.Add(p2); end; lp := DoublePoint(figMinX,figMinY); dist := -1; xp:= nil; For i := 0 to xPoints.Count - 1 do begin p := PDoublePoint(xPoints[i]); len := GetLineLenght(p^,lp); if dist = -1 then begin dist := len; xp := p; end else begin if len < dist then begin dist := len; xp := p; end; end; end; xPoints.Free; result := xp; end; procedure TNet.GetSelBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); var i: Integer; p: TDoublePoint; index: Integer; Path: TnetPath; Struct: TnetStruct; begin if Points.Count = 0 then exit; if (SelType = stPath) and (SelIndex > 0) then begin index := SelIndex - 1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); Path.GetBounds(figMaxX, figMaxY, figMinX, figMinY); end; end else if (SelType = stStruct) and (SelIndex > 0) then begin index := SelIndex - 1; if index < Structs.Count then begin Struct := TNetStruct(Structs[Index]); Struct.GetBounds(figMaxX, figMaxY, figMinX, figMinY); end; end else begin p := PDoublePoint(Points[0])^; figMaxX := p.x; figMinX := p.x; figMaxY := p.y; figMinY := p.y; For i := 1 to Points.Count - 1 do begin p := PDoublePoint(Points[i])^; if p.x > figMaxX then figMaxX := p.x; if p.x < figMinX then figMinX := p.x; if p.y > figMaxY then figMaxY := p.y; if p.y < figMinY then figMinY := p.y; end; end; end; procedure TNet.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); var i: Integer; p: TDoublePoint; begin if Points.Count = 0 then //Tolik 01/07/2019 -- переменные изначально приходят неинициализированные, поэтому для отрисовки нужно сбросить "мусор" !!! begin figMaxX := 0; figMaxY := 0; figMinX := 0; figMinY := 0; // exit; end; p := PDoublePoint(Points[0])^; figMaxX := p.x; figMinX := p.x; figMaxY := p.y; figMinY := p.y; For i := 1 to Points.Count - 1 do begin p := PDoublePoint(Points[i])^; if (abs(p.x) < 10000) and (abs(p.y) < 10000) then begin if p.x > figMaxX then figMaxX := p.x; if p.x < figMinX then figMinX := p.x; if p.y > figMaxY then figMaxY := p.y; if p.y < figMinY then figMinY := p.y; end; end; end; procedure TNet.GetModPoints(ModList: TMyList); var i, j, index: Integer; CControl: TPCdrawing; x, y: Double; SelPoint, p: PDoublePoint; path, SelPath: TnetPath; struct: TNetStruct; stair: TFigure; act: Boolean; mp, cp: TDoublePoint; modP: TmodPoint; Door: TNetDoor; begin CControl := TPCDrawing(Owner); path := nil; struct := nil; SelPoint := Self.SelPt; if SelPoint <> nil then//23.08.2011 if (FSelPtIdx <> -1) and (FSelPtIdx < Points.Count) then begin //23.08.2011 p := Points[FSelPtIdx]; ModList.Add(CControl.RegisterModPoint(self, ptPolyPoint, ptCircle, clBlue, 2, SelPoint^.x, SelPoint^.y, FSelPtIdx)); end else begin if (SelType = stPath) and (SelIndex > 0) then begin index := SelIndex - 1; if index > Paths.Count - 1 then SelIndex := 0; if index < Paths.Count then path := TnetPath(Paths[Index]); end else if (SelType = stStruct) and (SelIndex > 0) then begin index := SelIndex - 1; if index > Structs.Count - 1 then SelIndex := 0; if index < Structs.Count then struct := TNetStruct(Structs[Index]); end; for i := 0 to Points.Count-1 do begin p := PDoublePoint(Points[i]); act := True; if assigned(path) then begin act := (path.isKnotIn(p) <> 0); // Если есть несколько выделенных сегментов if Not act then for j := 0 to FSelection.Count - 1 do begin SelPath := TNetPath(FSelection[j]); if (SelPath <> path) and (Paths.IndexOf(SelPath) <> -1) then if (SelPath.isKnotIn(p) <> 0) then begin act := true; Break; //// BREAK //// end; end; end else if assigned(Struct) then begin act := (Struct.isKnotIn(p) <> -1); end; if act then begin ModList.Add(CControl.RegisterModPoint(self, ptPolyPoint, ptCircle, clBlue, 2, p.x, p.y, i)); end; end; if assigned(path) then begin if (Path.DoorIndex > -1) then begin //13.10.2010 i := (Paths.IndexOf(path)); //13.10.2010 mp := MPoint(path.p1^, path.p2^, 6.0); //13.10.2010 ModList.Add(CControl.RegisterModPoint(self, ptGroupPoint, ptRect, clRed, 3, mp.x, mp.y, i)); //11.10.2010 Door Mod-points Door := Path.ActiveDoor; if Door <> nil then begin ModList.Add(CControl.RegisterModPoint(self, ptControlPoint, ptCircle, clGreen, 2, Door.p1.x, Door.p1.y, -3)); ModList.Add(CControl.RegisterModPoint(self, ptControlPoint, ptCircle, clGreen, 2, Door.p2.x, Door.p2.y, -3)); end; end else begin //13.10.2010 - мод.поинт для перемещения сегмента в стороны i := (Paths.IndexOf(path)); if path.GetLenByPoints(path.p1^, path.p2^) > 0 then begin mp := MPoint(path.p1^, path.p2^, 6.0); // Tolik - 11/01/2022 - тут проеб...так как здесь i - уже не индекс точки в списке, за счет этого // "выбьет" произвольную точку из модпоинтов, определяемых ниже, как нередактируемые(черные) //ModList.Add(CControl.RegisterModPoint(self, ptGroupPoint, ptRect, clRed, 3, mp.x, mp.y, i)); ModList.Add(CControl.RegisterModPoint(self, ptGroupPoint, ptRect, clRed, 3, mp.x, mp.y, -5)); // //22.10.2010 - мод.поинт для изменения радиуса if path.IsArc then begin //Tolik --11/01/2022 -- та же херня //ModList.Add(CControl.RegisterModPoint(self, ptArcControl, ptRect, clGreen, 3, path.ArcCenter.x, path.ArcCenter.y, i)); ModList.Add(CControl.RegisterModPoint(self, ptArcControl, ptRect, clGreen, 3, path.ArcCenter.x, path.ArcCenter.y, -5)); // end; end; end; end; end; // Остальные точки черным цветом и без возможности модификации for i := 0 to Points.Count - 1 do begin // Проверяем есть ли такой индекс в списке p := nil; for j := 0 to ModList.Count - 1 do begin modP := TmodPoint(ModList[j]); if modP.SeqNbr = i then begin p := Points[i]; Break; //// BREAK //// end; end; if p = nil then begin p := Points[i]; ModList.Add(CControl.RegisterModPoint(self, ptPolyPoint, ptCircle, clBlack, 1, p^.x, p^.y, -4)); end; end; end; function TNet.GetNetPath(p1, p2: PDoublePoint): TnetPath; var i: Integer; path: TnetPath; begin result := nil; for i := 0 to Paths.Count - 1 do begin path := TnetPath(paths[i]); if path.AreYou(p1,p2) then begin result:= path; exit; end; end; end; procedure TNet.GetPathBounds(xPaths: Tlist; var figMaxX, figMaxY, figMinX, figMinY: Double; aLengthType: TShowPathLengthType=sltPoints); var i: Integer; p: TDoublePoint; p1,p2: PDoublePoint; xPoints: TList; xPath: TNetPath; begin xPoints := TList.Create; for i := 0 to xPaths.Count-1 do begin xPath := TNetPath(Xpaths[i]); //28.04.2012 p1 := xPath.p1; //28.04.2012 p2 := xPath.p2; if aLengthType <> sltPoints then xPath.DefineInOutPoints; p1 := xPath.GetPointByLenghType(1, aLengthType); p2 := xPath.GetPointByLenghType(2, aLengthType); if xPoints.IndexOf(p1) = -1 then xPoints.Add(p1); if xPoints.IndexOf(p2) = -1 then xPoints.Add(p2); end; if xPoints.Count = 0 then begin xPOints.Free; exit; end; p := PDoublePoint(xPoints[0])^; figMaxX := p.x; figMinX := p.x; figMaxY := p.y; figMinY := p.y; For i := 1 to xPoints.Count-1 do begin p := PDoublePoint(xPoints[i])^; if p.x > figMaxX then figMaxX := p.x; if p.x < figMinX then figMinX := p.x; if p.y > figMaxY then figMaxY := p.y; if p.y < figMinY then figMinY := p.y; end; xPoints.Free; end; procedure TNet.GetSize(aLengthType: TShowPathLengthType; var figHeight, figWidth: Double); var figMaxX, figMaxY, figMinX, figMinY: Double; begin //28.04.2012 GetBounds(figMaxX,figMaxY,figMinX,figMinY); GetPathBounds(Paths, figMaxX,figMaxY,figMinX,figMinY); figHeight := figMaxY - figMinY; figWidth := figMaxX - figMinX; end; procedure TNet.GetPathsOfKnot(p: PDoublePoint; var xPaths: TList); var i: Integer; begin for i := 0 to Paths.Count - 1 do begin if TnetPath(Paths[i]).isKnotIn(p) > 0 then begin xPaths.Add(Paths[i]); end; end; end; procedure TNet.GetPathsOfKnot(p: PDoublePoint; lPaths: Tlist; var xPaths: TList); var i: Integer; begin for i := 0 to lPaths.Count - 1 do begin if TnetPath(lPaths[i]).isKnotIn(p) > 0 then begin xPaths.Add(lPaths[i]); end; end; end; Function TNet.GroupPathPointsByIntersection(pArr: TDoublePointArr; var pGrp: TDoublePointGroup): Boolean; var p1, p2, p, p3, p4: TDoublePoint; i, pCnt, cnt, k: Integer; iArr: TDoublePointArr; done: Boolean; gCnt, iCnt: Integer; path: TNetPath; begin result := true; pCnt:= Length(pArr); if Not FDisableMergePaths then //15.10.2010 if FAllowDelPathOnMake then //26.09.2011 begin for i := 0 to pCnt - 2 do begin p1 := pArr[i]; p2 := pArr[i + 1]; for k := Paths.Count - 1 downto 0 do begin path := TnetPath(Paths[k]); if (IsPointInLine(p1, p2, path.p1^, 1, 0) and IsPointInLine(p1, p2, path.p2^, 1, 0)) or (IsPointInLine(path.p1^, path.p2^, p1, 1, 0) and IsPointInLine(path.p1^, path.p2^, p2, 1, 0)) then begin if (path.Broken) then begin DeletePath(path); end else begin result := false; exit; end; end; end; end; end; //Делаем из полигона правильный,если у него нет последней точки if (not EQDP(pArr[pCnt-1], pArr[0]))and(GCadForm.PCad.ToolInfo = 'TWallRect') then begin pCnt:= pCnt + 1; SetLength(pArr,pCnt); pArr[pCnt-1] := pArr[0]; end; p1 := pArr[0]; p2 := pArr[1]; p3 := pArr[pCnt - 2]; p4 := pArr[pcnt - 1]; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); if path.IsPointIn(p1.x, p1.y) then begin path.PointToWall(p1, p2); pArr[0] := p1; end else if path.IsPointIn(p4.x, p4.y) then begin path.PointToWall(p4, p3); pArr[pcnt-1] := p4; end; end; gCnt := 1; SetLength(pGrp,gCnt); pCnt:= Length(pArr); SetLength(pGrp[0], 0); done := false; // Add first point i := 0; cnt := 0; cnt := cnt + 1; SetLength(pGrp[gCnt - 1], cnt); p1 := pArr[i]; pGrp[gcnt - 1][cnt - 1] := p1; repeat p1 := pArr[i]; p2 := pArr[i + 1]; if Not FDisableMergePaths and FindIntersections(p1, p2, iArr) then begin // Add Intersecting Points iCnt := Length(iArr); for k := 0 to icnt - 1 do begin cnt := cnt + 1; SetLength(pGrp[gCnt - 1], cnt); pGrp[gcnt - 1][cnt - 1] := iArr[k]; gCnt := gCnt + 1; SetLength(pGrp, gCnt); cnt := 0; cnt := cnt + 1; SetLength(pGrp[gCnt - 1], cnt); pGrp[gcnt - 1][cnt - 1] := iArr[k]; end; // Add LastPoint cnt := cnt + 1; SetLength(pGrp[gCnt - 1], cnt); pGrp[gcnt - 1][cnt - 1] := p2; end else begin cnt := cnt + 1; SetLength(pGrp[gCnt - 1], cnt); pGrp[gcnt - 1][cnt - 1] := p2; end; i := i + 1; if i >= pcnt - 1 then done := true; until done; end; procedure TNet.Initialize; begin inherited; PointCount:= 0; Paths := TList.Create; Points := TList.Create; Structs := TList.Create; Modified := False; LockMove := False; EndDraw := True; ContextMenu := True; DrawGuides := True; EditMode := False; DrawAsTrace := False; DetDraw := False; FAllowDelPathOnMake := true; //26.09.2011 //FAllowCleanSamePointsInGrpPointArray := false; //21.06.2012 FAllowAddPathWithSamePoints := true; //21.06.2012 FDrawedPt1 := TList.Create; //13.05.2011 FDrawedPt2 := TList.Create; //13.05.2011 FPointIDs := TList.Create; //04.10.2010 FSelection := TList.Create; //27.07.2011 FSelectingPt := false; FSelPtIdx := -1; FAfterAllScale := AfterAllScale; FBeforeAllScale := BeforeAllScale; FScaleAllEvent := ScaleAllEvent; FBeforeDelFromParent := BeforeDelFromParent; FAfterUndo := AfterUndo; FPathTracePoint := nil; //21.10.2010 FRelatedOwner := nil; //21.10.2010 FRelatedPoints := TList.Create; FRelatedNets := TList.Create; FRelatedObject := nil; FRelatedMPoint := nil; //19.10.2010 FRelatedMPath := nil; //24.05.2011 FSrcNet := nil; //21.10.2010 FJoinedMovePoints := TList.Create; //23.05.2011 FJoinedMovePointsDirections := TList.Create; FJoinedMovePointsFixedState := TList.Create; //27.05.2011 FJoinedMovePaths := TList.Create; //24.05.2011 FJoinedMovePathsDirections := TList.Create; FSavedPoints := TList.Create; FSavedScaledPoints := TList.Create; if Not Assigned(Self.FOnDelete) then GArchEngine.SetHandlersToObj(Self); end; function CheckPointForOtherNets(Point1: TDoublePoint): Boolean; Var CAD: TF_CAD; Figure: TFigure; i,j,PathsCount: Integer; xNet: TNet; xNetPath: TNetPath; P1,P2: TDoublePoint; begin Result := False; PathsCount := 0; CAD := TF_CAD(GCadForm); for i := 0 to CAD.PCad.Figures.Count - 1 do begin Figure := TFigure(CAD.PCad.Figures[i]); if (Figure is TNet) and (TNet(Figure).FComponID <> 0) then begin xNet := Tnet(Figure); for j := 0 to xNet.Paths.Count - 1 do begin xNetPath := TNetPath(xNet.Paths[j]); p1 := xNetPath.p1^; P2 := xNetPath.p2^; if ((P1.x = Point1.x)and(P1.y = Point1.y))or((P2.x = Point1.x)and(P2.y = Point1.y))then begin Inc(PathsCount); Break; end; end; end; end; Result := PathsCount > 1; end; Function CheckNetByRoof(aNetPath: TNetPath): Boolean; var SCSCompon: TSCSComponent; i: Integer; begin Result := False; SCSCompon := nil; SCSCompon := GetArchObjByCADObj(aNetPath); if SCSCompon <> nil then for i := 0 to SCSCompon.Properties.Count - 1 do begin if PProperty(SCSCompon.Properties[i]).SysName = 'ROOF_HIP_TYPE' then begin Result := True; Break; end; end; end; // Tolik 17/10/2016-- // Function TNet.InsertKnot(p: TDoublePoint; force: Boolean = false; aPathOnKnot: Pointer=nil): PDoublePoint; Function TNet.InsertKnot(p: TDoublePoint; force: Boolean = false; aPathOnKnot: Pointer=nil; aPrevPoint: PDoublePoint = nil): PDoublePoint; // var i: Integer; p1, p2: PDoublePoint; path, nPt: TnetPath; {//22.06.2012 Function CheckForPoints(pp: TDoublePoint): PDoublePoint; var xp: PDoublePoint; k: Integer; LastDist: Double; CurrDist: Double; begin result := nil; LastDist := -1; for k := 0 to Points.Count - 1 do begin xp := PDoublePoint(Points[k]); //if EQDP(xp^, pp) then // begin CurrDist := GetLineLenght(xp^, pp); if CurrDist <= (WallThick / 2) then begin if (LastDist = -1) or (LastDist > CurrDist) then begin LastDist := CurrDist; result := xp; //exit; end; end; end; end;} Function CheckDistance(pn: TDoublePoint): Boolean; var k: Integer; px: TDoublePoint; begin result := true; for k := 0 to Points.Count - 1 do begin px:= PDoublePOint(Points[k])^; if GetLineLenght(pn, px) <= (WallThick / 2) then begin result := false; exit; end; end; end; begin result := nil; if aPathOnKnot <> nil then //02.04.2013 TNetPath(aPathOnKnot^) := nil; //22.06.2012 p1 := CheckForPoints(p); // Tolik 17/10/2016-- p1 := Nil; p1 := CheckForPoints(p, aPrevPoint); if assigned(p1) then begin result := p1; if aPathOnKnot <> nil then //02.04.2013 for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); if path.isKnotIn(result) <> 0 then begin TNetPath(aPathOnKnot^) := path; Break; //// BREAK //// end; end; exit; end; if Not FDisableMergePaths then //#From Oleg# begin for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); if (path.isPointOnLine(p.x, p.y)) then begin PointToLine(path.p1^, path.p2^, p.x, p.y); p1 := CheckForPoints(p); if not assigned(p1) then begin if CheckDistance(p) then begin //Если это не крыша, тогда делать как раньше... if not CheckNetByRoof(path.Opath) then begin p1 := AddPoint(p, path); p2 := path.p2; path.p2 := p1; nPt := AddPath(p1, p2, path.border); if Assigned(FOnAutoAddPath) then FOnAutoAddPath(Self, path, nPt); if nPt <> nil then begin nPt.wstyle := path.wstyle; nPt.FColor := path.FColor; nPt.FBrushColor := path.FBrushColor; nPt.FBrushStyle := path.FBrushStyle; if nPt.Width <> path.Width then begin nPt.Width := path.Width; RefreshPaths; end; end; end else p1 := AddPoint(p, path); end else exit; end; result := p1; //02.04.2013 if aPathOnKnot <> nil then TNetPath(aPathOnKnot^) := path; exit; end; end; end; if force then begin // Tolik 17/10/2016-- если потребуется возможность расстановки точек ближе друг к дружке, чем толщина стены -- // тогда раскомментить то, что закомменчено ниже // if aPrevPoint = nil then begin // if CheckDistance(p) then begin p1 := AddPoint(p); result := p1; end; end; // Tolik 17/10/2016-- // else // result := AddPoint(p); end; end; // Tolik -- 19/10/2016 -- попытаться выровнять Procedure TNet.CorrectNetPathPosbyRelatedPath(aPath: TNetPath; dx,dy: double); var currNet, RelatedNet: TNet; RelatedPathList: TList; RelatedPath: TNetPath; deltax, deltay: double; aPathLength, RelatedPathLength: double; i: Integer; OrthoPoint: PDoublePoint; // вернет ортогональную точку, но только в том случае, если она есть и ее можно двинуть // т.е. у нее нет приконнекченных точек function GetOrthogonalPoint(aPoint: PDoublePoint): PDoublePoint; var i: Integer; currPathList: TList; currPath: TNetPath; currPoint: PDoublePoint; isOrthogonal: Boolean; RelatedPointsList: TList; begin Result := Nil; // получить смежные пути в точке currPathList := GetPathListByPoint(aPoint); if ((currPathList <> nil) and (currPathList.Count > 0)) then begin currPath := nil; for i := 0 to currPathList.Count - 1 do begin if TNetPath(currPathList) <> aPath then begin currPath := TNetPath(currPathList[i]); break; end; end; FreeAndNil(currPathList); // противоположная точка смежного пути if currPath <> nil then begin currPoint := nil; if currPath.p1 <> APoint then currPoint := currPath.p1 else if currPath.p2 <> aPoint then currPoint := currPath.p2; end; if currPoint <> nil then begin if ((CompareValue(aPoint.x, currPoint.x) = 0) or (CompareValue(aPoint.y, currPoint.y) = 0)) then begin // получить список присоединенных точек RelatedPointsList := GetRelatedPoints(currPoint); // если присоединенных точек нет - возвращаем резутьтат if ((RelatedPointsList = nil) or ((RelatedPointsList <> nil) and (RelatedPointsList.Count = 0))) then Result := currPoint; if RelatedPointsList <> nil then FreeAndNil(RelatedPointsList); end; end; end; end; begin if aPath <> nil then begin //if Self.IsRectangle and (self.Paths.Count = 4) then // лучше так ибо бывает подвисает IsRectangle да и быстрее проверить self.Paths.Count // см. задачу: https://app.asana.com/0/388690353475548/876171867625289 // при такой конфигурации стен (важно где какой нод расположен) - https://prnt.sc/l90su0 if (self.Paths.Count = 4) and Self.IsRectangle then begin RelatedNet := nil; RelatedPathList := GetRelatedPaths(aPath); if RelatedPathList <> nil then begin RelatedPath := TNetPath(RelatedPathList[0]); deltax := 0; deltay := 0; // первая точка if pointNear(aPath.p1^, RelatedPath.p1^,3) then begin deltax := RelatedPath.p1.x - aPath.p1.x; deltay := RelatedPath.p1.y - aPath.p1.y; end else if pointNear(aPath.p1^, RelatedPath.p2^, 3) then begin deltax := RelatedPath.p2.x - aPath.p1.x; deltay := RelatedPath.p2.y - aPath.p1.y; end; if (deltax <> 0) or (deltay <> 0) then // если нужно притянуть точку к соседней begin OrthoPoint := Nil; aPath.p1.x := aPath.p1.x + deltax; aPath.p1.y := aPath.p1.y + deltay; // получить ортогональную точку OrthoPoint := GetOrthogonalPoint(aPath.p1); if OrthoPoint <> nil then begin OrthoPoint.x := OrthoPoint.x + deltax; OrthoPoint.y := OrthoPoint.y + deltay; end; end; deltax := 0; deltay := 0; OrthoPoint := Nil; // вторая точка if pointNear(aPath.p2^, RelatedPath.p1^,3) then begin deltax := RelatedPath.p1.x - aPath.p2.x; deltay := RelatedPath.p1.y - aPath.p2.y; end else if pointNear(aPath.p2^, RelatedPath.p2^, 3) then begin deltax := RelatedPath.p2.x - aPath.p2.x; deltay := RelatedPath.p2.y - aPath.p2.y; end; if (deltax <> 0) or (deltay <> 0) then begin aPath.p2.x := aPath.p2.x + deltax; aPath.p2.y := aPath.p2.y + deltay; // получить ортогональную точку OrthoPoint := GetOrthogonalPoint(aPath.p2); if OrthoPoint <> nil then begin OrthoPoint.x := OrthoPoint.x + deltax; OrthoPoint.y := OrthoPoint.y + deltay; end; end; Self.RefreshPoints; Self.SetModified; {Self.FMoveAllPoints := True; Self.Move(deltax, deltay); Self.FMoveAllPoints := False;} { if deltax <> 0 then begin for i := 0 to Points.Count - 1 do begin PDoublePoint(Points[i])^.x := PDoublePoint(Points[i])^.x + deltax; end; end; if deltay <> 0 then begin for i := 0 to Points.Count - 1 do begin PDoublePoint(Points[i])^.y := PDoublePoint(Points[i])^.y + deltay; end; end; } GCadForm.PCad.Refresh; end; end; end; end; Function TNet.GetSCSRoomConture(aNet: TNet):TDoublePointArr; // Tolik 22/06/2018 -- var currPath: TNetPath; PasedList, PathList: TList; i:Integer; ResultList: TList; isPathConture: Boolean; FullPathConture: TDoublePointArr; begin SetLength(Result, 0); ResultList := TList.Create; if aNet.Paths.Count > 2 then begin for i := 0 to aNet.Paths.Count - 1 do begin currPath := TNetPath(aNet.Paths[i]); Result := currPath.GetFullConture; end; {SetLength(Result, ResultList.Count); for i := 0 to ResultList.count - 1 do begin Result[i].x := PDoublePoint(ResultList[i]).x; Result[i].y := PDoublePoint(ResultList[i]).y; Result[i].z := 0; end; ResultList.free;} end; end; class function TNet.InsideSelection: Boolean; begin result := True; end; procedure TNet.IntersectCorner(pIndex:Integer); var path: TnetPath; p1,p2: TDoublePoint; p3,p4: TDoublePoint; xPaths: TList; p: PDoublePoint; id,i,k,cnt,icnt: Integer; path1,path2: TnetPath; ip,ip1,ip2: TDoublePOint; intersect: Boolean; closed: Boolean; lPath: TnetPath; r1,r2,radius: Double; HasWall: Boolean; HasGlass: Boolean; j1,j2: TDoublePOint; //pl1, pl2, pl3, pl4: Double; PathsAngleRad: Double; FindedPt: Boolean; MovedPt: Boolean; //17.05.2012 MovedPtSide: Integer; MovedPtPathSide: Char; // l or r MovePtDeltaX, MovePtDeltaY: Double; //17.05.2012 MovePtStaticPath: TNetPath; MovePtPath: TNetPath; MovePtIntersect, MoveSPtIntersect: PDoublePoint; //17.05.2012 MovePtInverseIntersect, MoveSPtInverseIntersect: PDoublePoint; //17.05.2012 MoveParallelEPt: PDoublePoint; ptrMovePerpendicularEPt: Pointer; StaticParallelEPt: PDoublePoint; PointList, OtherPointList: TList; ptrTempPt, ptrTempPt2: PDoublePoint; MoveOtherPath: TNetPath; ap, bp: TDoublePoint; OtherIp: PDoublePoint; j, l: Integer; TempPt1, TempPt2: TDoublePoint; TempLinePt1, TempLinePt2: TDoublePoint; arcPoints: TList; arcLPoints: TList; procedure CorrectCoord(var aCoord, aSecondCoord: Double); begin if Abs(aCoord - aSecondCoord) < 0.2 then aSecondCoord := aCoord; end; procedure CorrectPtCoord(var aPt, aSecondPt: TDoublePoint); begin CorrectCoord(aPt.x, aSecondPt.x); CorrectCoord(aPt.y, aSecondPt.y); CorrectCoord(aPt.x, aSecondPt.y); //aPt.x := RoundX(aPt.x, 2); //aPt.y := RoundX(aPt.y, 2); end; //17.05.2012 procedure ApplyIntersectPt(aPath: TNetPath; aPtSide: Integer; aPathSide: Char; aDestPt, aSecondDestPt, aParallelEPt, aInversePt, aInverseSPt: PDoublePoint; aPerpendicularPt: Pointer); var ptCmp: TDoublePoint; begin if MovedPt then begin if MovePtPath = aPath then begin // Если не совпадают координаты, то запоминаем сегмент и его точку, которая будет подтянута к точке связанного сегмента ptCmp := aDestPt^; ptCmp.x := ptCmp.x - aPath.FPerpendDX; ptCmp.y := ptCmp.y - aPath.FPerpendDY; if Not EQDP(ptCmp, ip) then begin MovePtDeltaX := ip.x - aDestPt^.x; MovePtDeltaY := ip.y - aDestPt^.y; MovedPtSide := aPtSide; MovedPtPathSide := aPathSide; MovePtIntersect := aDestPt; MoveSPtIntersect := aSecondDestPt; MoveParallelEPt := aParallelEPt; ptrMovePerpendicularEPt := aPerpendicularPt; MovePtInverseIntersect := aInversePt; MoveSPtInverseIntersect := aInverseSPt; //MovePtPath := aPath; end; end else if MovePtStaticPath = aPath then begin // Если совпадают координаты, то запоминаем ссылку на точку сегмента, к которой будет подведена точка другого сегмента if EQDP(aDestPt^, ip) then begin StaticParallelEPt := aParallelEPt; end; end; end; if Not MovedPt then begin aDestPt^ := ip; aSecondDestPt^ := aDestPt^; end; end; begin p := pDoublePoint(points[pIndex]); xPaths := TList.Create; cnt := 0; HasWall:= False; HasGlass := False; lpath := nil; //#From Oleg# //14.09.2010 MovePtIntersect := nil; arcPoints := TList.Create; arcLPoints := TList.Create; for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); closed:= path.Isclosed; id := path.isKnotValIn(p^); if (id > 0) and (not Closed) then begin if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then begin if Path.WType in [wtWall,wtOpen] then hasWall := True else HasGlass := True; cnt := cnt + 1; //15.08.2011 xPaths.Add(path); if id = 1 then path.Angle := GetRadOfLine(p^,path.p2^) else path.Angle := GetRadOfLine(p^,path.p1^); path.Dir := id; lPath := path; if Path.WStyle = wsLine then //15.08.2011 begin Path.a1 := Path.p1^; Path.b1 := Path.p1^; Path.l1 := Path.p1^; Path.el1 := Path.p1^; Path.r1 := Path.p1^; Path.er1 := Path.p1^; Path.a2 := Path.p2^; Path.b2 := Path.p2^; Path.l2 := Path.p2^; Path.el2 := Path.p2^; Path.r2 := Path.p2^; Path.er2 := Path.p2^; end else xPaths.Add(path); end; end; end; cnt := xPaths.Count; if haswall and hasGlass then begin for i := cnt - 1 downto 0 do begin Path := TnetPath(xPaths[i]); if Path.WType in [wtGlass,wtHalf] then xPaths.Remove(Path); end; end; cnt := xPaths.Count; if cnt = 1 then begin if (lpath.dir = 1) then begin lpath.Empty1 := true; if not lPath.isArc then begin lPath.a1 := MPoint(lPath.a1,lPath.a2, -lpath.Width/2); lPath.b1 := MPoint(lPath.b1,lPath.b2, -lpath.Width/2); lPath.l1 := MPoint(lPath.l1,lPath.l2, -lpath.Width/2); lPath.el1 := lPath.l1; lPath.r1 := MPoint(lPath.r1,lPath.r2, -lpath.Width/2); lPath.er1 := lPath.r1; end; end else begin lpath.Empty2 := true; if not lPath.isArc then begin lPath.a2 := MPoint(lPath.a2,lPath.a1, -lpath.Width/2); lPath.b2 := MPoint(lPath.b2,lPath.b1, -lpath.Width/2); lPath.l2 := MPoint(lPath.l2,lPath.l1, -lpath.Width/2); lPath.el2 := lPath.l2; lPath.r2 := MPoint(lPath.r2,lPath.r1, -lpath.Width/2); lPath.er2 := lPath.r2; end; end; end; // Tolik 21/07/2018 -- if xPaths.Count < 2 then // Tolik -- 07/02/2017 -- // exit; begin FreeAndNil(xPaths); arcPoints.free; arcLPoints.free; exit; end; // SortPathAngles(xPaths,0,xPaths.Count - 1); for i := 0 to xPaths.Count - 1 do begin path1 := TNetPath(xPaths[i]); if i < xPaths.Count - 1 then k := i + 1 else k := 0; path2 := TNetPath(xPaths[k]); intersect := true; if Intersect then begin /// if (not path1.isArc) and (not path2.isArc) then begin if path1.Dir = 1 then begin //CorrectPtCoord(path1.r1, path1.r2); //12.04.2012 p1 := path1.r1; p2 := path1.r2; end else begin //CorrectPtCoord(path1.l1, path1.l2); //12.04.2012 p1 := path1.l1; p2 := path1.l2; end; if path2.Dir = 2 then begin //CorrectPtCoord(path2.l1, path2.l2); //12.04.2012 p3 := path2.r1; p4 := path2.r2; end else begin //CorrectPtCoord(path2.l1, path2.l2); //12.04.2012 p3 := path2.l1; p4 := path2.l2; end; //12.04.2012 - если X или Y точки очччень рядом, то подтягиваем к одной? чтобы небыло длинных "фанер" {CorrectPtCoord(p1, p2); CorrectPtCoord(p1, p3); CorrectPtCoord(p1, p4); CorrectPtCoord(p2, p3); CorrectPtCoord(p2, p4); CorrectPtCoord(p3, p4);} PathsAngleRad := CorrectAngle(RadToDeg(GetRadOfLine(p1, p2) - GetRadOfLine(p3, p4)), 180); //if PathsAngleRad > 180 then // PathsAngleRad := PathsAngleRad - 180 //else if PathsAngleRad < 180 then FindedPt := false; MovedPt := false; // Если угол более менее есть, то находим точку в обычном режиме if {(PathsAngleRad = 0) or} ((PathsAngleRad >= 5) and (Abs(PathsAngleRad - 180) >= 5)) then // 3 //if true then // begin // ??? if GetIntersectionPoint(p1, p2, p3, p4, ip) then begin FindedPt := true; end; // ??? end else begin //EmptyProcedure; GetLinesNearPoints(@p1, @p2, @p3, @p4, ap, bp); FindedPt := true; //MovedPt := true; MovePtDeltaX := 0; MovePtDeltaY := 0; MovePtPath := nil; MovePtStaticPath := nil; {if Path1.Width < Path2.Width then begin MovePtPath := Path1; MovePtStaticPath := Path2; end else if Path1.Width > Path2.Width then begin MovePtPath := Path2; MovePtStaticPath := Path1; end;} case CompareValue(Path1.Width, Path2.Width) of LessThanValue: begin MovePtPath := Path1; MovePtStaticPath := Path2; end; GreaterThanValue: begin MovePtPath := Path2; MovePtStaticPath := Path1; end; EqualsValue: begin // Перемещать грань будем, которая не вертикальна и не горизонтальна if Not EQD(Path1.r1.x,Path1.r2.x) and Not EQD(Path1.r1.y, Path1.r2.y) then begin MovePtPath := Path1; MovePtStaticPath := Path2; end else if Not EQD(Path2.r1.x, Path2.r2.x) and Not EQD(Path2.r1.y, Path2.r2.y) then begin MovePtPath := Path2; MovePtStaticPath := Path1; end; if MovePtPath = nil then if Path1.GetLenByPoints(Path1.p1^,Path1.p2^) < Path2.GetLenByPoints(Path2.p1^,Path2.p2^) then begin MovePtPath := Path1; MovePtStaticPath := Path2; end else begin MovePtPath := Path2; MovePtStaticPath := Path1; end; end; end; MovedPt := MovePtPath <> nil; ip := ap; //ip := bp; if MovePtPath <> nil then begin if MovePtPath.FPerpendSide = 1 then begin if MovePtPath.Dir = 1 then ip := bp; end else if MovePtPath.Dir <> 1 then ip := bp; end; MovedPtSide := 0; MovedPtPathSide := #0; MovePtIntersect := nil; MoveSPtIntersect := nil; MovePtInverseIntersect := nil; MoveSPtInverseIntersect := nil; MoveParallelEPt := nil; StaticParallelEPt := nil; ptrMovePerpendicularEPt := nil; end; if FindedPt then begin {//17.05.2012 if path1.Dir = 1 then begin path1.r1 := ip; path1.er1 := path1.r1; end else begin path1.l2 := ip; path1.el2 := path1.l2; end; if path2.Dir = 1 then begin path2.l1 := ip; path2.el1 := path2.l1; end else begin path2.r2 := ip; path2.er2 := path2.r2; end; } //17.05.2012 Применение точки пересечения обоим Path if path1.Dir = 1 then ApplyIntersectPt(path1, 1, 'r', @path1.r1,@path1.er1, @path1.el1, @path1.r2,@path1.er2, @path1.epl1) else ApplyIntersectPt(path1, 2, 'l', @path1.l2,@path1.el2, @path1.er2, @path1.l1,@path1.el1, @path1.epr2); if path2.Dir = 1 then ApplyIntersectPt(path2, 1, 'l', @path2.l1,@path2.el1, @path2.er1, @path2.l2,@path2.el2, @path2.epr1) else ApplyIntersectPt(path2, 2, 'r', @path2.r2,@path2.er2, @path2.el2, @path2.r1,@path2.er1, @path2.epl2); // Если была подтянута точка, то остальный подтягиваем тож, чтобы небыло трапеций не сегменте if MovedPt then if MovePtIntersect <> nil then begin //ptrTempPt := MovePtPath.GetConnectedPoint(MovePtStaticPath); //if GetPathCountByPoint(ptrTempPt) < 3 then begin //TempPt := MovePtInverseIntersect; // TempPt^.x := TempPt^.x + MovePtDeltaX; // TempPt^.y := TempPt^.y + MovePtDeltaY; // TempPt := MoveSPtInverseIntersect; // TempPt^.x := TempPt^.x + MovePtDeltaX; // TempPt^.y := TempPt^.y + MovePtDeltaY; //PointList := TList.Create; //PointList.Add(@MovePtPath.r1); //PointList.Add(@MovePtPath.er1); //PointList.Add(@MovePtPath.r2); //PointList.Add(@MovePtPath.er2); //PointList.Add(@MovePtPath.l1); //PointList.Add(@MovePtPath.el1); //PointList.Add(@MovePtPath.l2); //PointList.Add(@MovePtPath.el2); // Для точки перпендикуляра от паралельной точки от перемещаемой, запоминаем ссылку на точку связянного сегмента, который толще if ptrMovePerpendicularEPt <> nil then begin ptrTempPt := MovePtPath.GetConnectedPoint(MovePtStaticPath); if GetPathCountByPoint(ptrTempPt) < 3 then PDoublePoint(ptrMovePerpendicularEPt^) := StaticParallelEPt else EmptyProcedure; //if FPerpendPoints <> nil then // FPerpendPoints.Add(StaticParallelEPt); end; //if MovePtPath.GetPointBySide(MovedPtSide) <> nil then //if pIndex < 0 then begin PointList := MovePtPath.GetConturePoints(false, 0); // , MovedPtSide, MovedPtPathSide for k := 0 to PointList.Count - 1 do begin ptrTempPt := PDoublePoint(PointList[k]); for j := 0 to Paths.Count - 1 do begin MoveOtherPath := TNetpath(Paths[j]); if (MoveOtherPath <> Path1) and (MoveOtherPath <> Path2) {and (MoveOtherPath.GetConnectedPoint(MovePtPath) <> nil)} then //if EQDP(MoveOtherPath.GetConnectedPoint(MovePtPath)^, MovePtPath.GetPointBySide(MovedPtSide)^) then //if MoveOtherPath.FComponId <> 163 then begin OtherPointList := MoveOtherPath.GetConturePoints(false); //OtherPointList := MoveOtherPath.GetConturePoints(false, MoveOtherPath.GetConnectedSide(MovePtPath)); for l := 0 to OtherPointList.Count - 1 do begin ptrTempPt2 := PDoublePoint(OtherPointList[l]); // Если эта точка уже ранее определена как перпендикулярная. то пропускаем //if FPerpendPoints <> nil then // if FPerpendPoints.IndexOf(ptrTempPt2) <> -1 then // Continue; //// CONTINUE //// if EQDP(ptrTempPt^, ptrTempPt2^) then begin ptrTempPt2^.x := ptrTempPt2^.x + MovePtDeltaX; ptrTempPt2^.y := ptrTempPt2^.y + MovePtDeltaY; end; end; MoveOtherPath.SetEPoints; FreeAndNil(OtherPointList); if MoveOtherPath.isArc and MoveOtherPath.Connected(MovePtPath) then begin MoveOtherPath.FillArcJoinPoints(arcPoints, arcLPoints); for l := 0 to arcPoints.Count - 1 do begin ptrTempPt2 := arcPoints[l]; if EQDP(ptrTempPt^, ptrTempPt2^) then begin ptrTempPt2^.x := ptrTempPt2^.x + MovePtDeltaX; ptrTempPt2^.y := ptrTempPt2^.y + MovePtDeltaY; end; ptrTempPt2 := arcLPoints[l]; if EQDP(ptrTempPt^, ptrTempPt2^) then begin ptrTempPt2^.x := ptrTempPt2^.x + MovePtDeltaX; ptrTempPt2^.y := ptrTempPt2^.y + MovePtDeltaY; end; end; end; end; end; //if (ptrTempPt <> MovePtIntersect) and (ptrTempPt <> MoveSPtIntersect) then begin ptrTempPt^.x := ptrTempPt^.x + MovePtDeltaX; ptrTempPt^.y := ptrTempPt^.y + MovePtDeltaY; end; end; FreeAndNil(PointList); MovePtPath.SetEPoints; end; MovePt(@MovePtPath.a1, MovePtDeltaX, MovePtDeltaY); MovePt(@MovePtPath.a2, MovePtDeltaX, MovePtDeltaY); MovePt(@MovePtPath.b1, MovePtDeltaX, MovePtDeltaY); MovePt(@MovePtPath.b2, MovePtDeltaX, MovePtDeltaY); {if MovedPtSide = 1 then begin MovePtPath.FPerpend1DX := MovePtDeltaX; MovePtPath.FPerpend1DY := MovePtDeltaY; end else if MovedPtSide = 2 then begin MovePtPath.FPerpend2DX := MovePtDeltaX; MovePtPath.FPerpend2DY := MovePtDeltaY; end;} MovePtPath.FPerpendDX := MovePtPath.FPerpendDX + MovePtDeltaX; MovePtPath.FPerpendDY := MovePtPath.FPerpendDY + MovePtDeltaY; // Подтягиваем точки елементов сегмента - двери, окна и т.д. if MovePtPath.Doors.Count > 0 then begin {TempPt1 := MovePtPath.p1^; TempPt2 := MovePtPath.p2^; //TempPt1.x := TempPt1.x + MovePtDeltaX; //TempPt1.y := TempPt1.y + MovePtDeltaY; //TempPt2.x := TempPt2.x + MovePtDeltaX; //TempPt2.y := TempPt2.y + MovePtDeltaY; TempPt1.x := TempPt1.x + MovePtPath.FPerpendDX; TempPt1.y := TempPt1.y + MovePtPath.FPerpendDY; TempPt2.x := TempPt2.x + MovePtPath.FPerpendDX; TempPt2.y := TempPt2.y + MovePtPath.FPerpendDY;} TempPt1 := MovePtPath.p1^; TempPt2 := MovePtPath.p2^; TempLinePt1 := MPoint(MovePtPath.el1, MovePtPath.er1); TempLinePt2 := MPoint(MovePtPath.el2, MovePtPath.er2); PointToLineByAngle(TempLinePt1, TempLinePt2, TempPt1); PointToLineByAngle(TempLinePt1, TempLinePt2, TempPt2); MovePtPath.CalculateDoorPoints(@TempPt1, @TempPt2); ////MovePtPath.CalculateDoorPoints(MovePtPath.p1, MovePtPath.p2); end; end; end; end; /// end else if (path1.isArc) and (not path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.r2; p2 := path1.r1; end else begin p1 := path1.l1; p2 := path1.l2; end; if path2.Dir = 2 then begin p3 := path2.r1; p4 := path2.r2; end else begin p3 := path2.l2; p4 := path2.l1; end; radius := GetLineLenght(p1,path1.ArcCenter); if GetLineCircleIntersection(p3,p4,path1.ArcCenter,radius,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p4, ip1, ip2); if path1.Dir = 1 then begin path1.r1 := ip; path1.er1 := path1.r1; path1.ArcJoinB1 := ip; path1.ArcJoinB1L := ip; end else begin path1.l2 := ip; path1.el2 := path1.l2; path1.ArcJoinA2 := ip; path1.ArcJoinA2L := ip; end; if path2.Dir = 1 then begin path2.l1 := ip; path2.el1 := path2.l1; end else begin path2.r2 := ip; path2.er2 := path2.r2; end; end else begin if (path1.Dir = 1) then j1 := path1.r1 else j1 := path1.l2; if path2.Dir = 1 then j2 := path2.l1 else j2 := path2.r2; if path1.Dir = 1 then begin path1.ArcJoinB1 := j1; path1.ArcJoinB1L := j2; end else begin path1.ArcJoinA2 := j1; path1.ArcJoinA2L := j2; end; end; end else if (not path1.isArc) and (path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.r2; p2 := path1.r1; end else begin p1 := path1.l1; p2 := path1.l2; end; if path2.Dir = 2 then begin p3 := path2.r1; p4 := path2.r2; end else begin p3 := path2.l2; p4 := path2.l1; end; radius := GetLineLenght(p3,path2.ArcCenter); if GetLineCircleIntersection(p1,p2,path2.ArcCenter,radius,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p2,ip1,ip2); if path1.Dir = 1 then begin path1.r1 := ip; path1.er1 := path1.r1; end else begin path1.l2 := ip; path1.el2 := path1.l2; end; if path2.Dir = 1 then begin path2.l1 := ip; path2.el1 := path2.l1; path2.ArcJoinA1 := ip; path2.ArcJoinA1L := ip; end else begin path2.r2 := ip; path2.er2 := path2.r2; path2.ArcJoinB2 := ip; path2.ArcJoinB2L := ip; end; end else begin if path1.Dir = 1 then j1 := path1.r1 else j1 := path1.l2; if (path2.Dir = 1) then j2 := path2.l1 else j2 := path2.r2; if path2.Dir = 1 then begin path2.ArcJoinA1 := j1; path2.ArcJoinA1L := j2; end else begin path2.ArcJoinB2 := j1; path2.ArcJoinB2L := j2; end; end; end else if ( path1.isArc) and (path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.r2; p2 := path1.r1; end else begin p1 := path1.l1; p2 := path1.l2; end; if path2.Dir = 2 then begin p3 := path2.r1; p4 := path2.r2; end else begin p3 := path2.l2; p4 := path2.l1; end; r1 := GetLineLenght(p1,path1.ArcCenter); r2 := GetLineLenght(p3,path2.ArcCenter); if GetCircleCircleIntersection(path1.ArcCenter,r1,path2.ArcCenter,r2,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p2,ip1,ip2); if path1.Dir = 1 then begin path1.r1 := ip; path1.er1 := path1.r1; path1.ArcJoinB1 := ip; path1.ArcJoinB1L := ip; end else begin path1.l2 := ip; path1.el2 := path1.l2; path1.ArcJoinA2 := ip; path1.ArcJoinA2L := ip; end; if path2.Dir = 1 then begin path2.l1 := ip; path2.el1 := path2.l1; path2.ArcJoinA1 := ip; path2.ArcJoinA1L := ip; end else begin path2.r2 := ip; path2.er2 := path2.r2; path2.ArcJoinB2 := ip; path2.ArcJoinB2L := ip; end; end else begin if path1.Dir = 1 then j1 := path1.r1 else j1 := path1.l2; if (path2.Dir = 1) then j2 := path2.l1 else j2 := path2.r2; if path1.Dir = 1 then begin path1.ArcJoinB1 := j1; path1.ArcJoinB1L := j2; end else begin path1.ArcJoinA2 := j1; path1.ArcJoinA2L := j2; end; if path2.Dir = 1 then begin path2.ArcJoinA1 := j1; path2.ArcJoinA1L := j2; end else begin path2.ArcJoinB2 := j1; path2.ArcJoinB2L := j2; end; end; end; //path1.el1 := path1.l1; //path1.el2 := path1.l2; //path1.er1 := path1.r1; //path1.er2 := path1.r2; //path2.el1 := path2.l1; //path2.el2 := path2.l2; //path2.er1 := path2.r1; //path2.er2 := path2.r2; //18.11.2010 определяем точки, подведенные из паралельных линий path1.PointToParralelLine; path2.PointToParralelLine; end; end; //path1 := GetNetPathByComponID(163, TF_CAD(TPowerCad(Owner).Owner)); //if path1 <> nil then // EmptyProcedure; {if MovePtIntersect <> nil then begin PointList := TList.Create; PointList.Add(@MovePtPath.r1); PointList.Add(@MovePtPath.er1); PointList.Add(@MovePtPath.r2); PointList.Add(@MovePtPath.er2); PointList.Add(@MovePtPath.l1); PointList.Add(@MovePtPath.el1); PointList.Add(@MovePtPath.l2); PointList.Add(@MovePtPath.el2); for k := 0 to PointList.Count - 1 do begin TempPt := PDoublePoint(PointList[k]); //if (TempPt <> MovePtIntersect) and (TempPt <> MoveSPtIntersect) then begin TempPt^.x := TempPt^.x + MovePtDeltaX; TempPt^.y := TempPt^.y + MovePtDeltaY; end; end; FreeAndNil(PointList); end;} //Tolik -- 07/02/2017 FreeAndNil(xPaths); // FreeAndNil(arcPoints); FreeAndNil(arcLPoints); end; procedure TNet.IntersectPaths(UseCols:Boolean=True); var i: Integer; path: TNetPath; begin for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); path.Empty1 := False; path.Empty2 := False; end; for i := 0 to Structs.Count-1 do if TnetStruct(Structs[i]) is TnetRow then TNetROw(structs[i]).GetPipePoints; for i := 0 to Points.Count-1 do begin IntersectCorner(i); IntersectPipeCorner(i); if usecols then IntersectColCorner(i); if usecols then IntersectColPipeCorner(i); end; for i := 0 to Paths.Count -1 do begin path := TNetPath(Paths[i]); path.CalculateExternSnaps; end; end; procedure TNet.InvertSelPath; var index: Integer; path: TNetPath; begin if SelIndex > 0 then begin index := SelIndex-1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); if path.isArc then begin Path.inverted := not path.inverted; RefreshPaths; end; end; end; end; function TNet.isPointIn(x, y: Double): boolean; var i: Integer; res: Boolean; DEngine:TPCDrawEngine; path: TNetPath; struct: TnetStruct; function CheckPath(APath: TNetPath; AIdx: Integer): Boolean; begin Result := false; if APath <> nil then if APath.IsPointIn(x,y) then begin //APath.Net.SrvDropFComponID; if Not FFigureModification then //#From Oleg# begin if PointNear(APath.p1^, DoublePoint(x,y)) then //18.08.2011 SelectPt(APath.p1) else if PointNear(APath.p2^, DoublePoint(x,y)) then SelectPt(APath.p2) else SelectPath(AIdx+1, true); end; Result := True; end; end; begin result := false; DEngine := TPCDrawing(Owner).DEngine; for i := 0 to Structs.Count - 1 do begin struct := TnetStruct(Structs[i]); if struct.IsPointIn(x, y) then begin SelIndex := i + 1; SelType := stStruct; Result := True; exit; end; end; if SelPt <> nil then begin if PointNear(PDoublePoint(Points[FSelPtIdx])^, DoublePoint(x,y)) then begin Result := True; exit; end; end else if (SelIndex <> 0) then if CheckPath(SelPath, SelIndex-1) then begin Result := True; exit; end; for i := 0 to Paths.Count - 1 do begin if i <> (SelIndex-1) then begin Path := TNetPath(paths[i]); {if Path.IsPointIn(x,y) then begin if Not FFigureModification then //#From Oleg# begin //27.07.2011 SelIndex := i + 1; //27.07.2011 SelType := stPath; //18.08.2011 SelectPath(i+1, true); //Path.TestShowPointsInfo; if PointNear(Path.p1^, DoublePoint(x,y)) then //18.08.2011 SelectPt(Path.p1) else if PointNear(Path.p2^, DoublePoint(x,y)) then SelectPt(Path.p2) else SelectPath(i+1, true); end; Result := True; exit; end;} if CheckPath(Path, i) then begin Result := True; exit; end; end; end; end; function TNet.IsPointOnWall(p: TDoublePoint): Boolean; var i: Integer; path: TnetPath; begin result := false; for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); if (path.isPointIn(p.x,p.y)) then begin result := True; exit; end; end; end; function TNet.LocatePoint(p: PDoublePoint; x, y: Double; allowCheckValid: Boolean=true): Boolean; var oldx,oldy: Double; dx,dy: Double; i: integer; //19.10.2010 RelNet: TNet; //19.10.2010 NetList: TList; begin Result := true; //19.10.2010 oldx := p.x; oldy := p.y; p.x := x; p.y := y; if allowCheckValid and not PathsValid(p) then begin p.x := oldx; p.y := oldy; Result := false; end; //19.10.2010 if Result then begin // Смещение от предыдущей позиции dx := x - oldx; dy := y - oldy; // Проверяем могут ли все связанные точки других объектов переметится for i := 0 to Self.FRelatedNets.Count - 1 do begin RelNet := TNet(Self.FRelatedNets[i]); if RelNet.FRelatedMPoint <> nil then begin Result := RelNet.CheckLocatePoint(RelNet.FRelatedMPoint, x, y); if Not Result then Break; //// BREAK //// end; end; if Result then begin if Assigned(FOnMovePoint) then //29.04.2011 FOnMovePoint(Self, p, GetPointID(p)); //29.04.2011 //23.05.2011 - Если это исходный, то прередвигаем связанные по подключению if FRelatedMPoint = nil then if Assigned(FOnDefineMoveObjects) and CanMoveJoined then begin NetList := TList.Create; NetList.Assign(Self.FRelatedNets); NetList.Insert(0, Self); p.x := oldx; p.y := oldy; FOnDefineMoveObjects(Self, p, nil, NetList); p.x := x; p.y := y; for i := 0 to NetList.Count - 1 do TNet(NetList[i]).MoveJoinedPoints(dx, dy, false); NetList.Free; end; for i := 0 to Self.FRelatedNets.Count - 1 do begin RelNet := TNet(Self.FRelatedNets[i]); if RelNet.FRelatedMPoint <> nil then begin Result := RelNet.LocatePoint(RelNet.FRelatedMPoint, x, y, false); if Not Result then Break; //// BREAK //// end; RelNet.FRelatedMPoint := nil; end; end; if Not Result then begin p.x := oldx; p.y := oldy; end; end; Self.FRelatedNets.Clear; SetModified; end; Function TNet.MakePathArc(pArr: TDoublePointArr; dontRefresh: Boolean = False): TNetPath; begin end; Function TNet.MakePath(pArr: TDoublePointArr; dontRefresh: Boolean = False): TNetPath; var i, k, p: Integer; path: TNetPath; cnt, pcnt: Integer; points: TDoublePointArr; p1, p2: TDoublePoint; valid: Boolean; wLen: Double; delPaths: TList; label ex; begin result := nil; pCnt:= Length(pArr); if pcnt < 2 then exit; if CheckLineOnLine(pArr) then exit; if not CheckSelfIntersection(pArr) then exit; if assigned(UndoProc) then UndoProc; if Paths.Count = 0 then begin result := CreatePaths(pArr, dontRefresh); Exit; end; delPaths := TList.Create; cnt := 0; SetLength(points, cnt); for i := 0 to pCnt - 2 do begin p1 := pArr[i]; p2 := pArr[i + 1]; wLen := GetLineLength(p1, p2); valid := True; if Not FDisableMergePaths then //15.10.2010 if FAllowDelPathOnMake then //26.09.2011 begin k := 0; repeat path := TNetPath(Paths[k]); if {(IsPointInLine(p1, p2, path.p1^, 1) and IsPointInLine(p1, p2, path.p2^, 1)) or } (IsPointInLine(path.p1^, path.p2^, p1, 1, 0) and IsPointInLine(path.p1^, path.p2^, p2, 1, 0)) then begin if path.MLen < wLen then begin delPaths.Add(path); end else begin Valid := False; end; end else if (IsPointInLine(p1, p2, path.p1^, 1, 0) and IsPointInLine(p1, p2, path.p2^, 1, 0)){ or (IsPointInLine(path.p1^, path.p2^, p1, 1) and IsPointInLine(path.p1^, path.p2^, p2, 1))} then begin if path.MLen > wLen then begin delPaths.Add(path); end else begin Valid := False; end; end; k := k + 1; until (k = Paths.Count) or (not valid); end; if Valid then begin p := 0; while p < Delpaths.Count do begin DeletePath(TNetPath(Delpaths[p])); p := p + 1; end; if cnt = 0 then begin cnt := cnt + 1; SetLength(points, cnt); points[cnt - 1] := p1; end; cnt := cnt + 1; SetLength(points, cnt); points[cnt - 1] := p2; end else begin result := CreatePaths(points, True); cnt := 0; SetLength(points, cnt); end; delPaths.Clear; end; delpaths.Free; if cnt > 0 then begin result := CreatePaths(points, True); end; Ex: if not DontRefresh then RefreshPaths; end; function TNet.MakePathOnShadow(pArr: TDoublePointArr; dontRefresh: Boolean = False): TnetPath; var SavedThick: Double; begin SavedThick := WallThick; try WallThick := GArchEngine.GetLastObjSize(aoskPathWidth, SavedThick); Result := MakePath(pArr, dontRefresh); finally WallThick := SavedThick; end; end; procedure TNet.MenuClicked(CommandId: integer); var mnIdx: Integer; merdIdx: Integer; begin {$ifndef limited} mnIdx := commandId - MenuIndex; if mnIdx < 0 then exit; case mnIdx of 0: DeleteSelected; 1: AddDoor; 2: AddWindow; 3: AddCol; 4: OpenAllWindows; 5: AddCols; end; {$endif limited} end; procedure TNet.Mirror(Point1, Point2: TDoublePoint); var a:Integer; pt: PDoublePoint; begin for a:= 0 to Points.Count - 1 do begin pt := PDoublePoint(Points[a]); pt^ := GetSymetricPoint(pt^,Point1,Point2); end; //08.05.2012 - Меняем переворот нишам, так как после Mirror они выглядят с других сторон сегментов RotateAllNiche; SetModified; //03.02.2012 ResetRegion; end; procedure TNet.Move(deltax, deltay: Double); var i: Integer; p: PDoublePoint; TraceFigure: TFigure; ShiftState: TShiftState; MoveAllPoints: Boolean; begin //01.10.2010 //if DragMove then // begin // FFigureModification := false; //#From Oleg# // // Tpowercad(Owner).SnapLocked := False; // TraceFigure := nil; // if assigned(owner) and assigned(TPowercad(owner).TraceFigure) then // TRaceFigure := TPowercad(owner).TraceFigure; // if assigned(TraceFigure) then // begin // if TraceFigure is TDoorTrace then // TDoorTrace(TraceFigure).EndTrace; // if TraceFigure is TPathTrace then // TPathTrace(TraceFigure).EndTrace; // end; // end // else // begin // for i := 0 to Points.Count - 1 do // begin // p := PDoublePoint(Points[i]); // p.x := p.x + deltax; // p.y := p.y + deltay; // end; // ResetRegion; // end; //24.04.2012 - Если время на DragOver было очень малое, то считаем что на клике случайно произошел move, и ничего не делаем if DragMove then if TPowerCad(Owner).FDragOverTime < 150 then begin EmptyProcedure; Exit; ///// EXIT ///// end; MoveAllPoints := FMoveAllPoints; if Not MoveAllPoints then begin if Not DragMove and //Not((GetKeyState(VK_SHIFT)AND$80)=$80) //Not((GetKeyState(VK_MENU)AND$80)=$80) //(Not((GetKeyState(VK_SHIFT)AND$80)=$80) and Not((GetKeyState(VK_CONTROL)AND$80)=$80)) ( (ssShift in GGlobalShiftState) and (ssCtrl in GGlobalShiftState)) then MoveAllPoints := true else if Assigned(Parent) and (Parent is TFigureGrp) then MoveAllPoints := true; end; if MoveAllPoints then begin // Перемещаем весь Net for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i]); p.x := p.x + deltax; p.y := p.y + deltay; end; if Assigned(FOnMove) then FOnMove(Self); SetModified; //03.02.2012 ResetRegion; end else begin FFigureModification := false; //#From Oleg# Tpowercad(Owner).SnapLocked := False; TraceFigure := nil; if assigned(owner) and assigned(TPowercad(owner).TraceFigure) then TRaceFigure := TPowercad(owner).TraceFigure; if assigned(TraceFigure) then begin if TraceFigure is TDoorTrace then TDoorTrace(TraceFigure).EndTrace; if TraceFigure is TPathTrace then TPathTrace(TraceFigure).EndTrace; end // если перемещение курсорами? перемещаем выделенный сегмент else if Not DragMove then begin //MovePath(SelPath, deltax,deltay); TraceFigure := CreateMoveTrace; if TraceFigure is TPathTrace then begin if ssShift in GGlobalShiftState then begin TPathTrace(TraceFigure).SnappedGrid := false; TPathTrace(TraceFigure).SnappedGuide := false; end; TPathTrace(TraceFigure).Move(deltax,deltay); TPathTrace(TraceFigure).EndTrace; end; //Tolik 18/10/2017 -- //TraceFigure.Free; FreeAndNil(TraceFigure); // end; end; end; procedure TNet.MovePath(path: TNetPath; dx, dy: Double); var IsMoved: Boolean; SamePaths: TList; i, j, IntersectType: Integer; NetPath: TNetPath; MovedPoints: TList; NetPathConnectedToMove: Boolean; BeforeP1, BeforeP2: TDoublePoint; procedure MovePathPoint(APath: TNetPath; Apt: PDoublePoint); begin if MovedPoints.IndexOf(APt) = -1 then begin Apt^.x := Apt^.x + dx; Apt^.y := Apt^.y + dy; MovedPoints.Add(Apt); if Assigned(APath.FOnMove) then APath.FOnMove(Self); end; end; begin if path <> nil then //01.10.2010 begin IsMoved := true; //22.08.2011 //22.08.2011 - Сегменты на тех же самих координатах SamePaths := nil; if Not (ssAlt in GGlobalShiftState) then for i := 0 to Paths.Count - 1 do begin NetPath := TNetPath(Paths[i]); if (NetPath <> Path) and Not Path.Connected(NetPath) {and (NetPath.GetLenByPoints(NetPath.p1^, NetPath.p2^) > 0)} then begin IntersectType := Path.CmpIntersectPath(NetPath); if IntersectType in [citEqual, citEntry, citAbsorb] then begin NetPathConnectedToMove := false; if IntersectType <> citAbsorb then if SamePaths <> nil then for j := 0 to SamePaths.Count - 1 do begin if TNetPath(SamePaths[j]).Connected(NetPath) then begin NetPathConnectedToMove := true; Break; //// BREAK //// end; end; // Если сегмент не подключен точкой к перемещаемому if Not NetPathConnectedToMove then begin if SamePaths = nil then SamePaths := TList.Create; SamePaths.Add(NetPath); end; end; end; end; BeforeP1 := Path.p1^; BeforeP2 := Path.p2^; Path.Move(dx,dy); // Tolik -- 02/02/2017 -- RefreshPoints; RefreshColPositions; RefreshPaths; // if (Not PathsValid(path.p1)) or (Not PathsValid(path.p2)) then begin Path.Move(-dx,-dy); begin IsMoved := false; //22.08.2011 RefreshPoints; RefreshColPositions; RefreshPaths; end; end; // Tolik -- 02/02/2017 -- if isMoved then begin isMoved := Self.CheckDeleteInnerWalls; if not isMoved then begin Path.Move(-dx,-dy); RefreshPoints; RefreshColPositions; RefreshPaths; end; end; if IsMoved then //22.08.2011 begin if SamePaths <> nil then //22.08.2011 begin MovedPoints := TList.Create; for i := 0 to SamePaths.Count - 1 do begin NetPath := TNetPath(SamePaths[i]); if (NetPath.Net.FJoinedMovePoints.IndexOf(NetPath.p1) = -1) and (NetPath.Net.FJoinedMovePoints.IndexOf(NetPath.p2) = -1) and (NetPath.Net.FJoinedMovePaths.IndexOf(NetPath) = -1) then begin //22.09.2011 NetPath.Move(dx,dy); MovePathPoint(NetPath, NetPath.p1); MovePathPoint(NetPath, NetPath.p2); end; end; MovedPoints.Free; end; //08.05.2012 - проверяем, было ли перемещение через сегменты (есть ли сегмент лежащий на траектории перемещения) //08.05.2012 если да, то меняем нишам направление, так как после переворачивания они меняют направление if ExistsPathOnPathTrajectory(path, @BeforeP1, @BeforeP2) then RotateAllNiche; // Tolik 19/10/2016--- CorrectNetPathPosbyRelatedPath(Path, dx, dy); //03.02.2012 ResetRegion; //03.02.2012 Modified := True; SetModified; DoResize; end; if SamePaths <> nil then //22.08.2011 SamePaths.Free; end; //01.10.2010 end; procedure TNet.OpenSelPath; var index: Integer; path: TNetPath; begin if SelIndex > 0 then begin index := SelIndex - 1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); if not path.Border then begin if Path.WType = wtOpen then Path.WType := wtWall else if Path.WType = wtWall then Path.WType := wtOpen; Path.WType := wtOpen; RefreshPaths; end; end; end; end; function TNet.PathIndex(p1, p2: TDoublePoint): Integer; var i: Integer; px: TnetPath; begin result := -1; for i := 0 to Paths.Count - 1 do begin px := TnetPath(Paths[i]); if (EQDP(p1,px.p1^) and EQDP(p2,px.p2^)) or (EQDP(p1,px.p2^) and EQDP(p2,px.p2^)) then begin result := i; exit; end; end; end; function TNet.PathsValid(p:PDoublePOint): Boolean; var i,k: Integer; path1,path2: TnetPath; CanOverlap: Boolean; begin result := true; for i := 0 to Paths.Count - 1 do begin Path1 := TnetPath(Paths[i]); if (path1.p1 = p) or (path1.p2 = p) then begin for k := 0 to Paths.Count - 1 do begin Path2 := TNetPath(paths[k]); if (path1 <> path2) and path1.overlaps(path2) then begin CanOverlap := false; if Assigned(FOnPathsOverlapQuery) then FOnPathsOverlapQuery(Path1, Path2, p, CanOverlap); if Not CanOverlap then begin result := false; exit; end; end; end; end; end; end; function TNet.PointIndex(p: TDoublePoint): Integer; var i: Integer; px: PDoublePoint; begin result := -1; for i := 0 to Points.Count - 1 do begin px := PDoublePoint(Points[i]); if EQDP(p,px^) then begin result := i; exit; end; end; end; procedure TNet.RefreshPaths(aUpdateRegion: Boolean=true); var i: Integer; path: TNetPath; begin FPerpendPoints := TList.Create; try MarkBrokenPaths; CalculatePathPoints; IntersectPaths; if assigned(XDrawEngine) and aUpdateRegion then UpdatePathRegion(XDrawEngine); for i := 0 to Paths.Count - 1 do begin path := TnetPath(paths[i]); path.refresh; end; FIsLoadedBounds := false; //30.01.2012 // Remove Saved 3D Model from Stream if FPlan changed if GSaved3DModelExist then begin // Remove3DModelStream; // GSaved3DModelExist := False; end; finally FreeAndNil(FPerpendPoints); end; end; procedure TNet.RefreshRegions(DEngine:TPCDrawEngine); begin end; procedure TNet.ResetRegion; begin Modified := True; end; procedure TNet.Rotate(aAngle: Double; cPoint: TDoublePoint); var i: Integer; p: PDoublePoint; point1: TDoublePoint; begin if assigned(UndoProc) then UndoProc; //cPoint := PDoublePoint(Points[1])^; for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i]); point1 := RotatePoint(cPoint,p^,aAngle); p.x := point1.x; p.y := point1.y; end; SetModified; //03.02.2012 ResetRegion; end; procedure TNet.BeforeAllScale(Sender: TObject); begin if Assigned(FOnScale) then begin SavePoints; // Запоминаем координаты точек //SaveScaledPoints; end; if Assigned(FOnScaleBefore) then FOnScaleBefore(Self); end; procedure TNet.ScaleAllEvent(Sender: TObject); begin if Assigned(FOnScale) then FOnScale(Self, 0, 0, nil); end; procedure TNet.AfterAllScale(Sender: TObject); begin if Assigned(FOnScale) then begin ClearSavedPoints; ClearSavedScaledPoints; end; if Assigned(FOnScaleAfter) then FOnScaleAfter(Self); end; procedure TNet.Scale(px, py: Double; rPoint: TDoublepoint); var i, j: Integer; p: PDoublePoint; point1: TDoublePoint; Path: TNetPath; Door: TNetDoor; OldLen: double; newdp1, newdp2, newp1: TDoublePoint; Col: TNetCol; begin // точки for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i]); point1 := ScalePoint(rPoint, p^, px, py); p.x := point1.x; p.y := point1.y; //p^.x := rPoint.x - (rPoint.x - p^.x)*px; //p^.y := rPoint.y - (rPoint.y - p^.y)*py; end; // объекты типа двери/окна в сегментах for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); for j := 0 to Path.Doors.Count - 1 do begin Door := TNetDoor(Path.Doors[j]); newdp1 := ScalePoint(rPoint, Door.p1, px, py); newdp2 := ScalePoint(rPoint, Door.p2, px, py); Door.p1 := newdp1; Door.p2 := newdp2; OldLen := Door.Len; Door.Len := SQRT(SQR(newdp1.x - newdp2.x) + SQR(newdp1.y - newdp2.y)); Door.Start := Door.Start * (Door.Len / OldLen); end; end; // колонны for i := 0 to Structs.Count - 1 do begin if TnetStruct(Structs[i]) is TNetCol then begin Col := TnetCol(Structs[i]); Col.w := Col.w * px; Col.h := Col.h * py; end; end; SetModified; //03.02.2012 ResetRegion; if Assigned(FOnScale) then //23.09.2011 begin SaveScaledPoints; // Запоминаем координаты точек после scale end; end; function TNet.TraceModification(CadControl: Pointer; mp: TModPoint; TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean; var tf: Tnet; oldPt: TDoublePoint; p: PDoublePoint; SavedPt: PDoublePoint; dx, dy, delta: Double; oPath, path: TnetPath; pIdx: Integer; i: integer; //19.10.2010 //Angle: Double; RelNet: TNet; SavedArcAng: Double; SavedArcCenter: TDoublePoint; CanRefresh: Boolean; begin Result := false; if not assigned(TraceFigure) then exit; tf := nil; //#From Oleg# //14.09.2010 if (mp.PType = ptPolyPoint) or (mp.PType = ptRectPoint) or (mp.PType = ptGroupPoint) then tf := Tnet(TraceFigure); if (mp.PType = ptPolyPoint) and (mp.Tag > -1) and (mp.Tag < tf.Points.Count) then begin CanRefresh := false; //24.05.2011 if (GetTickCount - FLastTickTraceRefresh) > 40 then begin FLastTickTraceRefresh := GetTickCount; CanRefresh := true; end; CanRefresh := true; // SnapModPoint(x, y, mp, tf); p := PDoublePoint(tf.Points[mp.tag]); oldPt := p^; p.x := x; p.y := y; if Not (ssShift in GGlobalShiftState) then //12.10.2010 p^ := PointToOrthogonal(p, x, y, tf); //12.10.2010 //dx := p^.x - oldPt.x; //23.05.2011 //dy := p^.y - oldPt.y; //23.05.2011 dx := 0; dy := 0; if CanMoveJoined then begin // Ищем смещение относительно начальной позиции SavedPt := tf.GetSavedPtByPoint(p); if SavedPt <> nil then begin dx := p^.x - SavedPt^.x; //23.05.2011 dy := p^.y - SavedPt^.y; //23.05.2011 end; tf.MoveJoinedPoints(dx, dy, true); end; //GCadForm.mProtocol.Lines.Add('dx - '+FloatToStr(dx)+' dy - '+FloatToStr(dy)); for i := 0 to tf.FRelatedNets.Count - 1 do begin RelNet := TNet(tf.FRelatedNets[i]); if (RelNet.FRelatedMPoint <> nil) then begin RelNet.FRelatedMPoint^ := p^; end; if CanMoveJoined then RelNet.MoveJoinedPoints(dx, dy, true); //23.05.2011 if CanRefresh then RelNet.RefreshPaths; //21.04.2011 end; if CanRefresh and Not EQDP(p^, oldPt) then begin //21.04.2011 tf.CalculatePathPoints; //22.10.2010 пересчитать данные для арок //tf.DefineInOutPoints; //21.04.2011 tf.RefreshPaths; //21.04.2011 end; // NormalizeKnot(p,tf); end else if (mp.PType = ptRectPoint) and (mp.Tag > -1) and (mp.Tag < tf.Paths.Count) then begin SnapModPoint(x, y, mp, Tnet(TraceFigure)); dx := x - mp.CoordX; dy := y - mp.CoordY; Path := TnetPath(tf.Paths[mp.Tag]); tf.EqualTracePaths; Path.Move(dx, dy); end else if (mp.PType = ptGroupPoint) and (mp.Tag > -1) and (mp.Tag < tf.Paths.Count) then begin SnapModPoint(x, y, mp, Tnet(TraceFigure)); dx := x - mp.CoordX; dy := y - mp.CoordY; Path := TnetPath(tf.Paths[mp.Tag]); tf.EqualTracePaths; tf.MoveSatih(path, dx, dy, False); if path.isArc then //10.01.2011 begin Path.ArcCenter := Path.Opath.ArcCenter; Path.ArcCenter.x := Path.ArcCenter.x + dx; Path.ArcCenter.y := Path.ArcCenter.y + dy; //Path.Net.CalculatePathPoints; Path.l1 := MovePoint(Path.Opath.l1, dx, dy); Path.l2 := MovePoint(Path.Opath.l2, dx, dy); Path.r1 := MovePoint(Path.Opath.r1, dx, dy); Path.r2 := MovePoint(Path.Opath.r2, dx, dy); end; Tnet(TraceFigure).RefreshPaths; //22.04.2011 end else if (mp.PType = ptControlPoint) and (mp.SeqNbr > 0) then begin TDoorTrace(TraceFigure).Locate(x, y); end else if (mp.PType = ptControlPoint) and (mp.SeqNbr = -2) then begin TraceFigure.Move(TPowercad(CadControl).TraceDeltax, TPowercad(CadControl).TraceDeltay); end //11.10.2010 else if (mp.PType = ptControlPoint) and (mp.SeqNbr = -3) then begin TDoorTrace(TraceFigure).MovePoint(DoublePoint(mp.CoordX, mp.CoordY), x, y); end //22.10.2010 else if mp.PType = ptArcControl then begin tf := TNet(TraceFigure); Path := TnetPath(tf.Paths[mp.Tag]); // точку ставим перпендикулярно Path //PointToLine(Path.p1^, Path.p2^, x, y); Path.ArcCenter := DoublePoint(x, y); if Path.Inverted then Path.ArcAng := GetRadOf2Lines(Path.p1^, Path.ArcCenter, Path.p2^) else Path.ArcAng := GetRadOf2Lines(Path.p2^, Path.ArcCenter, Path.p1^); //21.04.2011 tf.CalculatePathPoints; tf.RefreshPaths; //21.04.2011 end; end; procedure TNet.UpdateAllRegions(Dengine:TPCDrawEngine); begin RefreshPaths; if assigned(XDrawEngine) then UpdatePathRegion(Dengine); if assigned(XDrawEngine) then RefreshRegions(Dengine); end; procedure TNet.UpdateMenu(var PopMenu: TPopUpMenu; var sIndex: integer); var mnItem,mnSub,mnSubSub: TMenuItem; i,xIndex: Integer; begin if not ContextMenu then exit; menuIndex := sIndex; mnItem := TMenuItem.Create(PopMenu); mnItem.Tag := sIndex; mnItem.Caption := 'Delete Selection'; PopMenu.Items.Add(mnItem); mnItem := TMenuItem.Create(PopMenu); mnItem.Tag := sIndex; mnItem.Caption := '-'; PopMenu.Items.Add(mnItem); if SelPath <> nil then begin mnItem := TMenuItem.Create(PopMenu); mnItem.Tag := sIndex + 1; mnItem.Caption := 'Add Door'; PopMenu.Items.Add(mnItem); mnItem := TMenuItem.Create(PopMenu); mnItem.Tag := sIndex + 2; mnItem.Caption := 'Add Window'; PopMenu.Items.Add(mnItem); mnItem := TMenuItem.Create(PopMenu); mnItem.Tag := sIndex + 3; mnItem.Caption := 'Add Column'; PopMenu.Items.Add(mnItem); mnItem := TMenuItem.Create(PopMenu); mnItem.Tag := sIndex + 4; mnItem.Caption := 'Divide Wall'; PopMenu.Items.Add(mnItem); end; mnItem := TMenuItem.Create(PopMenu); mnItem.Tag := sIndex + 5; mnItem.Caption := 'Open All Windows'; PopMenu.Items.Add(mnItem); mnItem := TMenuItem.Create(PopMenu); mnItem.Tag := sIndex + 6; mnItem.Caption := 'Create All Columns'; PopMenu.Items.Add(mnItem); sIndex := SIndex + 7; end; procedure TNet.UpdatePathRegion(Dengine:TPCDrawEngine); var i: Integer; path: TNetPath; begin if PathRgn <> 0 then // Tolik 21/11/2019 -- DeleteObject(PathRgn); pathRgn := CreateRectRgn(0,0,0,0); for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); path.UpdateRegion(DEngine); CombineRgn(PathRgn,PathRgn,path.Region,RGN_OR); end; end; function TNet.AddDoor(aDoorObjType: TDoorObjType=dotDoor; aLen: Double=-1): TNetDoor; var index, i: Integer; path: TNetPath; region, wLen: Double; begin Result := nil; if (SelIndex > 0) and (selType = stPath) then begin index := SelIndex -1 ; if assigned(undoProc) then UndoProc; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); wLen := aLen; if wLen = -1 then begin wLen := 15; if path.AbsLen < 15 then wLen := path.AbsLen * 0.9; //Path.NewDoor(15, wLen, dotDoor); end; Result := Path.NewDoor(15, wLen, aDoorObjType); RefreshPaths; end; end; end; function TNet.AddWindow(aLen: Double=-1): TNetDoor; var index, i: Integer; path: TNetPath; wLen: Double; begin Result := nil; if (SelIndex > 0) and (selType = stPath) then begin index := SelIndex - 1; if assigned(undoProc) then UndoProc; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); wLen := aLen; if wLen = -1 then begin wLen := path.AbsLen * 0.7; if wLen > 50 then wLen := 50; end; Result := Path.NewDoor(15, wLen, dotWindow); RefreshPaths; end; end; end; Function TNet.AddNetCol(p: TdoublePoint):TNetCol; var p1: PDoublePoint; col: TnetCol; begin result := nil; if not assigned(p1) then exit; p1 := InsertKnot(p, true); col := TnetCol.Create(Self, p1); Col.SetPosition; Structs.Add(col); result := col; RefreshPaths; end; Function TNet.AddNetRow(xp1, xp2: TdoublePoint): TNetRow; var p1, p2: PDoublePoint; row: TnetRow; begin Result := nil; p1 := InsertKnot(xp1, true); p2 := InsertKnot(xp2, true); row := TnetRow.Create(Self, p1, p2); Structs.Add(row); result := row; RefreshPaths; end; procedure TNet.MovePathDoor(path: TNetPath; delta: Double); begin Path.MoveDoor(Delta); //03.02.2012 ResetRegion; //03.02.2012 Modified := True; SetModified; end; procedure TNet.ColPosition(pos: Integer); var index: Integer; struct: TNetStruct; begin if SelIndex > 0 then begin index := SelIndex-1; if index < Structs.Count then begin struct := TNetStruct(Structs[Index]); if Struct is TNetCol then begin TNetCol(Struct).Position := pos; end; end; end; RefreshPaths; end; function TNet.GetPathOfPoint(x, y: Double): TnetPath; var i: Integer; path: TnetPath; begin result := nil; for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); if (path.isPointIn(x,y)) then begin result := path; exit; end; end; end; procedure TNet.RefreshColPositions; var i: Integer; begin for i := 0 to Structs.Count - 1 do if TNetStruct(Structs[i]) is TNetcol then TNetCol(Structs[i]).SetPosition; end; procedure TNet.AddCols; var i: Integer; p: PDoublePoint; xPoints: TList; col: TnetCol; begin if assigned(UndoProc) then UndoProc; xPoints := TList.Create; for i := 0 to Points.Count - 1 do begin xPoints.Add(Points[i]); end; try for i := 0 to Structs.Count - 1 do begin if TNetStruct(Structs[i]) is TNetCol then begin xPoints.Remove(TNetCol(Structs[i]).p1); end; end; except // ShowMessage(CPowerCadMessage + 'TNet.AddCols'); end; for i := 0 to xPoints.Count - 1 do begin p := pDoublePoint(xPoints[i]); col := TnetCol.Create(Self,p); Col.SetPosition; Structs.Add(col); RefreshPaths; end; end; procedure TNet.RefreshPoints; var i: Integer; xPath: TnetPath; Struct: TNetStruct; p: PDoublePoint; xPoints: TList; begin xPoints := TList.Create; for i := 0 to Points.Count - 1 do begin xPoints.Add(Points[i]); end; try for i := 0 to Structs.Count - 1 do begin if TNetStruct(Structs[i]) is TNetCol then begin xPoints.Remove(TNetCol(Structs[i]).p1); end else if TNetStruct(Structs[i]) is TNetRow then begin xPoints.Remove(TNetRow(Structs[i]).p1); xPoints.Remove(TNetRow(Structs[i]).p2); end; end; For i := 0 to Paths.Count - 1 do begin xPath := TnetPath(Paths[i]); xPoints.Remove(xPath.p1); xPoints.Remove(xPath.p2); end; for i := 0 to xPoints.Count - 1 do begin p := PDoublePoint(xPoints[i]); //04.10.2010 Points.Remove(p); //04.10.2010 Dispose(p); DeletePoint(p); end; except // ShowMessage(CPowerCadMessage + 'TNet.RefreshPoints'); end end; procedure TNet.CombinePathsOfKnot(p: PDoublePoint); var xList: TList; xp1,xp2: TDoublePoint; a1,a2: Double; path1,path2: TNetPath; i: Integer; begin xList:= TList.Create; GetStructsOfKnot(p,xList); if xList.Count > 0 then //Tolik -- 07/02/2017 -- // exit; begin FreeAndnil(xList); exit; end; // GetPathsOfKnot(p,xList); if xList.Count = 2 then begin path1 := TnetPath(xList[0]); path2 := TnetPath(xList[1]); xp1 := path1.OtherPoint(p)^; xp2 := path2.OtherPoint(p)^; a1 := GetRadOfLine(p^,xp1); a2 := GetRadOfLine(p^,xp2); if EQD(abs(a1 - a2), pi) then begin path1.p1 := path1.OtherPoint(p); path1.p2 := path2.OtherPoint(p); paths.remove(path2); for i := 0 to path2.Doors.Count - 1 do begin path1.Doors.Add(path2.Doors[i]); end; path2.Doors.Clear; path2.Free; //04.10.2010 Points.Remove(p); //04.10.2010 Dispose(p); DeletePoint(p); end; end; xList.Free; end; procedure TNet.GetStructsOfKnot(p: PDoublePoint; var xStructs: TList); var i: Integer; begin for i := 0 to Structs.Count - 1 do begin if TNetStruct(Structs[i]).IsKnotIn(p) > -1 then xStructs.Add(Structs[i]); end; end; procedure TNet.DeleteSelected; var index: Integer; Path: TnetPath; Struct: TnetStruct; Stair: TFigure; begin {$ifndef limited} if (SelType = stPath) and (SelIndex > 0) then begin index := SelIndex - 1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); if path.DoorIndex = -1 then begin DeletePath(Path); SelectPath(0); //27.07.2011 SelIndex := 0; end else begin Path.DeleteDoor; end; end; end else if (SelType = stStruct) and (SelIndex > 0) then begin index := SelIndex - 1; if index < Structs.Count then begin Struct := TNetStruct(Structs[Index]); DeleteStruct(Struct); SelIndex := 0; end; end; //03.02.2012 ResetRegion; //03.02.2012 Modified := True; SetModified; {$endif limited} end; procedure TNet.DeleteStruct(Struct: TNetStruct); var i: Integer; begin Structs.Remove(Struct); For i := 0 to Struct.Points.Count-1 do begin CombinePathsOfKnot(PDoublePoint(Struct.Points[i])); end; RefreshPoints; Struct.free; RefreshPaths; end; function TNet.FindPathOfPoints(p1, p2: TDoublePOint): TNetPath; var i: Integer; path: TnetPath; begin result := nil; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); if path.AreYou(p1,p2) then begin result := path; exit; end; end; end; procedure TNet.OpenAllWindows; var i: Integer; path: TnetPath; wLen: Double; begin if assigned(UndoProc) then UndoProc; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); if (path.Border) and (path.Doors.Count = 0) and (path.AbsLen >= 20) then begin wLen := path.AbsLen * 0.7; if wLen > 50 then wLen := 50; path.NewDoor(15, wLen, dotWindow); end; end; RefreshPaths; end; procedure TNet.SetWallType(wt: TWallType); var index: Integer; path: TNetPath; begin if SelIndex > 0 then begin index := SelIndex - 1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); if (wt = wtHalf) and (not path.border) then exit; if path.border and (wt = wtOpen) then wt := wtWall; Path.WType := wt; if (path.WType <> wtWall) then begin path.DeleteDoors; end; RefreshPaths; end; end; end; procedure TNet.SetArcPath(a: Boolean); var index: Integer; path: TNetPath; begin if (SelType = stPath) and (SelIndex > 0) then begin index := SelIndex-1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); Path.isArc := a; RefreshPaths; end; end; end; procedure TNet.SetArcAng(val: Double); var index: Integer; path: TNetPath; ang: double; begin if (SelType = stPath) and (SelIndex > 0) then begin index := SelIndex-1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); if path.isArc then begin Path.ArcAng := val; RefreshPaths; end; end; end; end; procedure TNet.ColAngle(ang: double); var index: Integer; struct: TNetStruct; begin if SelIndex > 0 then begin index := SelIndex-1; if index < Structs.Count then begin struct := TNetStruct(Structs[Index]); if Struct is TNetCol then begin TNetCol(Struct).Angle := ang; end; end; end; end; procedure TNet.ColHeight(ch: double); var index: Integer; struct: TNetStruct; begin if SelIndex > 0 then begin index := SelIndex-1; if index < Structs.Count then begin struct := TNetStruct(Structs[Index]); if Struct is TNetCol then begin TNetCol(Struct).h := ch; end; end; end; end; procedure TNet.ColWidth(cw: double); var index: Integer; struct: TNetStruct; begin if SelIndex > 0 then begin index := SelIndex-1; if index < Structs.Count then begin struct := TNetStruct(Structs[Index]); if Struct is TNetCol then begin TNetCol(Struct).W := cw; end; end; end; end; procedure TNet.RowThick(th: double); var index: Integer; struct: TNetStruct; begin if SelIndex > 0 then begin index := SelIndex-1; if index < Structs.Count then begin struct := TNetStruct(Structs[Index]); if Struct is TNetRow then begin TNetRow(Struct).Thick := th; end; end; end; end; procedure TNet.DoorLen(ww: Double); var index: Integer; path: TNetPath; door: TnetDoor; begin if SelIndex > 0 then begin index := SelIndex - 1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); door := Path.ActiveDoor; if assigned(door) then begin door.Len := ww; RefreshPaths; end; end; end; end; procedure TNet.SetPropertyFromStream(xCode: Byte; data: pointer; size: integer); var pCnt,i,xsize: Integer; p: PDoublePoint; xd, yd: Double; SubStream, fStream: TMemoryStream; path: TnetPath; struct: TnetStruct; regName: String; rver: Byte; SIndex: Integer; Stair: TFigure; alan: Byte; DoorNbr,SahNo: Integer; txMar,tymar: Double; // test PosBegin: Integer; PosEnd: Integer; Delta: Integer; OldPlan: Boolean; xInt: Integer; //#From Oleg# //04.10.2010 begin case xCode of 92: FillWalls := Bool(PByte(Data)^); 93: WorldDim := Bool(PByte(Data)^); 20: MapScale := PInt(Data)^; //21: FID := PInt(Data)^; 21: FComponID := PInt(Data)^; 220: WallThick := PDouble(Data)^; // MapScale 239: MapScale := pDouble(data)^; 150: begin //points SubStream := TMemoryStream.Create; SubStream.Write(pByte(data)^, size); SubStream.Position := 0; pCnt := Size div 16; for i := 1 to pCnt do begin SubStream.read(xd, 8); SubStream.read(yd, 8); new(p); p^.x := xd; p^.y := yd; Points.Add(p); FPointIDs.Add(Pointer(0)); //#From Oleg# //04.10.2010 end; SubStream.Free; //#From Oleg# //04.10.2010 end; 151: begin //paths SubStream := TMemoryStream.Create; SubStream.Write(pByte(data)^, size); SubStream.Position := 0; SubStream.Read(pCnt, 4); // TEST PosBegin := SubStream.Position; path := TnetPath.CreateFromStream(SubStream, Self, False); PosEnd := SubStream.Position; Delta := PosEnd - PosBegin; if Delta = 27 then OldPlan := True else OldPlan := False; SubStream.Position := 4; for i := 1 to pCnt do begin path := TnetPath.CreateFromStream(SubStream, Self, OldPlan); if assigned(path) then Paths.Add(Path); end; SubStream.Free; XDrawEngine := TPCDrawing(Self.Owner).DEngine; RefreshPaths; end; 152: begin //structs SubStream := TMemoryStream.Create; SubStream.Write(pByte(data)^, size); SubStream.Position := 0; SubStream.Read(pCnt, 4); for i := 1 to pCnt do begin struct := TnetStruct.CreateFromStream(SubStream, Self); if assigned(struct) then Structs.Add(struct); end; SubStream.Free; end; 153: // point ids //#From Oleg# //04.10.2010 begin SubStream := TMemoryStream.Create; SubStream.Write(pByte(data)^, size); SubStream.Position := 0; pCnt := Size div SizeOf(Integer); for i := 0 to pCnt - 1 do begin SubStream.read(xInt, SizeOf(Integer)); FPointIDs[i] := Pointer(xInt); end; SubStream.Free; end; end; //if Not Assigned(Self.FOnDelete) then // GArchEngine.SetHandlersToObj(Self); GArchEngine.AfterLoadProps(Self); end; //Tolik 04/04/2019 -- procedure TNet.WriteToStream(Stream: TStream); var xByte: Byte; xInt: Integer; xDbl: Double; i: Integer; p: TDoublePoint; path: TnetPath; Struct: TNetStruct; aPoints: Pointer; SubStream: TMemoryStream; begin inherited; xInt := Round(MapScale); WriteField(20, Stream, xInt, 4); //xInt := Round(FID); //WriteField(21, Stream, xInt, 4); xInt := Round(FComponID); WriteField(21, Stream, xInt, 4); xDbl := WallThick; WriteField(220, Stream, xDbl, 8); xByte := Byte(FillWalls); WriteField(92, Stream, xByte, 1); xByte := Byte(WorldDim); WriteField(93, Stream, xByte, 1); // MapScale xDbl := MapScale; WriteField(239, Stream, xDbl, sizeof(xDbl)); //Tolik 07/12/2021 == тут просто сбросим запись в стрим, если нет точек (если нет точек - пути тоже нех писать, т.к. // нет основания их строить) if Points.Count > 0 then begin // // write points GetMem(aPoints, Points.Count * 16); for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i])^; pDouble(PAnsiChar(aPoints) + ((i) * 16) + 0)^ := p.x; pDouble(PAnsiChar(aPoints) + ((i) * 16) + 8)^ := p.y; end; WriteBinField(150, Stream, pByte(aPoints), Points.Count * 16); FreeMem(aPoints, Points.Count * 16); // write paths SubStream := TMemoryStream.Create; SubStream.Write(Paths.Count, 4); for i := 0 to Paths.Count - 1 do begin path := TNetpath(paths[i]); path.WriteToStream(SubStream); end; WriteStreamField(151, Stream, SubStream); SubStream.Free; end; // write structs SubStream := TMemoryStream.Create; SubStream.Write(Structs.Count, 4); for i := 0 to Structs.Count - 1 do begin Struct := TNetStruct(Structs[i]); Struct.WriteToStream(SubStream); end; WriteStreamField(152, Stream, SubStream); SubStream.Free; // write point ids //#From Oleg# //04.10.2010 GetMem(aPoints, FPointIDs.Count * SizeOf(Integer)); For i := 0 to FPointIDs.Count - 1 do Integer(Pointer(PAnsiChar(aPoints) + (i*SizeOf(Integer)) )^ ) := Integer(FPointIDs[i]); WriteBinField(153, Stream, pByte(aPoints), FPointIDs.Count * SizeOf(Integer)); FreeMem(aPoints, FPointIDs.Count * SizeOf(Integer)); end; (* procedure TNet.WriteToStream(Stream: TStream); var xByte: Byte; xInt: Integer; xDbl: Double; i: Integer; p: TDoublePoint; path: TnetPath; Struct: TNetStruct; aPoints: Pointer; SubStream,fStream: TMemoryStream; size:Integer; begin inherited; xInt := Round(MapScale); WriteField(20, Stream, xInt, 4); //xInt := Round(FID); //WriteField(21, Stream, xInt, 4); xInt := Round(FComponID); WriteField(21, Stream, xInt, 4); xDbl := WallThick; WriteField(220, Stream, xDbl, 8); xByte := Byte(FillWalls); WriteField(92, Stream, xByte, 1); xByte := Byte(WorldDim); WriteField(93, Stream, xByte, 1); // MapScale xDbl := MapScale; WriteField(239, Stream, xDbl, sizeof(xDbl)); // write points GetMem(aPoints, Points.Count * 16); For i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i])^; pDouble(pChar(aPoints) + ((i) * 16) + 0)^ := p.x; pDouble(pChar(aPoints) + ((i) * 16) + 8)^ := p.y; end; WriteBinField(150, Stream, pByte(aPoints), Points.Count * 16); FreeMem(aPoints, Points.Count * 16); // write paths SubStream := TMemoryStream.Create; SubStream.Write(Paths.Count, 4); for i := 0 to Paths.Count - 1 do begin path := TNetpath(paths[i]); path.WriteToStream(SubStream); end; WriteStreamField(151, Stream, SubStream); SubStream.Free; // write structs SubStream := TMemoryStream.Create; SubStream.Write(Structs.Count, 4); for i := 0 to Structs.Count - 1 do begin Struct := TNetStruct(Structs[i]); Struct.WriteToStream(SubStream); end; WriteStreamField(152, Stream, SubStream); SubStream.Free; // write point ids //#From Oleg# //04.10.2010 GetMem(aPoints, FPointIDs.Count * SizeOf(Integer)); For i := 0 to FPointIDs.Count - 1 do Integer(Pointer(pChar(aPoints) + (i*SizeOf(Integer)) )^ ) := Integer(FPointIDs[i]); WriteBinField(153, Stream, pByte(aPoints), FPointIDs.Count * SizeOf(Integer)); FreeMem(aPoints, FPointIDs.Count * SizeOf(Integer)); end; *) procedure TNet.ClearNetPoints; var i: Integer; p: PDoublePOint; begin try for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i]); Dispose(p); end; Points.Clear; except // ShowMessage(CPowerCadMessage + 'TNet.ClearNetPoints'); end; end; procedure TNet.ClearPaths; var i: Integer; p: TNetPath; begin try for i := 0 to Paths.Count - 1 do begin p := TNetPath(Paths[i]); p.free; end; except // ShowMessage(CPowerCadMessage + 'TNet.ClearPaths'); end; end; procedure TNet.ClearStructs; var i: Integer; S: TNetStruct; begin try for i := 0 to Structs.Count - 1 do begin s := TNetStruct(Structs[i]); s.free; end; except // ShowMessage(CPowerCadMessage + 'TNet.ClearStructs'); end; end; procedure TNet.drawline(DEngine:TPCDrawEngine;p1, p2: TDoublePoint; Color, Width: Integer; Style: TPenStyle); var z: Double; tp1,tp2,bp1,bp2: TDoublePoint; begin DEngine.drawline(p1, p2, Color, Width, ord(style), 0); end; procedure TNet.MarkBrokenPaths; var xPath: TNetPath; brDone: Boolean; xPaths: TList; i: Integer; begin xPaths:= TList.Create; for i := 0 to Paths.Count-1 do begin xPaths.Add(Paths[i]); TNetPath(Paths[i]).Broken := False; end; brDone := false; repeat xPath := FindBrokenPath(xPaths); if assigned(xPath) then begin xPath.Broken := True; xPaths.Remove(xPath); end else begin brDone := true; end; until brDone; xPaths.Free; end; function TNet.CountIntersectingPathsOfKnot(p: PDoublePoint; lPaths: Tlist): Integer; var i,cnt: Integer; path: TnetPath; begin result := 0; cnt := 0; for i := 0 to lPaths.Count - 1 do begin path := TnetPath(lPaths[i]); if (path.isKnotIn(p) > 0) then begin cnt := cnt + 1; end; end; result := cnt; end; function TNet.SnapPoints(var x, y: Double; DotsPerMil: Double): Boolean; var dx,dy,d: Double; i: Integer; path: TnetPath; struct: TnetStruct; fig: String; sx,sy: Double; begin result := false; fig := TPowerCad(Owner).SnapInfo; if (fig = 'TPipeLine') or (Fig = 'TPipe') or (Fig = 'TCircleVertex') or (Fig = 'TLine') or (Fig = 'TCanliHat') or (Fig = 'TDikmeHat') then begin result := False; sx := x; sy := y; FindClosestSnap(sx,sy); d:= GetLineLength(DoublePoint(sx,sy),DoublePoint(x,y)); if ((d * DotsPerMil) <= 24) and (d <> 0) then begin result := true; x := sx; y := sy; end; end else if (fig = 'TWallPath') or (fig = 'TWallRect') or (fig = 'TInsertCol') or (fig = 'TInsertRow') then begin result := SnapToKnots(x,y,DotsPerMil,True); end else if (fig = 'TMirror') or (TPowerCad(Owner).ToolInfo = 'TMirror') or (assigned(TPowerCad(Owner).TraceFigure) and (TPowerCad(Owner).TraceFigure.Cname = 'TMirror')) then begin result := SnapToKnots(x,y,DotsPerMil,False); end else if (fig = 'TRoundStairs') or (fig = 'TSimpleStairs') or (fig = 'TRectangle') or (fig = 'TFloor') then begin for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); if path.SnapToCorners(x,y,DotsPerMil) then begin result := true; exit; end; end; end; end; procedure TNet.IntersectPipeCorner(pIndex: Integer); var path: TnetPath; p1,p2: TDoublePoint; p3,p4: TDoublePoint; xPaths: TList; p: PDoublePoint; id,i,k,cnt,icnt: Integer; path1,path2: TnetPath; ip,ip1,ip2: TDoublePOint; intersect: Boolean; closed: Boolean; lPath: TnetPath; r1,r2,radius: Double; HasWall: Boolean; HasGlass: Boolean; j1,j2: TDoublePOint; flat: Boolean; begin p := pDoublePoint(points[pIndex]); xPaths := TList.Create; cnt := 0; HasWall:= False; HasGlass := False; lPath := nil; //#From Oleg# //14.09.2010 for i := 0 to Paths.Count -1 do begin path := TNetPath(Paths[i]); closed:= path.Isclosed; id := path.isKnotValIn(p^); if (id > 0) and (not Closed) then begin if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then begin if Path.WType in [wtWall,wtOpen] then hasWall := True else HasGlass := True; cnt := cnt+1; xPaths.Add(path); if id = 1 then path.Angle := GetRadOfLine(p^,path.p2^) else path.Angle := GetRadOfLine(p^,path.p1^); path.Dir := id; lPath := path; end; end; end; cnt := xPaths.Count; if haswall and hasGlass then begin for i := cnt-1 downto 0 do if TnetPath(xPaths[i]).WType in [wtGlass,wtHalf] then xPaths.Remove(xPaths[i]); end; cnt := xPaths.Count; if cnt = 1 then begin if lpath.dir = 1 then begin lpath.Empty1 := true; if not lPath.isArc then begin lPath.Hl1 := MPoint(lPath.Hl1,lPath.Hl2,-((lpath.Width/2)+1)); lPath.Hr1 := MPoint(lPath.Hr1,lPath.Hr2,-((lpath.Width/2)+1)); end; end else begin lpath.Empty2 := true; if not lPath.isArc then begin lPath.HL2 := MPoint(lPath.Hl2,lPath.Hl1,-((lpath.Width/2)+1)); lPath.HR2 := MPoint(lPath.Hr2,lPath.Hr1,-((lpath.Width/2)+1)); end; end; end; if xPaths.Count < 2 then //Tolik 07/02/2017 -- // exit; begin FreeAndNil(xPaths); exit; end; // SortPathAngles(xPaths,0,xPaths.Count-1); for i := 0 to xPaths.Count-1 do begin path1 := TNetPath(xPaths[i]); if i < xPaths.Count-1 then k := i+1 else k := 0; path2 := TNetPath(xPaths[k]); intersect := true; if Intersect then begin if (not path1.isArc) and (not path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.Hr1; p2 := path1.Hr2; end else begin p1 := path1.Hl1; p2 := path1.Hl2; end; if path2.Dir = 2 then begin p3 := path2.Hr1; p4 := path2.Hr2; end else begin p3 := path2.Hl1; p4 := path2.Hl2; end; if GetIntersectionPoint(p1,p2,p3,p4,ip) then begin flat := EQDP(ip,p1) or EQDP(p2,ip); if path1.Dir = 1 then begin if flat then path1.HR1 := MPoint(path1.HR1,path1.HR2,((path1.Width/2)+1)) else path1.Hr1 := ip; end else begin if flat then path1.Hl2 := MPoint(path1.Hl2,path1.Hl1,((path1.Width/2)+1)) else path1.Hl2 := ip; end; if path2.Dir = 1 then begin if flat then path2.HL1 := MPoint(path2.HL1,path2.HL2,((path2.Width/2)+1)) else path2.Hl1 := ip end else begin if flat then path2.Hr2 := MPoint(path2.Hr2,path2.Hr1,((path2.Width/2)+1)) else path2.Hr2 := ip; end; end; end else if (path1.isArc) and (not path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.Hr2; p2 := path1.Hr1; end else begin p1 := path1.Hl1; p2 := path1.Hl2; end; if path2.Dir = 2 then begin p3 := path2.Hr1; p4 := path2.Hr2; end else begin p3 := path2.Hl2; p4 := path2.Hl1; end; radius := GetLineLenght(p1,path1.ArcCenter); if GetLineCircleIntersection(p3,p4,path1.ArcCenter,radius,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p4,ip1,ip2); if path1.Dir = 1 then begin path1.Hr1 := ip; //path1.ArcJoinB1 := ip; //path1.ArcJoinB1L := ip; end else begin path1.Hl2 := ip; //path1.ArcJoinA2 := ip; //path1.ArcJoinA2L := ip; end; if path2.Dir = 1 then path2.Hl1 := ip else path2.Hr2 := ip; end else begin if (path1.Dir = 1) then j1 := path1.Hr1 else j1 := path1.Hl2; if path2.Dir = 1 then j2 := path2.Hl1 else j2 := path2.Hr2; if path1.Dir = 1 then begin //path1.ArcJoinB1 := j1; //path1.ArcJoinB1L := j2; end else begin //path1.ArcJoinA2 := j1; //path1.ArcJoinA2L := j2; end; end; end else if (not path1.isArc) and (path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.Hr2; p2 := path1.Hr1; end else begin p1 := path1.Hl1; p2 := path1.Hl2; end; if path2.Dir = 2 then begin p3 := path2.Hr1; p4 := path2.Hr2; end else begin p3 := path2.Hl2; p4 := path2.Hl1; end; radius := GetLineLenght(p3,path2.ArcCenter); if GetLineCircleIntersection(p1,p2,path2.ArcCenter,radius,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p2,ip1,ip2); if path1.Dir = 1 then path1.Hr1 := ip else path1.Hl2 := ip; if path2.Dir = 1 then begin path2.Hl1 := ip; //path2.ArcJoinA1 := ip; //path2.ArcJoinA1L := ip; end else begin path2.Hr2 := ip; //path2.ArcJoinB2 := ip; //path2.ArcJoinB2L := ip; end; end else begin if path1.Dir = 1 then j1 := path1.Hr1 else j1 := path1.Hl2; if (path2.Dir = 1) then j2 := path2.Hl1 else j2 := path2.Hr2; if path2.Dir = 1 then begin //path2.ArcJoinA1 := j1; //path2.ArcJoinA1L := j2; end else begin //path2.ArcJoinB2 := j1; //path2.ArcJoinB2L := j2; end; end; end else if ( path1.isArc) and (path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.Hr2; p2 := path1.Hr1; end else begin p1 := path1.Hl1; p2 := path1.Hl2; end; if path2.Dir = 2 then begin p3 := path2.Hr1; p4 := path2.Hr2; end else begin p3 := path2.Hl2; p4 := path2.Hl1; end; r1 := GetLineLenght(p1,path1.ArcCenter); r2 := GetLineLenght(p3,path2.ArcCenter); if GetCircleCircleIntersection(path1.ArcCenter,r1,path2.ArcCenter,r2,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p2,ip1,ip2); if path1.Dir = 1 then begin path1.Hr1 := ip; //path1.ArcJoinB1 := ip; //path1.ArcJoinB1L := ip; end else begin path1.Hl2 := ip; //path1.ArcJoinA2 := ip; //path1.ArcJoinA2L := ip; end; if path2.Dir = 1 then begin path2.Hl1 := ip; //path2.ArcJoinA1 := ip; //path2.ArcJoinA1L := ip; end else begin path2.Hr2 := ip; //path2.ArcJoinB2 := ip; //path2.ArcJoinB2L := ip; end; end else begin if path1.Dir = 1 then j1 := path1.Hr1 else j1 := path1.Hl2; if (path2.Dir = 1) then j2 := path2.Hl1 else j2 := path2.Hr2; if path1.Dir = 1 then begin //path1.ArcJoinB1 := j1; //path1.ArcJoinB1L := j2; end else begin //path1.ArcJoinA2 := j1; //path1.ArcJoinA2L := j2; end; if path2.Dir = 1 then begin //path2.ArcJoinA1 := j1; //path2.ArcJoinA1L := j2; end else begin //path2.ArcJoinB2 := j1; //path2.ArcJoinB2L := j2; end; end; end; end; end; //Tolik -- 07/02/2017 -- FreeAndNil(xPaths); // end; Function TNet.CreatePaths(pArr: TDoublePointArr; dontRefresh: Boolean): TNetPath; var i, k: Integer; pa, pb: PDoublePoint; path: TnetPath; p1, p2, p: TDoublePoint; cnt, pCnt: Integer; pGrp: TDoublePointGroup; gCnt: Integer; gArr: TDoublePointArr; dx, dy: Double; Polly: TDoublePointArr; PathOnKnotA, PathOnKnotB, PathOnKnot: TNetPath; //02.04.2013 //Tolik 07/12/2021 -- function CheckIsOnePoint(a,b: PDoublePoint): Boolean; begin Result := ((CompareValue(a^.x, b^.x, 0.05) = 0) and (CompareValue(a^.y, b^.y, 0.05) = 0)); end; // begin result := nil; cnt := Length(pArr); if cnt < 2 then exit; if CheckLineOnLine(pArr) then exit; if not CheckSelfIntersection(pArr) then exit; if not GroupPathPointsByIntersection(pArr, pGrp) then exit; //SetLength(pGrp, 1); //pGrp[0] := pArr; if Length(pGrp) > 0 then begin //SetLength(Polly, .); end; cnt := Length(pArr); gCnt := Length(pGrp); pCnt := 0; for i := 0 to gCnt - 1 do begin gArr := pGrp[i]; cnt := Length(gArr); for k := 0 to cnt - 2 do begin p1 := gArr[k]; p2 := gArr[k + 1]; if not EQDP(p1, p2) then //if Not CmpDP(@p1, @p2) then //18.02.2011 if not EQDP(p1, p2) then begin PathOnKnotA := nil; //02.04.2013 PathOnKnotB := nil; //02.04.2013 pa := InsertKnot(p1, true, @PathOnKnotA); // Tolik 17/10/2016-- //pb := InsertKnot(p2, true, @PathOnKnotB); pb := InsertKnot(p2, true, @PathOnKnotB, pa); // if assigned(pa) and assigned(pb) then begin if FAllowAddPathWithSamePoints or (pa <> pb) then begin //Tolik 07/12/2021 -- if not CheckIsOnePoint(pa,pb) then begin // path := AddPath(pa, pb, false); if assigned(path) then begin PathOnKnot := PathOnKnotA; if PathOnKnot = nil then PathOnKnot := PathOnKnotB; if PathOnKnot <> nil then begin path.wstyle := PathOnKnot.wstyle; path.FColor := PathOnKnot.FColor; path.FBrushColor := PathOnKnot.FBrushColor; path.FBrushStyle := PathOnKnot.FBrushStyle; end; pCnt := pCnt + 1; if pcnt = 1 then result := path; end; end; end; end; end; end; end; //if pCnt > 1 then result := nil; if not DontRefresh then RefreshPaths; end; procedure TNet.GetCornerPatch(pIndex:Integer; var pArr: TdoublePointArr); var path: TnetPath; p1,p2: TDoublePoint; p3,p4: TDoublePoint; xPaths: TList; p: PDoublePoint; id,i,k,cnt,icnt: Integer; path1,path2: TnetPath; ip,ip1,ip2: TDoublePOint; intersect: Boolean; closed: Boolean; lPath: TnetPath; r1,r2,radius: Double; HasWall: Boolean; HasGlass: Boolean; j1,j2: TDoublePOint; begin SetLength(pArr,0); p := pDoublePoint(points[pIndex]); for i := 0 to Structs.Count -1 do begin if (TnetStruct(Structs[i]) is TNetCol) and (TNetCol(Structs[i]).p1 = p) then exit; end; xPaths := TList.Create; cnt := 0; HasWall:= False; HasGlass := False; for i := 0 to Paths.Count -1 do begin path := TNetPath(Paths[i]); closed:= path.Isclosed; id := path.isKnotValIn(p^); if (id > 0) and (not Closed) then begin if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then begin if Path.WType in [wtWall,wtOpen] then hasWall := True else HasGlass := True; cnt := cnt+1; xPaths.Add(path); if id = 1 then path.Angle := GetRadOfLine(p^,path.p2^) else path.Angle := GetRadOfLine(p^,path.p1^); path.Dir := id; lPath := path; end; end; end; cnt := xPaths.Count; if haswall and hasGlass then begin for i := cnt-1 downto 0 do if TnetPath(xPaths[i]).WType in [wtGlass,wtHalf] then xPaths.Remove(xPaths[i]); end; cnt := xPaths.Count; if xPaths.Count < 3 then //Tolik 07/02/2017 -- // exit; begin FreeAndNil(xPaths); exit; end; // SortPathAngles(xPaths,0,xPaths.Count-1); SetLength(pArr,xPaths.Count); for i := 0 to xPaths.Count-1 do begin path1 := TNetPath(xPaths[i]); if i < xPaths.Count-1 then k := i + 1 else k := 0; path2 := TNetPath(xPaths[k]); intersect := true; if Intersect then begin if (not path1.isArc) and (not path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.r1; p2 := path1.r2; end else begin p1 := path1.l1; p2 := path1.l2; end; if path2.Dir = 2 then begin p3 := path2.r1; p4 := path2.r2; end else begin p3 := path2.l1; p4 := path2.l2; end; GetIntersectionPoint(p1,p2,p3,p4,ip); pArr[i] := ip; end else if (path1.isArc) and (not path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.r2; p2 := path1.r1; end else begin p1 := path1.l1; p2 := path1.l2; end; if path2.Dir = 2 then begin p3 := path2.r1; p4 := path2.r2; end else begin p3 := path2.l2; p4 := path2.l1; end; radius := GetLineLenght(p1,path1.ArcCenter); if GetLineCircleIntersection(p3,p4,path1.ArcCenter,radius,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p4,ip1,ip2); pArr[i] := ip; end else begin if (path1.Dir = 1) then j1 := path1.r1 else j1 := path1.l2; pArr[i] := j1; end; end else if (not path1.isArc) and (path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.r2; p2 := path1.r1; end else begin p1 := path1.l1; p2 := path1.l2; end; if path2.Dir = 2 then begin p3 := path2.r1; p4 := path2.r2; end else begin p3 := path2.l2; p4 := path2.l1; end; radius := GetLineLenght(p3,path2.ArcCenter); if GetLineCircleIntersection(p1,p2,path2.ArcCenter,radius,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p2,ip1,ip2); pArr[i] := ip; end else begin if path1.Dir = 1 then j1 := path1.r1 else j1 := path1.l2; pArr[i] := j1; end; end else if ( path1.isArc) and (path2.isArc) then begin if path1.Dir = 1 then begin p1 := path1.r2; p2 := path1.r1; end else begin p1 := path1.l1; p2 := path1.l2; end; if path2.Dir = 2 then begin p3 := path2.r1; p4 := path2.r2; end else begin p3 := path2.l2; p4 := path2.l1; end; r1 := GetLineLenght(p1,path1.ArcCenter); r2 := GetLineLenght(p3,path2.ArcCenter); if GetCircleCircleIntersection(path1.ArcCenter,r1,path2.ArcCenter,r2,ip1,ip2,iCnt) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(p2,ip1,ip2); pArr[i] := ip; end else begin if path1.Dir = 1 then j1 := path1.r1 else j1 := path1.l2; pArr[i] := j1; end; end; end; end; // Tolik 07/02/2017 -- FreeAndNil(xPaths); // end; procedure TNet.IntersectColCorner(pIndex: Integer); var path: TnetPath; col: TnetCol; p1,p2: TDoublePoint; p3,p4: TDoublePoint; xPaths: TList; p: PDoublePoint; id,i,k,cnt,icnt: Integer; path1,path2: TnetPath; ip,ip1,ip2: TDoublePOint; intersect: Boolean; closed: Boolean; lPath: TnetPath; r1,r2,radius: Double; HasWall: Boolean; HasGlass: Boolean; j1,j2: TDoublePOint; ap1,ap2,ap3,ap4: TdoublePoint; begin p := pDoublePoint(points[pIndex]); Col := GetKnotCol(p); if not assigned(col) then exit; Col.GetPoints(ap1,ap2,ap3,ap4); xPaths := TList.Create; cnt := 0; HasWall:= False; HasGlass := False; for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); closed:= path.Isclosed; id := path.isKnotValIn(p^); if (id > 0) and (not Closed) then begin if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then begin if Path.WType in [wtWall,wtOpen] then hasWall := True else HasGlass := True; cnt := cnt + 1; xPaths.Add(path); if id = 1 then path.Angle := GetRadOfLine(p^,path.p2^) else path.Angle := GetRadOfLine(p^,path.p1^); path.Dir := id; lPath := path; end; end; end; cnt := xPaths.Count; if haswall and hasGlass then begin for i := cnt - 1 downto 0 do if TnetPath(xPaths[i]).WType in [wtGlass,wtHalf] then xPaths.Remove(xPaths[i]); end; cnt := xPaths.Count; for i := 0 to xPaths.Count - 1 do begin lPath := TNetPath(xPaths[i]); Col.IntersectPath(lPath); end; end; function TNet.GetKnotCol(p: PdoublePoint): TnetCol; var i: Integer; begin result:= nil; for i := 0 to Structs.Count - 1 do begin if TnetStruct(Structs[i]) is TnetCol then begin if TnetCol(Structs[i]).p1 = p then begin result := TnetCol(Structs[i]); exit; end; end; end; end; procedure TNet.IntersectColPipeCorner(pIndex: Integer); var path: TnetPath; col: TnetCol; row: TNetRow; p1,p2: TDoublePoint; p3,p4: TDoublePoint; xPaths: TList; p: PDoublePoint; id,i,k,cnt,icnt: Integer; path1,path2: TnetPath; ip,ip1,ip2: TDoublePOint; intersect: Boolean; closed: Boolean; lPath: TnetPath; r1,r2,radius: Double; HasWall: Boolean; HasGlass: Boolean; j1,j2: TDoublePOint; begin p := pDoublePoint(points[pIndex]); xPaths := TList.Create; cnt := 0; HasWall:= False; HasGlass := False; for i := 0 to Paths.Count -1 do begin path := TNetPath(Paths[i]); closed:= path.Isclosed; id := path.isKnotValIn(p^); if (id > 0) and (not Closed) then begin if path.WType in [wtWall,wtOpen,wtGlass,wtHalf] then begin if Path.WType in [wtWall,wtOpen] then hasWall := True else HasGlass := True; cnt := cnt + 1; xPaths.Add(path); if id = 1 then path.Angle := GetRadOfLine(p^,path.p2^) else path.Angle := GetRadOfLine(p^,path.p1^); path.Dir := id; lPath := path; end; end; end; cnt := xPaths.Count; if haswall and hasGlass then begin for i := cnt - 1 downto 0 do if TnetPath(xPaths[i]).WType in [wtGlass,wtHalf] then xPaths.Remove(xPaths[i]); end; cnt := xPaths.Count; Col := GetKnotCol(p); if assigned(col) then begin for i := 0 to xPaths.Count - 1 do begin lPath := TNetPath(xPaths[i]); Col.IntersectPathPipe(lPath); end; end; for k := 0 to Structs.Count - 1 do begin if TnetStruct(Structs[k]) is TNetRow then begin if (TnetRow(Structs[k]).p1 = p) or (TnetRow(Structs[k]).p2 = p) then begin for i := 0 to xPaths.Count-1 do begin lPath := TNetPath(xPaths[i]); TnetRow(Structs[k]).IntersectPathPipe(lPath); end; end; end; end; end; procedure TNet.SnapModPoint(var x, y: Double; mp: TModPoint; traceNet: Tnet); var dx, dy: Double; wt: Double; l, d, minD, dist: Double; path: TnetPath; begin minD := 100 / MapScale; wt := WallThick; dx := abs(mp.Coordx - x); dy := abs(mp.Coordy - y); if (mp.PType = ptPolyPoint) then begin if dx > dy then dy := 0 else dx := 0; end else if ((mp.PType = ptRectPoint) or (mp.PType = ptGroupPoint)) and (mp.Tag > -1) and (mp.Tag < traceNet.Paths.Count) then begin Path := TnetPath(traceNet.Paths[mp.Tag]); if Path.PosType = ptVertical then dy := 0 else dx := 0; end; if not Tpowercad(owner).SnapToNearPoint then begin if dx <> 0 then y := mp.Coordy; if dy <> 0 then x := mp.Coordx; exit; end; if dx <> 0 then begin d := dx; d := d + wt; l := Trunc(d / minD) * mind; dist := d - l; if dist >= (mind / 2) then begin l := l + MinD; end; l := l - wt; if x > mp.Coordx then x := mp.Coordx + l else x := mp.Coordx - l; end else x := mp.Coordx; if (dy <> 0) then begin d := dy; d := d + wt; l := Trunc(d / minD) * mind; dist := d - l; if dist >= (mind / 2) then begin l := l + MinD; end; l := l - wt; if y > mp.CoordY then y := mp.CoordY + l else y := mp.CoordY - l; end else y := mp.CoordY; end; function TNet.PointOnPath(p: TDoublePoint): TNetPath; var i: Integer; path: TnetPath; begin result := nil; for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); if (path.isPointIn(p.x,p.y)) then begin result := path; exit; end; end; end; function TNet.FindCloserPath(p: TDoublePoint): TNetPath; var i: Integer; d,dmin: Double; path,pMin: TnetPath; begin result := nil; dmin := -1; pMin := nil; for i := 0 to Paths.Count - 1 do begin path := TnetPath(paths[i]); if (path.WType = wtWall) and not (path.isArc) then begin d := GetDistToLine(path.p1^,path.p2^,p); if (dMin = -1) then begin dMin := d; pMin := path; end; if d < dMin then begin dMin := d; pMin := path; end; end; end; result := pMin; end; procedure TNet.NormalizeKnot(p: PDoublePoint; Net: Tnet); var xPaths: TList; path: TnetPath; px: PDoublePOint; i: Integer; dx, dy: Double; begin xPaths := TList.Create; Net.GetPathsOfKnot(p, xPaths); for i := 0 to xPaths.Count - 1 do begin path := TnetPath(xPaths[i]); px := path.OtherPoint(p); dx := abs(px^.x - p^.x); dy := abs(px^.y - p^.y); if (dx < 3) then p^.x := px^.x; if (dy < 3) then p^.y := px^.y; end; end; procedure TNet.InvertSelPathValue(val: Boolean); var index: Integer; path: TNetPath; begin if SelIndex > 0 then begin index := SelIndex-1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); if path.isArc then begin Path.inverted := val; RefreshPaths; end; end; end; end; procedure TNet.FindClosestSnap(var x, y: Double); var dx,dy: Double; i: Integer; path: TnetPath; struct: TnetStruct; fig: String; ox,oy,sx,sy: Double; dSnap,d: Double; rFig:TFigure; begin if (Paths.Count = 0) and (Structs.Count=0) then exit; ox := x; oy := y; dSnap := -1234567; sx := 0; //#From Oleg# //14.09.2010 sy := 0; //#From Oleg# //14.09.2010 for i := 0 to Structs.Count - 1 do begin x := ox; y := oy; Struct := TnetStruct(Structs[i]); if Struct.SnapPoints(x,y,TPowercad(owner).DotsPerMil) then begin d := GetLineLenght(DoublePoint(ox,oy),DoublePoint(x,y)); dSnap := d; sx := x; sy := y; end; end; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); x := ox; y := oy; if path.ForceSnapToPipeCorners(x,y,dSnap) then begin sx := x; sy := y; end; end; if (dSnap * TPowercad(owner).DotsPermil) < 24 then begin x := sx; y := sy; exit; end; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); x := ox; y := oy; if path.ForceSnapToPipeLine(x,y,dSnap) then begin sx := x; sy := y; end; end; x := sx; y := sy; end; procedure TNet.SetWallKris(val: Boolean); var index: Integer; path: TNetPath; begin if SelIndex > 0 then begin index := SelIndex - 1; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); Path.isRow := val; RefreshPaths; end; end; end; procedure TNet.FillColSpaces; begin end; function TNet.SelCenter: TDoublePoint; var index: Integer; path: TnetPath; Struct: TNetStruct; begin result := DoublePoint(0, 0); index := SelIndex - 1; if (SelType = stPath) and (SelIndex > 0) then begin if index < Paths.Count then begin path := TnetPath(Paths[Index]); result := MPoint(path.p1^,path.p2^); exit; end; end; if (SelType = stStruct) and (SelIndex > 0) then begin if index < Structs.Count then begin struct := TNetStruct(Structs[Index]); if Struct is TNetCol then begin result := TnetCol(Struct).p1^; exit; end else if Struct is TNetRow then begin result := Mpoint(TnetRow(Struct).p1^,TnetRow(Struct).p2^); exit; end; end; end; Result := RectCenter(GetBoundRect); end; function TNet.SnapToKnots(var x, y: Double; DotsPerMil: Double; SnapLine: Boolean): Boolean; var i: INteger; path: TNetPath; begin result := false; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); if path.SnapToKnots(x,y,DotsPerMil,SnapLine) then begin result := true; exit; end; end; end; Function TNet.Edit: Boolean; var index: Integer; enterstr: string; Path: TnetPath; begin Result := False; if selpath <> nil then begin //07.06.2010 - Запрещаем разделение стен по дв.клику if Self.FComponID = 0 then begin DivSelPath(DoublePoint(EditX,Edity)); Result := True; end else begin if selpath.DoorIndex <> -1 then TNetDoor(selpath.Doors[selpath.DoorIndex]).DoDblClick else selpath.DoDblClick; end; end; end; procedure TNet.DrawFigureGuides(DEngine: TPCDrawEngine); var i: Integer; begin if (not DrawGuides) then exit; for i := 0 to Paths.Count - 1 do begin TnetPath(Paths[i]).DrawGuides(Dengine); end; for i := 0 to Structs.Count - 1 do begin TnetStruct(Structs[i]).DrawGuides(Dengine); end; end; function TNet.FindMostSWPath(pathList: TList): TNetPath; var path: TnetPath; mp:TDoublePOint; ms,ds,mW,dw: Double; i:Integer; begin result := nil; if pathList.Count = 0 then exit; path := TnetPath(pathList[0]); mp := MPoint(path.p1^,path.p2^); mS := WorkHeight - mp.y; mW := mp.x; result := path; for i := 1 to pathList.Count - 1 do begin path := TnetPath(pathList[i]); mp := MPoint(path.p1^,path.p2^); dS := WorkHeight - mp.y; dW := mp.x; if EQD(dS,mS) then begin if dw < mW then begin result := path; mS := ds; mW := dW; end; end else if dS < mS then begin result := path; mS := ds; mW := dW; end; end; end; function TNet.FindMostSEPath(pathList: TList): TNetPath; var path: TnetPath; mp: TDoublePOint; ms,ds,mE,dE: Double; i: Integer; begin result := nil; if pathList.Count = 0 then exit; path := TnetPath(pathList[0]); mp := MPoint(path.p1^,path.p2^); mS := WorkHeight - mp.y; mE := mp.x; for i := 1 to pathList.Count - 1 do begin path := TnetPath(pathList[i]); mp := MPoint(path.p1^,path.p2^); dS := WorkHeight - mp.y; dE := mp.x; if dS < mS then begin result := path; mS := ds; mE := dE; end else if dS = mS then begin if dE > mE then begin result := path; mS := ds; mE := dE; end; end; end; end; function TNet.SelPath: TnetPath; begin result := nil; if (SelIndex > 0) and (selType = stPath) and (SelIndex <= Paths.Count) then begin result := TNetPath(Paths[SelIndex - 1]); end; end; function TNet.SelPt: PDoublePoint; begin Result := nil; if (FSelPtIdx <> -1) and (FSelPtIdx < Points.Count) then Result := Points[FSelPtIdx]; end; procedure TNet.DivSelPath; var index,i: Integer; path: TNetPath; mp:TdoublePoint; xp,op:PDoublePoint; begin if (SelIndex > 0) and (selType = stPath) then begin index := SelIndex-1; if assigned(undoProc) then UndoProc; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); Path.BeforeDiv; //06.10.2010 try mp := MPoint(path.p1^,path.p2^); xp := InsertKnot(mp); RefreshPaths; finally Path.AfterDiv; //06.10.2010 end; end; end; end; function TNet.SelDoor: TnetDoor; var path: TnetPath; begin result := nil; path := SelPath; if assigned(path) and (path.ActiveDoor <> nil) and (path.ActiveDoor.DoorObjType = dotDoor) then begin result := path.ActiveDoor; end; end; function TNet.SelWindow: TnetDoor; var path:TnetPath; begin result := nil; path := SelPath; if assigned(path) and (path.ActiveDoor <> nil) and (path.ActiveDoor.DoorObjType = dotWindow) then begin result := path.ActiveDoor; end; end; function TNet.SelCol: TnetCol; begin result := nil; if (SelType = stStruct) and (SelIndex > 0) and (SelIndex <= Structs.Count) then begin if TNetStruct(Structs[SelIndex - 1]) is TNetCol then result := Structs[SelIndex - 1]; end; end; function TNet.SelRow: TnetRow; begin result := nil; if (SelType = stStruct) and (SelIndex > 0) and (SelIndex <= Structs.Count) then begin if TNetStruct(Structs[SelIndex - 1]) is TNetRow then result := Structs[SelIndex - 1]; end; end; procedure TNet.AddNetCol; var index, i: Integer; path: TNetPath; begin if (SelIndex > 0) and (selType = stPath) then begin index := SelIndex - 1; if assigned(undoProc) then UndoProc; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); Path.AddCols; RefreshPaths; end; end; end; procedure TNet.AddCol; begin if SelPath <> nil then begin SelPath.AddCols; RefreshPaths; end; end; procedure TNet.LocatePathPoint(p: PDoublePoint; x, y: Double); var p1,p2: PDoublePOint; pArr: TDoublePOintArr; xPath: TNetPath; SelPathWidth: Double; begin if SelPath = nil then exit; p1 := SelPath.OtherPoint(p); SetLength(pArr, 2); pArr[0] := DoublePoint(p1.x, p1.y); pArr[1] := DoublePoint(x, y); if SelPath <> nil then SelPathWidth := SelPath.Width else SelPathWidth := -1; if DeletePathSilent(SelPath) then begin xPath := MakePath(pArr, False); if assigned(xPath) then begin //27.07.2011 SelType := stPath; //27.07.2011 SelIndex := Paths.IndexOf(xPath) + 1; SelectPath(Paths.IndexOf(xPath) + 1); if SelPathWidth <> -1 then begin if xPath.Width <> SelPathWidth then begin xPath.Width := SelPathWidth; RefreshPaths; end; end; end; end else begin LocatePoint(p,x,y); end; end; procedure TNet.DoublePath(path: TNetPath; delta: Double); var p1,p2: TDoublePoint; pArr: TDoublePOintArr; xPath: TNetPath; dx,dy: Double; begin dx := abs(path.p1^.x - path.p2^.x); dy := abs(path.p1^.y - path.p2^.y); if dx > dy then begin delta := -delta; p1 := MovePoint(path.p1^,0,delta); p2 := MovePoint(path.p2^,0,delta); end else begin p1 := MovePoint(path.p1^,delta,0); p2 := MovePoint(path.p2^,delta,0); end; SetLength(pArr,2); pArr[0] := p1; pArr[1] := p2; xPath := MakePath(pArr,False); if assigned(xPath) then begin //27.07.2011 SelType := stPath; //27.07.2011 SelIndex := Paths.IndexOf(xPath) + 1; SelectPath(Paths.IndexOf(xPath) + 1); end; end; procedure TNet.LocatePath(path: TNetPath; delta: Double;delOld,repair:Boolean); var p1,p2,op1,op2,xp1,xp2: TDoublePoint; o1,o2: PDoublePoint; pArr: TDoublePOintArr; xPath,aPath: TNetPath; dx,dy: Double; xUndo: TUndoProc; list: TList; i: INteger; xEq,yEq: Boolean; label ex; begin dx := abs(path.p1^.x - path.p2^.x); dy := abs(path.p1^.y - path.p2^.y); op1 := path.p1^; op2 := path.p2^; o1 := path.p1; o2 := path.p2; if dx > dy then begin delta := -delta; p1 := MovePoint(path.p1^,0,delta); p2 := MovePoint(path.p2^,0,delta); end else begin p1 := MovePoint(path.p1^,delta,0); p2 := MovePoint(path.p2^,delta,0); end; SetLength(pArr,2); xEq := EQD(p1.x, p2.x); yEq := EQD(p1.y, p2.y); xp1 := p1; xp2 := p2; Self.SnapToKnots(xp1.x,xp1.y,8,False); if xEq then xp2.x := xp1.x; if yEq then xp2.y := xp1.y; Self.SnapToKnots(xp2.x,xp2.y,8,False); if xEq then xp1.x := xp2.x; if yEq then xp1.y := xp2.y; pArr[0] := xp1; pArr[1] := xp2; xUndo := UndoProc; UndoProc := nil; xPath := nil; //#From Oleg# //14.09.2010 try xPath := MakePath(pArr,False); except end; if not assigned(xPath) then goto ex; try if assigned(xPath) and repair then begin if xPath.Empty1 then begin pArr[0] := op1; pArr[1] := xpath.p1^; aPath := MakePath(pArr,False); end; if xPath.Empty2 then begin pArr[0] := op2; pArr[1] := xpath.p2^; aPath := MakePath(pArr,False); end; end; if (paths.IndexOf(path) = -1) then begin path := nil; path := Self.FindPathOfPoints(op1,op2); end; if assigned(path) and assigned(xPath) then begin xpath.CopyFrom(path); end; try if delOld and (paths.IndexOf(path) <> -1) then begin DeletePath(path) end else begin path := Self.FindPathOfPoints(op1,op2); if delOld and (assigned(path)) then DeletePath(path); end; except end; if assigned(xPath) and repair and delOld then begin list := TList.Create; if Self.Points.IndexOf(o1) > -1 then Self.GetPathsOfKnot(o1,list); if list.Count = 1 then begin aPath := TnetPath(list[0]); DeletePath(aPath); end; list.Clear; if Self.Points.IndexOf(o2) > -1 then Self.GetPathsOfKnot(o2,list); if list.Count = 1 then begin aPath := TnetPath(list[0]); DeletePath(aPath); end; list.Free; end; except end; ex: UndoProc := xUndo; try RefreshPaths; except end; try if assigned(xPath) then begin //27.07.2011 SelType := stPath; //27.07.2011 SelIndex := Paths.IndexOf(xPath) + 1; SelectPath(Paths.IndexOf(xPath) + 1); end; except end; end; procedure TNet.LocateSelPath(Delta: Double;delOld,repair:Boolean); begin if selpath = nil then exit; Locatepath(SelPath,delta,delOld,repair); end; procedure TNet.DoubleSelPath(Delta: Double); begin if selpath = nil then exit; Doublepath(SelPath,delta); end; procedure TNet.MoveSatih(rpath: TNetPath; dx, dy: Double; control: Boolean); var xPaths,fPaths:Tlist; rad,pRad: Double; lPath,path:TnetPath; i: Integer; p1: PDoublePoint; found:Boolean; pList: TList; valid:Boolean; dAngle : Double; dif: Double; height1,height2: Double; PointID1,POintID2: integer; begin rad := GetRadOfLine(rpath.p1^,rpath.p2^); xPaths := TList.Create; fPaths := Tlist.Create; lPath := rpath; p1 := rpath.p1; repeat xPaths.Clear; GetPathsOfKnot(p1,xPaths); xPaths.Remove(lPath); found := false; for i := 0 to xPaths.Count - 1 do begin path := TNetPath(xPaths[i]); if rpath.Net.FSRCNet <> nil then begin PointID1 := Integer(rpath.Net.FSRCNet.FPointIDs[rpath.Net.Points.IndexOf(path.p1)]); PointID2 := Integer(rpath.Net.FSRCNet.FPointIDs[rpath.Net.Points.IndexOf(path.p2)]); height1 := GetZPointByID(rpath.Net.FSRCNet, PointID1); height2 := GetZPointByID(rpath.Net.FSRCNet, PointID2); end else begin height1 := GetZPoint(rpath.Net,path.p1); height2 := GetZPoint(rpath.Net,path.p2); end; if (EQDP(path.p1^,path.p2^))and(height1 <> height2)and(IFFiguraIsRoof(path.Net)) then begin found := false; Break; end else begin prad := GetRadOfLine(path.p1^,path.p2^); dAngle := abs(rad - prad); if (dAngle > pi) then dAngle := 2 * pi - dAngle; dif := (2 * (pi / 180)); if not (dAngle <= dif ) then prad := GetRadOfLine(path.p2^,path.p1^); dAngle := abs(rad - prad); if (dAngle > pi) then dAngle := 2 * pi - dAngle; if (dAngle <= dif ) then begin fPaths.Add(path); p1 := path.OtherPoint(p1); lPath := path; found := true; if fPaths.Count > 200 then begin fPaths.Clear; break; end; end; end; end; until (not found) or (xPaths.Count = 0); lPath := rpath; p1 := rpath.p2; repeat xPaths.Clear; GetPathsOfKnot(p1,xPaths); xPaths.Remove(lPath); found := false; for i := 0 to xPaths.Count - 1 do begin path := TNetPath(xPaths[i]); if rpath.Net.FSRCNet <> nil then begin PointID1 := Integer(rpath.Net.FSRCNet.FPointIDs[rpath.Net.Points.IndexOf(path.p1)]); PointID2 := Integer(rpath.Net.FSRCNet.FPointIDs[rpath.Net.Points.IndexOf(path.p2)]); height1 := GetZPointByID(rpath.Net.FSRCNet, PointID1); height2 := GetZPointByID(rpath.Net.FSRCNet, PointID2); end else begin height1 := GetZPoint(rpath.Net,path.p1); height2 := GetZPoint(rpath.Net,path.p2); end; if (EQDP(path.p1^,path.p2^))and(height1 <> height2)and(IFFiguraIsRoof(path.Net)) then begin found := false; Break; end else begin prad := GetRadOfLine(path.p1^,path.p2^); if not Eqd(rad,prad) then prad := GetRadOfLine(path.p2^,path.p1^); if eqd(rad,prad) then begin fPaths.Add(path); p1 := path.OtherPoint(p1); lPath := path; found := true; if fPaths.Count > 200 then begin fPaths.Clear; break; end; end; end; end; until (not found) or (xPaths.Count = 0); xPaths.free; pList := TList.Create; pList.Add(rPath.p1); pList.Add(rPath.p2); for i := 0 to fPaths.Count - 1 do begin Path := TNetPath(fPaths[i]); if (pList.IndexOf(path.p1) = -1) then pList.Add(path.p1); if (pList.IndexOf(path.p2) = -1) then pList.Add(path.p2); end; for i := 0 to pList.Count - 1 do begin p1 := PDoublePOint(pList[i]); p1^:= Movepoint(p1^,dx,dy); end; Valid := True; if Control then begin for i := 0 to pList.Count - 1 do begin p1 := PDoublePOint(pList[i]); if (Not PathsValid(p1)) then Valid := False; end; end; if not Valid then begin for i := 0 to pList.Count - 1 do begin p1 := PDoublePOint(pList[i]); p1^:= Movepoint(p1^,-dx,-dy); end; end; fPaths.Free; pList.Free; //03.02.2012 ResetRegion; //03.02.2012 Modified := True; SetModified; end; procedure TNet.EqualTracePaths; var i: Integer; path: TnetPath; begin for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); if assigned(path.Opath) then begin path.p1.x := path.opath.p1.x; path.p1.y := path.opath.p1.y; path.p2.x := path.opath.p2.x; path.p2.y := path.opath.p2.y; end; end; end; function TNet.DeletePathSilent(Path: TnetPath): Boolean; var i: Integer; begin result := false; if assigned(UndoProc) then UndoProc; Paths.Remove(path); CombinePathsOfKnot(path.p1); CombinePathsOfKnot(path.p2); RefreshPoints; path.free; RefreshColPositions; RefreshPaths; result := true; end; procedure TNet.UpdateWallThick(Value: Double); var i,k: Integer; path: TNetPath; begin WallThick := Value; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); path.Width := Value; for k := 0 to path.Doors.Count - 1 do TnetDoor(path.Doors[k]).Width := Value; end; RefreshPaths; //03.02.2012 ResetRegion; //03.02.2012 Modified := True; SetModified; end; function TNet.FindLenToCloserStruct(p: TDoublePoint): Double; var i: Integer; cDist: Double; Struct: TNetStruct; begin result := -1; for i := 0 to Structs.Count - 1 do begin Struct := TNetStruct(Structs[i]); cDist := Struct.GetDistToPoint(p); if (i = 0) or (cDist < Result) then Result := cDist; end; end; function TNet.CreateMoveTrace: TFigure; var Path: TNetPath; index: Integer; Clone: TNet; MoveNet: TNet; MoveNetPathLen: Double; NetsByPt, NetsPathByPt: TList; //07.05.2012 NetByPt: TNet; NetPathByPt: TNetPath; NetPathByPtLen: Double; CanMergeNets: Boolean; RelNets: TList; //19.10.2010 //RelNets: TList; //07.05.2012 RelNet: TNet; RelDupNet: TNet; i: Integer; RelPathTrace: TPathTrace; NetList: TList; procedure CreateNetCloneForTrace(APathTrace: TPathTrace); begin Clone := APathTrace.Path.Net.DuplicateByPath(APathTrace.Path, false, true); Clone.FRelatedOwner := APathTrace; Clone.DrawStyle := dsTrace; Clone.color := clLime; Clone.Style := 1; Clone.width := 1; Clone.Brs := 1; Clone.RefreshPaths; Clone.DefineInOutPoints; APathTrace.Clone := Clone; //22.04.2011 APathTrace.FPathInClone := Clone.GetPathByPointsIn(APathTrace.Path.p1^, APathTrace.Path.p2^); if APathTrace.FPathInClone <> nil then APathTrace.FPathInCloneInversePt := Not PointNear(APathTrace.Path.p1^, APathTrace.FPathInClone.p1^); end; begin result := nil; if assigned(undoProc) then UndoProc; if SelType = stPath then begin // Tolik 28/09/2016-- модет придти нолик - получис АВ (что и наблюдальсь ранее) // index := SelIndex - 1; if SelIndex > 0 then index := SelIndex - 1 else exit; // if index < Paths.Count then begin Path := TNetPath(Paths[Index]); if Path.DoorIndex > -1 then begin Result := TDoorTrace.Create(Self, path, Path.ActiveDoor); end else begin //Clone := DuplicateByPath(Path, false, true); //Clone.DrawStyle := dsTrace; //Clone.color := clLime; //Clone.Style := 1; //Clone.width := 1; //Clone.Brs := 1; //Clone.RefreshPaths; //Clone.DefineInOutPoints; MoveNet := Self; MoveNetPathLen := GetLineLenght(Path.p1^, Path.p2^); //07.05.2012 - ищем Net с самым большим сегментом, в который попадают точки Path.p1, Path.p2 NetsPathByPt := TList.Create; NetsByPt := GetNetsByPoints(TPowerCad(Owner), Path.p1, Path.p2, NetsPathByPt); for i := 0 to NetsByPt.Count - 1 do begin NetByPt := TNet(NetsByPt[i]); if NetByPt <> Self then begin CanMergeNets := true; if Assigned(FOnMergeNetsQuery) then FOnMergeNetsQuery(Self, NetByPt, CanMergeNets); if CanMergeNets then begin NetPathByPt := NetsPathByPt[i]; NetPathByPtLen := GetLineLenght(NetPathByPt.p1^, NetPathByPt.p2^); if NetPathByPtLen > MoveNetPathLen then begin MoveNet := NetByPt; MoveNetPathLen := NetPathByPtLen; Path := NetPathByPt; end; end; end; end; NetsPathByPt.Free; NetsByPt.Free; Result := TPathTrace.Create(path, MoveNet, (ssShift in TPowercad(owner).CurrentShift), (ssCtrl in TPowercad(owner).CurrentShift)); //TPathTrace(Result).Clone := Clone; //22.04.2011 //TPathTrace(Result).FPathInClone := Clone.GetPathByPointsIn(Path.p1^, Path.p2^); //if TPathTrace(Result).FPathInClone <> nil then // TPathTrace(Result).FPathInCloneInversePt := Not PointNear(Path.p1^, TPathTrace(Result).FPathInClone.p1^); TPathTrace(Result).SnappedNearPoint := TPowercad(Owner).SnapToNearPoint; TPathTrace(Result).SnappedGrid := TPowerCad(Owner).SnapToGrids; TPathTrace(Result).SnappedGuide := TPowerCad(Owner).SnapToGuides; CreateNetCloneForTrace(TPathTrace(Result)); MoveNet.FRelatedNets.Clear; //19.10.2010 if Not Path.IsArc then begin RelNets := MoveNet.GetRelatedNetsByPoints(Path.p1, Path.p2, citNone, true); if RelNets <> nil then begin for i := 0 to RelNets.Count - 1 do begin RelNet := TNet(RelNets[i]); RelNet.ClearRels; RelDupNet := nil; if RelNet.FRelatedObject <> nil then begin if (RelNet.FRelatedObject is TNetPath) and Not TNetPath(RelNet.FRelatedObject).IsArc then begin //24.05.2011 //RelPathTrace := TPathTrace.Create(TNetPath(RelNet.FRelatedObject), RelNet, (ssShift in TPowercad(owner).CurrentShift), (ssCtrl in TPowercad(owner).CurrentShift)); // RelPathTrace.SnappedNearPoint := TPowercad(Owner).SnapToNearPoint; // RelPathTrace.SnappedGrid := TPowerCad(Owner).SnapToGrids; // RelPathTrace.SnappedGuide := TPowerCad(Owner).SnapToGuides; // RelPathTrace.FIsRelated := true; // CreateNetCloneForTrace(RelPathTrace); // // RelPathTrace.FRelatedOwner := Result; // TPathTrace(Result).FRelatedTraces.Add(RelPathTrace); RelNet.FRelatedMPath := TNetPath(RelNet.FRelatedObject); RelDupNet := RelNet.DuplicateByPath(TNetPath(RelNet.FRelatedObject), false, true); RelDupNet.FRelatedMPath := RelDupNet.GetPathByNearPoints(RelNet.FRelatedMPath.p1, RelNet.FRelatedMPath.p2); end; end else if RelNet.FRelatedPoints.Count > 0 then begin RelNet.FRelatedMPoint := PDoublePoint(RelNet.FRelatedPoints[0]); RelNet.FPathTracePoint := nil; // Находим с какой точкой связан TPathTrace(Result) if PointNear(RelNet.FRelatedMPoint^, TPathTrace(Result).p1) then RelNet.FPathTracePoint := @TPathTrace(Result).p1 else if PointNear(RelNet.FRelatedMPoint^, TPathTrace(Result).p2) then RelNet.FPathTracePoint := @TPathTrace(Result).p2; //24.05.2011 MoveNet.FRelatedNets.Add(RelNet); RelDupNet := RelNet.DuplicateByKnot(RelNet.FRelatedMPoint, true); //13.05.2011 RelDupNet := RelNet.DuplicateByKnot(RelNet.FRelatedMPoint); RelDupNet.FRelatedMPoint := RelDupNet.GetPointByNear(RelNet.FRelatedMPoint^); //24.05.2011 RelDupNet.DrawStyle := dsTrace; //24.05.2011 RelDupNet.color := clLime; //24.05.2011 RelDupNet.Style := 1; //24.05.2011 RelDupNet.width := 1; //24.05.2011 RelDupNet.Brs := 1; // Находим с какой точкой связан TPathTrace(Result) //if PointNear(RelDupNet.FRelatedMPoint^, TPathTrace(Result).p1) then // RelDupNet.FPathTracePoint := @TPathTrace(Result).p1 //else //if PointNear(RelDupNet.FRelatedMPoint^, TPathTrace(Result).p2) then // RelDupNet.FPathTracePoint := @TPathTrace(Result).p2; RelDupNet.FPathTracePoint := RelNet.FPathTracePoint; //24.05.2011 RelDupNet.FRelatedOwner := Result; //24.05.2011 TPathTrace(Result).FRelatedNets.Add(RelDupNet); end else if CanMoveJoined then begin RelDupNet := TNet(RelNet.Duplicate); RelDupNet.SetPathsHidden(true); end; if RelDupNet <> nil then //24.05.2011 begin MoveNet.FRelatedNets.Add(RelNet); RelDupNet.DrawStyle := dsTrace; RelDupNet.color := clLime; RelDupNet.Style := 1; RelDupNet.width := 1; RelDupNet.Brs := 1; RelDupNet.FRelatedOwner := Result; TPathTrace(Result).FRelatedNets.Add(RelDupNet); RelDupNet.RefreshPaths; RelDupNet.DefineInOutPoints; end; end; RelNets.Free; end; if Assigned(FOnDefineMoveObjects) then begin NetList := TList.Create; NetList.Assign(TPathTrace(Result).FRelatedNets); NetList.Insert(0, TPathTrace(Result).Clone); if FOnDefineMoveObjects(MoveNet, nil, Path, NetList) then begin for i := 0 to NetList.Count - 1 do begin TNet(NetList[i]).SetPathsHidden(false); end; end; NetList.Free; end; end; end; end; end; end; procedure TNet.CollectBoundPoints(p: TNetPath; var BPoints1,BPoints2: TDoublePointArr; APathTrace: TPathTrace=nil); var i: Integer; path: TNetPath; ShowPathLengthType: TShowPathLengthType; //procedure AddWidth(var AWidthInner, AWidthOuter: Double; APath: TNetPath); //begin //if (BWidth1 = 0) or (BWidth < APath.Width) then //BWidth := APath.Width; //AWidthInner := APath. //end; procedure AddWidth(ANumPt, APathPt: Integer; APath: TNetPath); var pt, PathPt: PDoublePoint; NDrawPt, NDrawPtFrom: TDoublePoint; begin pt := nil; case ANumPt of 1: begin if APathTrace <> nil then begin APathTrace.WidthInner1 := APath.InnerLen; APathTrace.WidthOut1 := APath.OutLen; end; pt := p.p1; end; 2: begin if APathTrace <> nil then begin APathTrace.WidthInner2 := APath.InnerLen; APathTrace.WidthOut2 := APath.OutLen; end; pt := p.p2; end; end; APath.DefineInOutPoints; PathPt := nil; NDrawPt := DoublePoint(0,0); NDrawPtFrom := DoublePoint(0,0); {//28.04.2012 case APathPt of 1: begin PathPt := APath.p1; case ShowPathLengthType of sltPoints: begin NDrawPt := APath.p1^; NDrawPtFrom := APath.p2^; end; sltInner: begin NDrawPt := APath.ip1^; NDrawPtFrom := APath.ip2^; end; sltOuter: begin NDrawPt := APath.op1^; NDrawPtFrom := APath.op2^; end; end; end; 2: begin PathPt := APath.p2; case ShowPathLengthType of sltPoints: begin NDrawPt := APath.p2^; NDrawPtFrom := APath.p1^; end; sltInner: begin NDrawPt := APath.ip2^; NDrawPtFrom := APath.ip1^; end; sltOuter: begin NDrawPt := APath.op2^; NDrawPtFrom := APath.op1^; end; end; end; end;} //28.04.2012 PathPt := APath.GetPointByLenghType(APathPt, sltPoints); NDrawPt := APath.GetPointByLenghType(APathPt, ShowPathLengthType)^; NDrawPtFrom := APath.GetPointByLenghType(GetOtherSide(APathPt), ShowPathLengthType)^; if (pt <> nil) and (PathPt <> nil) then begin PointToLine(pt^, PathPt^, NDrawPt.x, NDrawPt.y); PointToLine(pt^, PathPt^, NDrawPtFrom.x, NDrawPtFrom.y); case APathPt of 1: begin SetLength(BPoints1,Length(BPoints1)+1); BPoints1[Length(BPoints1)-1] := APath.p1^; if APathTrace <> nil then begin SetLength(APathTrace.NDrawPoints1,Length(APathTrace.NDrawPoints1)+1); APathTrace.NDrawPoints1[Length(APathTrace.NDrawPoints1)-1] := NDrawPt; APathTrace.FDrawP1 := NDrawPtFrom; end; end; 2: begin SetLength(BPoints2,Length(BPoints2)+1); BPoints2[Length(BPoints2)-1] := APath.p2^; if APathTrace <> nil then begin SetLength(APathTrace.NDrawPoints2,Length(APathTrace.NDrawPoints2)+1); APathTrace.NDrawPoints2[Length(APathTrace.NDrawPoints2)-1] := NDrawPt; APathTrace.FDrawP2 := NDrawPtFrom; end; end; end; end; end; begin SetLength(BPoints1,0); SetLength(BPoints2,0); if APathTrace <> nil then begin APathTrace.WidthInner1 := 0; APathTrace.WidthInner2 := 0; APathTrace.WidthOut1 := 0; APathTrace.WidthOut2 := 0; SetLength(APathTrace.NDrawPoints1,0); SetLength(APathTrace.NDrawPoints2,0); end; ShowPathLengthType := sltInner; if Assigned(p.FOnGetShowPathTraceLengthType) then ShowPathLengthType := p.FOnGetShowPathTraceLengthType(p); for i := 0 to Paths.Count - 1 do begin path := TNetPath(paths[i]); if path <> p then begin if (path.p1 = p.p1) then begin //18.04.2011 SetLength(BPoints1,Length(BPoints1)+1); //18.04.2011 BPoints1[Length(BPoints1)-1] := path.p2^; AddWidth(1, 2, path); end else if (path.p2 = p.p1) then begin //18.04.2011 SetLength(BPoints1,Length(BPoints1)+1); //18.04.2011 BPoints1[Length(BPoints1)-1] := path.p1^; AddWidth(1, 1, path); end else if (path.p1 = p.p2) then begin //18.04.2011 SetLength(BPoints2,Length(BPoints2)+1); //18.04.2011 BPoints2[Length(BPoints2)-1] := path.p2^; AddWidth(2, 2, path); end else if (path.p2 = p.p2) then begin //18.04.2011 SetLength(BPoints2,Length(BPoints2)+1); //18.04.2011 BPoints2[Length(BPoints2)-1] := path.p1^; AddWidth(2, 1, path); end; end; end; end; procedure TNet.DeleteNonePaths; var i, k: Integer; path: TNetPath; delList: Tlist; xPath: TnetPath; begin DelList := TList.Create; for i := 0 to Paths.Count - 1 do begin path := TnetPath(Paths[i]); if EqDp(path.p1^,path.p2^) then begin DelList.Add(path); for k := 0 to Paths.Count - 1 do begin xPath := TnetPath(Paths[k]); if DelList.IndexOf(xPath) = -1 then begin if (xPath.p1 = path.p2) then xPath.p1 := path.p1 else if (xPath.p2 = path.p2) then xPath.p2 := path.p1; end; end; end; end; try for i := 0 to DelList.Count - 1 do begin xPath := TnetPath(Dellist[i]); Paths.Remove(xPath); xPath.Free; end; except // ShowMessage(CPowerCadMessage + 'TNet.DeleteNonePaths'); end; if Dellist.Count > 0 then RefreshPoints; Dellist.Free; end; procedure TNet.FindBottomPaths(pathList, ReList: TList); var i: Integer; mp,cp: TDoublePoint; path: TnetPath; begin cp := GetCenterOfPaths(pathList); for i := 0 to pathList.Count - 1 do begin path:= TnetPath(Pathlist[i]); mp := MPoint(path.p1^,path.p2^); if (mp.y > cp.y) and (path.PosType <> ptVertical) then Relist.Add(Path); end; end; function TNet.FindClosedRegions(pathList:TList): TList; var vetPaths: TList; horPaths: TList; path: TnetPath; i: Integer; Points: TStringList; Points2: TStringList; begin Result := nil; //#From Oleg# //14.09.2010 vetPaths := TList.Create; horPaths := TList.Create; Points := TStringList.Create; Points2 := TStringList.Create; try for i := 0 to pathList.Count - 1 do begin path := TnetPath(Pathlist[i]); Points.Add('(p1.x, p1.y) (p2.x, p2.y) ('+FloatToStr(path.p1^.x)+' '+FloatToStr(path.p1^.y)+') ('+FloatToStr(path.p2^.x)+' '+FloatToStr(path.p2^.y)+')'); Points2.Add('(a1.x, a1.y)-(b1.x, b1.y) (a2.x, a2.y)-(b2.x, b2.y) ('+ FloatToStr(path.a1.x)+' '+FloatToStr(path.a1.y)+')-('+FloatToStr(path.b1.x)+' '+FloatToStr(path.b1.y)+')'+ FloatToStr(path.a2.x)+' '+FloatToStr(path.a2.y)+')-('+FloatToStr(path.b2.x)+' '+FloatToStr(path.b2.y)+')' ); if path.PosType = ptHorizontal then horPaths.Add(path) else if path.PosType = ptVertical then vetPaths.Add(path); end; finally FreeAndNil(Points); FreeAndNil(Points2); FreeAndNil(vetPaths); FreeAndNil(horPaths); end; end; procedure TNet.FindLeftPaths(pathList, ReList: TList); var i: Integer; mp,cp: TDoublePoint; path: TnetPath; begin cp := GetCenterOfPaths(pathList); for i := 0 to pathList.Count - 1 do begin path := TnetPath(Pathlist[i]); mp := MPoint(path.p1^,path.p2^); if (mp.x < cp.x) and (path.PosType <> ptHorizontal) then Relist.Add(Path); end; end; procedure TNet.FindRightPaths(pathList, ReList: TList); var i: Integer; mp,cp: TDoublePoint; path: TnetPath; begin cp := GetCenterOfPaths(pathList); for i := 0 to pathList.Count - 1 do begin path:= TnetPath(Pathlist[i]); mp := MPoint(path.p1^,path.p2^); if (mp.x > cp.x) and (path.PosType <> ptHorizontal) then Relist.Add(Path); end; end; procedure TNet.FindTopPaths(pathList, ReList: TList); var i: Integer; mp,cp: TDoublePoint; path: TnetPath; begin cp := GetCenterOfPaths(pathList); for i := 0 to pathList.Count - 1 do begin path:= TnetPath(Pathlist[i]); mp := MPoint(path.p1^,path.p2^); if (mp.y < cp.y) and (path.PosType <> ptVertical) then Relist.Add(Path); end; end; function TNet.GetCenterOfPaths(Paths: TList): TDoublePoint; var i: Integer; path: TNetPath; px,py: Double; minx,miny,maxX,maxY: Double; begin result := DoublePOint(0,0); if paths.Count = 0 then exit; Path := TNetPath(Paths[0]); minx := path.p1^.x; miny := path.p1^.y; maxx := path.p1^.x; maxy := path.p1^.y; for i:= 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); px := path.p1^.x; py := path.p1^.y; if px < minx then minx := px; if py < miny then miny := py; if px > maxx then maxx := px; if py > maxy then maxy := py; px := path.p2^.x; py := path.p2^.y; if px < minx then minx := px; if py < miny then miny := py; if px > maxx then maxx := px; if py > maxy then maxy := py; end; Result := DoublePoint((minx + maxx) / 2, (miny + maxy) / 2); end; function TNet.FindMostEPath(pathList: TList): TNetPath; var path: TnetPath; mp: TDoublePOint; ms,ds,mE,dE: Double; i: Integer; begin result := nil; if pathList.Count = 0 then exit; path := TnetPath(pathList[0]); mp := MPoint(path.p1^,path.p2^); mS := WorkHeight - mp.y; mE := mp.x; for i := 1 to pathList.Count - 1 do begin path := TnetPath(pathList[i]); mp := MPoint(path.p1^,path.p2^); dS := WorkHeight-mp.y; dE := mp.x; if dE > mE then begin result := path; mS := ds; mE := dE; end; end; end; procedure TNet.DeleteRegions; var i: Integer; path: TnetPath; begin if PathRgn <> 0 then // Tolik 21/11/2019 -- DeleteObject(PathRgn); PathRgn := 0; for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); Path.DeleteRegions; end; end; procedure TNet.DivSelPath(mp: TDoublePOint); var index,i: Integer; path: TNetPath; xp1,xp2:TdoublePoint; xp,op:PDoublePoint; begin if (SelIndex > 0) and (selType = stPath) then begin index := SelIndex-1; if assigned(undoProc) then UndoProc; if index < Paths.Count then begin Path := TNetPath(Paths[Index]); Path.BeforeDiv; //06.10.2010 try xp1 := path.p1^; xp2 := path.p2^; PointtoLine(xp1,xp2,mp.x,mp.y); xp := InsertKnot(mp); RefreshPaths; finally Path.AfterDiv; end; end; end; end; function TNet.DivPath(APath: TNetPath; APoint: TDoublePoint): PDoublePoint; var xp1,xp2:TdoublePoint; xp,op:PDoublePoint; begin Result := nil; if APath.Net = Self then begin APath.BeforeDiv; //06.10.2010 try xp1 := APath.p1^; xp2 := APath.p2^; PointtoLine(xp1,xp2,APoint.x,APoint.y); xp := InsertKnot(APoint); Result := xp; RefreshPaths; finally APath.AfterDiv; //06.10.2010 end; end; end; procedure TNet.DrawRelated(DEngine: TPCDrawEngine; isGrayed: Boolean); var i: Integer; begin try for i := 0 to FRelatedNets.Count - 1 do TNet(FRelatedNets[i]).draw(DEngine, isGrayed); except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; procedure TNet.DoClick(X, Y: Double); var Path, NetSelPath: TNetPath; ModPoint: TModPoint; SelectedPt: Boolean; PathChild: TNetDoor; begin if Not FFigureModification and Not CheckOtherNetModification then begin SelectedPt := false; if (Self.SelPt <> nil) then begin //ModPoint := TPCDrawing(Self.Owner).HitTestModPoint(x,y); //if (ModPoint <> nil) and (ModPoint.Figure = Self.Net) and (ModPoint.SeqNbr = Self.FSelPtIdx) then if PointNear(PDoublePoint(Points[FSelPtIdx])^, DoublePoint(x, y)) then begin SelectedPt := true; Self.DoClickPoint(PDoublePoint(Points[FSelPtIdx])); end; end; if Not SelectedPt then begin Path := nil; NetSelPath := Self.SelPath; //22.08.2011 if (NetSelPath <> nil) and (NetSelPath.IsPointIn(x, y)) then Path := NetSelPath else Path := Self.GetPathOfPoint(x, y); if Path <> nil then begin PathChild := Path.ActiveDoor; if PathChild <> nil then PathChild.DoClick else Path.DoClick(x, y); end; end; end; end; procedure TNet.DoClickPoint(APoint: PDoublePoint); var PointIndex: Integer; begin SelectPt(APoint); //ReSelect; // Сбросить ModPoint сегмента и получить ModPoint точки if Assigned(FOnSelectPoint) then begin FSelectingPt := true; try PointIndex := Points.IndexOf(APoint); if PointIndex <> -1 then FOnSelectPoint(Self, APoint, Integer(FPointIDs[PointIndex])); finally FSelectingPt := false; end; end; end; procedure TNet.DefineInOutPoints; var i: Integer; begin for i := 0 to Paths.Count - 1 do if Not TNetPath(Paths[i]).FIsHidden then TNetPath(Paths[i]).DefineInOutPoints; end; procedure TNet.DeleteNet; var Net: TNet; Path: TNetPath; Col: TNetCol; i: integer; begin if Not FDeleting then begin Net := Self; i := 0; while i < Net.Paths.Count do begin Path := TNetPath(Net.Paths[i]); Net.DeletePath(Path); end; i := 0; while i < Net.Structs.Count do begin Col := TNetCol(Net.Structs[i]); Net.DeleteStruct(Col); end; DoDelete; if Assigned(Parent) and (Parent is TFigureGrp) then TFigureGrp(Parent).RemoveFromGrp(Self); TPowerCad(Owner).Figures.Remove(Self); end; end; procedure TNet.AfterUndo(Sender: TObject); var i: integer; Path: TNetPath; begin for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); Path.AfterLoadProps; end; end; function TNet.CanMoveJoined: Boolean; begin Result := Not (ssAlt in GGlobalShiftState); //Not (ssShift in GGlobalShiftState); end; Function TNet.CheckForPoints(pp: TDoublePoint; aPrevPoint: PDoublePoint = nil): PDoublePoint; var xp: PDoublePoint; k: Integer; LastDist: Double; CurrDist: Double; begin result := nil; LastDist := -1; for k := 0 to Points.Count - 1 do begin if Points[k] <> aPrevPoint then begin xp := PDoublePoint(Points[k]); //if EQDP(xp^, pp) then // begin CurrDist := GetLineLenght(xp^, pp); if CurrDist <= (WallThick / 2) then begin if (LastDist = -1) or (LastDist > CurrDist) then begin LastDist := CurrDist; result := xp; //exit; end; end; end; end; end; function TNet.CheckIntersect(ANet: TNet): Boolean; var i: integer; begin Result := false; for i := 0 to ANet.Points.Count - 1 do if Self.GetPointByNear(PDoublePoint(ANet.Points[i])^) <> nil then begin Result := true; Break; //// BREAK //// end; end; function TNet.CheckLocatePoint(p: PDoublePoint; x, y: Double): Boolean; var oldx,oldy: Double; begin oldx := p.x; oldy := p.y; p.x := x; p.y := y; Result := PathsValid(p); p.x := oldx; p.y := oldy; end; function TNet.CheckOtherNetModification: Boolean; var TraceFigure: TFigure; begin Result := false; try TraceFigure := TPCDrawing(Self.Owner).TraceFigure; if Assigned(TraceFigure) and (TraceFigure is TNet) then begin if (TNet(TraceFigure).FSrcNet <> nil) and (TNet(TraceFigure).FSrcNet.FFigureModification) then Result := true; end; except end; end; function TNet.CheckPtInJoinedMove(Apt: PDoublePoint): Boolean; var i: Integer; Path: TNetPath; begin Result := false; if FJoinedMovePoints.IndexOf(Apt) <> -1 then Result := true else for i := 0 to FJoinedMovePaths.Count - 1 do begin Path := TNetPath(FJoinedMovePaths[i]); if (Path.p1 = Apt) or (Path.p2 = Apt) then begin Result := true; Break; //// BREAK //// end; end; end; procedure TNet.ClearRels; begin FRelatedNets.Clear; FRelatedOwner := nil; FRelatedMPoint := nil; FRelatedMPath := nil; end; procedure TNet.ClearSavedScaledPoints; begin ClearPointsList(FSavedScaledPoints); end; procedure TNet.ClearSavedPoints; //var // i: Integer; begin //for i := 0 to FSavedPoints.Count - 1 do // FreeMem(FSavedPoints[i], SizeOf(TDoublePoint)); //FSavedPoints.Clear; ClearPointsList(FSavedPoints); end; procedure TNet.ClearPointsList(AList: TList); var i: Integer; begin for i := 0 to AList.Count - 1 do FreeMem(AList[i], SizeOf(TDoublePoint)); AList.Clear; end; function TNet.CmpIntersectPaths(p1,p2, ap1, ap2: PDoublePoint; MarginDelta:Double = 2; AEqualRotate: Pointer=nil): Integer; var p1InAPath, p2InAPath: Boolean; ap1InPath, ap2InPath: Boolean; begin Result := citNone; if AEqualRotate <> nil then Boolean(AEqualRotate^) := false; if (PointNear(p1^, ap1^) and PointNear(p2^, ap2^)) then Result := citEqual else if (PointNear(p1^, ap2^) and PointNear(p2^, ap1^)) then begin Result := citEqual; if AEqualRotate <> nil then Boolean(AEqualRotate^) := true; end else begin p1InAPath := isPointInLine(ap1^, ap2^, p1^,1,MarginDelta); p2InAPath := isPointInLine(ap1^, ap2^, p2^,1,MarginDelta); ap1InPath := isPointInLine(p1^,p2^, ap1^,1,MarginDelta); ap2InPath := isPointInLine(p1^,p2^, ap2^,1,MarginDelta); if p1InAPath and p2InAPath then Result := citEntry else if ap1InPath and ap2InPath then Result := citAbsorb else if p1InAPath or p2InAPath or ap1InPath or ap2InPath then Result := citSide; end; end; function TNet.CmpDP(p1,p2: PDoublePoint): Boolean; begin Result := false; if FCmpPointPrecision <> -1 then Result := PointNear(p1^,p2^, FCmpPointPrecision) else Result := EQDP(p1^, p2^); end; function TNet.CreateDuplicate: TNet; var Res: TNet; i,j: Integer; path, xPath: TNetPath; door, XDoor: TNetDoor; pId: Integer; p1,p2: PDoublePoint; pt1: TnetPath; begin Result := nil; Res := Tnet.Create(LayerHandle, DrawStyle, Owner); Res.FSrcNet := Self; //21.10.2010 Res.MapScale := MapScale; Res.WorldDim := WorldDim; Res.Clear; For i := 0 to Points.Count - 1 do begin p1 := PDoublePoint(points[i]); res.AddPoint(p1^); end; for i := 0 to Paths.Count - 1 do begin p1 := nil; p2 := nil; xPath := nil; //#From Oleg# //14.09.2010 path := TNetPath(paths[i]); pId := Points.IndexOf(path.p1); if (pId > -1) and (pId < res.Points.Count) then p1 := PDoublePoint(res.Points[pId]); pId := Points.IndexOf(path.p2); if (pId > -1) and (pId < res.Points.Count) then p2 := PDoublePoint(res.Points[pId]); if assigned(p1) and assigned(p2) then xPath := res.AddPath(p1,p2,path.Border); if assigned(xPath) then begin xPath.Info := Path.Info; xPath.Width := Path.Width; xPath.AssignProps(Path); xPath.Opath := path; for j := 0 to path.Doors.Count - 1 do begin door := TNetDoor(path.Doors[j]); XDoor := TnetDoor.Create(door.Start,door.Width,door.Len,door.DoorObjType, xPath.net); XDoor.FPath := XPath; XDoor.DoorType := door.DoorType; XDoor.DoorObjType := door.DoorObjType; XDoor.FComponID := door.FComponID; XDoor.FSrcDoor := door; XDoor.FRotation := door.FRotation; XPath.doors.Add(XDoor); end; end; end; Tnet(Res).WallThick := WallThick; Tnet(Res).EndDraw := EndDraw; Tnet(Res).ContextMenu := ContextMenu; Tnet(Res).DrawGuides := DrawGuides; Tnet(Res).EditMode := EditMode; Result := res; //Result := TNet(duplicate); if Assigned(FOnDuplicate) then FOnDuplicate(Self, Result); end; procedure TNet.BeforeDelFromParent(Sender: TObject); begin //if Assigned(Parent) and (Parent is TFigureGrp) then // DoDelete; end; procedure TNet.DeletePoint(APoint: PDoublePoint); var Index: Integer; begin Index := Points.IndexOf(APoint); if Index <> -1 then begin if Assigned(FOnDeletePoint) then FOnDeletePoint(Self, APoint, Integer(FPointIDs[Index])); Points.Delete(Index); Dispose(APoint); FPointIDs.Delete(Index); end; end; procedure TNet.DeSelect; begin // Если не выделяем этот объект снова для выделения другого сегмента if Not ((ssCtrl in GGlobalShiftState) and TPCDrawing(Owner).FIsSelectingFig) then begin inherited ; if Not FDeleting then begin SelectPath(0); SelectPt(nil); end; end; end; procedure TNet.DoDelete; begin if Not FDeleting then begin FDeleting := true; if Assigned(FOnDelete) then FOnDelete(Self); end; end; procedure TNet.DoResize; begin if Assigned(FOnResize) then FOnResize(Self); end; function TNet.FindPathInRelatedNearPoints(Ap1, Ap2: PDoublePoint): TNetPath; var i: Integer; begin Result := nil; for i := 0 to FRelatedNets.Count - 1 do begin Result := TNet(FRelatedNets[i]).GetPathByNearPoints(Ap1, Ap2); if Result <> nil then Break; //// BREAK //// end; end; function TNet.ExistsPathOnPathTrajectory(aPath: TNetPath; beginP1, beginP2: PDoublePoint): Boolean; var i: Integer; Path: TNetPath; begin Result := false; for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); if Path <> aPath then begin if (IsPointInLine(beginP1^, aPath.p1^, Path.p1^, 1, 0.1) and IsPointInLine(beginP2^, aPath.p2^, Path.p2^, 1, 0.1)) or (IsPointInLine(beginP1^, aPath.p1^, Path.p2^, 1, 0.1) and IsPointInLine(beginP2^, aPath.p2^, Path.p1^, 1, 0.1)) then begin Result := true; Break; //// BREAK //// end; end; end; end; function TNet.GetContureByPt: TDoublePointArr; var i: integer; basep, p, ConnPt, ConnCheckPt: PDoublePoint; LookedPoints: TList; NextPath, Path: TNetPath; Done: Boolean; PIndex: integer; procedure AddPoint(pt: PDoublepoint); begin SetLength(Result, Length(Result) + 1); Result[Length(Result)-1] := pt^; LookedPoints.Add(pt); end; begin try SetLength(Result, 0); basep := nil; if Paths.Count > 0 then basep := TNetPath(Paths[0]).p1; if basep <> nil then begin LookedPoints := TList.Create; Done := False; p := basep; repeat AddPoint(p); ConnPt := nil; for i := 0 to Paths.Count - 1 do begin Path := Paths[i]; ConnCheckPt := nil; if Path.p1 = p then ConnCheckPt := Path.p2 else if Path.p1 = p then ConnCheckPt := Path.p1; if (ConnCheckPt <> nil) and ((ConnCheckPt = basep) or (LookedPoints.IndexOf(ConnCheckPt) = -1)) then begin ConnPt := ConnCheckPt; Break; //// BREAK //// end; end; p := ConnPt; if (p = nil) or (ConnCheckPt = basep) then Done := true; until Done; LookedPoints.Free; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'GetContureByPt', E.Message); end; end; function TNet.GetLengthForShow(ALength: Double): Double; begin Result := ALength; if WorldDim then Result := Result / 1000 * MapScale else Result := Result / 10; end; function TNet.GetMainTraceNet: TNet; begin Result := nil; if Assigned(FRelatedOwner) then begin if (FRelatedOwner is TNet) then Result := TNet(FRelatedOwner) else if (FRelatedOwner is TPathTrace) then begin if Assigned(TPathTrace(FRelatedOwner).FRelatedOwner) then begin if TPathTrace(FRelatedOwner).FRelatedOwner is TPathTrace then if Assigned(TPathTrace(TPathTrace(FRelatedOwner).FRelatedOwner).Clone) then Result := TPathTrace(TPathTrace(FRelatedOwner).FRelatedOwner).Clone; end else if Assigned(TPathTrace(FRelatedOwner).Clone) then Result := TPathTrace(FRelatedOwner).Clone; end end else Result := Self; end; function TNet.GetObjInPoint(x, y: Double): TObject; var i: Integer; path: TNetPath; struct: TnetStruct; Obj: TObject; begin Result := nil; for i := 0 to Structs.Count - 1 do begin struct := TnetStruct(Structs[i]); if struct.IsPointIn(x, y) then begin Result := struct; exit; end; end; for i := 0 to Paths.Count - 1 do begin Path := TNetPath(paths[i]); Obj := Path.GetObjInPoint(x,y); if Obj <> nil then begin Result := Obj; exit; end; end; end; function TNet.GetPathByMainPoint(APoint: TDoublePoint): TNetPath; var i: Integer; Path: TNetPath; begin Result := nil; for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); if CmpPoints(Path.p1^, APoint) or CmpPoints(Path.p2^, APoint) then begin Result := Path; Exit; ///// EXIT ///// end; end; end; function TNet.GetPathByNearPoints(APoint1, APoint2: PDoublePoint; delta: Double=1): TNetPath; var i: Integer; Path: TnetPath; begin Result := nil; if (APoint1 <> nil) and (APoint2 <> nil) then begin for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); if (PointNear(APoint1^, Path.p1^, delta) and PointNear(APoint2^, Path.p2^, delta)) or (PointNear(APoint1^, Path.p2^, delta) and PointNear(APoint2^, Path.p1^, delta)) then begin Result := Path; Break; //// BREAK //// end; end; end; end; function TNet.GetPathByPointsIn(p1, p2: TDoublePoint): TNetPath; var i: Integer; path: TnetPath; begin Result := nil; for i := 0 to Paths.Count - 1 do begin path := TNetPath(Paths[i]); //if path.isPointIn(p1.x, p1.y) and path.isPointIn(p2.x, p2.y) then if isPointInLine(path.p1^,path.p2^,DoublePoint(p1.x, p1.y),1) and isPointInLine(path.p1^,path.p2^,DoublePoint(p2.x, p2.y),1) then begin Result := path; exit; end; end; end; function TNet.GetPathCountByPoint(aPt: PDoublePoint): Integer; var i: integer; begin Result := 0; if aPt <> nil then for i := 0 to Paths.Count - 1 do if TNeTPath(Paths[i]).isKnotIn(aPt) <> 0 then Inc(Result); end; function TNet.GetPathListByPoint(APoint: PDoublePoint): TList; var i: Integer; Path: TNetPath; begin Result := nil; if APoint <> nil then begin Result := TList.Create; for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); if (Path.p1 = APoint) or (Path.p2 = APoint) then Result.Add(Path); end; end; end; function TNet.GetPathListByPointID(APointID: Integer): TList; begin Result := GetPathListByPoint(GetPointByID(APointID)); end; function TNet.GetPoint(x,y: Double; AOtherNearPoints: TList=nil): PDoublePoint; var i: integer; pt: TDoublePoint; begin Result := nil; pt.x := x; pt.y := y; for i := 0 to Points.Count - 1 do begin if EQDP(PDoublePoint(Points[i])^, pt) then begin if (AOtherNearPoints <> nil) and (Result <> nil) then AOtherNearPoints.Add(Result); Result := Points[i]; Break; //// BREAK //// end; end; end; function TNet.GetPointByNear(ANearPoint: TDoublePoint; ASkipList: TList): PDoublePoint; var i: Integer; p: PDoublePoint; begin Result := nil; for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i]); if (Not Assigned(ASkipList) or (ASkipList.IndexOf(p)=-1)) and PointNear(ANearPoint, p^) then begin Result := p; Break; //// BREAK //// end; end; end; function TNet.GetPointsByNear(ANearPoint: TDoublePoint; ASkipList: TList=nil): TList; var i: Integer; p: PDoublePoint; begin Result := TList.Create; for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i]); if (Not Assigned(ASkipList) or (ASkipList.IndexOf(p)=-1)) and PointNear(ANearPoint, p^) then Result.Add(p); end; end; function TNet.GetPointByID(APointID: Integer): PDoublePoint; var PointIndex: Integer; begin Result := nil; PointIndex := FPointIDs.IndexOf(Pointer(APointID)); if PointIndex <> -1 then Result := Points[PointIndex]; end; function TNet.GetPointFromList(AList: TList; ANetPt: PDoublePoint): PDoublePoint; var Idx: Integer; begin Result := nil; if Points.Count = AList.Count then begin Idx := Points.IndexOf(ANetPt); if Idx <> -1 then Result := AList[Idx]; end; end; function TNet.GetPointID(APoint: PDoublePoint): Integer; var PointIndex: Integer; begin Result := 0; PointIndex := Points.IndexOf(APoint); if PointIndex <> -1 then Result := Integer(FPointIDs[PointIndex]); end; function TNet.GetPointPath(APoint: PDoublePoint): TNetPath; var i: Integer; begin Result := nil; for i := 0 to Paths.Count - 1 do if TNetPath(Paths[i]).SecondPoint(APoint) <> nil then begin Result := TNetPath(Paths[i]); Break; //// BREAK //// end; end; function TNet.GetSavedScaledPtByPoint(pt: PDoublePoint): PDoublePoint; begin Result := GetPointFromList(FSavedScaledPoints, pt); end; function TNet.GetSavedPtByPoint(pt: PDoublePoint): PDoublePoint; //var // Idx: Integer; begin //Result := nil; //if Points.Count = FSavedPoints.Count then //begin // Idx := Points.IndexOf(pt); // if Idx <> -1 then // Result := FSavedPoints[Idx]; //end; Result := GetPointFromList(FSavedPoints, pt); end; function TNet.GetSelectedObject: TObject; begin Result := Self.SelPath; if Result <> nil then if TNetPath(Result).ActiveDoor <> nil then Result := TNetPath(Result).ActiveDoor; end; function TNet.IsPathDrawed(ap1, ap2: PDoublePoint): Boolean; var i: integer; p1, p2: PDoublePoint; begin Result := false; for i := 0 to FDrawedPt1.Count - 1 do begin p1 := FDrawedPt1[i]; p2 := FDrawedPt2[i]; if (PointNear(p1^, ap1^) and PointNear(p2^, ap2^)) or (PointNear(p1^, ap2^) and PointNear(p2^, ap1^)) then begin Result := true; Break; //// BREAK //// end; end; end; function TNet.IsPointInArc(p: PDoublePoint): Boolean; var i: Integer; Path: TNetPath; begin Result := false; for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); if Path.isArc and ((Path.p1 = p) or (Path.p1 = p)) then begin Result := true; Break; //// BREAK //// end; end; end; function TNet.IsRectangle: Boolean; var Angle90Count: Integer; i, j: integer; FirstPt, PrevPt: PDoublePoint; Path, FirstPath, PrevPath, PathI, PathJ: TNetPath; LastDistToOrigin, DistToOrigin: Double; pc, pi, pj: PDoublePoint; Angle: Double; begin Result := false; // if Paths.Count >= 4 then begin Angle90Count := 0; //28.04.2012 - ищем сегмент, который ближе к началу координат - для того чтобы не бегать по перегородкам FirstPath := nil; FirstPt := nil; LastDistToOrigin := -1; for i := 0 to Points.Count - 1 do begin DistToOrigin := GetLineLength(DoublePoint(0,0), PDoublePoint(Points[i])^); if (FirstPt = nil) or (DistToOrigin < LastDistToOrigin) then begin FirstPt := Points[i]; LastDistToOrigin := DistToOrigin; end; end; if FirstPt <> nil then begin FirstPath := GetNetPathByP1P2(nil, FirstPt^);//777 Path := FirstPath; PrevPath := nil; PrevPt := FirstPt; while Path <> nil do begin // бывает подвисает // см. задачу: https://app.asana.com/0/388690353475548/876171867625289 // при такой конфигурации стен (важно где какой нод расположен) - https://prnt.sc/l90su0 // поэтому костыль - но желательно переделать пробежку по контуру // все одно Result в true только если Angle90Count = 4 if Angle90Count > 4 then break; if PrevPath <> nil then begin pc := PrevPt; pi := Path.OtherPoint(pc); pj := PrevPath.OtherPoint(pc); Angle := Abs(RadToDeg(GetRadOf2Lines(pi^, pc^, pj^))); Angle := CorrectAngle(Angle, 90); if Abs(Angle - 90) < 1 then Angle90Count := Angle90Count + 1 else begin Angle90Count := 5; Break; //// BREAK //// end; // Если полностю обошли контур - пришли на первый сегмент, то завершаем поиск углов if Path = FirstPath then Break; //// BREAK //// end; // Ищем след. сегмент PrevPath := Path; if PrevPt = Path.p1 then begin PrevPt := Path.p2; Path := GetNetPathByP1P2(Path, Path.p2^) end else if PrevPt = Path.p2 then begin PrevPt := Path.p1; Path := GetNetPathByP1P2(Path, Path.p1^) end else Path := nil; end; Result := Angle90Count = 4; end; {for i := 0 to Paths.Count - 1 do begin PathI := TNetPath(Paths[i]); for j := i+1 to Paths.Count - 1 do begin PathJ := TNetPath(Paths[j]); pc := PathI.GetConnectedPoint(PathJ); if pc <> nil then begin pi := PathI.OtherPoint(pc); pj := PathJ.OtherPoint(pc); Angle := Abs(RadToDeg(GetRadOf2Lines(pi^, pc^, pj^))); Angle := CorrectAngle(Angle); if Abs(Angle - 90) < 0.1 then Angle90Count := Angle90Count + 1 else begin Angle90Count := 5; Break; //// BREAK //// end; //pj //if end; end; end; Result := Angle90Count = 4;} end; end; Procedure TNet.ModifySelection(mm: TModifyMode; value: Integer); var i: Integer; PathList: TList; SlPath: TNetPath; begin inherited; {if SelPath <> nil then begin case mm of //mmPenColor : Color := value; mmPenWidth: SelPath.FPathWidth := value; mmPenStyle: SelPath.FPathStyle := TPenstyle(value); mmBrushStyle: SelPath.FBrushStyle := value; mmBrushColor : SelPath.FBrushColor := value; //mmRowStyle : RowStyle := value; end; end;} PathList := FSelection; if SelType = stStruct then PathList := Paths; for i := 0 to PathList.Count - 1 do begin SlPath := TNetPath(PathList[i]); if Paths.IndexOf(SlPath) <> -1 then case mm of mmPenColor : SlPath.FColor := value; mmPenWidth: SlPath.FPathWidth := value; mmPenStyle: SlPath.FPathStyle := TPenstyle(value); mmBrushStyle: SlPath.FBrushStyle := value; mmBrushColor : SlPath.FBrushColor := value; //mmRowStyle : RowStyle := value; end; end; end; function TNet.MoveJoinedPoints(ADeltaX, ADeltaY: Double; AFromSaved: Boolean): Boolean; var i: integer; pt, srcPt: PDoublePoint; RelType: Integer; Path: TNetPath; sign: integer; begin Result := false; if FJoinedMovePoints.Count = FJoinedMovePointsDirections.Count then begin for i := 0 to FJoinedMovePoints.Count - 1 do begin pt := FJoinedMovePoints[i]; srcPt := pt; // Если смещение относительно исходной позиции if AFromSaved then srcPt := GetSavedPtByPoint(pt); if srcPt <> nil then begin RelType := Integer(FJoinedMovePointsDirections[i]); sign := 0; if RelType = crtDirect then sign := 1 else if RelType = crtReverse then sign := -1; pt^.x := srcPt^.x + ADeltaX*sign; pt^.y := srcPt^.y + ADeltaY*sign; //if RelType = crtDirect then //begin // pt^.x := srcPt^.x + ADeltaX; // pt^.y := srcPt^.y + ADeltaY; //end //else if RelType = crtReverse then //begin // pt^.x := srcPt^.x + ADeltaX*(-1); // pt^.y := srcPt^.y + ADeltaY*(-1); //end; end; end; Result := FJoinedMovePoints.Count > 0; end; if Not AFromSaved and (FJoinedMovePaths.Count = FJoinedMovePathsDirections.Count) then begin for i := 0 to FJoinedMovePaths.Count - 1 do begin Path := TNetPath(FJoinedMovePaths[i]); RelType := Integer(FJoinedMovePathsDirections[i]); sign := 0; if RelType = crtDirect then sign := 1 else if RelType = crtReverse then sign := -1; Path.p1^.x := Path.p1^.x + ADeltaX*sign; Path.p1^.y := Path.p1^.y + ADeltaY*sign; Path.p2^.x := Path.p2^.x + ADeltaX*sign; Path.p2^.y := Path.p2^.y + ADeltaY*sign; end; if Not Result then Result := FJoinedMovePaths.Count > 0; end; if Result and Assigned(FOnMoveJoinedPoints) then begin FOnMoveJoinedPoints(Self); SetModified; //03.02.2012 ResetRegion; end; end; procedure TNet.RotateAllNiche; var i,j:Integer; Path: TNetPath; Door: TNetDoor; begin for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); for j := 0 to Path.Doors.Count - 1 do begin Door := TNetDoor(Path.Doors[j]); if Door.DoorObjType = dotNiche then Door.FRotation := Door.FRotation xor 1; end; end; end; //procedure TNet.RestorePointsFromSaved; //var // i: integer; //begin // if Points.Count = FSavedPoints.Count then // for i := 0 to Points.Count - 1 do // PDoublePoint(Points[i])^ := PDoublePoint(FSavedPoints[i])^; //end; procedure TNet.SaveScaledPoints; begin SavePointsToList(FSavedScaledPoints); end; procedure TNet.SavePoints; //var // i: Integer; // pt: PDoublePoint; begin //ClearSavedPoints; //for i := 0 to Points.Count - 1 do //begin // GetMem(pt, SizeOf(TDoublePoint)); // pt^ := PDoublePoint(Points[i])^; // FSavedPoints.Add(pt); //end; SavePointsToList(FSavedPoints); end; procedure TNet.SavePointsToList(AList: TList); var i: Integer; pt: PDoublePoint; begin ClearPointsList(AList); for i := 0 to Points.Count - 1 do begin GetMem(pt, SizeOf(TDoublePoint)); pt^ := PDoublePoint(Points[i])^; AList.Add(pt); end; end; procedure TNet.SelectAllPaths; begin FSelPtIdx := -1; FSelection.Clear; FSelection.Assign(Paths); end; function TNet.SelectNextPathByPt(x,y: Double): Boolean; var i, ResIdx: Integer; Path: TNetPath; begin Result := false; ResIdx := -1; for i := SelIndex to Paths.Count - 1 do //for i := Paths.Count - 1 downto SelIndex do begin if i >= 0 then begin Path := TNetPath(Paths[i]); if Path.IsPointIn(x, y) then begin SelectPath(i+1); ResIdx := i; Result := true; Break; //// BREAK //// end; end; end; //if ResIdx <> -1 then //begin // // Смещаем все с начала в конец, чтобы ResIdx был нулевой // for i := 0 to ResIdx - 1 do // Paths.Move(0, Paths.Count - 1); // SelectPath(1); // Result := true; //end; end; function TNet.SelectNextPointByPt(x,y: Double): Boolean; var i: Integer; Path: TNetPath; begin Result := false; for i := (FSelPtIdx + 1) to Points.Count - 1 do begin if i >= 0 then begin //if EQDP(PDoublePoint(Points[i])^, DoublePoint(x, y)) then if PointNear(PDoublePoint(Points[i])^, DoublePoint(x, y)) then begin SelectPt(PDoublePoint(Points[i])); Result := true; Break; //// BREAK //// end; end; end; end; procedure TNet.SelectPt(APt: PDoublEPoint); begin FSelPtIdx := Points.IndexOf(APt); SelIndex := 0; FSelection.Clear; end; procedure TNet.SelectPath(AIndex: Integer; AllowMultisel: Boolean=false); var Path: TNetPath; begin FSelPtIdx := -1; SelIndex := AIndex; SelType := stPath; if AIndex = 0 then FSelection.Clear else begin // Если не множественное выделение, то очищаем список выделенных if Not AllowMultisel or Not (ssCtrl in GGlobalShiftState) then FSelection.Clear; Path := TNetPath(Paths[SelIndex-1]); if FSelection.IndexOf(Path) = -1 then FSelection.Add(Path); end; end; procedure TNet.SetMapScale(AMapScale: Double); begin if Assigned(FOnSetScale) then FOnSetScale(Self, MapScale, AMapScale); MapScale := AMapScale; end; procedure TNet.SetPathsHidden(AHidden: Boolean); var i: integer; begin for i := 0 to Paths.Count - 1 do TNetPath(Paths[i]).FIsHidden := AHidden; end; procedure TNet.SetPointID(APoint: PDoublePoint; AID: Integer); var PointIndex: Integer; begin PointIndex := Points.IndexOf(APoint); if PointIndex <> -1 then FPointIDs[PointIndex] := Pointer(AID); end; {//24.05.2012 function TNet.GetRoomConture: TDoublePointArr; var i: integer; p, basep: TDoublePoint; NextPath: TNetPath; Done: Boolean; PIndex: integer; begin try Done := False; p := FindStartConturePPoint; basep := p; PIndex := 0; SetLength(Result, 0); NextPath := nil; while not Done do begin NextPath := GetNetPathByP1P2(NextPath, p); if NextPath <> nil then begin SetLength(Result, Length(Result) + 1); Result[PIndex] := p; if EQDP(NextPath.p1^, p) then p := NextPath.p2^ else if EQDP(NextPath.p2^, p) then p := NextPath.p1^; if EQDP(p, basep) then Done := True; PIndex := PIndex + 1; end else begin SetLength(Result, Length(Result) + 1); Result[PIndex] := p; Done := True; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetRoomConture', E.Message); end; end;} function TNet.GetRoomConture(aPaths: TList): TDoublePointArr; var i: integer; p, basep: PDoublePoint; PrevPt, OtherPt, PrevOtherPt: PDoublePoint; NextPath, PrevPath: TNetPath; Done: Boolean; PIndex: integer; pSide, pOtherSide: Integer; PrevPSide: Integer; ptrPerpendP: PDoublePoint; PerpendP1: TDoublePoint; PerpendP2: TDoublePoint; AddedPt: Boolean; ArcPoints: TDoublePointArr; // Tolik 23/08/2018 -- TmpPath: tNetPath; // function GetPerpendPtBySide(aPath: TNetPath; aSide: Integer): PDoublePoint; begin Result := nil; if aSide = 1 then begin if aPath.epl1 <> nil then Result := aPath.epl1 else if aPath.epr1 <> nil then Result := aPath.epr1; end else if aSide = 2 then begin if aPath.epl2 <> nil then Result := aPath.epl2 else if aPath.epr2 <> nil then Result := aPath.epr2; end; end; procedure AddPtToRes(aPt: PDoublePoint); var CanAdd: Boolean; begin CanAdd := true; if PIndex > 0 then CanAdd := EQDP(Result[PIndex-1], aPt^) = false; if CanAdd then begin SetLength(Result, Length(Result) + 1); Result[PIndex] := aPt^; PIndex := PIndex + 1; end; end; procedure AddPointsByPerpend(aPath: TNetPath; aSide: Integer; aPerpendPt: PDoublePoint; aDesc: Boolean); var AddPoints: TDoublePointArr; SidePt: PDoublePoint; MPtFrom, MPtTo: TDoublePoint; PtFromProjected: TDoublePoint; ptFrom, ptTo: PDoublepoint; begin Setlength(AddPoints, 0); // Определяем точку, с которой определен aPerpendPt SidePt := aPath.GetPointByPerpend(aPerpendPt); if SidePt <> nil then begin ptFrom := aPath.GetPointBySide(aSide); ptTo := aPath.GetPointBySide(GetOtherSide(aSide)); if (ptFrom <> nil) and (ptTo <> nil) then begin if aSide = 1 then begin MPtFrom := MPoint(aPath.el1, aPath.er1); MPtTo := MPoint(aPath.el2, aPath.er2); end else if aSide = 2 then begin MPtFrom := MPoint(aPath.el2, aPath.er2); MPtTo := MPoint(aPath.el1, aPath.er1); end; // Проецируем ptFrom на линию MPtFrom, MPtTo PtFromProjected := ptFrom^; PointToLineByAngle(MPtFrom, MPtTo, PtFromProjected); //SetLength(Result, Length(Result) + 2); //if Not aDesc then //begin // Result[PIndex] := PtFromProjected; // Result[PIndex+1] := MPtTo; //end //else //begin // Result[PIndex] := MPtTo; // Result[PIndex+1] := PtFromProjected; //end; //PIndex := PIndex + 2; if Not aDesc then begin AddPtToRes(@PtFromProjected); AddPtToRes(@MPtTo); end else begin AddPtToRes(@MPtTo); AddPtToRes(@PtFromProjected); end; end; end; end; begin try Done := False; NextPath := nil; // Tolik {$if Defined(ES_GRAPH_SC)} p := FindStartConturePoint(aPaths, @NextPath, @pSide); {$else} p := nil; if aPaths.Count > 0 then begin p := TNetPath(aPaths[0]).P1; if aPaths.Count = 1 then NextPath := TNetPath(aPaths[0]); pSide := 1; if aPaths.Count > 1 then begin NextPath := TNetPath(aPaths[1]); if ((CompareValue(NextPath.p1.x, p.x) <> 0) and (CompareValue(NextPath.p1.y, p.y) <> 0)) or ((CompareValue(NextPath.p2.x, p.x) <> 0) and (CompareValue(NextPath.p2.y, p.y) <> 0)) then begin p := TNetPath(aPaths[0]).P2; Pside := 2; end; {if ((CompareValue(NextPath.p1.x, p.x) = 0) and (CompareValue(NextPath.p1.y, p.y) = 0)) then pSide := 1 else if ((CompareValue(NextPath.p2.x, p.x) = 0) and (CompareValue(NextPath.p2.y, p.y) = 0)) then pSide := 2;} end; end; {$ifEND} if NextPath = nil then exit; // Tolik 23/08/2018 -- на всякий -- basep := p; PrevPt := nil; PrevOtherPt := nil; PrevPath := nil; PrevPSide := 0; PIndex := 0; SetLength(Result, 0); //23.05.2012 NextPath := nil; while not Done and (p <> nil) do begin if NextPath <> nil then begin pOtherSide := GetOtherSide(pSide); OtherPt := NextPath.GetPointBySide(pOtherSide); // Если другая точка сегмента - это предыдущая точка, то определяем с нее точки по перпендикуляру if OtherPt = PrevPt then begin //ptrPerpendP := GetPerpendPtBySide(PrevPath, GetOtherSide(PrevPSide)); //if ptrPerpendP <> nil then // AddPointsByPerpend(PrevPath, GetOtherSide(PrevPSide), ptrPerpendP, false) ptrPerpendP := GetPerpendPtBySide(NextPath, pOtherSide); if ptrPerpendP <> nil then AddPointsByPerpend(NextPath, pOtherSide, ptrPerpendP, false) else begin ptrPerpendP := GetPerpendPtBySide(NextPath, pSide); if ptrPerpendP <> nil then AddPointsByPerpend(NextPath, pSide, ptrPerpendP, true) end; end else if PrevPt = nil then begin ptrPerpendP := GetPerpendPtBySide(NextPath, pOtherSide); ptrPerpendP := GetPerpendPtBySide(NextPath, pSide); end; {if p = PrevOtherPt then begin ptrPerpendP := GetPerpendPtBySide(PrevPath, PrevPSide); if ptrPerpendP <> nil then AddPointsByPerpend(PrevPath, PrevPSide, ptrPerpendP, false) else begin ptrPerpendP := GetPerpendPtBySide(NextPath, pSide); if ptrPerpendP <> nil then AddPointsByPerpend(PrevPath, PrevPSide, ptrPerpendP, false) end; end;} end; if (p = basep) and (PrevPt <> nil) then Done := True; if Not Done then begin AddedPt := false; SetLength(Result, Length(Result) + 1); //28.05.2012 Result[PIndex] := p^; //Result[PIndex] := p^; if NextPath.isArc then begin //DxfMode16 := true; DxfMode32 := true; try NextPath.FillArcPointsByEndPoints(ArcPoints, NextPath.p1, NextPath.p2, false); finally //DxfMode16 := false; DxfMode32 := false; end; if Length(ArcPoints) > 2 then begin SetLength(Result, Length(Result) + Length(ArcPoints)); // Первую и последнюю точки пропускаем for i := 0 to Length(ArcPoints) - 1 do if p = NextPath.p2 then Result[i+PIndex] := ArcPoints[Length(ArcPoints)-i-1] else Result[i+PIndex] := ArcPoints[i]; end; PIndex := PIndex + Length(ArcPoints); Result[PIndex] := p^; AddedPt := true; end; //else //if PrevPath <> nil then // if PrevPath.isArc then // begin // Result[PIndex] := p^; // AddedPt := true; // end; if Not AddedPt then begin if pSide = 1 then Result[PIndex] := MPoint(NextPath.a1, NextPath.b1) //MPoint(NextPath.r1, NextPath.l1) else if pSide = 2 then Result[PIndex] := MPoint(NextPath.a2, NextPath.b2) //MPoint(NextPath.r2, NextPath.l2) else // На всякий случай Result[PIndex] := p^; AddedPt := true; end; PIndex := PIndex + 1; PrevPath := NextPath; PrevPSide := pSide; PrevOtherPt := OtherPt; NextPath := GetNextNetPathByP1P2(aPaths, NextPath, p); if NextPath <> nil then begin if NextPath.isArc then Result[PIndex-1] := p^; PrevPt := p; if NextPath.p1 = p then begin p := NextPath.p2; pSide := 2; end else if NextPath.p2 = p then begin p := NextPath.p1; pSide := 1; end; end else Done := True; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetRoomConture', E.Message); end; end; function TNet.GetRoomSCSConture(aPaths: TList=nil): TDoublePointArr; // Tolik 27/06/2018 -- var i: Integer; begin end; {//24.05.2012 function TNet.GetRoomInnerConture: TDoublePointArr; var i: integer; p, r, basep: TDoublePoint; PrevPath, NextPath: TNetPath; Done: Boolean; PIndex: integer; begin try Done := False; p := FindStartConturePPoint; basep := p; PIndex := 0; SetLength(Result, 0); PrevPath := nil; NextPath := nil; while not Done do begin NextPath := GetNetPathByP1P2(PrevPath, p); if NextPath <> nil then begin SetLength(Result, Length(Result) + 1); if EQDP(NextPath.p1^, p) then begin Result[PIndex] := NextPath.r1; p := NextPath.p2^; end else if EQDP(NextPath.p2^, p) then begin Result[PIndex] := NextPath.r2; p := NextPath.p1^; end; if EQDP(p, basep) then Done := True; PIndex := PIndex + 1; PrevPath := NextPath; end else begin SetLength(Result, Length(Result) + 1); if EQDP(PrevPath.p1^, p) then begin Result[PIndex] := PrevPath.r1; end else if EQDP(PrevPath.p2^, p) then begin Result[PIndex] := PrevPath.r2; end; Done := True; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetRoomInnerConture', E.Message); end; end;} function TNet.GetRoomInnerConture: TDoublePointArr; var i: integer; p, r, basep: TDoublePoint; PrevPath, NextPath: TNetPath; Done: Boolean; PIndex: integer; begin try Done := False; p := FindStartConturePPoint; basep := p; PIndex := 0; SetLength(Result, 0); PrevPath := nil; NextPath := nil; while not Done do begin NextPath := GetNetPathByP1P2(PrevPath, p); if NextPath <> nil then begin SetLength(Result, Length(Result) + 1); if EQDP(NextPath.p1^, p) then begin Result[PIndex] := NextPath.ip1^; p := NextPath.p2^; end else if EQDP(NextPath.p2^, p) then begin Result[PIndex] := NextPath.ip2^; p := NextPath.p1^; end; if EQDP(p, basep) then Done := True; PIndex := PIndex + 1; PrevPath := NextPath; end else begin SetLength(Result, Length(Result) + 1); if EQDP(PrevPath.p1^, p) then begin Result[PIndex] := PrevPath.ip1^; end else if EQDP(PrevPath.p2^, p) then begin Result[PIndex] := PrevPath.ip2^; end; Done := True; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetRoomInnerConture', E.Message); end; end; {//24.05.2012 function TNet.GetRoomOuterConture: TDoublePointArr; var i: integer; p, l, basep: TDoublePoint; PrevPath, NextPath: TNetPath; Done: Boolean; PIndex: integer; begin try Done := False; p := FindStartConturePPoint; basep := p; PIndex := 0; SetLength(Result, 0); PrevPath := nil; NextPath := nil; while not Done do begin NextPath := GetNetPathByP1P2(NextPath, p); if NextPath <> nil then begin SetLength(Result, Length(Result) + 1); Result[PIndex] := p; if EQDP(NextPath.p1^, p) then begin Result[PIndex] := NextPath.l1; p := NextPath.p2^; end else if EQDP(NextPath.p2^, p) then begin Result[PIndex] := NextPath.l2; p := NextPath.p1^; end; if EQDP(p, basep) then Done := True; PIndex := PIndex + 1; PrevPath := NextPath; end else begin SetLength(Result, Length(Result) + 1); if EQDP(PrevPath.p1^, p) then begin Result[PIndex] := PrevPath.l1; end else if EQDP(PrevPath.p2^, p) then begin Result[PIndex] := PrevPath.l2; end; Done := True; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetRoomOuterConture', E.Message); end; end; } function TNet.GetRoomOuterConture: TDoublePointArr; var i: integer; p, l, basep: TDoublePoint; PrevPath, NextPath: TNetPath; Done: Boolean; PIndex: integer; begin try Done := False; p := FindStartConturePPoint; basep := p; PIndex := 0; SetLength(Result, 0); PrevPath := nil; NextPath := nil; while not Done do begin NextPath := GetNetPathByP1P2(NextPath, p); if NextPath <> nil then begin SetLength(Result, Length(Result) + 1); Result[PIndex] := p; if EQDP(NextPath.p1^, p) then begin Result[PIndex] := NextPath.op1^; p := NextPath.p2^; end else if EQDP(NextPath.p2^, p) then begin Result[PIndex] := NextPath.op2^; p := NextPath.p1^; end; if EQDP(p, basep) then Done := True; PIndex := PIndex + 1; PrevPath := NextPath; end else begin SetLength(Result, Length(Result) + 1); if EQDP(PrevPath.p1^, p) then begin Result[PIndex] := PrevPath.op1^; end else if EQDP(PrevPath.p2^, p) then begin Result[PIndex] := PrevPath.op2^; end; Done := True; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetRoomOuterConture', E.Message); end; end; function TNet.GetFloorConture: TDoublePointArr; var i: integer; // 2011-05-10 p1, p2, p, r, basep: TDoublePoint; NextPath: TNetPath; Done: Boolean; PIndex: integer; SCSCompon: TSCSComponent; wall_h1, wall_h2: double; j: integer; ArcPointArray: T3DPointArray; TempArr: T3DPointArray; begin try Done := False; // 2011-05-10 r := FindStartContureRPoint; basep := r; //p := FindStartConturePPoint; //basep := p; wall_h1 := 0; //#From Oleg# wall_h2 := 0; PIndex := 0; SetLength(Result, 0); NextPath := nil; while not Done do begin // 2011-05-10 NextPath := GetNetPathByR1R2(NextPath, r); //NextPath := GetNetPathByP1P2(NextPath, p); if NextPath <> nil then begin SCSCompon := nil; SCSCompon := GetArchObjByCADObj(NextPath); if not assigned(SCSCompon) then exit; wall_h1 := SCSCompon.GetPropertyValueAsFloat(pnCoordZ) * FScaleDelta; if wall_h1 < FFloorDelta then wall_h1 := FFloorDelta; // 2011-05-10 r.z := wall_h1; SetLength(Result, Length(Result) + 1); Result[PIndex] := r; //p.z := wall_h1; //SetLength(Result, Length(Result) + 1); //Result[PIndex] := p; if NextPath.isArc then begin SetLength(TempArr, 2); // 2011-05-10 TempArr[0] := NextPath.r1; TempArr[1] := NextPath.r2; //TempArr[0] := NextPath.p1^; //TempArr[1] := NextPath.p2^; { if EQDP(NextPath.r1, r) then begin TempArr[0] := r; TempArr[1] := NextPath.r2; end else if EQDP(NextPath.r2, r) then begin TempArr[0] := NextPath.r1; TempArr[1] := r; end; } { TempArr[0] := r; if EQDP(NextPath.r1, r) then TempArr[1] := NextPath.r2 else if EQDP(NextPath.r2, r) then TempArr[1] := NextPath.r1; } //TempArr[0] := p; // if EQDP(NextPath.p1^, p) then // TempArr[1] := NextPath.p2^ // else if EQDP(NextPath.p2^, p) then // TempArr[1] := NextPath.p1^; ArcPointArray := GetArcWallPointsAll(TempArr, NextPath); if Length(ArcPointArray) > 2 then begin // 2011-05-10 if EQDP(ArcPointArray[0], r) then //if EQDP(ArcPointArray[0], p) then begin for j := 1 to Length(ArcPointArray) - 2 do begin PIndex := PIndex + 1; SetLength(Result, Length(Result) + 1); Result[PIndex] := ArcPointArray[j]; Result[PIndex].z := wall_h2; end; end else begin for j := Length(ArcPointArray) - 2 downto 1 do begin PIndex := PIndex + 1; SetLength(Result, Length(Result) + 1); Result[PIndex] := ArcPointArray[j]; Result[PIndex].z := wall_h2; end; end; end; end; // 2011-05-10 if EQDP(NextPath.r1, r) then r := NextPath.r2 else if EQDP(NextPath.r2, r) then r := NextPath.r1; if EQDP(r, basep) then {if EQDP(NextPath.p1^, p) then p := NextPath.p2^ else if EQDP(NextPath.p2^, p) then p := NextPath.p1^; if EQDP(p, basep) then} Done := True; PIndex := PIndex + 1; end else begin // 2011-05-10 r.z := wall_h1; SetLength(Result, Length(Result) + 1); Result[PIndex] := r; //p.z := wall_h1; //SetLength(Result, Length(Result) + 1); //Result[PIndex] := p; Done := True; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetFloorConture', E.Message); end; end; function TNet.GetCeilingConture: TDoublePointArr; var i: integer; // 2011-05-10 p1, p2, p, r, basep: TDoublePoint; NextPath: TNetPath; Done: Boolean; PIndex: integer; SCSCompon: TSCSComponent; wall_h1, wall_h2: double; j: integer; ArcPointArray: T3DPointArray; TempArr: T3DPointArray; corner_side1, corner_side2: double; Corners: TSCSComponents; begin try Done := False; // 2011-05-10 r := FindStartContureRPoint; basep := r; //p := FindStartConturePPoint; //basep := p; PIndex := 0; SetLength(Result, 0); NextPath := nil; while not Done do begin // 2011-05-10 NextPath := GetNetPathByR1R2(NextPath, r); //NextPath := GetNetPathByP1P2(NextPath, p); if NextPath <> nil then begin SCSCompon := nil; SCSCompon := GetArchObjByCADObj(NextPath); if not assigned(SCSCompon) then exit; wall_h1 := SCSCompon.GetPropertyValueAsFloat(pnCoordZ); wall_h2 := (wall_h1 + SCSCompon.GetPropertyValueAsFloat(pnHeight)) * FScaleDelta + FFCeilingDelta; try corner_side1 := wall_h2; corner_side2 := wall_h2; Corners := GetArchCornersForWall(SCSCompon); corner_side1 := Corners[0].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if corner_side1 = 0 then corner_side1 := wall_h2; corner_side2 := Corners[1].GetPropertyValueAsFloat(pnHeight) * FScaleDelta; if corner_side2 = 0 then corner_side2 := wall_h2; except end; wall_h2 := corner_side1; // 2011-05-10 r.z := wall_h2; SetLength(Result, Length(Result) + 1); Result[PIndex] := r; //p.z := wall_h2; //SetLength(Result, Length(Result) + 1); //Result[PIndex] := p; if NextPath.isArc then begin SetLength(TempArr, 2); // 2011-05-10 TempArr[0] := NextPath.r1; TempArr[1] := NextPath.r2; { if EQDP(NextPath.r1, r) then begin TempArr[0] := r; TempArr[1] := NextPath.r2; end else if EQDP(NextPath.r2, r) then begin TempArr[0] := NextPath.r1; TempArr[1] := r; end; } { TempArr[0] := r; if EQDP(NextPath.r1, r) then TempArr[1] := NextPath.r2 else if EQDP(NextPath.r2, r) then TempArr[1] := NextPath.r1; } //TempArr[0] := NextPath.p1^; //TempArr[1] := NextPath.p2^; //02.06.2011 TempArr[0] := p; //02.06.2011 if EQDP(NextPath.p1^, p) then //02.06.2011 TempArr[1] := NextPath.p2^ //02.06.2011 else if EQDP(NextPath.p2^, p) then //02.06.2011 TempArr[1] := NextPath.p1^; ArcPointArray := GetArcWallPointsAll(TempArr, NextPath); if Length(ArcPointArray) > 2 then begin // 2011-05-10 if EQDP(ArcPointArray[0], r) then //if EQDP(ArcPointArray[0], p) then begin for j := 1 to Length(ArcPointArray) - 2 do begin PIndex := PIndex + 1; SetLength(Result, Length(Result) + 1); Result[PIndex] := ArcPointArray[j]; Result[PIndex].z := wall_h2; end; end else begin for j := Length(ArcPointArray) - 2 downto 1 do begin PIndex := PIndex + 1; SetLength(Result, Length(Result) + 1); Result[PIndex] := ArcPointArray[j]; Result[PIndex].z := wall_h2; end; end; end; end; // 2011-05-10 if EQDP(NextPath.r1, r) then r := NextPath.r2 else if EQDP(NextPath.r2, r) then r := NextPath.r1; if EQDP(r, basep) then {if EQDP(NextPath.p1^, p) then p := NextPath.p2^ else if EQDP(NextPath.p2^, p) then p := NextPath.p1^; if EQDP(p, basep) then} Done := True; PIndex := PIndex + 1; end else begin // 2011-05-10 r.z := corner_side2; //wall_h2; SetLength(Result, Length(Result) + 1); Result[PIndex] := r; //p.z := corner_side2; //wall_h2; //SetLength(Result, Length(Result) + 1); //Result[PIndex] := p; Done := True; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetCeilingConture', E.Message); end; end; function TNet.GetNetPathByP1P2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath; var i: integer; NetPath: TNetPath; begin Result := nil; try for i := 0 to Paths.Count - 1 do begin NetPath := TNetPath(Paths[i]); if EQDP(NetPath.p1^, p) and (NetPath <> aCurNetPath) then begin Result := TNetPath(Paths[i]); break; end; end; if Result = nil then begin for i := 0 to Paths.Count - 1 do begin NetPath := TNetPath(Paths[i]); if EQDP(NetPath.p2^, p) and (NetPath <> aCurNetPath) then begin Result := TNetPath(Paths[i]); break; end; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetNetPathByP1P2', E.Message); end; end; function TNet.GetNextNetPathByP1P2(aPaths: TList; aCurNetPath: TNetPath; p: PDoublePoint; aSide: Pointer): TNetPath; var i: integer; NetPath: TNetPath; LookPaths: TList; begin Result := nil; LookPaths := aPaths; if LookPaths = nil then LookPaths := Paths; try for i := 0 to LookPaths.Count - 1 do begin NetPath := TNetPath(LookPaths[i]); if ((NetPath.p1 = p)or(NetPath.p2 = p)) and (NetPath <> aCurNetPath) then begin Result := TNetPath(LookPaths[i]); if aSide <> nil then Integer(aSide^) := 1; break; end; end; if Result = nil then begin for i := 0 to LookPaths.Count - 1 do begin NetPath := TNetPath(LookPaths[i]); if (NetPath.p2 = p) and (NetPath <> aCurNetPath) then begin Result := TNetPath(LookPaths[i]); if aSide <> nil then Integer(aSide^) := 2; break; end; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetNextNetPathByP1P2', E.Message); end; end; // 2011-05-10 function TNet.GetNetPathByR1R2(aCurNetPath: TNetPath; p: TDoublePoint): TNetPath; var i: integer; NetPath: TNetPath; begin Result := nil; try for i := 0 to Paths.Count - 1 do begin NetPath := TNetPath(Paths[i]); if EQDP(NetPath.r1, p) and (NetPath <> aCurNetPath) then begin Result := TNetPath(Paths[i]); break; end; end; if Result = nil then begin for i := 0 to Paths.Count - 1 do begin NetPath := TNetPath(Paths[i]); if EQDP(NetPath.r2, p) and (NetPath <> aCurNetPath) then begin Result := TNetPath(Paths[i]); break; end; end; end; except on E: Exception do AddExceptionToLogEx('TNet.GetNetPathByP1P2', E.Message); end; end; function TNet.FindStartConturePPoint(aPointPath: Pointer; aSide: Pointer): TDoublePoint; var i, j, PCount: integer; NetPath: TNetPath; // 2011-05-10 p, r: TDoublePoint; pSide: Integer; Wall: TSCSComponent; begin try Result := PDoublePoint(Points[0])^; for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i])^; PCount := 0; for j := 0 to Paths.Count - 1 do begin NetPath := TNetPath(Paths[j]); pSide := 0; if EQDP(NetPath.p1^, p) then pSide := 1 else if EQDP(NetPath.p2^, p) then pSide := 2; if pSide <> 0 then begin Wall := nil; Wall := GetArchObjByCADObj(NetPath); if not Assigned(Wall) then exit; if Wall.IsLine <> ctArhWallDivision then begin PCount := PCount + 1; if PCount = 1 then begin if (aPointPath <> nil) then TNetPath(aPointPath^) := NetPath; if aSide <> nil then Integer(aSide^) := pSide; end; end; end; end; // is Start Point if PCount = 1 then begin Result := p; exit; end; end; except on E: Exception do AddExceptionToLogEx('TNet.FindStartConturePoint', E.Message); end; end; function TNet.FindStartConturePoint(aPaths: TList; aPointPath: Pointer = nil; aSide: Pointer = nil): PDoublePoint; var i, j, PCount: integer; NetPath: TNetPath; p, r: PDoublePoint; pSide: Integer; Wall: TSCSComponent; LookPaths: TList; begin try Result := nil; LookPaths := aPaths; if LookPaths = nil then LookPaths := Paths; for i := 0 to Points.Count - 1 do //for i := Points.Count - 1 downto 0 do begin p := Points[i]; PCount := 0; for j := 0 to LookPaths.Count - 1 do begin NetPath := TNetPath(LookPaths[j]); pSide := 0; if NetPath.p1 = p then pSide := 1 else if NetPath.p2 = p then pSide := 2; if pSide <> 0 then begin Wall := nil; {$if Defined(ES_GRAPH_SC)} // Tolik 19/06/2018 - - если ГрафМодуль Wall := GetArchObjByCADObj(NetPath); if not Assigned(Wall) then exit; if Wall.IsLine <> ctArhWallDivision then begin Result := p; if (aPointPath <> nil) then TNetPath(aPointPath^) := NetPath; if aSide <> nil then Integer(aSide^) := pSide; Break; //// BREAK //// end; {$else} // Tolik 20/06/2018 -- если СКС Result := p; if (aPointPath <> nil) then TNetPath(aPointPath^) := NetPath; if aSide <> nil then Integer(aSide^) := pSide; Break; //// BREAK //// {$ifend} end; end; if Result <> nil then Break; //// BREAK //// end; except on E: Exception do AddExceptionToLogEx('TNet.FindStartConturePoint', E.Message); end; end; // 2011-05-10 function TNet.FindStartContureRPoint: TDoublePoint; var i, j, PCount: integer; NetPath: TNetPath; p, r: TDoublePoint; Wall: TSCSComponent; begin try //Result := PDoublePoint(Points[0])^; Result := TNetPath(Paths[0]).r1; for i := 0 to Points.Count - 1 do begin p := PDoublePoint(Points[i])^; PCount := 0; for j := 0 to Paths.Count - 1 do begin NetPath := TNetPath(Paths[j]); if EQDP(NetPath.p1^, p) or EQDP(NetPath.p2^, p) then begin Wall := nil; Wall := GetArchObjByCADObj(NetPath); if not Assigned(Wall) then exit; if Wall.IsLine <> ctArhWallDivision then begin if EQDP(NetPath.p1^, p) then r := NetPath.r1; if EQDP(NetPath.p2^, p) then r := NetPath.r2; PCount := PCount + 1; end; end; end; // is Start Point if PCount = 1 then begin Result := r; exit; end; end; except on E: Exception do AddExceptionToLogEx('TNet.FindStartContureRPoint', E.Message); end; end; function TNet.GetRelatedNets(AllowPathCmpType: Integer=citNone; ASubRelNets: Boolean=false): TList; var i, j: Integer; Path: TNetPath; RelNets: TList; RelNet: TNet; begin Result := TList.Create; for i := 0 to Paths.Count - 1 do begin Path := TNetPath(Paths[i]); RelNets := GetRelatedNetsByPoints(Path.p1, Path.p2); if RelNets <> nil then begin for j := 0 to RelNets.Count - 1 do begin RelNet := TNet(RelNets[j]); if Result.IndexOf(RelNet) = -1 then Result.Add(RelNet); end; FreeAndNil(RelNets); end; end; end; function TNet.GetRelatedNetsByPoints(APoint1, APoint2: PDoublePoint; AllowPathCmpType: Integer=citNone; ASubRelNets: Boolean=false): TList; var i, j, k: Integer; Nets: TList; Figure, InFigure: TFigure; Net: TNet; TempNet: TNet; NetPath: TNetPath; CanMergeNets: Boolean; p: PDoublePoint; NetAdded: Boolean; Path: TNetPath; IsRelated: Boolean; PointPaths: TList; AllNetList: TList; NoAdded: TList; JoinedNets: TList; procedure AddNetToRes(ANet: TNet); begin if Result = nil then Result := TList.Create; Result.Add(ANet); end; procedure FindNetRelPaths(pt1, pt2: PDoublePoint; ANet: TNet; var ANetAdded: Boolean); var i: Integer; CmpRes: Integer; NetPath: TNetPath; begin for i := 0 to ANet.Paths.Count - 1 do begin NetPath := TNetPath(ANet.Paths[i]); CmpRes := Self.CmpIntersectPaths(pt1,pt2, NetPath.p1, NetPath.p2); if (CmpRes in [citAbsorb, citEntry]) or ((AllowPathCmpType <> citNone) and (CmpRes = AllowPathCmpType)) then begin if Not ANetAdded then begin AddNetToRes(ANet); ANetAdded := true; end; if ANet.FRelatedPoints.IndexOf(NetPath.p1) = -1 then ANet.FRelatedPoints.Add(NetPath.p1); if ANet.FRelatedPoints.IndexOf(NetPath.p2) = -1 then ANet.FRelatedPoints.Add(NetPath.p2); if ANet.FRelatedObject = nil then ANet.FRelatedObject := NetPath; end; end; end; procedure HandleNet(ANet: TNet); var j: Integer; begin Net := ANet; CanMergeNets := true; if Assigned(FOnMergeNetsQuery) then FOnMergeNetsQuery(Self, Net, CanMergeNets); if CanMergeNets then begin Net.FRelatedPoints.Clear; Net.FRelatedObject := nil; NetAdded := false; for j := 0 to Net.Points.Count - 1 do begin p := PDoublepoint(Net.Points[j]); if ((APoint1 <> nil) and PointNear(APoint1^, p^)) or ((APoint2 <> nil) and PointNear(APoint2^, p^)) then begin if Not NetAdded then begin AddNetToRes(Net); NetAdded := true; end; Net.FRelatedPoints.Add(p); end; end; if NetAdded then begin // Если по двум точкам, то смотрим является ли это сегмент if (APoint1 <> nil) and (APoint2 <> nil) then Net.FRelatedObject := Net.GetPathByNearPoints(APoint1, APoint2); end; // Ищем сегменты, которые входят в сегмент APoint1, APoint2 if (APoint1 <> nil) and (APoint2 <> nil) then begin FindNetRelPaths(APoint1, APoint2, Net, NetAdded); end else if APoint1 <> nil then begin if PointPaths = nil then begin PointPaths := TList.Create; GetPathsOfKnot(APoint1, PointPaths); end; // ищем в этом объекте вторую точку на сегментах подключенных к этой точке APoint1 //for j := 0 to PointPaths.Count - 1 do //begin // Path := TNetPath(PointPaths[j]); // if Path.p1 = APoint1 then // FindNetRelPaths(APoint1, Path.p2, Net, NetAdded) // else if Path.p2 = APoint1 then // FindNetRelPaths(APoint1, Path.p1, Net, NetAdded); //end; end; if Not NetAdded and Assigned(NoAdded) then NoAdded.Add(Net); //AddNetToRes(Net); end; end; begin Result := nil; PointPaths := nil; NoAdded := nil; if ASubRelNets then NoAdded := TList.Create; {//07.05.2012 for i := 0 to TPowercad(Owner).Figures.Count - 1 do begin Figure := TFigure(TPowercad(Owner).Figures[i]); if (Figure is TNet) and (Figure <> Self) then HandleNet(TNet(Figure)) else if Figure is TfigureGrp then for j := 0 to TFigureGrp(Figure).InFigures.Count - 1 do begin InFigure := TFigure(TFigureGrp(Figure).InFigures[j]); if (InFigure is TNet) and (InFigure <> Self) then HandleNet(TNet(InFigure)) end; end;} Nets := GetAllNets(TPowercad(Owner)); for i := 0 to Nets.Count - 1 do begin Figure := TFigure(Nets[i]); if Figure <> Self then HandleNet(TNet(Figure)) end; FreeAndNil(Nets); if PointPaths <> nil then PointPaths.Free; //23.05.2011 - Добавляем TNet которые по точкам связаны с теми что попали в результат if ASubRelNets and {Assigned(Result) and }Assigned(NoAdded) and (NoAdded.Count > 0) then begin {AllNetList := TList.Create; if Assigned(Result) then AllNetList.Assign(Result); AllNetList.Insert(0, Self); for i := 0 to AllNetList.Count - 1 do begin Net := TNet(AllNetList[i]); for j := 0 to NoAdded.Count - 1 do begin TempNet := TNet(NoAdded[j]); for k := 0 to TempNet.Points.Count - 1 do begin //if Net.GetPointByNear(PDoublePoint(TempNet.Points[k])^) <> nil then if Not Assigned(Result) or (Result.IndexOf(TempNet) = -1) then begin AddNetToRes(TempNet); TempNet := nil; Break; //// BREAK //// end; end; //if TempNet = nil then // Break; //// BREAK //// end; end; AllNetList.Free;} if Assigned(FOnDefineJoinedNets) then begin AllNetList := TList.Create; if Assigned(Result) then AllNetList.Assign(Result); AllNetList.Insert(0, Self); JoinedNets := TList.Create; FOnDefineJoinedNets(Self, AllNetList, NoAdded, JoinedNets); for i := 0 to JoinedNets.Count - 1 do AddNetToRes(TNet(JoinedNets[i])); JoinedNets.Free; AllNetList.Free; end; end; if NoAdded <> nil then NoAdded.Free; end; function TNet.GetRelatedPaths(APath: TNetPath; ACmpRes: TList=nil; AllowBySide: Boolean=false): TList; var //RelNets: TList; //RelNet: TNet; RelPath: TNetPath; i, j: Integer; Figure: TFigure; Net: TNet; CanMergeNets: Boolean; CmpRes: Integer; begin Result := nil; if ACmpRes <> nil then ACmpRes.Clear; if APath.isArc = false then for i := 0 to TPowercad(Owner).Figures.Count - 1 do begin Figure := TFigure(TPowercad(Owner).Figures[i]); if (Figure is TNet) and (Figure <> Self) then begin Net := TNet(Figure); CanMergeNets := true; if Assigned(FOnMergeNetsQuery) then FOnMergeNetsQuery(Self, Net, CanMergeNets); if CanMergeNets then begin //NetAdded := false; for j := 0 to Net.Paths.Count - 1 do begin RelPath := TNetPath(Net.Paths[j]); if RelPath.isArc = false then begin CmpRes := APath.CmpIntersectPath(RelPath); if (CmpRes <> citNone) and ((CmpRes <> citSide) or AllowBySide) then begin if Result = nil then Result := TList.Create; Result.Add(RelPath); if ACmpRes <> nil then ACmpRes.Add(Pointer(CmpRes)); end; end; end; end; end; end; end; function TNet.GetRelatedPoints(APoint: PDoublePoint; AOutPoints: TList=nil; APointNets: TList=nil): TList; var RelPt: PDoublePoint; RelPtID: Integer; i, j: Integer; Figure: TFigure; Net: TNet; CanMergeNets: Boolean; CmpRes: Integer; begin Result := nil; if AOutPoints <> nil then AOutPoints.Clear; for i := 0 to TPowercad(Owner).Figures.Count - 1 do begin Figure := TFigure(TPowercad(Owner).Figures[i]); if (Figure is TNet) then begin Net := TNet(Figure); CanMergeNets := true; if Assigned(FOnMergeNetsQuery) then FOnMergeNetsQuery(Self, Net, CanMergeNets); if CanMergeNets then begin for j := 0 to Net.Points.Count - 1 do begin RelPt := Net.Points[j]; if (RelPt <> APoint) and PointNear(APoint^, RelPt^) then begin RelPtID := Net.GetPointID(RelPt); if RelPtID <> 0 then begin if Result = nil then Result := Tlist.Create; Result.Add(Pointer(RelPtID)); if AOutPoints <> nil then AOutPoints.Add(RelPt); if APointNets <> nil then APointNets.Add(Net); end; end; end; end; end; end; end; function TNet.GetSelPathChild: TNetDoor; var Path: TNetPath; begin Result := nil; Path := Self.SelPath; if Path <> nil then Result := Path.ActiveDoor; end; function TNet.PointToOrthogonal(APoint: PDoublePoint; x, y: Double; ANet: TNet; APointMoved: Pointer=nil): TDoublePoint; var RelatedPoints: TList; // Очки на других концах сегментов RelNets: TList; RelNet: TNet; RelPath: TNetPath; CanMergePaths: Boolean; i, j: Integer; Path: TNetPath; p: PDoublePoint; OrthX, OrthY: Pointer; pFromI, pFromJ: PDoublePoint; TempP: TDoublePoint; //Angle: Double; //dAndle: Double; // Разница угла rAndle: Double; NewP: TDoublePoint; PreResPoint: TDoublePoint; CurrDistance: Double; LastDistance: Double; LastDistanceX, LastDistanceY: Double; Len_X, Len_Y: double; PointMoved: Boolean; PointMovedX, PointMovedY: Boolean; MovingOrthogonal: Boolean; PointInLine: Boolean; Figure: TFigure; Net: TNet; CanMergeNets: Boolean; function PointToRes(var AResult, ANewPoint: TDoublePoint; var ALastDist: Double; var AMovedStatus: Boolean): Boolean; var CurrDistance: Double; begin Result := false; CurrDistance := GetLineLenght(DoublePoint(PreResPoint.x, PreResPoint.y), ANewPoint); if (ALastDist = 0) or (CurrDistance < ALastDist) then begin ALastDist := CurrDistance; AResult := ANewPoint; AMovedStatus := true; Result := true; end; end; begin Result := DoublePoint(x, y); //APoint^; PreResPoint := DoublePoint(x, y); PointMoved := false; RelatedPoints := TList.Create; // Подтянуть точку к точке другого TNet RelNets := GetRelatedNetsByPoints(@PreResPoint, nil); if RelNets <> nil then begin Path := ANet.GetPointPath(APoint); if Path <> nil then begin for i := 0 to RelNets.Count - 1 do begin RelNet := TNet(RelNets[i]); if RelNet.FRelatedPoints.Count > 0 then begin CanMergePaths := true; if Assigned(FOnMergeNetsQuery) then FOnMergeNetsQuery(Self, RelNet, CanMergePaths); if CanMergePaths then begin p := PDoublePoint(RelNet.FRelatedPoints[0]); RelPath := RelNet.GetPointPath(p); if Assigned(FOnMergePathsQuery) then FOnMergePathsQuery(Path, RelPath, CanMergePaths); if CanMergePaths then begin PointMoved := true; Result.x := p^.x; Result.y := p^.y; if APointMoved <> nil then Boolean(APointMoved^) := PointMoved; end; end; end; end; end; RelNets.Free; end; if Not PointMoved then begin OrthX := nil; OrthY := nil; for i := 0 to ANet.Paths.Count - 1 do begin p := TNetPath(ANet.Paths[i]).SecondPoint(APoint); if p <> nil then begin RelatedPoints.Add(p); // Если X или Y рядом с (X или Y) другой точки if Abs(PreResPoint.x - p^.x) < 4 then OrthX := @(p^.x) else if Abs(PreResPoint.y - p^.y) < 4 then OrthY := @(p^.y) end; end; // Если нашлись координаты для прямого угла if (OrthX <> nil) and (OrthY <> nil) then begin PointMoved := true; Result.x := Double(OrthX^); Result.y := Double(OrthY^); end; end; //OrthCorners := TList.Create; //OrthCorners.Add(Pointer(0)); //OrthCorners.Add(Pointer(45)); //OrthCorners.Add(Pointer(90)); //OrthCorners.Add(Pointer(135)); //OrthCorners.Add(Pointer(180)); //OrthCorners.Add(Pointer(225)); //OrthCorners.Add(Pointer(270)); //OrthCorners.Add(Pointer(360)); if Not PointMoved then begin // Если точка почти выравнивает подключенные линии в одну диагональ, то подгонять под эту диагональ for i := 0 to ANet.Paths.Count - 1 do begin pFromI := TNetPath(ANet.Paths[i]).SecondPoint(APoint); if pFromI <> nil then for j := (i+1) to ANet.Paths.Count - 1 do begin pFromJ := TNetPath(ANet.Paths[j]).SecondPoint(APoint); if pFromJ <> nil then begin // Ищем расстояние точки (x, y) от диагонали (pFromI pFromJ) NewP := DoublePoint(x, y); TempP := NewP; PointToLine(pFromI^, pFromJ^, TempP.x, TempP.y); // расстояние от точки до линии CurrDistance := GetLineLenght(NewP, TempP); if (CurrDistance < 4) and isPointinLine(pFromI^, pFromJ^, TempP,1) then begin Result := TempP; PointMoved := true; end; end; end; if PointMoved then Break; //// BREAK //// end; end; if Not PointMoved then begin // Если точка почти на другом сегменте, тогда ее подтягиваем на него //EmptyProcedure; LastDistance := 0; for i := 0 to TPowercad(Owner).Figures.Count - 1 do begin Figure := TFigure(TPowercad(Owner).Figures[i]); if (Figure is TNet) and (Figure <> Self) and (Figure <> ANet.FSrcNet) then begin Net := TNet(Figure); CanMergeNets := true; if Assigned(FOnMergeNetsQuery) then FOnMergeNetsQuery(Self, Net, CanMergeNets); if CanMergeNets then begin for j := 0 to Net.Paths.Count - 1 do begin Path := TNetPath(Net.Paths[j]); if Path.isArc = false then begin TempP := Result; PointToLine(Path.p1^, Path.p2^, TempP.x, TempP.y); CurrDistance := GetLineLenght(TempP, Result); if (CurrDistance <= Path.Width) and ((LastDistance = 0) or (CurrDistance < LastDistance)) and (isPointinLine(Path.p1^, Path.p2^, TempP, 1) or //23.05.2011 isPointinLine(Path.p1^, TempP, Path.p2^, 1) or //23.05.2011 isPointinLine(Path.p2^, TempP, Path.p1^, 1)) then begin //PointInLine := isPointinLine(Path.p1^, Path.p2^, TempP,1,0.1); //TempP := Result; //PointToLineByLen(Path.p1^, Path.p2^, TempP); //PointInLine := isPointinLine(Path.p1^, Path.p2^, TempP,1,0.1); LastDistance := CurrDistance; Result := TempP; PointMoved := true; end; end; end; end; end; end; end; if Not PointMoved then begin LastDistance := 0; // Дистанция - на сколько нужно отклонить точку //LastDistanceX := 0; //LastDistanceY := 0; //PointMovedX := false; //PointMovedY := false; MovingOrthogonal := false; for i := 0 to RelatedPoints.Count - 1 do begin p := RelatedPoints[i]; {TempP := p^; TempP.x := TempP.x + 100; // С проверяемой точки пускаем перпендикуляр по горизонтале - делаем воображаемую линию Angle := GetLinesAngle(APoint^, TempP, p^, TempP); for j := 0 to OrthCorners.Count - 1 do begin dAndle := Integer(OrthCorners[j]) - Angle; // Если мы рядом возле нужного угла //if Abs(dAndle) <= 5 then begin NewP := RotateDPoint(p^, APoint^, dAndle); // Куда нужно оттянуть APoint CurrDistance := GetLineLenght(APoint^, NewP); if CurrDistance <= 5 then if (LastDistance = 0) or (LastDistance < CurrDistance) then begin LastDistance := CurrDistance; Result := NewP; GCADForm.sbView.Panels[2].Text := 'OldAngle - '+FloatToStr(Angle)+ ' Angle - '+FloatToStr(Integer(OrthCorners[j]))+ ' Distance - '+FloatToStr(CurrDistance); end; end; end;} NewP := PreResPoint; TempP := p^; rAndle := 1 / tan(Integer(45) * pi / 180 / 2); Len_X := {abs(TempP.x - Result.X); //14.10.2010} abs(TempP.x - PreResPoint.X); Len_Y := {abs(TempP.y - Result.Y); //14.10.2010} abs(TempP.y - PreResPoint.Y); // Если ведем точку по вертикальной, или горизонтальной прямой, то оставляем на прямой if (Len_X = 0) or (Len_Y = 0) then begin Result := PreResPoint; PointMoved := true; Break; //// BREAK //// end; // Если точка рядом с ортогональной линией //if (Len_X < 5) or (Len_Y < 5) then begin if Len_X > Len_Y then begin if Len_X > rAndle * Len_Y then NewP.y := TempP.Y else if Len_X < rAndle * Len_Y then begin if NewP.Y > TempP.Y then NewP.Y := TempP.Y + Len_X else if NewP.Y < TempP.Y then NewP.Y := TempP.Y - Len_X; end; //PointToRes(NewP, LastDistanceY, PointMovedY); end else if (Len_X < Len_Y) then begin if Len_Y > rAndle * Len_X then begin if trunc(TempP.X) = 32 then TempP.X := TempP.X; NewP.X := TempP.X; end else if Len_Y < rAndle * Len_X then begin if NewP.X > TempP.X then NewP.X := TempP.X + Len_Y else if NewP.X < TempP.X then NewP.X := TempP.X - Len_Y; end; //PointToRes(NewP, LastDistanceX, PointMovedX); end; //CurrDistance := GetLineLenght(DoublePoint(x, y), NewP); //if (LastDistance = 0) or (CurrDistance < LastDistance) then //begin // LastDistance := CurrDistance; // Result := NewP; // PointMoved := true; //end; PointToRes(Result, NewP, LastDistance, PointMoved); if PointMoved then begin EmptyProcedure; end; //if (Len_X < 5) or (Len_Y < 5) then //begin // MovingOrthogonal := true; // LastDistance := 0; // PointToRes(Result, NewP, LastDistance, PointMoved); // //PreResPoint := NewP; //end //else //if Not MovingOrthogonal then // PointToRes(Result, NewP, LastDistance, PointMoved); end; end; //PointMoved := PointMovedX or PointMovedY; end; //OrthCorners.Free; RelatedPoints.Free; end; procedure TNet.SrvDropFComponID; var i: Integer; begin FComponID := 0; for i := 0 to Paths.Count - 1 do TNetPath(Paths[i]).FComponID := 0; for i := 0 to FPointIDs.Count - 1 do FPointIDs[i] := Pointer(0); end; { TnetPath } function TnetPath.ActiveDoor: TNetDoor; begin result := nil; if (DoorIndex = -1) or (DoorIndex > Doors.Count-1) then exit; result := TNetDoor(Doors[DoorIndex]); end; function TNetPath.AreYou(xp1, xp2: PDoublePoint): Boolean; begin result := false; result := ((p1 = xp1) and (p2 = xp2)) or ((p2 = xp1) and (p1 = xp2)); end; procedure TnetPath.AddBezierPoints(var pArr: TDoublePointArr; Direction: TPathDirection; IncFirst: Boolean); begin // Case wType of // wtWall,wtOpen: begin if isArc then AddArcPoints(pArr,Direction,incFirst) else AddWallPoints(pArr,Direction,incFirst); // end; // wtOpen: begin // AddOpenPoints(pArr,Direction,incFirst); // AddWallPoints(pArr,Direction,incFirst); // end; // wtHalf: begin // AddHalfPoints(pArr,Direction,incFirst); // end; // wtGlass: begin // AddGlassPoints(pArr,Direction,incFirst); // end; // end; end; function TnetPath.AreYou(xp1, xp2: TDoublePoint): Boolean; begin result := false; result := (EQDP(p1^,xp1) and EQDP(p2^,xp2)) or (EQDP(p2^,xp1) and EQDP(p1^,xp2)); end; (* procedure TnetPath.CalculatePoints(topZ,botZ:Double); var ww,outw: Double; yp1,yp2,xp1,xp2: TDoublePOint; //22.05.2012 door: TnetDoor; i: Integer; xPaths: TList; toWall: Boolean; begin epl1 := nil; epl2 := nil; epr1 := nil; epr2 := nil; FPerpendDX := 0; FPerpendDY := 0; outw := 0; if border then outw := 1; if isArc then begin ww := (Width / 2); if Inverted then begin ArcCenter := GetArcCenter(p2^,p1^,ArcAng); ArcA1 := GetRadOfLine(ArcCenter,p1^); ArcA2 := GetRadOfLine(ArcCenter,p2^); end else begin ArcCenter := GetArcCenter(p1^,p2^,ArcAng); ArcA2 := GetRadOfLine(ArcCenter,p1^); ArcA1 := GetRadOfLine(ArcCenter,p2^); end; if ArcA2 = 0 then ArcA2 := 2 * pi; ArcRad := GetLineLenght(p1^,ArcCenter); if Inverted then ww := -ww; OffsetPoint(p1^,ArcCenter,yp1,ww); OffsetPoint(p2^,ArcCenter,yp2,ww); l1 := yp1; l2 := yp2; el1 := l1; //14.04.2011 el2 := l2; //14.04.2011 a1 := yp1; a2 := yp2; OffsetPoint(p1^,ArcCenter,yp1,-ww); OffsetPoint(p2^,ArcCenter,yp2,-ww); r1 := yp1; r2 := yp2; er1 := r1; //14.04.2011 er2 := r2; //14.04.2011 b1 := yp1; b2 := yp2; OffsetPoint(p1^,ArcCenter,yp1,ww+1); OffsetPoint(p2^,ArcCenter,yp2,ww+1); Hl1 := yp1; Hl2 := yp2; OffsetPoint(p1^,ArcCenter,yp1,-(ww+1)); OffsetPoint(p2^,ArcCenter,yp2,-(ww+1)); Hr1 := yp1; Hr2 := yp2; end else begin if wType in [wtWall,wtOpen] then begin ww := 0; if WStyle = wsWall then ww := (Width / 2); GetParallelPoints(p1^,p2^,yp1,yp2,-ww); l1 := yp1; l2 := yp2; el1 := l1; //14.04.2011 el2 := l2; //14.04.2011 a1 := yp1; a2 := yp2; GetParallelPoints(p1^,p2^,yp1,yp2,ww); r1 := yp1; r2 := yp2; er1 := r1; //14.04.2011 er2 := r2; //14.04.2011 b1 := yp1; b2 := yp2; //ww := (Width / 2) + 1; ww := 1; if WStyle = wsWall then ww := ww + (Width / 2); GetParallelPoints(p1^,p2^,yp1,yp2,-ww); Hl1 := yp1; Hl2 := yp2; GetParallelPoints(p1^,p2^,yp1,yp2,ww); Hr1 := yp1; Hr2 := yp2; end else if wType in [wtGlass,wtHalf] then begin xp1 := p1^; xp2 := p2^; xPaths := TList.Create; Net.GetPathsOfKnot(p1,xPaths); ToWall := False; for i := 0 to xpaths.Count - 1 do begin if (TnetPath(xPaths[i]).WType <> wtGlass) and (TnetPath(xPaths[i]).WType <> wtHalf) and (TnetPath(xPaths[i]).isArc = False) then ToWall := True; end; if toWall then xp1 := MPoint(p1^,p2^,Width/2); xPaths.Clear; Net.GetPathsOfKnot(p2,xPaths); ToWall := False; for i := 0 to xpaths.Count - 1 do begin if (TnetPath(xPaths[i]).WType <> wtGlass) and (TnetPath(xPaths[i]).WType <> wtHalf) and (TnetPath(xPaths[i]).isArc = False) then ToWall := True; end; if toWall then xp2 := MPoint(p2^,p1^,Width/2); ww := Width / 2; GetParallelPoints(xp1,xp2,yp1,yp2,-ww); l1 := yp1; l2 := yp2; el1 := l1; //14.04.2011 el2 := l2; //14.04.2011 a1 := yp1; a2 := yp2; GetParallelPoints(xp1,xp2,yp1,yp2,ww); r1 := yp1; r2 := yp2; er1 := r1; //14.04.2011 er2 := r2; //14.04.2011 b1 := yp1; b2 := yp2; ww := (Width / 2)+1; GetParallelPoints(xp1,xp2,yp1,yp2,-ww); Hl1 := yp1; Hl2 := yp2; GetParallelPoints(xp1,xp2,yp1,yp2,ww); Hr1 := yp1; Hr2 := yp2; end; SortDoors; {//22.05.2012 for i := 0 to Doors.Count - 1 do begin Door := TnetDoor(Doors[i]); Door.CalculatePoints(p1^,p2^); end;} CalculateDoorPoints(p1, p2); end; end; *) procedure TnetPath.CalculatePoints(topZ,botZ:Double); var ww,outw: Double; yp1,yp2,xp1,xp2: TDoublePOint; //22.05.2012 door: TnetDoor; i: Integer; xPaths: TList; toWall: Boolean; cp1, cp2: TDoublePoint; begin epl1 := nil; epl2 := nil; epr1 := nil; epr2 := nil; FPerpendDX := 0; FPerpendDY := 0; if FPointsOffset = 0 then begin cp1 := p1^; cp2 := p2^; end else GetParallelPoints(p1^,p2^, cp1,cp2, FPointsOffset); outw := 0; if border then outw := 1; if isArc then begin ww := (Width / 2); if Inverted then begin ArcCenter := GetArcCenter(cp2,cp1,ArcAng); ArcA1 := GetRadOfLine(ArcCenter,cp1); ArcA2 := GetRadOfLine(ArcCenter,cp2); end else begin ArcCenter := GetArcCenter(cp1,cp2,ArcAng); ArcA2 := GetRadOfLine(ArcCenter,cp1); ArcA1 := GetRadOfLine(ArcCenter,cp2); end; if ArcA2 = 0 then ArcA2 := 2 * pi; ArcRad := GetLineLenght(cp1,ArcCenter); if Inverted then ww := -ww; OffsetPoint(cp1,ArcCenter,yp1,ww); OffsetPoint(cp2,ArcCenter,yp2,ww); l1 := yp1; l2 := yp2; el1 := l1; //14.04.2011 el2 := l2; //14.04.2011 a1 := yp1; a2 := yp2; OffsetPoint(cp1,ArcCenter,yp1,-ww); OffsetPoint(cp2,ArcCenter,yp2,-ww); r1 := yp1; r2 := yp2; er1 := r1; //14.04.2011 er2 := r2; //14.04.2011 b1 := yp1; b2 := yp2; OffsetPoint(cp1,ArcCenter,yp1,ww+1); OffsetPoint(cp2,ArcCenter,yp2,ww+1); Hl1 := yp1; Hl2 := yp2; OffsetPoint(cp1,ArcCenter,yp1,-(ww+1)); OffsetPoint(cp2,ArcCenter,yp2,-(ww+1)); Hr1 := yp1; Hr2 := yp2; end else begin if wType in [wtWall,wtOpen] then begin ww := 0; if WStyle = wsWall then ww := (Width / 2); GetParallelPoints(cp1,cp2,yp1,yp2,-ww); l1 := yp1; l2 := yp2; el1 := l1; //14.04.2011 el2 := l2; //14.04.2011 a1 := yp1; a2 := yp2; GetParallelPoints(cp1,cp2,yp1,yp2,ww); r1 := yp1; r2 := yp2; er1 := r1; //14.04.2011 er2 := r2; //14.04.2011 b1 := yp1; b2 := yp2; //ww := (Width / 2) + 1; ww := 1; if WStyle = wsWall then ww := ww + (Width / 2); GetParallelPoints(cp1,cp2,yp1,yp2,-ww); Hl1 := yp1; Hl2 := yp2; GetParallelPoints(cp1,cp2,yp1,yp2,ww); Hr1 := yp1; Hr2 := yp2; end else if wType in [wtGlass,wtHalf] then begin xp1 := p1^; xp2 := p2^; xPaths := TList.Create; Net.GetPathsOfKnot(p1,xPaths); ToWall := False; for i := 0 to xpaths.Count - 1 do begin if (TnetPath(xPaths[i]).WType <> wtGlass) and (TnetPath(xPaths[i]).WType <> wtHalf) and (TnetPath(xPaths[i]).isArc = False) then ToWall := True; end; if toWall then xp1 := MPoint(p1^,p2^,Width/2); xPaths.Clear; Net.GetPathsOfKnot(p2,xPaths); ToWall := False; for i := 0 to xpaths.Count - 1 do begin if (TnetPath(xPaths[i]).WType <> wtGlass) and (TnetPath(xPaths[i]).WType <> wtHalf) and (TnetPath(xPaths[i]).isArc = False) then ToWall := True; end; if toWall then xp2 := MPoint(p2^,p1^,Width/2); ww := Width / 2; GetParallelPoints(xp1,xp2,yp1,yp2,-ww); l1 := yp1; l2 := yp2; el1 := l1; //14.04.2011 el2 := l2; //14.04.2011 a1 := yp1; a2 := yp2; GetParallelPoints(xp1,xp2,yp1,yp2,ww); r1 := yp1; r2 := yp2; er1 := r1; //14.04.2011 er2 := r2; //14.04.2011 b1 := yp1; b2 := yp2; ww := (Width / 2)+1; GetParallelPoints(xp1,xp2,yp1,yp2,-ww); Hl1 := yp1; Hl2 := yp2; GetParallelPoints(xp1,xp2,yp1,yp2,ww); Hr1 := yp1; Hr2 := yp2; end; SortDoors; {//22.05.2012 for i := 0 to Doors.Count - 1 do begin Door := TnetDoor(Doors[i]); Door.CalculatePoints(p1^,p2^); end;} CalculateDoorPoints(@cp1, @cp2); end; end; procedure TnetPath.ClearDoors; var door:TNetDoor; i: Integer; begin try For i := 0 to Doors.Count - 1 do begin door := TnetDoor(Doors[i]); door.free; end; doors.clear; except // ShowMessage(CPowerCadMessage + 'TnetPath.ClearDoors'); end; end; function TnetPath.Connected(path: TnetPath): Boolean; begin result := false; result := (p1 = path.p1) or (p2 = path.p2) or (p1 = path.p2) or (p2 = path.p1); end; procedure TnetPath.CopyFrom(sPath: TnetPath; AWithDoors: Boolean=true); var i: Integer; sDoor,door: TnetDoor; begin Border := sPath.Border; WType := sPath.wType; WStyle := sPath.WStyle; Width := sPath.Width; isArc := sPath.isArc; ArcAng := sPath.ArcAng; ArcRad := sPath.ArcRad; Inverted := sPath.Inverted; Info := sPath.Info; FPointsOffset := sPath.FPointsOffset; FPerpendSide := sPath.FPerpendSide; FPerpendDX := sPath.FPerpendDX; FPerpendDY := sPath.FPerpendDY; if AWithDoors then begin ClearDoors; if WType = wtWall then begin for i := 0 to sPath.Doors.Count - 1 do begin sDoor := TnetDoor(sPath.Doors[i]); door := TnetDoor.Create(sDoor.Start,sDoor.Width,sDoor.Len,sDoor.DoorObjType,net); door.FComponID := sDoor.FComponID; doors.Add(Door); end; end; end; end; constructor TNetPath.Create(xp1, xp2: PDoublePoint; xBorder: Boolean; xNet: Tnet); begin inherited create; Id := 0;// Tolik 21/12/2019 -- p1 := xp1; p2 := xp2; // Tolik 31/10/2019 -- if p1 <> nil then p1.z := 0; if p2 <> nil then p2.z := 0; // p1H := -1; p2H := -1; Border := xBorder; Empty1 := False; Empty2 := False; Region := 0; DeadIdx := 0; Net := xNet; WType := GDefWallType; //13.04.2011 wtWall; WStyle := wsWall; //15.04.2011 //WStyle := wsLine; Width := Net.wallThick; isArc := False; ArcAng := pi/2; Region := 0; Doors := TList.Create; DoorIndex := -1; Broken := False; Info := ''; FShowLength := True; FPathStyle := psSolid; FPathWidth := 1; //FID := 0; //FBrushColor := clBlack; //23.03.2013 //if FColor <> nil then // FBrushColor := Integer(FColor) //else // FBrushColor := Net.Color; FColor := clBlack; //nil; if Net <> nil then begin FColor := Net.Color; FBrushColor := Net.Color; end else begin FColor := clBlack; FBrushColor := clBlack; end; FBrushStyle := -1; //17.03.2013 FComponID := 0; FDeleting := false; FDivedFrom := nil; //14.12.2010 FIsHidden := false; //21.04.2011 FIsInner := false; FSelecting := false; FOnAfterDiv := nil; //06.10.2010 FOnBeforeDiv := nil; //06.10.2010 FOnDblClick := nil; FOnDelete := nil; FOnGetHeight := nil; FOnGetHeightOfPt := nil; FOnGetPathCheckOverlapMargin := nil; //FOnGetShowPathLength := nil; //FOnGetShowPathTraceLength := nil; FOnGetShowPathLengthType := nil; FOnGetShowPathTraceLengthType := nil; FOnMove := nil; FOnSelect := nil; ZeroMemory(@el1, SizeOf(TDoublePoint)); ZeroMemory(@el2, SizeOf(TDoublePoint)); ZeroMemory(@er1, SizeOf(TDoublePoint)); ZeroMemory(@er2, SizeOf(TDoublePoint)); FSrcPaths := TList.Create; FSubRegions := TList.Create; //18.05.2012 - Перпендикулярные точки - ссылки на el1,el2,er1,er2 связанного сегмента FPointsOffset := 0; FPerpendSide := 0; FPerpendDX := 0; FPerpendDY := 0; epl1 := nil; epl2 := nil; epr1 := nil; epr2 := nil; // Tolik op1 := nil; op2 := nil; ip1 := nil; ip2 := nil; //26.03.2013 //if Net <> nil then // if Net.FPathDivision <> nil then // begin // WStyle := Net.FPathDivision.WStyle; // FColor := Net.FPathDivision.FColor; // FBrushColor := Net.FPathDivision.FBrushColor; // FBrushStyle := Net.FPathDivision.FBrushStyle; // end; GArchEngine.SetHandlersToObj(Self); // Tolik 07/05/2019 -- if not GProjectChanged then SetProjectChanged(True); // initialize; // Tolik 21/12/2019 -- end; Procedure TNetPath.Initialize; begin if GCadForm <> nil then if GCadForm.PCad <> nil then begin Inc(GCadForm.PCad.FLastFigureId); id := GCadForm.PCad.FLastFigureId; end; end; // Tolik 21/11/2019 - - //function TnetPath.CreateArcRgn(DEngine: TPCDrawEngine): Integer; function TnetPath.CreateArcRgn(DEngine: TPCDrawEngine): HRGN; // var pArr: TDoublePointArr; i: Integer; //reg,reg1,reg2: Integer; reg,reg1,reg2: HRGN; rad1,rad2,ang1,ang2,ang3,ang4: Double; begin SetLength(pArr,4); pArr[0] := ArcJoinA1; pArr[1] := ArcJoinA1L; pArr[2] := ArcJoinB1L; pArr[3] := ArcJoinB1; reg1 := Dengine.PolygonRegion(pArr); pArr[0] := ArcJoinA2; pArr[1] := ArcJoinA2L; pArr[2] := ArcJoinB2L; pArr[3] := ArcJoinB2; reg2 := Dengine.PolygonRegion(pArr); rad1 := GetLineLenght(ArcCenter,l1); if Inverted then begin ang1 := GetRadOfLine(ArcCenter,l1); ang2 := GetRadOfLine(ArcCenter,l2); end else begin ang1 := GetRadOfLine(ArcCenter,l2); ang2 := GetRadOfLine(ArcCenter,l1); end; if ang2 = 0 then ang2 := 2 * pi; rad2 := GetLineLenght(ArcCenter,r1); if Inverted then begin ang3 := GetRadOfLine(ArcCenter,r1); ang4 := GetRadOfLine(ArcCenter,r2); end else begin ang3 := GetRadOfLine(ArcCenter,r2); ang4 := GetRadOfLine(ArcCenter,r1); end; if ang4 = 0 then ang4 := 2*pi; reg := Dengine.CreateDoubleArcRegion(ArcCenter.x,ArcCenter.y,rad1,rad2,ang1,ang2,ang3,ang4); CombineRgn(Reg,Reg,reg1,RGN_OR); CombineRgn(Reg,Reg,reg2,RGN_OR); DeleteObject(reg1); DeleteObject(reg2); Result := reg; end; class function TnetPath.CreateFromStream(Stream: TStream; xNet: Tnet; aOldPlan: Boolean): TnetPath; var PathVersion: Byte; index: Integer; i,dCnt: integer; door: TnetDoor; xByte: Byte; xDbl: Double; begin Result := nil; Result := TnetPath.Create(nil, nil, False, xNet); Result.Width := xNet.WallThick; Stream.Read(PathVersion, 1); Stream.Read(xByte, 1); Result.Border := Bool(xByte); Stream.Read(xByte, 1); Result.FShowLength := Bool(xByte); Stream.Read(xDbl, 8); if xDbl = 0 then xDbl := xNet.WallThick; Result.Width := xDbl; if not aOldPlan then begin Stream.Read(index, 4); Result.FPathStyle := TPenStyle(Index); Stream.Read(index, 4); Result.FPathWidth := Index; end; Stream.Read(index, 4); if (index > -1) and (index < (xNet.Points.Count)) then begin Result.p1 := xNet.Points[index]; // Tolik 04/09/2018 -- //Result.p1.z := -1; if Result.p1 <> nil then Result.p1.z := 0; end; Stream.Read(index, 4); if (index > -1) and (index < (xNet.Points.Count)) then begin Result.p2 := xNet.Points[index]; // Tolik 04/09/2018 -- //Result.p1.z := -1; if Result.p2 <> nil then Result.p2.z := 0; end; if (not assigned(result.p1)) or (not assigned(result.p2)) then begin result.free; result := nil; exit; end; Stream.Read(xByte,1); Result.Wtype := TWallType(xByte); Stream.Read(xByte,1); Result.isArc := BBool(xByte); if (result.isarc) then begin Stream.Read(Result.ArcAng,8); Stream.Read(xByte,1); Result.Inverted := BBool(xByte); end; //25.05.2010 if PathVersion >= 2 then begin Stream.Read(Result.FComponID,4); if PathVersion >= 3 then begin Stream.Read(xByte,1); Result.WStyle := TWallStyle(xByte); end; if PathVersion >= 4 then //22.05.2012 Stream.Read(Result.FPerpendSide, 1); if PathVersion >= 5 then begin Stream.Read(index, 4); Result.FColor := index; Stream.Read(xByte, 1); // Tolik 21/12/2019 -- //Result.FBrushStyle := xByte; if xByte = 255 then Result.FBrushStyle := -1 else Result.FBrushStyle := xByte; // Stream.Read(index, 4); Result.FBrushColor := index; end; end; Stream.Read(dCnt,4); //15.04.2011 //if dcnt < 11 then // begin // for i := 1 to dcnt do // begin // Door := TnetDoor.CreateFromStream(Stream,Result); // if assigned(Door) then // begin // Result.Doors.Add(Door); // end; // end; // end // else // begin // result.free; // result := nil; // exit; // end; //15.04.2011 for i := 1 to dcnt do begin Door := TnetDoor.CreateFromStream(Stream,Result); if assigned(Door) then Result.Doors.Add(Door); end; // Tolik 04/09/2018 -- if PathVersion >= 6 then begin {if Result.p1 <> nil then Stream.Read(Result.p1.z, 8); if Result.p2 <> nil then Stream.Read(Result.p2.z, 8);} Stream.Read(Result.p1H, 8); Stream.Read(Result.p2H, 8); end; // //GArchEngine.SetHandlersToObj(Result); Result.AfterLoadProps; end; // Tolik 21/11/2019 -- //function TnetPath.CreateInRgn(DEngine: TPCDrawEngine): Integer; function TnetPath.CreateInRgn(DEngine: TPCDrawEngine): HRGN; // begin if not isArc then begin Result := CreateLinearRgn(DEngine); CreateLinearSubRgns(DEngine); end else begin Result := CreateArcRgn(DEngine); end; end; // Tolik 21/11/2019 -- //function TnetPath.CreateLinearRgn(DEngine: TPCDrawEngine): Integer; function TnetPath.CreateLinearRgn(DEngine: TPCDrawEngine): HRGN; // var {//24.03.2013 pArr:TPointArr; i: Integer; xx,yy,z:Double; Points: TList;} //reg: Integer; reg: HRGN; begin {//24.03.2013 Points := TList.Create; Points.Add(@l1); Points.Add(@l2); Points.Add(@r2); Points.Add(@r1); SetLength(pArr, 4); for i := 0 to Points.Count - 1 do begin z := 0; xx := PDoublePOint(Points[i]).x; yy := PDoublePOint(Points[i]).y; DEngine.ConvertPoint(xx,yy,z); PArr[i] := Point(round(xx),round(yy)); end; Result := Dengine.PolygonRegion(pArr); Points.Clear; Points.Add(@a1); Points.Add(@a2); Points.Add(@b2); Points.Add(@b1); SetLength(pArr,4); for i := 0 to POints.Count - 1 do begin xx := PDoublePOint(Points[i]).x; yy := PDoublePOint(Points[i]).y; DEngine.ConvertPoint(xx,yy,z); PArr[i] := Point(round(xx),round(yy)); end; reg := Dengine.PolygonRegion(pArr); CombineRgn(Result,Result,reg,RGN_OR); DeleteObject(reg); Points.Free;} Result := CreatePolygonRgnByPoints(DEngine, @l1, @l2, @r2, @r1); reg := CreatePolygonRgnByPoints(DEngine, @a1, @a2, @b2, @b1); CombineRgn(Result, Result, reg,RGN_OR); DeleteObject(reg); end; procedure TnetPath.CreateLinearSubRgns(DEngine:TPCDrawEngine); var i, DoorsLen: Integer; xL1, xR1: TDoublePoint; Door: TNetDoor; reg, regSide: HRGN; begin for i := 0 to FSubRegions.Count - 1 do DeleteObject(HGDIOBJ(FSubRegions.Items[i])); FSubRegions.Clear; if Doors.Count > 0 then begin xL1 := l1; xR1 := r1; for i := 0 to Doors.Count-1 do begin Door := TnetDoor(Doors[i]); //da1 := Door.a1; //da2 := Door.a2; //db1 := Door.b1; //db2 := Door.b2; //Net.drawline(Dengine, xL1, da1, color, 1, s); //Net.drawline(Dengine, xr1, db1, color, 1, s); //Net.drawline(Dengine, xL1, da1, color, FPathWidth, FPathStyle); //Net.drawline(Dengine, xr1, db1, color, FPathWidth, FPathStyle); reg := CreatePolygonRgnByPoints(DEngine, @xL1, @Door.a1, @Door.b1, @xr1); if i = 0 then begin // points side 1 //regSide := CreatePolygonRgnByPoints(DEngine, @a1, @b1, @Door.a1, @Door.b1); //regSide := CreatePolygonRgnByPoints(DEngine, @a1, @b1, @r1, @l1); regSide := CreatePolygonRgnByPoints(DEngine, @a1, @b1, @l1, @r1); CombineRgn(reg, reg, regSide, RGN_OR); DeleteObject(regSide); end; FSubRegions.Add(Pointer(reg)); xl1 := Door.a2; xr1 := Door.b2; end; reg := CreatePolygonRgnByPoints(DEngine, @xL1, @xr1, @r2, @l2); // points side 2 //regSide := CreatePolygonRgnByPoints(DEngine, @a2, @b2, @Door.a2, @Door.b2); regSide := CreatePolygonRgnByPoints(DEngine, @a2, @b2, @r2, @l2); //regSide := CreatePolygonRgnByPoints(DEngine, @a2, @b2, @l2, @r2); CombineRgn(reg, reg, regSide, RGN_OR); DeleteObject(regSide); FSubRegions.Add(Pointer(reg)); end; end; procedure TnetPath.DeleteDoor; var Door: TnetDoor; begin if (DoorIndex > -1) and (DoorIndex < Doors.Count) then begin Door := TnetDoor(Doors[DoorIndex]); //Doors.Remove(Door); //Door.Free; DeleteDoorObj(Door); DoorIndex := -1; end; end; destructor TnetPath.Destroy; Var i: Integer; // Tolik 24/12/2019 -- begin ClearDoors; Doors.Free; if Region <> 0 then // Tolik 21/11/2019 -- DeleteObject(Region); // Tolik 24/12/2019 -- for i := 0 to FSubRegions.Count - 1 do DeleteObject(HGDIOBJ(FSubRegions.Items[i])); FSubRegions.Clear; // FreeAndNil(FSubRegions); //23.03.2013 FreeAndNil(FSrcPaths); //15.02.2011 inherited; end; procedure TNetPath.Draw(Dengine: TPCDrawEngine;Color:TColor); var s: Integer; mp: TDoublePOint; begin //if FColor <> nil then // Color := Integer(FColor); //Tolik 02/11/2021 -- если портить входящий цвет, не будет рисовать серым, если слой установлен как серый // Color := FColor; // if not IsClosed then begin if isArc then begin s := Style; if (wType = wtOpen) then begin s := ord(psDot); end; DrawArc(DEngine,Color,s); end else if (wType = wtOpen) then begin DrawOpen(Dengine,Color); end else if (wType = wtWall) then begin if isRow then color := clred; DrawWall(Dengine,Color); end else if (wType = wtGlass) then begin DrawGlass(Dengine,Color); end else if (wType = wtHalf) then begin DrawHalf(Dengine,Color); end; end; DrawDoors(Dengine,Color); end; procedure TnetPath.DrawArc(Dengine: TPCDrawEngine;Color:Tcolor; style:Integer); var rgn: HRGN; rad1,rad2,ang1,ang2: Double; px,py:TDoublePoint; begin rad1 := GetLineLenght(ArcCenter,l1); if Inverted then begin ang1 := GetRadOfLine(ArcCenter,l1); ang2 := GetRadOfLine(ArcCenter,l2); end else begin ang1 := GetRadOfLine(ArcCenter,l2); ang2 := GetRadOfLine(ArcCenter,l1); end; if ang2 = 0 then ang2 := 2 * pi; Dengine.drawbezarc(ArcCenter.x,ArcCenter.y,rad1,ang1,ang2,color,1,style,0,0,0,rgn,px,py,true,0); rad1 := GetLineLenght(ArcCenter,r1); if Inverted then begin ang1 := GetRadOfLine(ArcCenter,r1); ang2 := GetRadOfLine(ArcCenter,r2); end else begin ang1 := GetRadOfLine(ArcCenter,r2); ang2 := GetRadOfLine(ArcCenter,r1); end; if ang2 = 0 then ang2 := 2 * pi; rgn := 1; Dengine.drawbezarc(ArcCenter.x,ArcCenter.y,rad1,ang1,ang2,color,1,style,0,0,0,rgn,px,py,true,0); DEngine.drawline(ArcJoinA1.x,ArcJoinA1.y,ArcJoinA1L.x,ArcJoinA1L.y,color,1,style,0); DEngine.drawline(ArcJoinA2.x,ArcJoinA2.y,ArcJoinA2L.x,ArcJoinA2L.y,color,1,style,0); DEngine.drawline(ArcJoinB1.x,ArcJoinB1.y,ArcJoinB1L.x,ArcJoinB1L.y,color,1,style,0); DEngine.drawline(ArcJoinB2.x,ArcJoinB2.y,ArcJoinB2L.x,ArcJoinB2L.y,color,1,style,0); if Empty1 and Net.EndDraw then DEngine.drawline(a1.x,a1.y,b1.x,b1.y,Color,1,style,0); if Empty2 and Net.EndDraw then DEngine.drawline(a2.x,a2.y,b2.x,b2.y,Color,1,style,0); ApplyStyle(Dengine, color); //17.03.2013 end; procedure TnetPath.DrawGlass(Dengine: TPCDrawEngine;Color:TColor); var xp1,xp2: TDoublePoint; w: Integer; begin xp1 := MPoint(l1,r1); xp2 := mPoint(l2,r2); if Style = ord(psSolid) then w := 2 else w := 1; Net.drawline(Dengine,xp1,xp2,color,w,TPenStyle(style)); end; procedure TnetPath.DrawHalf(Dengine: TPCDrawEngine;Color:TColor); var s: TPenStyle; xp1,xp2: TDoublePoint; begin xp1 := MPoint(l1,r1); xp2 := mPoint(l2,r2); Net.drawline(Dengine,xp1,xp2,color,1,TPenStyle(Style)); end; procedure TnetPath.DrawOpen(Dengine: TPCDrawEngine; Color:TColor); var s: TPenStyle; begin s := psDot; Net.drawline(Dengine,a1,b1,color,1,s); Net.drawline(Dengine,a2,b2,color,1,s); Net.drawline(Dengine,a1,a2,color,1,s); Net.drawline(Dengine,b1,b2,color,1,s); end; procedure TNetPath.DrawTrace(Dengine: TPCDrawEngine); var mp: TDoublePOint; l: Double; lText, utext: String; aLength: string; aText: string; pt1, pt2: TDoublePoint; TraceLen: Double; ShowPathLengthType: TShowPathLengthType; MainNet: TNet; begin if not IsClosed and Not FIsHidden then begin pt1 := p1^; pt2 := p2^; ShowPathLengthType := sltPoints; if Assigned(FOnGetShowPathTraceLengthType) then ShowPathLengthType := FOnGetShowPathTraceLengthType(Self); //if Opath <> nil then begin case ShowPathLengthType of sltInner: if (ip1 <> nil) and (ip2 <> nil) then begin pt1 := ip1^; //PointToLine(p1^, p2^, pt1.x, pt1.y); pt2 := ip2^; //PointToLine(p1^, p2^, pt2.x, pt2.y); end; sltOuter: if (op1 <> nil) and (op2 <> nil) then begin pt1 := op1^; //PointToLine(p1^, p2^, pt1.x, pt1.y); pt2 := op2^; //PointToLine(p1^, p2^, pt2.x, pt2.y); end; end; end; DEngine.Canvas.Pen.Mode:= pmXor; DEngine.drawline(p1^.x, p1^.y, p2^.x, p2^.y, clLime, 1, ord(psSolid), 0); mp := MPoint(p1^, p2^); TraceLen := 0; if IsArc then TraceLen := GetArcLenByPoints(pt1, pt2, ArcCenter, Inverted) else TraceLen := GetLineLenght(pt1, pt2); aLength := FormatFloat(ffMask, MetreToUOM(Net.GetLengthForShow(TraceLen))); //21.04.2011 FormatFloat(ffMask, MetreToUOM(Len)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8); //22.10.2010 if IsArc then begin DrawArc(DEngine, clLime, Ord(psSolid)); //DrawArcCenter(DEngine, clLime, Ord(psSolid)); // линии от центральной точки до точек сегмента DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p1^.x,p1^.y, clLime, 1, Ord(psSolid), 0); DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p2^.x,p2^.y, clLime, 1, Ord(psSolid), 0); end; //13.05.2011 - запоминаем отрисованные точки //MainNet := nil; //if Assigned(Net.FRelatedOwner) then //begin // if (Net.FRelatedOwner is TNet) then // MainNet := TNet(Net.FRelatedOwner) // else if (Net.FRelatedOwner is TPathTrace) {and Assigned(TPathTrace(Net.FRelatedOwner).Clone)} then // begin // if Assigned(TPathTrace(Net.FRelatedOwner).FRelatedOwner) then // begin // if TPathTrace(Net.FRelatedOwner).FRelatedOwner is TPathTrace then // if Assigned(TPathTrace(TPathTrace(Net.FRelatedOwner).FRelatedOwner).Clone) then // MainNet := TPathTrace(TPathTrace(Net.FRelatedOwner).FRelatedOwner).Clone; // end // else if Assigned(TPathTrace(Net.FRelatedOwner).Clone) then // MainNet := TPathTrace(Net.FRelatedOwner).Clone; // end //end //else // MainNet := Net; MainNet := Net.GetMainTraceNet; if MainNet <> nil then begin MainNet.FDrawedPt1.Add(p1); MainNet.FDrawedPt2.Add(p2); end; end; end; procedure TnetPath.DrawWall(Dengine: TPCDrawEngine;Color:TColor); var i: Integer; door: TnetDoor; xl1, xr1, da1, da2, db1, db2: TDoublePoint; s: TPenStyle; xp1, xp2, xp, mp: TDoublePoint; ang: Double; xlen: Double; aLength: string; aText: string; procedure DrawPerpendicular(pp1, pp2: PDoublepoint); begin if (pp1 <> nil) and (pp2 <> nil) then Net.drawline(Dengine, pp1^, pp2^, color, FPathWidth, FPathStyle); end; begin s := TpenStyle(Style); // Test // FPathWidth := 3; // FPathStyle := psDot; if Net.FIsGroup and (Opath = nil) then Color := clBLue; if Doors.Count > 0 then begin xL1 := l1; xR1 := r1; for i := 0 to Doors.Count-1 do begin Door := TnetDoor(Doors[i]); da1 := Door.a1; da2 := Door.a2; db1 := Door.b1; db2 := Door.b2; //Net.drawline(Dengine, xL1, da1, color, 1, s); //Net.drawline(Dengine, xr1, db1, color, 1, s); Net.drawline(Dengine, xL1, da1, color, FPathWidth, FPathStyle); Net.drawline(Dengine, xr1, db1, color, FPathWidth, FPathStyle); Net.drawline(Dengine, da1, db1, color, 1, s); Net.drawline(Dengine, da2, db2, color, 1, s); xl1 := da2; xr1 := db2; //xl1 := da1; //xr1 := db1; end; if WStyle = wsWall then begin // ===== Net.drawline(Dengine, xL1, l2, color, FPathWidth, FPathStyle); Net.drawline(Dengine, xr1, r2, color, FPathWidth, FPathStyle); // ===== //18.05.2012 - Перпендикулярные линии- если сегмент тоньше связанного //DrawPerpendicular(@xL1, epl1); //DrawPerpendicular(@xr1, epr1); DrawPerpendicular(@l1, epl1); DrawPerpendicular(@r1, epr1); DrawPerpendicular(@l2, epl2); DrawPerpendicular(@r2, epr2); end; end else begin if WStyle = wsWall then begin // ===== Net.drawline(Dengine, l1, l2, color, FPathWidth, FPathStyle); Net.drawline(Dengine, r1, r2, color, FPathWidth, FPathStyle); // ===== //18.05.2012 - Перпендикулярные линии- если сегмент тоньше связанного DrawPerpendicular(@l1, epl1); DrawPerpendicular(@r1, epr1); DrawPerpendicular(@l2, epl2); DrawPerpendicular(@r2, epr2); end; end; if Net.ShowDims then begin xp1 := MPoint(a1, b1, 6.0); xp2 := MPoint(a2, b2, 6.0); xp := MPoint(xp1,xp2); if EQD(xp1.x,xp2.x) then Angle := 3 * (pi / 2) else if EQD(xp1.y, xp2.y) then Angle := 0 else Angle := GetRadOfLine(xp1, xp2); aLength := FormatFloat(ffMask, MetreToUOM(Len)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; if FShowLength then DEngine.DrawCenteredText(xp, clBlack, aLength + aText, 'Tahoma', 3.0, Angle); end; if Net.ShowPathCenters then begin xp := MPoint(p1^,p2^); Dengine.drawselectionpoint(xp.x, xp.y, xp.z, ptECircle, 1, clGray, false); end; if WStyle = wsWall then begin // ===== if Empty1 and Net.EndDraw then Net.drawline(Dengine, a1, b1, color, FPathWidth, FPathStyle); if Empty2 and Net.EndDraw then Net.drawline(Dengine, a2, b2, color, FPathWidth, FPathStyle); // ===== ApplyStyle(Dengine, color); //17.03.2013 end else if WStyle = wsLine then begin Net.drawline(Dengine, p1^, p2^, color, FPathWidth, FPathStyle); end; if Info <> '' then begin xp := MPoint(p1^,p2^); ang := GetRadOfLine(p1^,p2^); if EQD(ang , pi) then ang := 0; if EQD(ang, 3 * pi / 2) then ang := pi / 2; if FShowLength then DEngine.DrawCenteredText(xp, clBlack, Info, 'Verdana', 2.5, ang); end; end; procedure TnetPath.Hatch(DEngine: TPCDrawEngine; isGrayed: Boolean); var reg: HRGN; color: TColor; Door: TnetDoor; xp1, xp2, xp: TDoublePoint; Angle: Double; aLength: string; aText: string; ShowPathLengthType: TShowPathLengthType; begin Door := ActiveDoor; if Assigned(Door) then begin Color := clGreen; if isGrayed then Color := clSilver; DEngine.FillRgn(Door.Region,Color,ord(bsFDiagonal)); end else begin Color := clBlue; if isGrayed then Color := clSilver; //25.03.2013 DEngine.FillRgn(Region,Color,ord(bsFDiagonal)); FillRegions(DEngine, Color, ord(bsFDiagonal)); //DEngine.FillRgn(Region, clMaroon,ord(bsCross)); if (not Net.ShowDims) then begin xp1 := MPoint(a1, b1, 6.0); xp2 := MPoint(a2, b2, 6.0); xp := MPoint(xp1,xp2); if EQD(xp1.x,xp2.x) then Angle := 3*(pi/2) else if EQD(xp1.y,xp2.y) then Angle := 0 else Angle := GetRadOfLine(xp1,xp2); //15.04.2011 aLength := FormatFloat(ffMask, MetreToUOM(Len)); aLength := ''; //if Assigned(FOnGetShowPathLength) then // aLength := FormatFloat(ffMask, MetreToUOM(FOnGetShowPathLength(Self))) //else // aLength := FormatFloat(ffMask, MetreToUOM(GetLenForShow(sltPoints))); ShowPathLengthType := sltPoints; if Assigned(FOnGetShowPathLengthType) then ShowPathLengthType := FOnGetShowPathLengthType(Self); aLength := FormatFloat(ffMask, MetreToUOM(GetLenForShow(ShowPathLengthType))); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; if FShowLength then DEngine.DrawCenteredText(xp, clBlack, aLength + aText, 'Tahoma', 3.0, Angle); end; //22.10.2010 if IsArc then begin DrawArcCenter(DEngine, clRed, Ord(psSolid)); //TPowerCad(Net.Owner). //if (DragState <> dsMove) and (DragState <> dsLocate) then begin // Точка по центру {Color := clGreen; if isGrayed then Color := clSilver; DEngine.drawselectionpoint(ArcCenter.x, ArcCenter.y, ArcCenter.z, ptRect, 3, Color); // линии от центральной точки до точек сегмента Color := clRed; if isGrayed then Color := Grayedcolor; DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p1^.x,p1^.y, Color, 1, ord(psSolid), 0); DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p2^.x,p2^.y, Color, 1, ord(psSolid), 0); // Линия между точками DEngine.DrawLine(p1^.x,p1^.y, p2^.x,p2^.y, Color, 1, ord(psDot), 0);} end; end; end; end; function TnetPath.ISClosed: Boolean; begin result := false; result := EQDP(p1^,p2^); end; function TnetPath.isKnotIn(p: PDoublePoint): Integer; begin result := 0; if (p = p1) then result := 1 else if (p=p2) then result := 2 else result := 0; end; function TnetPath.isKnotValIn(p: TDoublePoint): Integer; begin result := 0; if EQDP(p,p1^) then result := 1 else if EQDP(p,p2^) then result := 2 else result := 0; end; function TnetPath.IsPointIn(x, y: Double; aSelect: Boolean=true): Boolean; var ipt: TPOint; dx,dy,z: Double; i: Integer; Door: TnetDoor; begin Result := False; if WStyle = wsLine then result := isPointInLine(p1^,p2^,DoublePoint(x,y),1) else if (wType <> wtHalf) and assigned(net) and assigned(net.XDrawEngine) and (region <> 0) then begin dx := x; dy := y; z := 0; net.XDrawEngine.ConvertPoint(dx,dy,z); ipt := Point(round(dx),round(dy)); if aSelect then begin DoorIndex := -1; for i := 0 to Doors.Count - 1 do begin Door := TnetDoor(Doors[i]); if ptInRegion(Door.Region,ipt.x,ipt.Y) then begin result := True; DoorIndex := i; exit; end; end; end; result := ptInRegion(region,ipt.x,ipt.Y); end else begin result := isPointInLine(p1^,p2^,DoublePoint(x,y),1); end; end; function TnetPath.IsPointOnLine(x, y: Double): Boolean; begin result := false; result := isPointInLine(p1^, p2^, DoublePoint(x, y), 1); end; function TnetPath.Len: Double; var w: Double; begin result := 0; w := width; // Result := (GetLineLenght(p1^,p2^) - w) / 1000; // if Net.WorldDim then // Result := (Result * Net.MapScale); Result := GetLenByPoints(p1^,p2^); //28.10.2010 GetLineLenght(p1^,p2^){ - w}; if Net.WorldDim then Result := Result / 1000 * Net.MapScale else Result := Result / 10; end; procedure TnetPath.Move(dx, dy: Double); begin p1.x := p1.x + dx; p1.y := p1.y + dy; p2.x := p2.x + dx; p2.y := p2.y + dy; if Assigned(FOnMove) then FOnMove(Self); end; procedure TnetPath.MoveDoor(delta: Double); var Door: TnetDoor; begin if (DoorIndex > -1) and (DoorIndex < Doors.Count) then begin Door := TnetDoor(Doors[DoorIndex]); Door.Start := Door.Start + Delta; end; end; function TnetPath.NewDoor(s, len: Double; aDoorObjType: TDoorObjType): TnetDoor; begin Result := nil; if WType <> wtWall then exit; s := (abslen - len) /2; s := s + (width / 2); Result := TNetDoor.Create(s, width, len, aDoorObjType, net); Doors.Add(Result); end; function TnetPath.OtherPoint(p: PDoublePoint): PDoublePoint; begin result := nil; if (p = p1) then result := p2 else result := p1; end; function TnetPath.Overlaps(path: TnetPath): Boolean; var p: TDoublePoint; a1,a2,a3,a4: Boolean; MarginDelta: Double; begin result := false; result := GetIntersectionPoint(p1^,p2^,path.p1^,path.p2^,p,false); if not result then begin MarginDelta := 2; if Assigned(FOnGetPathCheckOverlapMargin) then FOnGetPathCheckOverlapMargin(Net, Self, Path, MarginDelta); a1 := False; a2 := false; a3 := false; a4 := false; if isKnotIn(path.p1) = 0 then a1:= isPointInLine(p1^,p2^,path.p1^,1, MarginDelta); if isKnotIn(path.p2) = 0 then a2 := isPointInLine(p1^,p2^,path.p2^,1, MarginDelta); if Path.isKnotIn(p1) = 0 then a3 := isPointInLine(path.p1^,path.p2^,p1^,1, MarginDelta); if Path.isKnotIn(p2) = 0 then a4 := isPointInLine(path.p1^,path.p2^,p2^,1, MarginDelta); result := a1 or a2 or a3 or a4; end; end; function TnetPath.PosType: TPosType; var dx,dy: Double; begin dx := abs(p1.x - p2.x); dy := abs(p1.y - p2.y); if dx > dy then result := ptHorizontal else if dx < dy then result := ptVertical else result := ptAngular; end; procedure TnetPath.SetArcAng(ang: Double); begin ArcAng := ang; end; procedure TnetPath.SetShape(xArc: Boolean); begin isArc := xArc; end; procedure TnetPath.SetType(xType: TWallType); begin WType := xType; end; Function GetDoorStartValue(Obj:Pointer):Double; begin result := TnetDoor(Obj).Start; end; procedure TnetPath.SortDoors; var Door,door2: TnetDoor; cnt: Integer; index,i: Integer; PathLen: Double; begin cnt := Doors.Count; PathLen := AbsLen + Width; if Cnt = 1 then begin Door := TnetDoor(Doors[0]); if Door.Len > PathLen then Door.Len := PathLen; if Door.Start+Door.Len > PathLen-(Width/2) then Door.Start := PathLen-(Width/2)-Door.Len; end; if cnt < 2 then exit; SortList(Doors,GetDoorStartValue); for i := 0 to cnt - 2 do begin Door := TnetDoor(Doors[i]); Door2 := TnetDoor(Doors[i + 1]); if Door.Start+Door.Len > Door2.Start then begin Door2.Start := Door.Start+Door.Len+2; end; if Door.Start+Door.Len > PathLen-(Width/2) then Door.Start := PathLen-(Width/2)-Door.Len; if Door2.Start+Door2.Len > PathLen-(Width/2) then Door2.Start := PathLen-(Width/2)-Door2.Len; end; end; procedure TnetPath.UpdateRegion(Dengine:TPCDrawEngine); var i: Integer; begin if Region <> 0 then // Tolik 21/11/2019 -- DeleteObject(Region); Region := CreateInRgn(Dengine); For i := 0 to Doors.Count-1 do begin TNetDoor(Doors[i]).UpdateRegion(Dengine); end; end; // Tolik 04/09/2018 -- старая закомменчена, смотри ниже procedure TnetPath.WriteToStream(Stream: TStream); var PathVersion: Byte; index: Integer; i: integer; door: TnetDoor; b: Byte; begin //PathVersion := 1; //25.05.2010 //PathVersion := 2; //15.04.2011 //PathVersion := 3; //22.05.2012 //PathVersion := 4; //17.03.2013 //PathVersion := 5; // 04/09/2018 PathVersion := 6; Stream.Write(PathVersion, 1); Stream.Write(Byte(Border), 1); Stream.Write(Byte(FShowLength), 1); Stream.Write(Width, 8); index := Ord(FPathStyle); Stream.Write(index, 4); index := FPathWidth; Stream.Write(index, 4); index := Net.Points.IndexOf(p1); Stream.Write(index, 4); index := Net.Points.IndexOf(p2); Stream.Write(index, 4); Stream.Write(Byte(Wtype),1); Stream.Write(Byte(isArc),1); if isArc then begin Stream.Write(ArcAng,8); Stream.Write(Byte(Inverted),1); end; Stream.Write(FComponID, 4); //25.05.2010 Stream.Write(Byte(WStyle),1); //15.04.2011 Stream.Write(FPerpendSide, 1); //22.05.2012 Stream.Write(FColor, 4); //23.03.2013 //Tolik 22/08/2019 //Stream.Write(Byte(FBrushStyle),1); //17.03.2013 // Tolik 21/12/2019 -- //b := FBrushStyle; if FBrushStyle = -1 then b := 255 else b := FBrushStyle; // Stream.Write(b,1); //17.03.2013 // Stream.Write(FBrushColor, 4); //23.03.2013 Stream.Write(Doors.Count,4); for i := 0 to Doors.Count - 1 do begin Door := TNetDoor(Doors[i]); Door.WriteToStream(Stream); end; // Tolik 04/09/2018 -- Stream.Write(p1H, 8); Stream.Write(p2H, 8); // end; { procedure TnetPath.WriteToStream(Stream: TStream); var PathVersion: Byte; index: Integer; i: integer; door: TnetDoor; b: Byte; begin //PathVersion := 1; //25.05.2010 //PathVersion := 2; //15.04.2011 //PathVersion := 3; //22.05.2012 //PathVersion := 4; //17.03.2013 PathVersion := 5; Stream.Write(PathVersion, 1); Stream.Write(Byte(Border), 1); Stream.Write(Byte(FShowLength), 1); Stream.Write(Width, 8); index := Ord(FPathStyle); Stream.Write(index, 4); index := FPathWidth; Stream.Write(index, 4); index := Net.Points.IndexOf(p1); Stream.Write(index, 4); index := Net.Points.IndexOf(p2); Stream.Write(index, 4); Stream.Write(Byte(Wtype),1); Stream.Write(Byte(isArc),1); if isArc then begin Stream.Write(ArcAng,8); Stream.Write(Byte(Inverted),1); end; Stream.Write(FComponID, 4); //25.05.2010 Stream.Write(Byte(WStyle),1); //15.04.2011 Stream.Write(FPerpendSide, 1); //22.05.2012 Stream.Write(FColor, 4); //23.03.2013 Stream.Write(Byte(FBrushStyle),1); //17.03.2013 Stream.Write(FBrushColor, 4); //23.03.2013 Stream.Write(Doors.Count,4); for i := 0 to Doors.Count - 1 do begin Door := TNetDoor(Doors[i]); Door.WriteToStream(Stream); end; end; } procedure TnetPath.AddArcPoints(var pArr: TDoublePointArr; Direction: TPathDirection; IncFirst: Boolean); var rgn: HRGN; rad1,rad2,ang1,ang2: Double; px,py: TDoublePoint; Points: T2DPointArray; pCnt,oCnt,i,k: Integer; reversed: Boolean; begin oCnt := Length(pArr); if (Direction = ptL12) or (Direction = ptL21) then begin rad1 := GetLineLenght(ArcCenter,l1); reversed := false; if Inverted then begin ang1 := GetRadOfLine(ArcCenter,l1); ang2 := GetRadOfLine(ArcCenter,l2); reversed := (Direction = ptL21); end else begin ang1 := GetRadOfLine(ArcCenter,l2); ang2 := GetRadOfLine(ArcCenter,l1); reversed := (Direction = ptL12); end; if ang2 = 0 then ang2 := 2 * pi; BezierArcPoints(Points,ArcCenter.x,ArcCenter.y,rad1,ang1,ang2); pCnt := Length(Points); for i := 0 to Pcnt - 1 do begin if (i > 0) or (incFirst) then begin k := i; if reversed then k := pcnt - 1 - i; oCnt := oCnt + 1; SetLength(pArr,OCnt); pArr[Ocnt-1] := DoublePoint(Points[k].X,Points[k].Y); end; end; end else begin rad1 := GetLineLenght(ArcCenter,r1); reversed := false; if Inverted then begin ang1 := GetRadOfLine(ArcCenter,r1); ang2 := GetRadOfLine(ArcCenter,r2); reversed := (Direction = ptR21); end else begin ang1 := GetRadOfLine(ArcCenter,r2); ang2 := GetRadOfLine(ArcCenter,r1); reversed := (Direction = ptR12); end; if ang2 = 0 then ang2 := 2 * pi; rgn := 1; BezierArcPoints(Points,ArcCenter.x,ArcCenter.y,rad1,ang1,ang2); pCnt := Length(Points); for i := 0 to Pcnt - 1 do begin if (i > 0) or (incFirst) then begin k := i; if reversed then k := pcnt - 1 - i; oCnt := oCnt + 1; SetLength(pArr,OCnt); pArr[Ocnt-1] := DoublePoint(Points[k].X,Points[k].Y); end; end; end; end; procedure TnetPath.AddGlassPoints(var pArr: TDoublePointArr; Direction: TPathDirection; IncFirst: Boolean); begin end; procedure TnetPath.AddHalfPoints(var pArr: TDoublePointArr; Direction: TPathDirection; IncFirst: Boolean); begin end; procedure TnetPath.AddOpenPoints(var pArr: TDoublePointArr; Direction: TPathDirection; IncFirst: Boolean); begin end; procedure TnetPath.AddWallPoints(var pArr: TDoublePointArr; Direction: TPathDirection; IncFirst: Boolean); var oCnt,pCnt: Integer; begin if incFirst then pCnt := 4 else pCnt := 3; oCnt := Length(pArr); pCnt := oCnt + pCnt; SetLength(pArr,pCnt); Case direction of ptL12: begin if incFirst then pArr[pCnt-4] := L1; pArr[pCnt-3] := L1; pArr[pCnt-2] := L2; pArr[pCnt-1] := L2; end; ptL21: begin if incFirst then pArr[pCnt-4] := L2; pArr[pCnt-3] := L2; pArr[pCnt-2] := L1; pArr[pCnt-1] := L1; end; ptR12: begin if incFirst then pArr[pCnt-4] := R1; pArr[pCnt-3] := R1; pArr[pCnt-2] := R2; pArr[pCnt-1] := R2; end; ptR21: begin if incFirst then pArr[pCnt-4] := R2; pArr[pCnt-3] := R2; pArr[pCnt-2] := R1; pArr[pCnt-1] := R1; end; end; end; procedure TnetPath.AddEndLine(var pArr: TDoublePointArr; Direction: TPathDirection); var pCnt,oCnt: Integer; begin pCnt := 3; oCnt := Length(pArr); pCnt := oCnt + pCnt; SetLength(pArr,pCnt); Case direction of ptL12: begin pArr[pCnt-3] := L2; pArr[pCnt-2] := R2; pArr[pCnt-1] := R2; end; ptL21: begin pArr[pCnt-3] := L1; pArr[pCnt-2] := R1; pArr[pCnt-1] := R1; end; ptR12: begin pArr[pCnt-3] := R2; pArr[pCnt-2] := L2; pArr[pCnt-1] := L2; end; ptR21: begin pArr[pCnt-3] := R1; pArr[pCnt-2] := L1; pArr[pCnt-1] := L1; end; end; end; procedure TnetPath.DrawInnerCorners(DEngine: TPCDrawEngine; Color, Width, Style: Integer); var xp1,xp2: TDoublePoint; begin if Dir = 2 then begin xp1 := isoTopL1; xp2 := isoBotL1; DEngine.drawline(xp1,xp2,color,Width,Style,0); xp1 := isoTopL2; xp2 := isoBotL2; DEngine.drawline(xp1,xp2,color,Width,Style,0); end else begin xp1 := isoTopR1; xp2 := isoBotR1; DEngine.drawline(xp1,xp2,color,Width,Style,0); xp1 := isoTopR2; xp2 := isoBotR2; DEngine.drawline(xp1,xp2,color,Width,Style,0); end; end; procedure TnetPath.DrawOuterCorners(DEngine: TPCDrawEngine; Color, Width, Style: Integer); var xp1,xp2: TDoublePoint; begin if Dir = 1 then begin xp1 := isoTopL1; xp2 := isoBotL1; DEngine.drawline(xp1,xp2,color,Width,Style,0); xp1 := isoTopL2; xp2 := isoBotL2; DEngine.drawline(xp1,xp2,color,Width,Style,0); end else begin xp1 := isoTopR1; xp2 := isoBotR1; DEngine.drawline(xp1,xp2,color,Width,Style,0); xp1 := isoTopR2; xp2 := isoBotR2; DEngine.drawline(xp1,xp2,color,Width,Style,0); end; end; procedure TnetPath.DrawDoors(Dengine: TPCDrawEngine; Color: TColor); var i: Integer; Door: TnetDoor; begin for i:= 0 to Doors.Count -1 do begin Door := TnetDoor(Doors[i]); Door.Draw(Dengine,Color); end; end; procedure TnetPath.IsometricDraw(Dengine: TPCDrawEngine; Color: TColor); var i: Integer; rgn: HRGN; bs: Integer; begin (* for i := 0 to Length(FaceDraws)-1 do begin rgn := 1; Dengine.drawpolygon(FaceDraws[i],Color,1,ord(psSOlid),clSilver,ord(bsClear),rgn); if i = 0 then begin Dengine.FillRgn(FaceRegions[i],clSilver,ord(bsSolid)); end; end; *) end; function TnetPath.AbsLen: Double; begin result := 0; Result := (GetLineLenght(p1^,p2^) - Width); end; function TnetPath.PointToWall(var p: TdoublePoint; refP: TDoublePoint): Boolean; var ip: TDoublePoint; begin result := false; if GetInterSectionPoint(p1^,p2^,p,refP,ip,True) then begin if IsPointIn(ip.x, ip.y, false) then //26.06.2012 begin if not CheckPointForOtherNets(p) then begin p := ip; result := True; end; end; end; end; Procedure TnetPath.CalculateDoorPoints(dp1, dp2: PDoublePoint); var Door: TNetDoor; i: Integer; begin for i := 0 to Doors.Count - 1 do begin Door := TnetDoor(Doors[i]); Door.CalculatePoints(dp1^,dp2^); end; end; procedure TnetPath.CalculateExternSnaps; var lL, lR: Double; begin lL := GetLineLenght(HL1,HL2); lR := GetLineLenght(HR1,HR2); HE1 := HL1; HE2 := HL2; if abs(lL - LR) > 1 then begin if lL > LR then begin HE1 := HR1; HE2 := HR2; PointToLine(Hl1,HL2,HE1.x,HE1.y); PointToLine(Hl1,HL2,HE2.x,HE2.y); end else begin HE1 := HL1; HE2 := HL2; PointToLine(HR1,HR2,HE1.x,HE1.y); PointToLine(HR1,HR2,HE2.x,HE2.y); end; end; end; function TnetPath.SnapToCorners(var x, y: Double; DotsPerMil: Double): Boolean; var d1,d2,d3,d4,d5,d6,d7,d8,d: Double; p,pd: TDoublePoint; snapDist: Double; begin result := false; snapDist := 24/dotspermil; p := DoublePoint(x,y); d1 := GetLineLenght(l1,p); d2 := GetLineLenght(l2,p); d3 := GetLineLenght(r1,p); d4 := GetLineLenght(r2,p); d5 := GetDistToLine(l1,l2,p); d6 := GetDistToLine(r1,r2,p); d := d1; pd := l1; if d2 < d then begin d := d2; pd := l2; end; if d3 < d then begin d := d3; pd := r1; end; if d4 < d then begin d := d4; pd := r2; end; if d5 < d then begin d := d5; pd := DoublePoint(x,y); PointToLine(l1, l2, pd.x, pd.y); end; if d6 < d then begin d := d6; pd := DoublePoint(x,y); PointToLine(r1, r2, pd.x, pd.y); end; if d < snapDist then begin x := pd.x; y := pd.y; result := true; end; end; function TnetPath.SnapToKnots(var x, y: Double; DotsPerMil: Double; SnapLine:Boolean): Boolean; var d1,d2,d3,d4,d5,d6,d7,d8,d: Double; p,pd: TDoublePoint; snapDist: Double; begin result := false; snapDist := 24 / dotspermil; p := DoublePoint(x, y); d1 := GetLineLenght(p1^, p); d2 := GetLineLenght(p2^, p); d3 := GetLineLenght(MPoint(p1^, p2^), p); d := d1; pd := p1^; if d2 < d then begin d := d2; pd := p2^; end; if d3 < d then begin d := d3; pd := MPoint(p1^, p2^); end; if (d >= snapDist) and SnapLine then begin d := GetDistToLine(p1^, p2^,p); pd := DoublePoint(x, y); PointToLine(p1^, p2^, pd.x, pd.y); end; if d < snapDist then begin x := pd.x; y := pd.y; result := true; end; end; function TnetPath.SnapToPipeLine(var x, y: Double; DotsPerMil: Double): Boolean; var d1,d2,d3,d4,d5,d6,d7,d8,d: Double; p,pd: TDoublePoint; snapDist: Double; begin result := false; snapDist := 24 / dotspermil; p := DoublePoint(x, y); d7 := GetDistToLine(hl1, hl2, p); d8 := GetDistToLine(hr1, hr2, p); if d7 > d8 then begin d := d8; d := d8; pd := DoublePoint(x, y); PointToLine(hr1, hr2, pd.x, pd.y); end else begin d := d7; pd := DoublePoint(x,y); PointToLine(hl1,hl2,pd.x,pd.y); end; if (d < snapDist) (*and (d<>0)*) then begin x := pd.x; y := pd.y; result := true; end; end; function TnetPath.SnapToPipeCorners(var x, y: Double; DotsPerMil: Double): Boolean; var d1,d2,d3,d4,d5,d6,d7,d8,d: Double; p,pd: TDoublePoint; snapDist: Double; begin result := false; snapDist := 24/dotspermil; p := DoublePoint(x,y); d1 := GetLineLenght(hl1,p); d2 := GetLineLenght(hl2,p); d3 := GetLineLenght(hr1,p); d4 := GetLineLenght(hr2,p); d5 := GetLineLenght(he1,p); d6 := GetLineLenght(he2,p); d := d1; pd := hl1; if d2 < d then begin d := d2; pd := hl2; end; if d3 < d then begin d := d3; pd := hr1; end; if d4 < d then begin d := d4; pd := hr2; end; if d5 < d then begin d := d5; pd := he1; end; if d6 < d then begin d := d6; pd := he2; end; if (d < snapDist) (*and (d<>0)*) then begin x := pd.x; y := pd.y; result := true; end; end; function TnetPath.ForceSnapToPipeCorners(var x, y, dSnap: Double): Boolean; var d1,d2,d3,d4,d5,d6,d7,d8,d: Double; p,pd: TDoublePoint; begin result := false; p := DoublePoint(x,y); d1 := GetLineLenght(hl1,p); d2 := GetLineLenght(hl2,p); d3 := GetLineLenght(hr1,p); d4 := GetLineLenght(hr2,p); d5 := GetLineLenght(he1,p); d6 := GetLineLenght(he2,p); d := d1; pd := hl1; if d2 < d then begin d := d2; pd := hl2; end; if d3 < d then begin d := d3; pd := hr1; end; if d4 < d then begin d := d4; pd := hr2; end; if d5 < d then begin d := d5; pd := he1; end; if d6 < d then begin d := d6; pd := he2; end; if (d < dSnap) or (dSnap = -1234567) then begin x := pd.x; y := pd.y; dSnap := d; result := true; end; end; function TnetPath.ForceSnapToPipeLine(var x, y, dSnap: Double): Boolean; var d1,d2,d3,d4,d5,d6,d7,d8,d: Double; p,pd: TDoublePoint; onLine: Boolean; begin result := false; p := DoublePoint(x,y); d7 := GetDistToLine(hl1,hl2,p); d8 := GetDistToLine(hr1,hr2,p); if d7 > d8 then begin d := d8; pd := DoublePoint(x,y); PointToLine(hr1,hr2,pd.x,pd.y); onLine := isPOintInLine(hr1,hr2,pd,1,0.1); end else begin d := d7; pd := DoublePoint(x,y); PointToLine(hl1,hl2,pd.x,pd.y); onLine := isPointInLine(hl1,hl2,pd,1,0.1); end; if ((d < dSnap) or (dSnap = -1234567)) and onLine then begin x := pd.x; y := pd.y; dSnap := d; result := true; end; end; procedure TnetPath.DrawGuides(DEngine: TPCDrawEngine); var xp,xp1,xp2: TDoublePOint; begin DEngine.DrawPoint(hl1,clGray); DEngine.DrawPoint(hl2,clGray); DEngine.DrawPoint(hr1,clGray); DEngine.DrawPoint(hr2,clGray); DEngine.DrawPoint(he1,clGray); DEngine.DrawPoint(he2,clGray); end; procedure TnetPath.DeleteDoors; var Door: TnetDoor; i: Integer; begin try for i := 0 to Doors.Count-1 do begin Door := TnetDoor(Doors[i]); //Doors.Remove(Door); //Door.Free; DeleteDoorObj(Door); end; Doors.Clear; DoorIndex := -1; except // ShowMessage(CPowerCadMessage + 'TnetPath.DeleteDoors'); end; end; function TnetPath.GetLeftCorner(var wp: TDoublePoint): TDoublePoint; var x2,x3,xpl,xpr:TdoublePoint; dl,dr: Double; rad: Double; xHL1,xHl2,xHr1,xHR2: TDoublePoint; begin result := DoublePoint(0, 0); xpl := wp; xpr := wp; xHL1 := MPoint(HL1, HL2, -20.0); xHL2 := MPoint(HL2, HL1, -20.0); xHR1 := MPoint(HR1, HR2, -20.0); xHR2 := MPoint(HR2, HR1, -20.0); PointToLine(xHL1, xHL2, xpl.x, xpl.y); PointToLine(xHR1, xHR2, xpr.x, xpr.y); dl := GetLineLenght(xpl, wp); dr := GetLineLenght(xpr, wp); if dl < dr then begin wp := xpl; rad := GetRadOfLine(xHL1, xHL2); x2 := RotatePoint(xHL1, xHL2, -rad); x3 := RotatePoint(xHL1, xHR2, -rad); if x3.y < x2.y then begin if x2.x < xhl1.x then result := xhl2 else result := xhl1; end else begin if x2.x < xhl1.x then result := xhl1 else result := xhl2; end; end else begin wp := xpr; rad := GetRadOfLine(xHR1, xHR2); x2 := RotatePoint(xHR1, xHR2, -rad); x3 := RotatePoint(xHR1, xHL2, -rad); if x3.y < x2.y then begin if x2.x < xhR1.x then result := xhR2 else result := xhR1; end else begin if x2.x < xhR1.x then result := xhR1 else result := xhR2; end; end; end; function TnetPath.GetRightCorner(var wp: TDoublePoint): TDoublePoint; var x2,x3,xpl,xpr: TDoublePoint; dl,dr: DOuble; rad: Double; xHL1,xHl2,xHr1,xHR2: TDoublePoint; begin xpl := wp; xpr := wp; xHL1 := MPoint(HL1, HL2, -20.0); xHL2 := MPoint(HL2, HL1, -20.0); xHR1 := MPoint(HR1, HR2, -20.0); xHR2 := MPoint(HR2, HR1, -20.0); PointToLine(xHL1, xHL2, xpl.x, xpl.y); PointToLine(xHR1, xHR2, xpr.x, xpr.y); dl := GetLineLenght(xpl, wp); dr := GetLineLenght(xpr, wp); if dl < dr then begin wp := xpl; rad := GetRadOfLine(xHL1, xHL2); x2 := RotatePoint(xHL1, xHL2, -rad); x3 := RotatePoint(xHL1, xHR2, -rad); if x3.y < x2.y then begin if x2.x > xhl1.x then result := xhl2 else result := xhl1; end else begin if x2.x > xhl1.x then result := xhl1 else result := xhl2; end; end else begin wp := xpr; rad := GetRadOfLine(xHR1, xHR2); x2 := RotatePoint(xHR1, xHR2, -rad); x3 := RotatePoint(xHR1, xHL2, -rad); if x3.y < x2.y then begin if x2.x > xhR1.x then result := xhR2 else result := xhR1; end else begin if x2.x > xhR1.x then result := xhR1 else result := xhR2; end; end; end; procedure TnetPath.AddCols; var col: TNetCol; begin col := TnetCol.Create(Net, Self.p1); Col.SetPosition; Net.Structs.Add(col); col := TnetCol.Create(Net, Self.p2); Col.SetPosition; Net.Structs.Add(col); end; procedure TnetPath.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); begin figMaxX := a1.x; figMaxY := a1.y; figMinX := a1.x; figMinY := a1.y; if a2.x > figMaxX then figMaxX := a2.x; if b1.x > figMaxX then figMaxX := b1.x; if b2.x > figMaxX then figMaxX := b2.x; if a2.x < figMinX then figMinX := a2.x; if b1.x < figMinX then figMinX := b1.x; if b2.x < figMinX then figMinX := b2.x; if a2.y > figMaxY then figMaxY := a2.y; if b1.y > figMaxY then figMaxY := b1.y; if b2.y > figMaxY then figMaxY := b2.y; if a2.y < figMinY then figMinY := a2.y; if b1.y < figMinY then figMinY := b1.y; if b2.y < figMinY then figMinY := b2.y; end; function TnetPath.HasDoor: Boolean; var i: Integer; Door: TnetDoor; begin result := false; for i:= 0 to Doors.Count -1 do begin Door := TnetDoor(Doors[i]); if door.DoorObjType = dotDoor then result := true; end; end; function TnetPath.isLineIntersect(xp1, xp2: TDoublePoint): Boolean; var rp1, rp2: TDoublePoint; begin Result := false; rp1 := p1^; rp2 := p2^; rp1.z := 0; rp2.z := 0; xp1.z := 0; xp2.z := 0; result := LinesIntersect(xp1, xp2, rp1, rp2); end; function TnetPath.MLen: Double; begin result := 0; Result := (GetLineLenght(p1^,p2^)); end; function TnetPath.InnerLen: Double; var // BPoints1,BPoints2: TDoublePointArr; LenL: Double; LenR: Double; begin Result := 0; if Net <> nil then begin //Net.CollectBoundPoints(Self, BPoints1,BPoints2); //if Length(BPoints1) > 0 then // Result := GetLineLenght(p1^,BPoints1[0])-Self.Width; //if Length(BPoints2) > 0 then // Result := GetLineLenght(p2^,BPoints2[0])-Self.Width; if (ip1 <> nil) and (ip2 <> nil) then Result := GetLenByPoints(ip1^, ip2^) else begin LenL := GetLenByPoints(el1, el2); //28.10.2010 GetLineLenght(el1, el2); LenR := GetLenByPoints(er1, er2); //28.10.2010 GetLineLenght(er1, er2); Result := Min(LenL, LenR); end; //Result := GetLenByPoints(el1, el2); end; end; procedure TnetPath.Refresh; var h1, h2, MaxDoorHeight, DoorH: Double; Door: TNetDoor; i: integer; Function GetMaxDoorHeight: Double; var dist1, dist2, LenH, LenG, koeff: Double; PathPoint1: TDoublePoint; begin if CompareValue(h1, h2) = 0 then Result := h1 else begin LenH := ABS(h1 - h2); // len diff LenG := GetLenByPoints(p1^, p2^); //Sqrt(Sqr(p1.x - p2.x) + Sqr(p1.y - p2.y)); if Net.WorldDim then LenG := LenG / 1000 * Net.MapScale else LenG := LenG / 10; Koeff := LenH/LenG; if CompareValue(h1, h2) = 1 then begin PathPoint1.x := p2.x; PathPoint1.y := p2.y; PathPoint1.z := h2; end else begin PathPoint1.x := p1.x; PathPoint1.y := p1.y; PathPoint1.z := h1; end; if Net.WorldDim then begin dist1 := GetLenByPoints(PathPoint1, Door.p1) / 1000 * Net.MapScale; dist2 := GetLenByPoints(PathPoint1, Door.p2) / 1000 * Net.MapScale; end else begin dist1 := GetLenByPoints(PathPoint1, Door.p1) / 10; dist2 := GetLenByPoints(PathPoint1, Door.p2) / 10; end; Result := RoundN((MaxDoorHeight + Min(dist1, dist2)* koeff), 2); //Max(dist1, dist2)* koeff; end; end; begin // на всякий if p1 = nil then exit else if p2 = nil then exit; // определяем окна/двери if p1h = -1 then h1 := F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.HeightRoom else h1 := p1h; if p2h = -1 then h2 := F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.HeightRoom else h2 := p2H; // здесь - пересчет высот дверей и окон до допустимых величин в зависимоти от высоты блока if (h1 = 0) then if (h2 = 0) then exit; // если оба края -- по нулям -- нах отсюда (пользователь сам дурак) for i := 0 to Doors.Count - 1 do begin MaxDoorHeight := Min(h1, h2); Door := TNetDoor(Doors[i]); DoorH := Door.Height; // Высота двери //if Door.DoorObjType = dotWindow then DoorH := DoorH + Door.WndPlacementHeight; // если окно - добавить высоту размещения окна if CompareValue(DoorH, MaxDoorHeight) = 1 then begin if CompareValue(h1, h2) <> 0 then MaxDoorHeight := GetMaxDoorHeight; if CompareValue(MaxDoorHeight, DoorH) = -1 then begin Door.Height := MaxDoorHeight - door.WndPlacementHeight - MetreToUom(0.1);//DoorH - (DoorH - MaxDoorHeight) - MetreToUom(0.1) if door.Height < 0 then Door.Height := 0; end; end; end; // end; procedure TnetPath.DeleteRegions; var i: Integer; begin // Tolik 21/11/2019 -- if Region <> 0 then begin // DeleteObject(Region); Region := 0; end; For i := 0 to Doors.Count-1 do begin TNetDoor(Doors[i]).DeleteRegion; end; For i := 0 to FSubRegions.Count-1 do DeleteObject(HRGN(FSubRegions[i])); FSubRegions.Clear; end; function TnetPath.LineIntersect(xp1, xp2: TDoublePoint; var ip: TDoublePoint): Boolean; var rp1,rp2: TDoublePoint; begin result := false; rp1 := p1^; rp2 := p2^; rp1.z := 0; rp2.z := 0; xp1.z := 0; xp2.z := 0; result := GetIntersectionPoint(xp1,xp2,rp1,rp2,ip,false,false); end; procedure TnetPath.MoveDoors(nPath: TnetPath); var i: Integer; Door: TNetDoor; begin try for i := 0 to Doors.Count - 1 do begin Door := TnetDoor(Doors[i]); if door.Start > Self.MLen then begin nPath.NewDoor(door.Start - Self.MLen, door.Len, door.DoorObjType); door.Free; Doors[i] := nil; end; end; for i := Doors.Count - 1 downto 0 do begin Door := TnetDoor(Doors[i]); if door = nil then begin Doors.Delete(i); end; end; except // ShowMessage(CPowerCadMessage + 'TnetPath.MoveDoors'); end; end; procedure TnetPath.SetLen(len: Double; back: Boolean); var xp1, xp2, np: TDoublePoint; dx, dy, dLen, slen: Double; pp1, pp2, pp, spp: PDoublePoint; xPaths: TList; i: Integer; xPath: TnetPath; begin len := abs(Len); len := Len + Width; if self.PosType = ptHorizontal then begin if p1^.x > p2^.x then begin xp1 := p2^; xp2 := p1^; pp1 := p2; pp2 := p1; end else begin xp1 := p1^; xp2 := p2^; pp1 := p1; pp2 := p2; end; end else begin if p1^.y > p2^.y then begin xp1 := p2^; xp2 := p1^; pp1 := p2; pp2 := p1; end else begin xp1 := p1^; xp2 := p2^; pp1 := p1; pp2 := p2; end; end; slen := GetLineLength(xp1, xp2); dLen := len - slen; xPaths := TList.Create; if back then begin np := Mpoint(xp1, xp2, -dLen); spp := pp1; dx := np.x - xp1.x; dy := np.y - xp1.y; end else begin np := Mpoint(xp2, xp1, -dLen); dx := np.x - xp2.x; dy := np.y - xp2.y; spp := pp2; end; Net.GetPathsOfKnot(spp, xPaths); xPaths.Remove(Self); for i := 0 to xpaths.Count - 1 do begin xPath := TNetPath(xPaths[i]); if xPath.PosType <> PosType then begin pp := xPath.OtherPoint(spp); pp^.x := pp^.x + dx; pp^.y := pp^.y + dy; end; end; spp^ := np; xPaths.Free; Net.RefreshPaths; end; function TnetPath.GetPoint(PType: Integer): TDoublePoint; var xp1, xp2: TDoublePOint; begin result := DoublePoint(0, 0); if PType = 2 then begin if EQD(mpa.x, mpb.x) then begin if mpa.y > mpb.y then begin xp1 := mpa; xp2 := mpb; end else begin xp1 := mpb; xp2 := mpa; end; end else begin if mpa.x > mpb.x then begin xp1 := mpa; xp2 := mpb; end else begin xp1 := mpb; xp2 := mpa; end; end; Result := MPoint(xp1, xp2, -3.0); end else if PType = 4 then begin if EQD(apa.x , apb.x) then begin if apa.y > apb.y then begin xp1 := apa; xp2 := apb; end else begin xp1 := apb; xp2 := apa; end; end else begin if apa.x > apb.x then begin xp1 := apa; xp2 := apb; end else begin xp1 := apb; xp2 := apa; end; end; Result := MPoint(xp1, xp2, -6.0); end; end; procedure TnetPath.AfterDiv; begin try if Assigned(FOnAfterDiv) then FOnAfterDiv(Self); finally //if Net <> nil then // Net.FPathDivision := nil; end; end; procedure TnetPath.BeforeDiv; begin //if Net <> nil then // Net.FPathDivision := Self; if Assigned(FOnBeforeDiv) then FOnBeforeDiv(Self); end; function TnetPath.AddDoorAtPt(pt: TDoublePoint; len: Double; aDoorObjType: TDoorObjType): TnetDoor; var s: Double; begin Result := nil; if WType <> wtWall then exit; s := GetLineLenght(Self.p1^, pt); //s := (abslen - len) /2; //s := s + (width / 2); s := s - (len / 2); Result := TNetDoor.Create(s, width, len, aDoorObjType, net); Doors.Add(Result); end; procedure TnetPath.AddLen(ALen: Double); //15.10.2010 var StaticPoint: PDoublepoint; // точка которая останется на месте MovePoint: PDoublepoint; // точка которая будет смещаться begin MovePoint := nil; // Если X примерно одинаковый, ищем у кого больше Y if Abs(p1^.x - p2^.x) < 0.01 then begin if p1^.y < p2^.y then MovePoint := p2 else MovePoint := p1; end // иначе перемещаем точку с большим X else begin if p1^.x < p2^.x then MovePoint := p2 else MovePoint := p1; end; //p2^ := MPoint(p1^, p2^, GetLineLenght(p1^,p2^) + ALen); StaticPoint := SecondPoint(MovePoint); MovePoint^ := MPoint(StaticPoint^, MovePoint^, GetLineLenght(p1^,p2^) + ALen); end; procedure TnetPath.AfterLoadProps; begin GArchEngine.AfterLoadProps(Self); end; procedure TnetPath.ApplyStyle(Dengine:TPCDrawEngine; Color:TColor); begin if FBrushStyle <> -1 then FillRegions(Dengine, FBrushColor, FBrushStyle); end; procedure TnetPath.Assign(ASource: TNetPath); begin CopyFrom(ASource); AssignProps(ASource); end; procedure TnetPath.AssignProps(APath: TNetPath); begin isArc := APath.isArc; Angle := APath.Angle; ArcAng := APath.ArcAng; ArcRad := APath.ArcRad; Inverted := APath.Inverted; ArcCenter := APath.ArcCenter; ArcA1 := APath.ArcA1; ArcA2 := APath.ArcA2; WStyle := APath.WStyle; FColor := APath.FColor; FBrushColor := APath.FBrushColor; FBrushStyle := APath.FBrushStyle; end; function TnetPath.CmpIntersectPath(APath: TNetPath; MarginDelta:Double = 2; AEqualRotate: Pointer=nil): Integer; //var // p1InAPath, p2InAPath: Boolean; // ap1InPath, ap2InPath: Boolean; begin Result := Net.CmpIntersectPaths(p1,p2, APath.p1, APath.p2, MarginDelta, AEqualRotate); {Result := citNone; if (PointNear(p1^, APath.p1^) and PointNear(p2^, APath.p2^)) or (PointNear(p1^, APath.p2^) and PointNear(p2^, APath.p1^)) then Result := citEqual else begin p1InAPath := isPointInLine(APath.p1^, APath.p2^, p1^,1); p2InAPath := isPointInLine(APath.p1^, APath.p2^, p2^,1); ap1InPath := isPointInLine(p1^,p2^, APath.p1^,1); ap2InPath := isPointInLine(p1^,p2^, APath.p2^,1); if p1InAPath and p2InAPath then Result := citEntry else if ap1InPath and ap2InPath then Result := citAbsorb else if p1InAPath or p2InAPath or ap1InPath or ap2InPath then Result := citSide; //if isPointInLine(APath.p1^, APath.p2^, p1^,1) and isPointInLine(APath.p1^, APath.p2^, p2^,1) then // Result := citEntry //else //if isPointInLine(p1^,p2^, APath.p1^,1) and isPointInLine(p1^,p2^, APath.p2^,1) then // Result := citAbsorb; end;} end; procedure TnetPath.DefineDoorsOwner; var i: Integer; begin for i := 0 to Doors.Count - 1 do begin TNetDoor(Doors[i]).FPath := Self; end; end; procedure TnetPath.DefineInOutPoints; var PathList: TList; i: Integer; OutPoints: TDoublePointArr; InnPoints: TDoublePointArr; IsRoof: boolean; //OutArea: Double; //InnArea: Double; begin //op1 := nil; //@el1; //op2 := nil; //@el2; //ip1 := nil; //@er1; //ip2 := nil; //@er2; op1 := @el1; op2 := @el2; ip1 := @er1; ip2 := @er2; FIsInner := false; FIsConture := false; PathList := TList.Create; // Определяем список сегментов так чтобы Self был в самом начале PathList.Assign(Net.Paths); PathList.Remove(Self); PathList.Insert(0, Self); GetPathsConturePoints(PathList, @OutPoints, @InnPoints, {nil, nil,}false, nil, nil, nil, nil); //OutArea := GetAreaFromPolygon(OutPoints); //InnArea := GetAreaFromPolygon(InnPoints); FIsConture := (Length(OutPoints) > 0) or (Length(InnPoints) > 0); isroof := IfFiguraisroof(Net); // Проверяем, входит ли один контур OutPoints во второй InnPoints if (Length(OutPoints) > 0) and (Length(InnPoints) > 0) then begin if CheckContrureEntry(@OutPoints, @InnPoints, false, false, isroof) then begin if IsPtInArray(el1, @OutPoints) and IsPtInArray(er1, @InnPoints) then begin op1 := @el1; op2 := @el2; ip1 := @er1; ip2 := @er2; end else if IsPtInArray(er1, @OutPoints) and IsPtInArray(el1, @InnPoints) then begin op1 := @er1; op2 := @er2; ip1 := @el1; ip2 := @el2; end else if CheckConturesEqual(@OutPoints, @InnPoints) then begin if IsPtInArray(er1, @InnPoints) then begin op1 := @el1; op2 := @el2; ip1 := @er1; ip2 := @er2; end else if IsPtInArray(el1, @InnPoints) then begin op1 := @er1; op2 := @er2; ip1 := @el1; ip2 := @el2; end; end; end else FIsInner := true; // признак что сегмент между двумя контурами end else begin EmptyProcedure; end; SetLength(OutPoints, 0); SetLength(InnPoints, 0); PathList.Free; end; Procedure TnetPath.DeleteDoorObj(ADoor: TNetDoor); begin if Not ADoor.FDeleting then begin ADoor.DoDelete; Doors.Remove(ADoor); ADoor.Free; end; end; procedure TnetPath.DoDelete; var Paths1, Paths2: TList; Path, PathToCheck: TNetPath; pt1, pt2, pt: PDoublePoint; i,j, DefCnt: Integer; //Tolik CanRemovePoint: boolean; PathCheckList: TList; begin if Not FDeleting then begin FDeleting := true; if Assigned(FOnDelete) then FOnDelete(Self); end; DefCnt := 3; if (Net.Paths.Count > DefCnt)and(Net.fcomponID <> 0) and Not (ssShift in GGlobalShiftState) then begin Paths1 := Net.GetPathListByPoint(Self.p1); Paths2 := Net.GetPathListByPoint(Self.p2); if (Paths1 <> nil) and (Paths2 <> nil) then begin Paths1.Remove(Self); Paths2.Remove(Self); if (Paths1.Count > 0) and (Paths2.Count > 0) then begin pt1 := Self.p1; pt2 := Self.p2; if Paths1.Count > Paths2.Count then begin ExchangeObjects(Paths1, Paths2); pt1 := Self.p2; pt2 := Self.p1; end; // 13/10/2016-- Tolik -- если треугольник - нех удалять и объединять а то буде кака CanRemovePoint := True; if (TNetPath(Paths1[0]).p1 = TNetPath(Paths2[0]).p1) or (TNetPath(Paths1[0]).p1 = TNetPath(Paths2[0]).p2) or (TNetPath(Paths1[0]).p2 = TNetPath(Paths2[0]).p1) or (TNetPath(Paths1[0]).p2 = TNetPath(Paths2[0]).p2) then CanRemovePoint := False; if CanRemovePoint then begin for i := 0 to Paths1.Count - 1 do begin Path := TNetPath(Paths1[i]); if Path.p1 = pt1 then Path.p1 := pt2 else if Path.p2 = pt1 then Path.p2 := pt2; end; Net.DeletePoint(pt1); end; end; end; if Paths1 <> nil then Paths1.Free; if Paths2 <> nil then Paths2.Free; end; end; Procedure TnetPath.DoClick(X, Y: Double); var ModPoint: TModPoint; begin FSelecting := true; try // Проверка клика на modpoint //#From Oleg# //05.10.2010 ModPoint := TPCDrawing(Self.Net.Owner).HitTestModPoint(x,y); if (ModPoint <> nil) and (ModPoint.Figure = Self.Net) then begin if PointNear(Self.p1^, DoublePoint(ModPoint.CoordX, ModPoint.CoordY)) then TNet(Self.Net).DoClickPoint(Self.p1) else if PointNear(Self.p2^, DoublePoint(ModPoint.CoordX, ModPoint.CoordY)) then TNet(Self.Net).DoClickPoint(Self.p2); end else begin if Assigned(FOnSelect) then FOnSelect(Self); end; finally FSelecting := false; end; end; Procedure TnetPath.DoDblClick; begin if Assigned(FOnDblClick) then FOnDblClick(Self); end; Procedure TnetPath.DrawArcCenter(Dengine:TPCDrawEngine; Color:Tcolor; Style:Integer); begin // Точка по центру DEngine.drawselectionpoint(ArcCenter.x, ArcCenter.y, ArcCenter.z, ptRect, 3, clGreen); // линии от центральной точки до точек сегмента DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p1^.x,p1^.y, Color, 1, Style, 0); DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p2^.x,p2^.y, Color, 1, Style, 0); // Линия между точками DEngine.DrawLine(p1^.x,p1^.y, p2^.x,p2^.y, Color, 1, ord(psDot), 0); end; function TnetPath.ExistsPerpendPt: Boolean; begin Result := (epl1<>nil)or(epl2<>nil)or(epr1<>nil)or(epr2<>nil); end; procedure TnetPath.FillArcJoinPoints(aPoints, aLPoints: TList); begin aPoints.Clear; aLPoints.Clear; aPoints.Add(@ArcJoinA1); aLPoints.Add(@ArcJoinA1L); aPoints.Add(@ArcJoinA2); aLPoints.Add(@ArcJoinA2L); aPoints.Add(@ArcJoinB1); aLPoints.Add(@ArcJoinB1L); aPoints.Add(@ArcJoinB2); aLPoints.Add(@ArcJoinB2L); end; procedure TnetPath.FillArcPointsByEndPoints(var aPoints: TDoublePointArr; ap1, ap2: PDoublePoint; aDxfMode: Boolean=false); var Radius, a1, a2: Double; OldDxfMode: Boolean; Fpoints: T2DPointArray; i: integer; begin SetLength(aPoints, 0); Radius := GetLineLenght(ap1^, Self.ArcCenter); a1 := GetRadOfLine(Self.ArcCenter, ap1^); a2 := GetRadOfLine(Self.ArcCenter, ap2^); if Not Self.Inverted then ExchangeDouble(a1, a2); OldDxfMode := DxfMode; // повышаем точность - количество точек для дуги DxfMode := aDxfMode; try BezierArcPoints(Fpoints, Self.ArcCenter.x, Self.ArcCenter.y, Radius, a1, a2); if Length(Fpoints) > 0 then begin SetLength(aPoints, Length(Fpoints)); for i := 0 to Length(Fpoints) - 1 do begin aPoints[i].x := Fpoints[i].x; aPoints[i].y := Fpoints[i].y; aPoints[i].z := 0; end; SetLength(Fpoints, 0); end; finally DxfMode := OldDxfMode; end; end; procedure TnetPath.FillRegions(Dengine:TPCDrawEngine; aBrushColor: TColor; aBrushStyle: Integer); var i: Integer; begin if FSubRegions.Count = 0 then DEngine.FillRgn(Region, aBrushColor, aBrushStyle) else begin for i := 0 to FSubRegions.Count - 1 do DEngine.FillRgn(HRGN(FSubRegions[i]), aBrushColor, aBrushStyle); end; end; function TnetPath.GetArcLPointByPt(apt: PDoublePoint): PDoublePoint; begin Result := nil; if EQDP(ArcJoinA1, apt^) then Result := @ArcJoinA1L else if EQDP(ArcJoinA2, apt^) then Result := @ArcJoinA2L else if EQDP(ArcJoinB1, apt^) then Result := @ArcJoinB1L else if EQDP(ArcJoinB2, apt^) then Result := @ArcJoinB2L else if EQDP(ArcJoinA1L, apt^) then Result := @ArcJoinA1 else if EQDP(ArcJoinA2L, apt^) then Result := @ArcJoinA2 else if EQDP(ArcJoinB1L, apt^) then Result := @ArcJoinB1 else if EQDP(ArcJoinB2L, apt^) then Result := @ArcJoinB2; if Result <> nil then if EQDP(Result^, apt^) then Result := nil; end; function TnetPath.GetConnected(APt: PDoublePoint): TNetPath; var i: integer; Path: TNetPath; begin Result := nil; for i := 0 to Net.Paths.Count - 1 do begin Path := TNetPath(Net.Paths[i]); if (Path <> Self) and ((Path.p1 = APt) or (Path.p2 = APt)) then begin Result := Path; Break; //// BREAK //// end; end; end; function TnetPath.GetConnectedPoint(APath: TNetPath): PDoublePoint; begin Result := nil; if (p1 = APath.p1) or (p1 = APath.p2) then Result := p1 else if (p2 = APath.p2) or (p2 = APath.p1) then Result := p2; end; function TnetPath.GetConnectedSide(APath: TNetPath): Integer; begin Result := Self.GetPointSide(GetConnectedPoint(APath)); end; function TnetPath.GetConturePolygon: TDoublePointArr; var i: Integer; begin SetLength(Result, 8); //Result[0] := el1; //Result[1] := el2; //Result[2] := er2; //Result[3] := er1; //Result[4] := el1; Result[0] := el1; Result[1] := el2; Result[2] := el2; Result[3] := er2; Result[4] := er2; Result[5] := er1; Result[6] := er1; Result[7] := el1; end; function TnetPath.GetConturePoints(aAllowEPoints: Boolean; aPointSide: Integer=0; aPathSide: Char=#0): TList; procedure AddPtToList(aPt: PDoublePoint; aPtSide: Integer; aSide: Char); begin if ((aPointSide = 0) or (aPointSide = aPtSide)) and ((aPathSide=#0) or (aPathSide = aSide)) then Result.Add(aPt); end; begin Result := TList.Create; //if (aSide = 0) or (aSide = 1) then // Result.Add(@r1); //if (aSide = 0) or (aSide = 2) then // Result.Add(@r2); //if (aSide = 0) or (aSide = 1) then // Result.Add(@l1); //if (aSide = 0) or (aSide = 2) then // Result.Add(@l2); AddPtToList(@r1, 1, 'r'); AddPtToList(@r2, 2, 'r'); AddPtToList(@l1, 1, 'l'); AddPtToList(@l2, 2, 'l'); if aAllowEPoints then begin //if (aSide = 0) or (aSide = 1) then // Result.Add(@er1); //if (aSide = 0) or (aSide = 2) then // Result.Add(@er2); //if (aSide = 0) or (aSide = 1) then // Result.Add(@el1); //if (aSide = 0) or (aSide = 2) then // Result.Add(@el2); AddPtToList(@er1, 1, 'r'); AddPtToList(@er2, 2, 'r'); AddPtToList(@el1, 1, 'l'); AddPtToList(@el2, 2, 'l'); end; end; function TnetPath.GetDoorByComponID(AComponID: Integer): TNetDoor; var i: Integer; begin Result := nil; for i := 0 to Doors.Count - 1 do begin if TNetDoor(Doors[i]).FComponID = AComponID then begin Result := TNetDoor(Doors[i]); Result.FPath := Self; Break; //// BREAK //// end; end; end; function TnetPath.GetFullConture: TDoublePointArr; var pa1, pa2, pb1, pb2: TDoublePoint; DirectionKoef: Integer; begin SetLength(Result, 4); // pa1-pa2 определяем как более длинная линия чем pb1-pb2 if GetLineLength(Self.r1, Self.r2) < GetLineLength(Self.l1, Self.l2) then begin pa1 := l1; pa2 := l2; pb1 := r1; pb2 := r2; end else begin pa1 := r1; pa2 := r2; pb1 := l1; pb2 := l2; end; DirectionKoef := GetParallelPointDirectionKoeff(pa1, pa2, pb1); GetParallelPoints(pa1, pa2, pb1, pb2, DirectionKoef * Self.Width); Result[0] := pa1; Result[1] := pa2; Result[2] := pb2; Result[3] := pb1; end; function TnetPath.GetHeight: Double; begin Result := 0; if Assigned(FOnGetHeight) then Result := FOnGetHeight(Self); end; function TnetPath.GetHeightOfPt(pt: PDoublePoint): Double; begin Result := 0; if Assigned(FOnGetHeightOfPt) then Result := FOnGetHeightOfPt(Self, pt); end; function TnetPath.GetLenByPoints(p1, p2: TDoublePoint): Double; var //AngGrad: Double; //radius: Double; PointsAng: Double; begin Result := 0; if IsArc then begin //AngGrad := ArcAng * 180/pi; //radius := GetLineLenght(ArcCenter, p1); //Result := (pi * radius * AngGrad) / 180; // следствие из (2 * pi * radius) * (AngGrad / 360) //a1 := GetRadOfLine(p1, ArcCenter); //a2 := GetRadOfLine(p2, ArcCenter); //PointsAng := 0; //if Not APatch.Inverted then // PointsAng := a1-a2; //else // PointsAng := a2-a1; //21.04.2011 //PointsAng := 0; // if Inverted then // PointsAng := GetRadOf2Lines(p1, ArcCenter, p2) // else // PointsAng := GetRadOf2Lines(p2, ArcCenter, p1); // // if PointsAng = 0 then // PointsAng := 2 * pi // else // if PointsAng < 0 then // PointsAng := (2 * pi) + PointsAng; // // Result := GetArcLen(ArcCenter, p1, PointsAng); Result := GetArcLenByPoints(p1, p2, ArcCenter, Inverted); end else Result := GetLineLenght(p1, p2); end; // Вернет длину для показа function TnetPath.GetLenForShow(AShowPathLengthType: TShowPathLengthType): Double; begin Result := 0; case AShowPathLengthType of sltPoints: Result := Len; sltOuter, sltInner: begin case AShowPathLengthType of sltOuter: Result := OutLen; sltInner: Result := InnerLen; end; if Net.WorldDim then Result := Result / 1000 * Net.MapScale else Result := Result / 10; end; end; end; function TnetPath.GetObjInPoint(x, y: Double): TObject; var ipt: TPOint; dx,dy,z: Double; i: Integer; Door: TnetDoor; begin Result := nil; if WStyle = wsLine then begin if isPointInLine(p1^,p2^,DoublePoint(x,y),1) then Result := Self; end else if (wType <> wtHalf) and assigned(net) and assigned(net.XDrawEngine) and (region <> 0) then begin dx := x; dy := y; z := 0; net.XDrawEngine.ConvertPoint(dx,dy,z); ipt := Point(round(dx),round(dy)); for i := 0 to Doors.Count - 1 do begin Door := TnetDoor(Doors[i]); if ptInRegion(Door.Region,ipt.x,ipt.Y) then begin Result := Door; exit; end; end; if ptInRegion(region,ipt.x,ipt.Y) then Result := Self; end else begin if isPointInLine(p1^,p2^,DoublePoint(x,y),1) then Result := Self; end; end; function TNetPath.GetPointByLenghType(ASideNum: Integer; aLengthType: TShowPathLengthType): PDoublePoint; begin Result := nil; case ASideNum of 1: case aLengthType of sltPoints: Result := Self.p1; sltInner: Result := Self.ip1; sltOuter: Result := Self.op1; end; 2: case aLengthType of sltPoints: Result := Self.p1; sltInner: Result := Self.ip1; sltOuter: Result := Self.op1; end; end; end; function TnetPath.GetPointByPerpend(aPerpendPt: PDoublePoint): PDoublePoint; begin Result := nil; if epl1 = aPerpendPt then Result := @el1 else if epr1 = aPerpendPt then Result := @er1 else if epl2 = aPerpendPt then Result := @el2 else if epr2 = aPerpendPt then Result := @er2; end; function TnetPath.GetPointsBySide(ASideNum: Integer; var L, R, LR, RL: TDoublePoint): Boolean; begin Result := false; L := DoublePoint(0,0); R := DoublePoint(0,0); LR := DoublePoint(0,0); RL := DoublePoint(0,0); if ASideNum = 1 then begin L := el1; R := er1; LR := LR1; RL := RL1; Result := true; end else if ASideNum = 2 then begin L := el2; R := er2; LR := LR2; RL := RL2; Result := true; end; end; function TnetPath.GetPointBySide(ASideNum: Integer): PDoublePoint; begin Result := nil; if aSideNum = 1 then Result := p1 else if aSideNum = 2 then Result := p2; end; function TnetPath.GetPointSide(aPoint: PDoublePoint): Integer; begin Result := 0; if p1 = aPoint then Result := 1 else if p2 = aPoint then Result := 2; end; function TnetPath.GetTrianglePointsBySide(ASideNum: Integer; var L, R, T: TDoublePoint): Boolean; var LR, RL: TDoublePoint; FindedPoint: Boolean; begin Result := Self.GetPointsBySide(ASideNum, L, R, LR, RL); if Result then begin // Выбираем третюю точку из LR или RL, в зависимости которая из них является перпендикуляром - лежит на линии FindedPoint := false; if IsPointInLine(el1, el2, LR, 1) then begin FindedPoint := true; T := LR; end else if IsPointInLine(er1, er2, RL, 1) then begin FindedPoint := true; T := RL; end else Result := false; end; end; procedure TnetPath.InvertPerpendSide(aUpdateRegion: Boolean=true); begin Self.FPerpendSide := Self.FPerpendSide xor 1; Self.Net.RefreshPaths(aUpdateRegion); end; function TnetPath.IsInnerNiche(aNiche: TNetDoor; aRefreshPathPoints: Boolean): Boolean; begin Result := false; if aNiche <> nil then begin if aRefreshPathPoints then DefineInOutPoints; aNiche.CalculatePoints(p1^,p2^); Result := IsPointInLine(ip1^, ip2^, aNiche.ClearP1, 1, 0.1) and IsPointInLine(ip1^, ip2^, aNiche.ClearP2, 1, 0.1); end; end; function TnetPath.LenByType(AType: Integer): Double; begin Result := 0; if AType = ltInner then Result := InnerLen else if AType = ltOuter then Result := OutLen; end; function TnetPath.OutLen: Double; var LenL: Double; LenR: Double; begin Result := 0; if (op1 <> nil) and (op2 <> nil) then Result := GetLenByPoints(op1^, op2^) else begin LenL := GetLenByPoints(el1, el2); //28.10.2010 GetLineLenght(el1, el2); LenR := GetLenByPoints(er1, er2); //28.10.2010 GetLineLenght(er1, er2); Result := Max(LenL, LenR); end; //Result := GetLenByPoints(er1, er2); end; function TnetPath.ProperLen: Double; var //LR1, LR2, RL1, RL2: TDoublePoint; LenL, LenR, LenL1R2, LenL2R1, LenR1L2, LenR2L1: Double; begin if IsArc then Result := InnerLen else begin // Длина L части сегмента LenL := GetLineLenght(el1, el2); // Длина R части сегмента LenR := GetLineLenght(er1, er2); // Длина L части сегмента с точкой из R2 LenL1R2 := GetLineLenght(el1, LR2); // Длина L части сегмента с точкой из R1 LenL2R1 := GetLineLenght(el2, LR1); // Длина R части сегмента с точкой из L2 LenR1L2 := GetLineLenght(er1, RL2); // Длина R части сегмента с точкой из L1 LenR2L1 := GetLineLenght(er2, RL1); // ищем кратчайшую длину Result := Min(LenL, LenR); Result := Min(Result, LenL1R2); Result := Min(Result, LenL2R1); Result := Min(Result, LenR1L2); Result := Min(Result, LenR2L1); end; end; procedure TnetPath.PointToParralelLine; begin LR1 := er1; LR2 := er2; RL1 := el1; RL2 := el2; // точка er1 опущена на линию el1, el2 PointtoLine(el1, el2, LR1.x,LR1.y); // точка er2 опущена на линию el1, el2 PointtoLine(el1, el2, LR2.x,LR2.y); // точка el1 опущена на линию er1, er2 PointtoLine(er1, er2, RL1.x,RL1.y); // точка el2 опущена на линию er1, er2 PointtoLine(er1, er2, RL2.x,RL2.y); end; function TnetPath.SecondPoint(p: PDoublePoint): PDoublePoint; begin result := nil; if (p = p1) then result := p2 else if (p = p2) then result := p1; end; procedure TnetPath.SetEPoints; begin Self.er1 := Self.r1; Self.er2 := Self.r2; Self.el1 := Self.l1; Self.el2 := Self.l2; end; procedure TnetPath.SetLenByType(ALen: Double; AType: Integer); var StepCount: Integer; begin StepCount := 0; DefineInOutPoints; // Устанавливаем длину в несколько попыток, // так как из-за при изменении длины, изменится угол с другим сегментом и эта длина будет искажена while Abs(ALen-LenByType(AType)) > 0.001 do begin AddLen(ALen-LenByType(AType)); Net.RefreshPaths; //Self.Refresh; Net.SetModified; //03.02.2012 Net.ResetRegion; StepCount := StepCount+1; if StepCount > 7 then Break; //// BREAK //// end end; procedure TnetPath.SetInnerLen(ALen: Double); begin SetLenByType(ALen, ltInner); end; procedure TnetPath.SetOutLen(ALen: Double); begin SetLenByType(ALen, ltOuter); end; procedure TnetPath.Select; var Index: integer; begin if Net <> nil then begin Index := Net.Paths.IndexOf(Self); if Index <> -1 then begin //27.07.2011 Net.SelIndex := Index + 1; //27.07.2011 Net.SelType := stPath; Net.SelectPath(Index + 1); end; end; end; procedure TnetPath.SelectDoor(ADoor: TNetDoor); var Index: Integer; begin Index := Doors.IndexOf(ADoor); if Index <> -1 then DoorIndex := Index; end; procedure TnetPath.TestShowPointsInfo; var Msg: String; procedure PointToMsg(APointName: String; APoint: TDoublePoint); begin if Msg <> '' then Msg := Msg + #13+#10; Msg := Msg + APointName + ': x-'+FloatToStr(APoint.x)+' y-'+FloatToStr(APoint.y); end; begin //Msg PointToMsg('p1', p1^); PointToMsg('r1', r1); PointToMsg('l1', l1); PointToMsg('LR1', LR1); PointToMsg('RL1', RL1); Msg := Msg + #13+#10; PointToMsg('p2', p2^); PointToMsg('r2', r2); PointToMsg('l2', l2); PointToMsg('LR2', LR2); PointToMsg('RL2', RL2); ShowMessage(Msg); end; // Tolik 12/07/2018 -- Function TnetPath.GetRelatedPaths: TList; var i : Integer; currPath: TNetPath; begin Result := TList.Create; for i := 0 to Net.Paths.Count - 1 do begin currPath := TNetPath(Net.Paths); if currPath <> Self then if Self.Connected(currPath) then if Result.IndexOf(currPath) = -1 then Result.Add(currPath); end; end; { TWallPath } function TWallPath.Closed: Boolean; begin result := false; result := EQDP(actualpoints[1], actualpoints[PointCount]); end; constructor TWallPath.create(p1: TDoublepoint; xNet: Tnet); begin inherited create(0, dsTrace, nil); Initialize; // tolik 29/07/2021 -- Net := xNet; pointcount := 1; SnapPoint(p1.x, p1.y); Valid := True; RefPaths := TList.Create; FStarted := False; CIndex := 0; end; class function TWallPath.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var points: TDoublePointArr; i, PointArrayIndex: Integer; // Tolik 21/12/2019 -- проверка последней точки, чтобы не зафигачить такую же function CheckPointisNotLastPoint(aPoint: TDoublePoint): Boolean; var ArrayLen: integer; begin Result := True; if Length(points) > 0 then begin ArrayLen := Length(Points) - 1; if ((CompareValue(TDoublePoint(points[ArrayLen]).x, aPoint.x) = 0) and (CompareValue(TDoublePoint(points[ArrayLen]).y, aPoint.y) = 0)) then Result := False; end; end; // begin //DrawShadowCrossPoints; result := nil; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; if TWallPath(Shadow).valid and assigned(ActiveNet) then begin while (Shadow.PointCount > 1) and EQDP(Shadow.FigurePoints[Shadow.PointCount], Shadow.FigurePoints[Shadow.PointCount - 1]) do begin Shadow.PointCount := Shadow.PointCount - 1; end; // Shadow.PointCount := Shadow.PointCount-1; // Tolik 21/12/2019 -- //SetLength(Points, Shadow.PointCount{-1}); SetLength(Points, 0); PointArrayIndex := 0; // For i := 1 to Shadow.PointCount{-1} do // SetLength(Points,Shadow.PointCount-1); // For i := 1 to Shadow.PointCount-1 do begin // Tolik 21/12/2019 -- здесь проверка, чтобы при клике в одной точке не насоздавать путей с одинаковыми координатами //Points[i - 1] := Shadow.FigurePoints[i]; if CheckPointisNotLastPoint(TDoublePoint(Shadow.FigurePoints[i])) then begin inc(PointArrayIndex); SetLength(points, PointArrayIndex); Points[PointArrayIndex - 1] := Shadow.FigurePoints[i]; TDoublePoint(Points[PointArrayIndex - 1]).z := 0; // на всякий, чтобы не попал мусор end; end; ActiveNet.MakePathOnShadow(points); //03.06.2013 ActiveNet.MakePath(points); end; SetLength(Points, 0);// Tolik 24/12/2019 -- // *UNDO* GCadForm.FCanSaveForUndo := True; end; class function TWallPath.CreateShadow(x, y: Double): TFigure; begin Result := nil; if not assigned(ActiveNet) then Exit; Result := TWallPath.Create(DoublePoint(x, y), ActiveNet); end; destructor TWallPath.Destroy; begin RefPaths.Free; inherited; end; procedure TWallPath.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var i, k: Integer; mp, p1, p2: TDoublePoint; xp1, xpmin, xpa: TDoublePoint; l, d, dmin: Double; ltext, uText: String; rgn: HRGN; xPath: TnetPath; aLength: string; aText: string; begin DEngine.Canvas.pen.mode := pmXor; dMin := 0; //#From Oleg# //14.09.2010 for i := 0 to RefPaths.Count - 1 do begin xPath := TNetPath(RefPaths[i]); for k := 1 to PointCount do begin xP1 := ActualPoints[k]; PointToLine(xPath.p1^, xPath.p2^, xp1.x, xp1.y); d := GetLineLength(xp1, ActualPoints[k]); if k = 1 then begin dMin := d; xpMin := xp1; xpa := ActualPoints[k]; end else begin if d < dMin then begin dMin := d; xpMin := xp1; xpa := ActualPoints[k]; end; end; end; p1 := xpmin; p2 := xpa; // === Dengine.drawline(p1, p2, clLime, 1, ord(psSOlid), 0); mp := MPoint(p1, p2); l := GetLen(p1, p2); if l > 0 then begin aLength := FormatFloat(ffMask, MetreToUOM(l)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8); end; end; if FStarted then begin for i := 1 to PointCount - 1 do begin p1 := ActualPoints[i]; p2 := ActualPoints[i + 1]; // === DEngine.drawline(p1.x, p1.y, p2.x, p2.y, clLime, 1, ord(psSolid), 0); if (i = PointCount - 1) then begin mp := MPoint(p1, p2); l := GetLen(p1, p2); if l > 0 then begin aLength := FormatFloat(ffMask, MetreToUOM(l)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; if EQD(p1.x, p2.x) then mp := MovePoint(mp, 2, 0) else mp := MovePoint(mp, 0, 2); Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8); end; end; end; if pointCount > 2 then begin p1 := ActualPoints[1]; p2 := ActualPoints[PointCount]; if EQDP(p1, p2) then begin rgn := 1; Dengine.DrawCircle(p1.x, p1.y, 4, clLime, 1, ord(psSolid), 0, ord(bsClear), rgn, false); end; end; end; end; function TWallPath.GetLen(p1, p2: TDoublePoint): Double; var wt: Double; l: Double; begin result := 0; l := GetLineLenght(p1, p2); if l = 0 then begin result := 0; exit; end; wt := net.WallThick; Result := l{ - wt}; if Net.WorldDim then Result := Result / 1000 * Net.MapScale else Result := Result / 10; end; //Tolik 18/01/2022 - - старая закомменчена, см ниже function TWallPath.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; var xPath: TNetPath; Cad: TPowercad; distx, disty: Double; DistToCrossPointX, DistToCrossPointY: Double; begin //DrawShadowCrossPoints; // Tolik 17/01/2022 -- if GCadForm.cbMagnetWalls.Down then begin if PointCount > 1 then begin x := ActualPoints[PointCount].x; y := ActualPoints[Pointcount].y; end; if Assigned(GWallPathPointX) then begin x := GWallPathPointX.x; DistToCrossPointX := Sqrt(sqr(GWallPathPointX.x - x) + sqr(GWallPathPointX.y - y)); if (compareValue(DistToCrossPointX, 2) < 1) then y := GWallPathPointX.y; end; if Assigned(GWallPathPointY) then begin DistToCrossPointY := Sqrt(sqr(GWallPathPointY.x - x) + sqr(GWallPathPointY.y - y)); if not Assigned(GWallPathPointX) then begin y := GWallPathPointY.y; if (compareValue(DistToCrossPointY, 2) < 1) then x := GWallPathPointY.x; end else begin if (compareValue(DistToCrossPointX, 2) > 1) then y := GWallPathPointY.y; end; end; end; if ClickIndex > 1 then begin if (not GCadForm.cbMagnetWalls.Down) then begin x := ActualPoints[ClickIndex].x; y := ActualPoints[ClickIndex].y; end; end; if ((not GCadForm.cbMagnetWalls.Down) or (GCadForm.cbMagnetWalls.Down and (ssShift in GGlobalShiftState))) then // Tolik 19/01/2022 -- SnapPoint(x, y); Result := false; Shift := []; if assigned(Net.Owner) then begin Cad := Tpowercad(Net.Owner); Shift := Cad.CurrentShift; end; if not FStarted and not(ssShift in Shift) then FStarted := True; if not FStarted then begin xPath := Net.GetPathOfPoint(x, y); if assigned(xPath) then RefPaths.Add(xPath); end; if FStarted and (cIndex = 0) then begin pointcount := 2; actualpoints[1] := Doublepoint(x, y); actualpoints[2] := Doublepoint(x, y); end; if FStarted then CIndex := CIndex + 1; if CIndex > 1 then begin PointCount := PointCount + 1; actualPoints[clickIndex] := DoublePoint(x, y); actualPoints[clickIndex + 1] := DoublePoint(x, y); //Tolik 19/01/2022 - - не знаю, нах. это ... лишняя точка нахер не нужная, которую потом же и удалять // при создании стены? закомментил пока что { if assigned(net) and (ActiveNet.IsPOintOnWall(Doublepoint(x, y))) then begin PointCount := PointCount + 1; actualPoints[PointCount] := DoublePoint(x, y); Result := True; end else } if assigned(net) and (ActiveNet.IsPOintOnWall(Doublepoint(x, y))) then begin //PointCount := PointCount + 1; //actualPoints[PointCount] := DoublePoint(x, y); Result := True; end else // if Closed then begin PointCount := PointCount + 1; // Tolik 19/01/2022 -- //actualPoints[PointCount] := DoublePoint(x, y); if not GCadForm.cbMagnetWalls.Down then actualPoints[PointCount] := DoublePoint(x, y); // Result := True; end; end; { if GCadForm.cbMagnetWalls.Down then begin if not (ssShift in GGlobalShiftState) then begin if checkNoConnectedPrevPoint then begin distx := ABS(ActualPoints[CIndex - 1].x - x); disty := ABS(ActualPoints[CIndex - 1].y - y); if CompareValue(distx, disty) = 1 then ActualPoints[CIndex - 1] := DoublePoint(ActualPoints[CIndex - 1].x, y) else ActualPoints[CIndex - 1] := DoublePoint(x, ActualPoints[CIndex - 1].y); end; end; end; } end; { function TWallPath.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; var xPath: TNetPath; Cad: TPowercad; begin DrawShadowCrossPoints; // Tolik 17/01/2022 -- if ClickIndex > 1 then begin x := ActualPoints[ClickIndex].x; y := ActualPoints[ClickIndex].y; end; SnapPoint(x, y); Result := false; Shift := []; if assigned(Net.Owner) then begin Cad := Tpowercad(Net.Owner); Shift := Cad.CurrentShift; end; if not FStarted and not(ssShift in Shift) then FStarted := True; if not FStarted then begin xPath := Net.GetPathOfPoint(x, y); if assigned(xPath) then RefPaths.Add(xPath); end; if FStarted and (cIndex = 0) then begin pointcount := 2; actualpoints[1] := Doublepoint(x, y); actualpoints[2] := Doublepoint(x, y); end; if FStarted then CIndex := CIndex + 1; if CIndex > 1 then begin PointCount := PointCount + 1; actualPoints[clickIndex] := DoublePoint(x, y); actualPoints[clickIndex + 1] := DoublePoint(x, y); if assigned(net) and (ActiveNet.IsPOintOnWall(Doublepoint(x, y))) then begin PointCount := PointCount + 1; actualPoints[PointCount] := DoublePoint(x, y); Result := True; end else if Closed then begin PointCount := PointCount + 1; actualPoints[PointCount] := DoublePoint(x, y); Result := True; end; end; end; } function TWallPath.checkNoConnectedPrevPoint:Boolean; // Tolik 18/01/2021 -- var i: integer; begin Result := False; if PointCount > 2 then begin Result := True; for I := 0 to Net.Points.Count - 1 do begin if CompareValue(ActualPoints[PointCount - 1].x, PDoublePoint(Net.Points[i])^.x, 0.2) = 0 then if CompareValue(ActualPoints[PointCount - 1].y, PDoublePoint(Net.Points[i])^.y, 0.2) = 0 then begin result := false; break; end; end; end; end; function TWallPath.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; var dx, dy: Double; i: integer; cP: TDoublePoint; Len_X, Len_Y: double; AngleOut: Double; LenSize: Double; FullLenSize: Double; isVertical: Boolean; ax, ay: Double; distx, disty: Double; begin result := false; if PointCount = 0 then begin PointCount := 0; Exit; end; //DrawShadowCrossPoints; // Tolik 17/01/2022 -- //else if GCadForm.cbMagnetWalls.Down then //if false then begin DefineShadowCrossPoints(x,y); // Tolik 17/01/2022 -- if (ssShift in GGlobalShiftState) then begin ax := x; ay := y; if GWallPathPointX <> nil then begin if CompareValue(GWallPathPointX.x, ActualPoints[PointCount].x, 1) = 0 then ax := GWallPathPointX.x; if GWallPathPointY = nil then begin if CompareValue(GWallPathPointX.y, ActualPoints[PointCount].y, 1) = 0 then ay := GWallPathPointX.y; end; end; if GWallPathPointY <> nil then begin if CompareValue(GWallPathPointY.y, ActualPoints[PointCount].y, 1) = 0 then ay := GWallPathPointY.Y; if GWallPathPointX = nil then begin if CompareValue(GWallPathPointY.x, ActualPoints[PointCount].x, 1) = 0 then ax := GWallPathPointY.x; end; end; ActualPoints[PointCount] := DoublePoint(ax, ay); end else begin //distx := ABS(ActualPoints[PointCount - 1].x - x); //disty := ABS(ActualPoints[PointCount - 1].y - y); distx := ABS(ActualPoints[cIndex].x - x); disty := ABS(ActualPoints[cIndex].y - y); if CompareValue(distx, disty) = 1 then ActualPoints[PointCount] := DoublePoint(x, ActualPoints[cIndex].y) else ActualPoints[PointCount] := DoublePoint(ActualPoints[cIndex].x, y); if PointCount > 1 then isVertical := (CompareValue(ActualPoints[PointCount].x, ActualPoints[PointCount - 1].x, 0.01) = 0); ax := ActualPoints[PointCount].x; ay := ActualPoints[PointCount].y; if isVertical then begin if GWallPathPointX <> nil then begin if CompareValue(GWallPathPointX.x, ActualPoints[PointCount].x, 1) = 0 then begin ax := GWallPathPointX.x; if PointCount > 1 then ActualPoints[PointCount - 1] := DoublePoint(ax, ActualPoints[PointCount - 1].y); end; if GWallPathPointY = nil then begin if CompareValue(GWallPathPointX.y, ActualPoints[PointCount].y, 1) = 0 then ay := GWallPathPointX.y; end; ActualPoints[PointCount] := DoublePoint(ax, ay); end; end else begin if GWallPathPointY <> nil then begin if CompareValue(GWallPathPointY.y, ActualPoints[PointCount].y, 1) = 0 then ay := GWallPathPointY.Y; if PointCount > 1 then ActualPoints[PointCount - 1] := DoublePoint(ActualPoints[PointCount - 1].x, ay); if GWallPathPointX = nil then begin if CompareValue(GWallPathPointY.y, ActualPoints[PointCount].x, 1) = 0 then ay := GWallPathPointX.x; end; end; end; ActualPoints[PointCount] := DoublePoint(ax, ay); { if PointCount > 2 then begin if checkNoConnectedPrevPoint then begin ax := ActualPoints[PointCount - 1].x; ay := ActualPoints[PointCount - 1].y; if isVertical then ay := ActualPoints[PointCount].y else ax := ActualPoints[PointCount].x; ActualPoints[PointCount - 1] := DoublePoint(ax, ay); end; end; } end; end else begin if Not (ssShift in GGlobalShiftState) then begin angle := 1 / tan(GDefaultAngle * pi / 180 / 2); Len_X := abs(actualpoints[ClickIndex].X - X); Len_Y := abs(actualpoints[ClickIndex].Y - Y); if Len_X > Len_Y then begin if Len_X > angle * Len_Y then Y := actualpoints[ClickIndex].Y else if Len_X < angle * Len_Y then begin if Y > actualpoints[ClickIndex].Y then Y := actualpoints[ClickIndex].Y + Len_X else if Y < actualpoints[ClickIndex].Y then Y := actualpoints[ClickIndex].Y - Len_X; end; end else if Len_X < Len_Y then begin if Len_Y > angle * Len_X then X := actualpoints[ClickIndex].X else if Len_Y < angle * Len_X then begin if X > actualpoints[ClickIndex].X then X := actualpoints[ClickIndex].X + Len_Y else if X < actualpoints[ClickIndex].X then X := actualpoints[ClickIndex].X - Len_Y; end; end; end; SnapPoint(x, y); actualpoints[PointCount] := DoublePoint(x, y); end; end; procedure TWallPath.SnapPoint(var x, y: Double); var dx, dy, dpm: Double; p1, p2: TDoublePoint; wt: Double; l, d, minD, dist: Double; path: TnetPath; begin if not assigned(net) then exit; if not TPowercad(Net.Owner).SnapToNearPoint then exit; if Net.SnapToKnots(x, y, TPowercad(Net.Owner).DotsPerMil, False) then exit; if PointCount > 1 then begin p1 := actualpoints[PointCount - 1]; end else begin path := Net.PointOnPath(DoublePoint(x, y)); if assigned(path) then p1 := path.p1^ else exit; end; dx := abs(p1.x - x); dy := abs(p1.y - y); if dx < dy then begin x := p1.x; dx := 0; end else begin y := p1.y; dy := 0; end; minD := 100 / Net.MapScale; wt := net.WallThick; if dy = 0 then begin d := dx; d := d + wt; l := Trunc(d / minD) * mind; dist := d - l; if dist >= (mind / 2) then begin l := l + MinD; end; l := l - wt; if x > p1.x then x := p1.x + l else x := p1.x - l; end else if dx = 0 then begin d := abs(y - p1.y); d := d + wt; l := Trunc(d / minD) * mind; dist := d - l; if dist >= (mind / 2) then begin l := l + MinD; end; l := l - wt; if y > p1.y then y := p1.y + l else y := p1.y - l; end; if PointCount > 3 then begin p1 := actualpoints[1]; dx := GetLineLenght(p1, DoublePoint(x, y)); if dx < 6 then begin x := p1.x; y := p1.y; p2 := actualpoints[PointCount - 1]; dx := abs(p2.x - x); dy := abs(p2.y - y); if dx < 7 then p2.x := x; if dy < 7 then p2.y := y; actualpoints[PointCount - 1] := p2; end; end; end; { TNetDoor } procedure TNetDoor.CalculatePoints(xp1, xp2: TDoublePoint); var ww: Double; begin p1 := MPoint(xp1, xp2, Start); p2 := MPoint(xp1, xp2, Start + Len); ww := (Width / 2); GetParallelPoints(p1, p2, a1, a2, -ww); GetParallelPoints(p1, p2, b1, b2, ww); GetParallelPoints(p1, p2, ca1, ca2, -0.5); GetParallelPoints(p1, p2, cb1, cb2, 0.5); //07.05.2012 - Определяем точки ниши, где убирается линия сегмента if DoorObjType = dotNiche then begin if FRotation = 0 then begin ClearP1 := b1; ClearP2 := b2; end else if FRotation = 1 then begin ClearP1 := a1; ClearP2 := a2; end; end; end; constructor TNetDoor.Create(s, w, l: Double; aDoorObjType: TDoorObjType; xNet: Tnet); begin inherited create; FComponID := 0; FDeleting := false; FPath := nil; FOnDblClick := nil; FOnDoorChangePathQuery := nil; FOnDelete := nil; FOnResize := nil; FOnSelect := nil; FRotation := 0; FSrcDoor := nil; // Tolik 15/09/2017 -- DoorImageType := dtSimple; // простые двери Mirrored := GArchEngine.GetLastObjParam(aoskPathDoorMirrored); // зеркально (в другую сторону) Doubled := GArchEngine.GetLastObjParam(aoskPathDoorDoubled); // двойные LeftRight := GArchEngine.GetLastObjParam(aoskPathDoorLeftRight); // двосторонние двери (если это двери, а не окно там или что-то еще) Opened := GArchEngine.GetLastObjParam(aoskPathDoorOpened); // открытая дверь HalfOpened := GArchEngine.GetLastObjParam(aoskPathDoorHalfOpened);// полуоткрытая дверь // Net := xNet; Start := s; Width := w; Len := l; //Window := isWindow; isDraw := True; Region := 0; DoorObjType := aDoorObjType; if DoorObjType = dotWindow then begin //Tolik 25/08/2021 -- //WndPlacementHeight := MetreToUom(0.7);// Tolik 05/09/2018 -- высота размещения окна в стене по умолчанию -- 70 см. //Height := MetreToUom(1.4); // высота окна WndPlacementHeight := 0.7;// Tolik 05/09/2018 -- высота размещения окна в стене по умолчанию -- 70 см. Height := 1.4; // высота окна // end else //if DoorObjType = dotDoor then begin // //Tolik 25/08/2021 -- //Height := MetreToUom(2); // высота двери //WndPlacementHeight := MetreToUom(0.1); // Tolik 05/09/2018 -- высота размещения двери в стене по умолчанию -- 10 см. Height := 2; // высота двери WndPlacementHeight := 0.1; // Tolik 05/09/2018 -- высота размещения двери в стене по умолчанию -- 10 см. // end; FIndent := 5; //if isWindow then //begin // Height := 1300 / 50; // WOffSet := 700 / 50; //end //else //begin // Height := 2000 / 50; // WOffSet := 0; //end; SetDefParams; GArchEngine.SetHandlersToObj(Self); end; class function TNetDoor.CreateFromStream(Stream: Tstream;xPath:TNetPath): TNetDoor; var DoorVersion, xByte: Byte; begin result := nil; Stream.Read(DoorVersion, 1); // DoorVersion = 1 Result := TNetDoor.Create(0, xPath.Width, 0, dotNone, xPath.net); Stream.Read(Result.Start, 8); Stream.Read(Result.FLen, 8); Stream.Read(xByte, 1); Result.Window := Bool(xByte); //if Result.Window then // Result.WOffset := 700 / 50 //else // Result.WOffset := 0; //if Result.Window then // Result.Height := 1300 / 50 //else // Result.Height := 2000 / 50; Result.DefineDoorObjType; Result.SetDefParams; if (DoorVersion >= 2) then begin Stream.Read(Result.Height, 8); Stream.Read(Result.WOffset, 8); end; //25.05.2010 if (DoorVersion >= 3) then begin Stream.Read(Result.FComponID, 4); Stream.Read(xByte, 1); Result.DoorObjType := TDoorObjType(xByte); end; //07.05.2012 if (DoorVersion >= 4) then Stream.Read(Result.FRotation, 1); // Tolik 15/09/2017 -- if DoorVersion >= 5 then begin Stream.Read(Byte(XByte), 1); Result.DoorImageType := TDoorImageType(XByte); Stream.Read(xByte, 1); Result.Doubled := Bool(xByte); Stream.Read(xByte, 1); Result.Mirrored := Bool(xByte); Stream.Read(xByte, 1); Result.LeftRight := Bool(xByte); Stream.Read(xByte, 1); Result.Opened := Bool(xByte); Stream.Read(xByte, 1); Result.HalfOpened := Bool(xByte); end; // Tolik -- 06/09/2018 -- if DoorVersion >=6 then Stream.Read(Result.WndPlacementHeight, 8) // высота размещения else begin if Result.DoorObjType = dotDoor then Result.WndPlacementHeight := MetreToUom(0.1) // дверь (порожек) else Result.WndPlacementHeight := MetreToUom(0.7); // окно end; // // //GArchEngine.SetHandlersToObj(Result); end; procedure TNetDoor.DefineDoorObjType; begin if DoorObjType = dotNone then begin if Window then DoorObjType := dotWindow else DoorObjType := dotDoor; end else begin Window := (DoorObjType = dotWindow); end; end; procedure TNetDoor.DeleteRegion; begin if Region <> 0 then DeleteObject(Region); Region := 0; end; destructor TNetDoor.Destroy; begin if Region <> 0 then DeleteObject(Region); inherited; end; procedure TNetDoor.Draw(Dengine: TPCDrawEngine;Color:TColor); var Style: Integer; DoorText: String; p1, p2, p: TDoublePoint; rad: Double; // Tolik 17/09/2017 -- DoorMiddlePoint, DoorSide1Point, DoorSide2Point: TDoublePoint; FullWidth, HalfWidth: Double; // ширина и половина ширины двери ArcCenterPoint: TDoublePoint; Reg: HRGN; DoorAngle: Double; // begin Style := ord(psSolid); if Net.DrawAsTrace then Style := ord(psDot); // Если окно, или дверь if DoorObjType in [dotDoor, dotWindow, dotArc] then begin Dengine.drawline(a1,b1,Color,1,Style,0); Dengine.drawline(a2,b2,Color,1,Style,0); if Window then begin Dengine.drawline(a1,a2,Color,1,style,0); Dengine.drawline(b1,b2,Color,1,style,0); Dengine.drawline(ca1,ca2,Color,1,style,0); Dengine.drawline(cb1,cb2,Color,1,style,0); end else if DoorObjType in [dotDoor, dotArc] then begin Dengine.drawline(ca1,ca2,Color,1,style,0); Dengine.drawline(cb1,cb2,Color,1,style,0); // Tolik -- if Doubled then // двойная дверь begin //DoorSide1Point := DoublePoint((a1.x + b1.x)/2, (a1.y + b1.y)/2); // средина одной боковушки //DoorSide2Point := DoublePoint((a2.x + b2.x)/2, (a2.y + b2.y)/2); // средина второй боковушки //DoorMiddlePoint := DoublePoint((DoorSide1Point.x + DoorSide2Point.x)/2, (DoorSide1Point.y + DoorSide2Point.y)/2); // точка посредине(по центру) двери //HalfWidth := Sqrt(sqr(a1.x - b1.x) + sqr(a1.y - b1.y))/2;// половина ширины дверного проема //Dengine.drawline(DoublePoint(DoorMiddlePoint.x, DoorMiddlePoint.y - HalfWidth),DoublePoint(DoorMiddlePoint.x, DoorMiddlePoint.y + HalfWidth),Color,1,style,0); if not Opened then // просто двойную -- перечеркиваем if not HalfOpened then Dengine.drawline(DoublePoint((a1.x + a2.x)/2, (a1.y + a2.y)/2),DoublePoint((b1.x + b2.x)/2, (b1.y + b2.y)/2),Color,1,style,0); if Mirrored then // если зеркально begin // открытая и полуоткрытая нарисуется добавлением арок и линий if Opened then // если рисовать как открытую дверь (угол арки 90 градусов) begin HalfWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y))/2; DoorAngle := GetRadOfLine(ca1, ca2); DoorMiddlePoint := DoublePoint((ca1.x + ca2.x)/2, (ca1.y + ca2.y)/2); // средина двери DEngine.drawbezarc(ca1.x, ca1.y, HalfWidth, DoorAngle + PI/2 - PI, DoorAngle, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(ca1,p1,Color,1,style,0); DEngine.drawbezarc(ca2.x, ca2.y, HalfWidth, DoorAngle - PI, DoorAngle + PI/2 - PI, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(ca2,p2,Color,1,style,0); end else if HalfOpened then // если рисовать как полуоткрытую дверь (угол арки 45 градусов) begin HalfWidth := Sqrt(sqr(cb1.x - cb2.x) + sqr(cb1.y - cb2.y))/2; DoorAngle := GetRadOfLine(cb1, cb2); DoorMiddlePoint := DoublePoint((cb1.x + cb2.x)/2, (cb1.y + cb2.y)/2); // средина двери DEngine.drawbezarc(cb1.x, cb1.y, HalfWidth, DoorAngle + PI/4 - PI/2, DoorAngle, 0,1,0,0,0,0,reg, p1, p2, true,0); //p1 := RotateDPoint(cb1, DoorMiddlePoint, DoorAngle + PI/4); //Dengine.drawline(cb1,p1,Color,1,style,0); Dengine.drawline(cb1,p1,Color,1,style,0); DEngine.drawbezarc(cb2.x, cb2.y, HalfWidth, DoorAngle + PI,DoorAngle + PI + PI/4, 0,1,0,0,0,0,reg, p1, p2, true,0); //p1 := RotateDPoint(cb2, DoorMiddlePoint, DoorAngle - PI/4); //Dengine.drawline(cb2,p1,Color,1,style,0); Dengine.drawline(cb2,p2,Color,1,style,0); end; end else begin // открытая и полуоткрытая нарисуется добавлением арок и линий if Opened then // если рисовать как открытую дверь (угол арки 90 градусов) begin HalfWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y))/2; DoorAngle := GetRadOfLine(ca1, ca2); DoorMiddlePoint := DoublePoint((ca1.x + ca2.x)/2, (ca1.y + ca2.y)/2); // средина двери DEngine.drawbezarc(ca1.x, ca1.y, HalfWidth, DoorAngle, DoorAngle + PI/2, 0,1,0,0,0,0,reg, p1, p2, true,0); //p1 := RotateDPoint(ca1, DoorMiddlePoint, DoorAngle + PI/2); //Dengine.drawline(ca1,p1,Color,1,style,0); Dengine.drawline(ca1,p2,Color,1,style,0); DEngine.drawbezarc(ca2.x, ca2.y, HalfWidth, DoorAngle - PI - PI/2, DoorAngle - PI, 0,1,0,0,0,0,reg, p1, p2, true,0); //p1 := RotateDPoint(ca2, DoorMiddlePoint, DoorAngle - PI/2); //Dengine.drawline(ca2,p1,Color,1,style,0); Dengine.drawline(ca2,p1,Color,1,style,0); end else if HalfOpened then // если рисовать как полуоткрытую дверь (угол арки 45 градусов) begin HalfWidth := Sqrt(sqr(cb1.x - cb2.x) + sqr(cb1.y - cb2.y))/2; DoorAngle := GetRadOfLine(cb1, cb2); DoorMiddlePoint := DoublePoint((cb1.x + cb2.x)/2, (cb1.y + cb2.y)/2); // средина двери DEngine.drawbezarc(cb1.x, cb1.y, HalfWidth, DoorAngle , DoorAngle + PI/4, 0,1,0,0,0,0,reg, p1, p2, true,0); //p1 := RotateDPoint(cb1, DoorMiddlePoint, DoorAngle + PI/4); //Dengine.drawline(cb1,p1,Color,1,style,0); Dengine.drawline(cb1,p2,Color,1,style,0); DEngine.drawbezarc(cb2.x, cb2.y, HalfWidth, DoorAngle - PI - PI/4, DoorAngle - PI, 0,1,0,0,0,0,reg, p1, p2, true,0); //p1 := RotateDPoint(cb2, DoorMiddlePoint, DoorAngle - PI/4); //Dengine.drawline(cb2,p1,Color,1,style,0); Dengine.drawline(cb2,p1,Color,1,style,0); end; end; end else // простая (не двойная дверь) begin if not Mirrored then // не зеркально begin if not LeftRight then //левосторонняя дверь begin if Opened then // если рисовать как открытую дверь begin FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y)); DoorAngle := GetRadOfLine(ca1, ca2); //DEngine.drawbezarc(ca1.x, ca1.y, FullWidth, DoorAngle, DoorAngle + PI/2, 0,1,0,0,0,0,reg, p1, p2, true,0); //Dengine.drawline(ca1,p2,Color,1,style,0); DEngine.drawbezarc(ca2.x, ca2.y, FullWidth, DoorAngle - PI - PI/2, DoorAngle - PI, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(ca2,p1,Color,1,style,0); end else if HalfOpened then // если рисовать как полуоткрытую дверь begin FullWidth := Sqrt(sqr(cb1.x - cb2.x) + sqr(cb1.y - cb2.y)); DoorAngle := GetRadOfLine(cb1, cb2); DEngine.drawbezarc(cb2.x, cb2.y, FullWidth, DoorAngle - PI - PI/4, DoorAngle - PI, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(cb2,p1,Color,1,style,0); end; end else // правосторонняя дверь begin if Opened then // если рисовать как открытую дверь begin FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y)); DoorAngle := GetRadOfLine(ca1, ca2); DEngine.drawbezarc(ca1.x, ca1.y, FullWidth, DoorAngle, DoorAngle + PI/2, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(ca1,p2,Color,1,style,0); end else if HalfOpened then // если рисовать как полуоткрытую дверь begin FullWidth := Sqrt(sqr(cb1.x - cb2.x) + sqr(cb1.y - cb2.y)); DoorAngle := GetRadOfLine(cb1, cb2); DEngine.drawbezarc(cb1.x, cb1.y, FullWidth,DoorAngle , DoorAngle + PI/4, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(cb1,p2,Color,1,style,0); end; end; end else begin // Зеркально if not LeftRight then //левосторонняя дверь begin if Opened then // если рисовать как открытую дверь begin FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y)); DoorAngle := GetRadOfLine(ca1, ca2); DEngine.drawbezarc(ca2.x, ca2.y, FullWidth, DoorAngle + PI, DoorAngle - PI/2, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(ca2,p2,Color,1,style,0); end else if HalfOpened then // если рисовать как полуоткрытую дверь begin FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y)); DoorAngle := GetRadOfLine(ca1, ca2); DEngine.drawbezarc(ca2.x, ca2.y, FullWidth, DoorAngle + PI, DoorAngle - PI/2 - PI/4, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(ca2,p2,Color,1,style,0); end; end else // правосторонняя дверь begin if Opened then // если рисовать как открытую дверь begin FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y)); DoorAngle := GetRadOfLine(ca1, ca2); DEngine.drawbezarc(ca1.x, ca1.y, FullWidth, DoorAngle - PI/2, DoorAngle, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(ca1,p1,Color,1,style,0); end else if HalfOpened then // если рисовать как полуоткрытую дверь begin FullWidth := Sqrt(sqr(ca1.x - ca2.x) + sqr(ca1.y - ca2.y)); DoorAngle := GetRadOfLine(ca1, ca2); DEngine.drawbezarc(ca1.x, ca1.y, FullWidth,DoorAngle - PI/4, DoorAngle, 0,1,0,0,0,0,reg, p1, p2, true,0); Dengine.drawline(ca1,p1,Color,1,style,0); end; end; end; end; // if (DoorType = dtOutDoor) and (DoorNbr <> 0) and (DoorNbr <> 9000) then begin if DoorNbr < 9000 then begin DoorText := '< 9000 '+ inttostr(DoorNbr); end else begin DoorText := '>= 9000 '+ inttostr(DoorNbr - 9000); end; p1 := Mpoint(a1,a2); p2 := Mpoint(b1,b2); ExtendLine(p1,p2,5.0); if InSide = 0 then p := p1 else p := p2; rad := GetRadOfLine(a1,a2); Dengine.DrawCenteredtext(p, color, DoorText, 'Tahoma', 3.0, Rad); end; end; end // Проем else if DoorObjType in [dotEmbrasure, dotBalcony] then begin Dengine.drawline(a1,b1,Color,1,Style,0); Dengine.drawline(a2,b2,Color,1,Style,0); Dengine.drawline(a1,a2,Color,1,style,0); Dengine.drawline(b1,b2,Color,1,style,0); if DoorObjType = dotBalcony then begin FIndent := 5; //if a2.x < a1.x then // Indent := Indent * -1; // Боковушки GetParallelPoints(a1, b1, p1, p2, FIndent * -1); Dengine.drawline(p1, p2, Color,1,Style,0); GetParallelPoints(a2, b2, p1, p2, FIndent); Dengine.drawline(p1, p2, Color,1,Style,0); // двойная линия по средине сегмента между боковушками GetShrinkedPoints(ca1, ca2, p1, p2, FIndent); Dengine.drawline(p1,p2,Color,1,style,0); GetShrinkedPoints(cb1, cb2, p1, p2, FIndent); Dengine.drawline(p1,p2,Color,1,style,0); //Dengine.drawline(DoublePoint(a1.x+Indent, a1.y), DoublePoint(b1.x+Indent, b1.y), Color,1,Style,0); //Dengine.drawline(DoublePoint(a2.x-Indent, a2.y), DoublePoint(b2.x-Indent, b2.y), Color,1,Style,0); end; end // Ниша else if DoorObjType = dotNiche then begin {// углубление нишы Dengine.drawline(ca1,b1,Color,1,Style,0); Dengine.drawline(ca2,b2,Color,1,Style,0); Dengine.drawline(ca1,ca2,Color,1,style,0); // Белым цветом сливаем стену ниши с прелегающей стеной Dengine.drawline(ca1,a1,clWhite,1,Style,0); Dengine.drawline(ca2,a2,clWhite,1,Style,0); // стена ниши Dengine.drawline(a1,a2,Color,1,style,0);} if FRotation = 0 then DrawNiche(Dengine, Color, Style, @a1,@a2, @b1,@b2, @ca1,@ca2) else if FRotation = 1 then DrawNiche(Dengine, Color, Style, @b1,@b2, @a1,@a2, @cb1,@cb2); end; end; Procedure TNetDoor.DrawNiche(Dengine: TPCDrawEngine; Color: TColor; aStyle: Integer; pa1, pa2, pb1, pb2, cp1, cp2: PDoublePoint); begin // углубление нишы Dengine.drawline(cp1^,pb1^,Color,1,aStyle,0); Dengine.drawline(cp2^,pb2^,Color,1,aStyle,0); Dengine.drawline(cp1^,cp2^,Color,1,astyle,0); // Белым цветом сливаем стену ниши с прелегающей стеной Dengine.drawline(cp1^,pa1^,clWhite,1,aStyle,0); Dengine.drawline(cp2^,pa2^,clWhite,1,aStyle,0); // стена ниши Dengine.drawline(pa1^,pa2^,Color,1,aStyle,0); {// углубление нишы Dengine.drawline(cb1,a1,Color,1,Style,0); Dengine.drawline(cb2,a2,Color,1,Style,0); Dengine.drawline(cb1,cb2,Color,1,style,0); // Белым цветом сливаем стену ниши с прелегающей стеной Dengine.drawline(cb1,b1,clWhite,1,Style,0); Dengine.drawline(cb2,b2,clWhite,1,Style,0); // стена ниши Dengine.drawline(b1,b2,Color,1,style,0);} end; procedure TNetDoor.GetInPoints(var top1, top2, bot1, bot2: TDoublePoint; PathDir: Integer); begin if PathDir = 2 then begin top1 := ta1; top2 := ta2; bot1 := ba1; bot2 := ba2; end else begin top1 := tb1; top2 := tb2; bot1 := bb1; bot2 := bb2; end; end; procedure TNetDoor.GetOutPoints(var top1, top2, bot1, bot2: TDoublePoint; PathDir: Integer); begin if PathDir = 1 then begin top1 := ta1; top2 := ta2; bot1 := ba1; bot2 := ba2; end else begin top1 := tb1; top2 := tb2; bot1 := bb1; bot2 := bb2; end; end; procedure TNetDoor.UpdateRegion(Dengine: TPCDrawEngine); var pArr: TDoublePointArr; begin if Region <> 0 then DeleteObject(Region); SetLength(pArr, 4); pArr[0] := a1; pArr[1] := a2; pArr[2] := b2; pArr[3] := b1; Region := Dengine.PolygonRegion(pArr); end; procedure TNetDoor.SetDefParams; begin if DoorObjType = dotWindow then begin //Height := 1300 / 50; // Tolik 06/09/2018 -- WOffSet := 700 / 50; Window := true; end else begin //Height := 2000 / 50; // Tolik 06/09/2018 -- WOffSet := 0; Window := false; end; end; procedure TNetDoor.WriteToStream(Stream: TStream); var DoorVersion, XByte: Byte; begin //DoorVersion := 2; //25.05.2010 //DoorVersion := 3; //25.05.2010 //DoorVersion := 4; //07.05.2012 //DoorVersion := 5; // Tolik -- 21/09/2017 -- DoorVersion := 6; // Tolik 05/09/2018 -- Stream.Write(DoorVersion, 1); Stream.Write(Start, 8); Stream.Write(Len, 8); Stream.Write(Byte(Window), 1); Stream.Write(Height, 8); Stream.Write(WOffSet, 8); Stream.Write(FComponID, 4); //25.05.2010 XByte := Ord(DoorObjType); Stream.Write(Byte(XByte), 1); Stream.Write(FRotation, 1); // Tolik 15/09/2017 -- XByte := Ord(DoorImageType); Stream.Write(Byte(XByte), 1); Stream.Write(Byte(Doubled), 1); Stream.Write(Byte(Mirrored), 1); Stream.Write(Byte(LeftRight), 1); Stream.Write(Byte(Opened), 1); Stream.Write(Byte(HalfOpened), 1); // Stream.Write(WndPlacementHeight, 8); // Tolik 06/09/2018 -- высота размещения окна end; procedure TNetDoor.DoClick; begin if Assigned(FOnSelect) then FOnSelect(Self); end; procedure TNetDoor.DoDblClick; begin if Assigned(FOnDblClick) then FOnDblClick(Self); end; procedure TNetDoor.DoDelete; begin if Not FDeleting then begin FDeleting := true; if Assigned(FOnDelete) then FOnDelete(Self); end; end; procedure TNetDoor.DoResize; begin if Assigned(FOnResize) then FOnResize(Self); end; function TNetDoor.DoChangePathQuery(APath, ANewPath: TNetPath): Boolean; begin Result := true; if Assigned(FOnDoorChangePathQuery) then FOnDoorChangePathQuery(Self, APath, ANewPath, Result); end; function TNetDoor.GetPath: TNetPath; var i: Integer; Path: TNetPath; begin Result := nil; if Net <> nil then begin for i := 0 to Net.Paths.Count - 1 do begin Path := TNetPath(Net.Paths[i]); if Path.Doors.IndexOf(Self) <> -1 then begin Result := Path; Break; //// BREAK //// end; end; end; end; procedure TNetDoor.TestSetVal(AValue: Double); begin FLen := AValue; end; { TNetStruct } constructor TNetStruct.Create(xNet: TNet); begin inherited Create; Net := xnet; Region := 0; Points := TList.Create; end; class function TNetStruct.CreateFromStream(Stream: Tstream; xNet: Tnet): TNetStruct; var classIndex: Byte; begin result := nil; Stream.Read(ClassIndex, 1); if ClassIndex = 1 then begin result := TNetCol.CreateFromStream(Stream, xNet); end else if ClassIndex = 2 then begin result := TNetRow.CreateFromStream(Stream, xNet); end; end; destructor TNetStruct.Destroy; begin if Region <> 0 then DeleteObject(Region); Points.Free; inherited Destroy; end; procedure TNetStruct.DoSolid(Faces: Tlist; topZ, botZ: Double); begin end; procedure TNetStruct.Draw(Dengine: TPCdrawEngine;isGrayed:Boolean); begin // end; procedure TNetStruct.DrawGuides(DEngine: TPCDrawEngine); begin end; procedure TNetStruct.DrawTrace(Dengine: TPCDrawEngine); begin end; function TNetStruct.Duplicate: TNetStruct; begin result := nil; end; function TNetStruct.DuplicateNonPoints: TNetStruct; begin result := nil; end; procedure TNetStruct.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); begin end; function TNetStruct.GetDistToPoint(p: TDoublePoint): Double; begin end; procedure TNetStruct.Hatch(Dengine: TPCdrawEngine; isGrayed: Boolean); begin if Region <> 0 then begin DEngine.Canvas.Brush.Style := bsFDiagonal; if isGrayed then DEngine.Canvas.Brush.Color := clSilver else DEngine.Canvas.Brush.Color := clGreen; FillRgn(Dengine.Canvas.Handle,Region,DEngine.Canvas.Brush.Handle); end; end; function TNetStruct.IsKnotIn(p: PDoublePoint): Integer; begin result := -1; result := Points.IndexOf(p); end; function TNetStruct.IsPointIn(x,y:Double): Boolean; var dx, dy, z: Double; begin result := false; if region <> 0 then begin if assigned(Net.XDrawEngine) then begin dx := x; dy := y; z := 0; Net.XDrawEngine.ConvertPoint(dx, dy, z); result := ptInRegion(Region, round(dx), round(dy)); end; end; end; function TNetStruct.PathInter(p1, p2: TDoublePoint): Boolean; begin result := false; end; procedure TNetStruct.PropUpdate(PropName, PropVal: String); begin end; procedure TNetStruct.ShowProperties; begin end; function TNetStruct.SnapPoints(var x, y: Double; DotsPerMil: Double): Boolean; begin result := false; end; procedure TNetStruct.WriteToStream(Stream: TStream); begin /// end; { TNetCol } constructor TNetCol.Create(xNet: Tnet; p: PDoublePoint); begin inherited Create(xNet); p1 := p; Points.Add(p1); w := 12; h := 12; Angle := 0; end; class function TNetCol.CreateFromStream(Stream: Tstream; xNet: Tnet): TNetStruct; var colVersion:Byte; i: Integer; xCol: TnetCol; begin result := nil; xCol := TNetCol.Create(xNet,nil); xCol.Points.Clear; Stream.Read(colversion,1); // colversion = 1; Stream.Read(i,4); if (i > -1) and (i figMaxX then figMaxX := xp2.x; if xp3.x > figMaxX then figMaxX := xp3.x; if xp4.x > figMaxX then figMaxX := xp4.x; if xp2.x < figMinX then figMinX := xp2.x; if xp3.x < figMinX then figMinX := xp3.x; if xp4.x < figMinX then figMinX := xp4.x; if xp2.y > figMaxY then figMaxY := xp2.y; if xp3.y > figMaxY then figMaxY := xp3.y; if xp4.y > figMaxY then figMaxY := xp4.y; if xp2.y < figMinY then figMinY := xp2.y; if xp3.y < figMinY then figMinY := xp3.y; if xp4.y < figMinY then figMinY := xp4.y; end; function TNetCol.GetDistToPoint(p: TDoublePoint): Double; var xp,xp1,xp2,xp3,xp4: TDoublePoint; dist: Double; begin result := 0; GetPoints(xp1,xp2,xp3,xp4); xp := p; PointToLine(xp1,xp2,xp.x,xp.y); dist := GetLineLength(xp,p); result := dist; xp := p; PointToLine(xp2,xp3,xp.x,xp.y); dist := GetLineLength(xp,p); if dist < result then result := dist; xp := p; PointToLine(xp3,xp4,xp.x,xp.y); dist := GetLineLength(xp,p); if dist < result then result := dist; xp := p; PointToLine(xp4,xp1,xp.x,xp.y); dist := GetLineLength(xp,p); if dist < result then result := dist; end; function TNetCol.GetPipePoints(var ap1, ap2, ap3, ap4: TDoublePoint): Boolean; var xp1,xp2,xp3,xp4: TDoublePoint; begin result := false; GetPoints(xp1,xp2,xp3,xp4); ap1 := MPoint(xp1,xp2,-1.0); ap2 := MPoint(xp2,xp1,-1.0); ap3 := MPoint(xp3,xp4,-1.0); ap4 := MPoint(xp4,xp3,-1.0); ap1 := MPoint(ap1,ap4,-1.0); ap4 := MPoint(ap4,ap1,-1.0); ap2 := MPoint(ap2,ap3,-1.0); ap3 := MPoint(ap3,ap2,-1.0); end; Function TNetCol.GetPoints(var ap1,ap2, ap3, ap4: TDoublePoint):Boolean; var dx,dy,delta: Double; begin result := false; if (not assigned(p1)) and (Points.Count > 0) then p1 := PDoublePoint(Points[0]); if (not assigned(p1)) then exit; ap1 := DoublePoint(p1^.x - (w / 2),p1^.y - (h / 2)); ap2 := DoublePoint(p1^.x + (w / 2),p1^.y - (h / 2)); ap3 := DoublePoint(p1^.x + (w / 2),p1^.y + (h / 2)); ap4 := DoublePoint(p1^.x - (w / 2),p1^.y + (h / 2)); dx := 0; dy := 0; if Position in [1,8,7] then dx := w / 2; if Position in [3,4,5] then dx := -w / 2; if Position in [1,2,3] then dy := h / 2; if Position in [7,6,5] then dy := -h / 2; delta := (net.WallThick / 2);//-0.4; if dx <> 0 then begin if dx > 0 then delta := -delta; dx := dx + delta; end; delta := (net.WallThick / 2);//-0.4; if dy <> 0 then begin if dy > 0 then delta := -delta; dy := dy + delta; end; ap1 := MovePoint(ap1,dx,dy); ap2 := MovePoint(ap2,dx,dy); ap3 := MovePoint(ap3,dx,dy); ap4 := MovePoint(ap4,dx,dy); ap1 := RotatePoint(p1^,ap1,Angle); ap2 := RotatePoint(p1^,ap2,Angle); ap3 := RotatePoint(p1^,ap3,Angle); ap4 := RotatePoint(p1^,ap4,Angle); result := True; end; procedure TNetCol.IntersectPath(Path: TnetPath); var ap1,ap2, ap3, ap4,ip,xp,ip1,ip2: TDoublePoint; radius: Double; iCnt: Integer; begin GetPoints(ap1,ap2,ap3,ap4); if not path.isArc then begin if GetIntersectionPoint(path.l1,path.l2,ap1,ap2,ip,false,true) then begin if path.dir = 1 then path.l1 := ip else path.l2 := ip; end; if GetIntersectionPoint(path.l1,path.l2,ap2,ap3,ip,false,true) then begin if path.dir = 1 then path.l1 := ip else path.l2 := ip; end; if GetIntersectionPoint(path.l1,path.l2,ap3,ap4,ip,false,true) then begin if path.dir = 1 then path.l1 := ip else path.l2 := ip; end; if GetIntersectionPoint(path.l1,path.l2,ap4,ap1,ip,false,true) then begin if path.dir = 1 then path.l1 := ip else path.l2 := ip; end; if GetIntersectionPoint(path.r1,path.r2,ap1,ap2,ip,false,true) then begin if path.dir = 1 then path.r1 := ip else path.r2 := ip; end; if GetIntersectionPoint(path.r1,path.r2,ap2,ap3,ip,false,true) then begin if path.dir = 1 then path.r1 := ip else path.r2 := ip; end; if GetIntersectionPoint(path.r1,path.r2,ap3,ap4,ip,false,true) then begin if path.dir = 1 then path.r1 := ip else path.r2 := ip; end; if GetIntersectionPoint(path.r1,path.r2,ap4,ap1,ip,false,true) then begin if path.dir = 1 then path.r1 := ip else path.r2 := ip; end; end else begin if path.Dir = 1 then xp := path.l2 else xp := path.l1; radius := GetLineLenght(xp,path.ArcCenter); if GetLineCircleIntersection(ap1,ap2,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap2,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.l1,path.l2,path.Inverted) then if path.Dir = 1 then begin path.l1 := ip; path.ArcJoinA1 := ip; path.ArcJoinA1L := ip; end else begin path.l2 := ip; path.ArcJoinA2 := ip; path.ArcJoinA2L := ip; end; end; if GetLineCircleIntersection(ap2,ap3,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap3,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.l1,path.l2,path.Inverted) then if path.Dir = 1 then begin path.l1 := ip; path.ArcJoinA1 := ip; path.ArcJoinA1L := ip; end else begin path.l2 := ip; path.ArcJoinA2 := ip; path.ArcJoinA2L := ip; end; end; if GetLineCircleIntersection(ap3,ap4,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap4,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.l1,path.l2,path.Inverted) then if path.Dir = 1 then begin path.l1 := ip; path.ArcJoinA1 := ip; path.ArcJoinA1L := ip; end else begin path.l2 := ip; path.ArcJoinA2 := ip; path.ArcJoinA2L := ip; end; end; if GetLineCircleIntersection(ap4,ap1,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap1,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.l1,path.l2,path.Inverted) then if path.Dir = 1 then begin path.l1 := ip; path.ArcJoinA1 := ip; path.ArcJoinA1L := ip; end else begin path.l2 := ip; path.ArcJoinA2 := ip; path.ArcJoinA2L := ip; end; end; if path.Dir = 1 then xp := path.r2 else xp := path.r1; radius := GetLineLenght(xp,path.ArcCenter); if GetLineCircleIntersection(ap1,ap2,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap2,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.r1,path.r2,path.Inverted) then if path.Dir = 1 then begin path.r1 := ip; path.ArcJoinB1 := ip; path.ArcJoinB1L := ip; end else begin path.r2 := ip; path.ArcJoinB2 := ip; path.ArcJoinB2L := ip; end; end; if GetLineCircleIntersection(ap2,ap3,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap3,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.r1,path.r2,path.Inverted) then if path.Dir = 1 then begin path.r1 := ip; path.ArcJoinB1 := ip; path.ArcJoinB1L := ip; end else begin path.r2 := ip; path.ArcJoinB2 := ip; path.ArcJoinB2L := ip; end; end; if GetLineCircleIntersection(ap3,ap4,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap4,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.r1,path.r2,path.Inverted) then if path.Dir = 1 then begin path.r1 := ip; path.ArcJoinB1 := ip; path.ArcJoinB1L := ip; end else begin path.r2 := ip; path.ArcJoinB2 := ip; path.ArcJoinB2L := ip; end; end; if GetLineCircleIntersection(ap4,ap1,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap1,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.r1,path.r2,path.Inverted) then if path.Dir = 1 then begin path.r1 := ip; path.ArcJoinB1 := ip; path.ArcJoinB1L := ip; end else begin path.r2 := ip; path.ArcJoinB2 := ip; path.ArcJoinB2L := ip; end; end; end; end; procedure TNetCol.IntersectPathPipe(Path: TnetPath); var ap1,ap2, ap3, ap4,ip,xp,ip1,ip2: TDoublePoint; radius: Double; iCnt: Integer; begin GetPipePoints(ap1,ap2,ap3,ap4); if not path.isArc then begin if GetIntersectionPoint(path.hl1,path.hl2,ap1,ap2,ip,false,true) then begin if path.dir = 1 then path.hl1 := ip else path.hl2 := ip; end; if GetIntersectionPoint(path.hl1,path.hl2,ap2,ap3,ip,false,true) then begin if path.dir = 1 then path.hl1 := ip else path.hl2 := ip; end; if GetIntersectionPoint(path.hl1,path.hl2,ap3,ap4,ip,false,true) then begin if path.dir = 1 then path.hl1 := ip else path.hl2 := ip; end; if GetIntersectionPoint(path.hl1,path.hl2,ap4,ap1,ip,false,true) then begin if path.dir = 1 then path.hl1 := ip else path.hl2 := ip; end; if GetIntersectionPoint(path.hr1,path.hr2,ap1,ap2,ip,false,true) then begin if path.dir = 1 then path.hr1 := ip else path.hr2 := ip; end; if GetIntersectionPoint(path.hr1,path.hr2,ap2,ap3,ip,false,true) then begin if path.dir = 1 then path.hr1 := ip else path.hr2 := ip; end; if GetIntersectionPoint(path.hr1,path.hr2,ap3,ap4,ip,false,true) then begin if path.dir = 1 then path.hr1 := ip else path.hr2 := ip; end; if GetIntersectionPoint(path.hr1,path.hr2,ap4,ap1,ip,false,true) then begin if path.dir = 1 then path.hr1 := ip else path.hr2 := ip; end; end else begin if path.Dir = 1 then xp := path.hl2 else xp := path.hl1; radius := GetLineLenght(xp,path.ArcCenter); if GetLineCircleIntersection(ap1,ap2,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap2,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.hl1,path.hl2,path.Inverted) then if path.Dir = 1 then begin path.hl1 := ip; end else begin path.hl2 := ip; end; end; if GetLineCircleIntersection(ap2,ap3,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap3,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.hl1,path.hl2,path.Inverted) then if path.Dir = 1 then begin path.hl1 := ip; end else begin path.hl2 := ip; end; end; if GetLineCircleIntersection(ap3,ap4,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap4,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.hl1,path.hl2,path.Inverted) then if path.Dir = 1 then begin path.hl1 := ip; end else begin path.hl2 := ip; end; end; if GetLineCircleIntersection(ap4,ap1,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap1,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.hl1,path.hl2,path.Inverted) then if path.Dir = 1 then begin path.hl1 := ip; end else begin path.hl2 := ip; end; end; if path.Dir = 1 then xp := path.hr2 else xp := path.hr1; radius := GetLineLenght(xp,path.ArcCenter); if GetLineCircleIntersection(ap1,ap2,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap2,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.hr1,path.hr2,path.Inverted) then if path.Dir = 1 then begin path.hr1 := ip; end else begin path.hr2 := ip; end; end; if GetLineCircleIntersection(ap2,ap3,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap3,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.hr1,path.hr2,path.Inverted) then if path.Dir = 1 then begin path.hr1 := ip; end else begin path.hr2 := ip; end; end; if GetLineCircleIntersection(ap3,ap4,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap4,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.hr1,path.hr2,path.Inverted) then if path.Dir = 1 then begin path.hr1 := ip; end else begin path.hr2 := ip; end; end; if GetLineCircleIntersection(ap4,ap1,path.ArcCenter,radius,ip1,ip2,iCnt,false) then begin if icnt = 1 then ip := ip1 else ip := GetClosePoint(ap1,ip1,ip2); if isPointinArc(ip,path.ArcCenter,radius,0,path.hr1,path.hr2,path.Inverted) then if path.Dir = 1 then begin path.hr1 := ip; end else begin path.hr2 := ip; end; end; end; end; function TNetCol.PathInter(p1, p2: TDoublePoint): Boolean; var ip,xp,xp1,xp2,xp3,xp4: TDoublePoint; dist: Double; i1,i2,i3,i4:Boolean; begin result := false; GetPoints(xp1, xp2, xp3, xp4); i1 := GetIntersectionPoint(p1,p2,xp1,xp2,ip,false,false); i2 := GetIntersectionPoint(p1,p2,xp2,xp3,ip,false,false); i3 := GetIntersectionPoint(p1,p2,xp3,xp4,ip,false,false); i4 := GetIntersectionPoint(p1,p2,xp4,xp1,ip,false,false); result := i1 or i2 or i3 or i4; end; procedure TNetCol.SetPosition; var path: TnetPath; xPaths: TList; xp1,xp2,xp3: TDoublePoint; a1,a2,a3: Double; Function isAngles2(ang1,ang2:Double): Boolean; begin result := ((ang1 = a1) and (ang2 = a2)) or ((ang1 = a2) and (ang2 = a1)) end; Function isAngles3(ang1,ang2,ang3:Double): Boolean; begin result := false; if (ang1 <> ang2) and (ang2 <> ang3) and (ang1 <> ang3) then begin result := ((ang1 = a1) or (ang1 = a2) or (ang1 = a3)) and ((ang2 = a1) or (ang2 = a2) or (ang2 = a3)) and ((ang3 = a1) or (ang3 = a2) or (ang3 = a3)); end; end; begin xPaths := TList.Create; Net.GetPathsOfKnot(p1,xPaths); if (xPaths.Count < 2) or (xPaths.Count > 3) then begin Position := 0; end else if xPaths.Count = 2 then begin path := TnetPath(xPaths[0]); xp1 := path.OtherPoint(p1)^; path := TnetPath(xPaths[1]); xp2 := path.OtherPoint(p1)^; a1 := GetRadOfLine(p1^,xp1); a2 := GetRadOfLine(p1^,xp2); if isAngles2(0,pi/2) then Position := 1 else if isAngles2(pi,pi/2) then Position := 3 else if isAngles2(3*(pi/2),0) then Position := 7 else if isAngles2(3*(pi/2),pi) then Position := 5; end else if xPaths.Count = 3 then begin path := TnetPath(xPaths[0]); xp1 := path.OtherPoint(p1)^; path := TnetPath(xPaths[1]); xp2 := path.OtherPoint(p1)^; path := TnetPath(xPaths[2]); xp3 := path.OtherPoint(p1)^; a1 := GetRadOfLine(p1^,xp1); a2 := GetRadOfLine(p1^,xp2); a3 := GetRadOfLine(p1^,xp3); if isAngles3(0,pi,pi/2) then Position := 2 else if isAngles3(0,pi,3*(pi/2)) then Position := 6 else if isAngles3(0,pi/2,3*(pi/2)) then Position := 8 else if isAngles3(pi,pi/2,3*(pi/2)) then Position := 4; end; xPaths.free; end; function TNetCol.SnapPoints(var x, y: Double; DotsPerMil: Double): Boolean; var d1,d2,d3,d4,d: Double; p,pd:TDoublePoint; tIdx: TPCTool; fig: string; snapDist: Double; ap1,ap2,ap3,ap4: TDoublePoint; begin result := false; snapDist := 24 / dotspermil; p := DoublePoint(x, y); tIdx := TPcDrawing(net.Owner).ToolIdx; fig := TPcDrawing(net.Owner).SnapInfo; if (fig = 'TPipeLine') or (Fig = 'TPipe') then begin GetPipePoints(ap1,ap2,ap3,ap4); d1 := GetLineLenght(ap1,p); d2 := GetLineLenght(ap2,p); d3 := GetLineLenght(ap3,p); d4 := GetLineLenght(ap4,p); d := d1;pd := ap1; if d2 < d then begin d := d2;pd := ap2; end; if d3 < d then begin d := d3;pd := ap3; end; if d4 < d then begin d := d4;pd := ap4; end; if (d < snapDist) then begin x := pd.x; y := pd.y; result := true; end; end; end; procedure TNetCol.WriteToStream(Stream: TStream); var colVersion:Byte; i: Integer; classIndex : Byte; begin classIndex := 1; Stream.Write(classIndex,1); colversion := 1; Stream.Write(colversion,1); i := net.Points.IndexOf(p1); Stream.Write(i,4); Stream.Write(w,8); Stream.Write(h,8); Stream.Write(Angle,8); Stream.Write(Position,1); end; procedure TNetCol._Draw(Dengine: TPCdrawEngine; xColor: TColor;Fill:Boolean); var s: Integer; ap1,ap2,ap3,ap4: TDoublePoint; begin if GetPoints(ap1,ap2,ap3,ap4) then begin if (net.DetDraw = false) and (Region <> 0) then DeleteObject(Region); fill := false; if fill then s := ord(bsSolid) else s := ord(bsClear); if (net.DetDraw = false) then Region := 0; Dengine.drawrect(ap1,ap2,ap3,ap4,xColor,1,ord(psSolid),clWhite,s,HRGN(Region)); end; end; { TInsertCol } constructor TInsertCol.create(p1: TDoublepoint; xNet: Tnet); begin inherited create(0, dsTrace, nil); Initialize; // tolik 29/07/2021 -- pointcount := 1; actualpoints[1] := Doublepoint(p1.x,p1.y); Net := xNet; end; class function TInsertCol.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; begin Result := nil; if assigned(TInsertCol(Shadow).Net) then begin TInsertCol(Shadow).Net.AddNetCol(Shadow.ap1); end; end; class function TInsertCol.CreateShadow(x, y: Double): TFigure; begin result := nil; CreateShadow := nil; if not assigned(activenet) then exit; CreateShadow := TInsertCol.create(Doublepoint(x,y),ActiveNet); end; function TInsertCol.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; begin result := True; end; function TInsertCol.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; begin end; { TNetRow } constructor TNetRow.Create(xNet: Tnet; xp1, xp2: PDoublePoint); begin inherited Create(xNet); Points.Add(xp1); Points.Add(xp2); Thick := 6; Height := 6; GetPipePoints(a1,a2,b1,b2); end; class function TNetRow.CreateFromStream(Stream: Tstream; xNet: Tnet): TNetStruct; var rowVersion: Byte; i: Integer; xRow: TNetRow; begin result := nil; xRow := TNetRow.Create(xNet, nil, nil); Stream.Read(rowversion, 1); // rowversion = 2; Stream.Read(i, 4); if (i > -1) and (i -1) and (i 1 then begin Stream.Read(xRow.Height, 8); end; Result := xRow; end; procedure TNetRow.Draw(Dengine: TPCdrawEngine; isGrayed: Boolean); var color: Integer; begin if isGrayed then Color := clSilver else Color := clRed; _Draw(Dengine,Color); end; procedure TNetRow.DrawGuides(DEngine: TPCDrawEngine); begin GetPipePoints; Dengine.DrawPoint(a1,clSilver); Dengine.DrawPoint(a2,clSilver); Dengine.DrawPoint(b1,clSilver); Dengine.DrawPoint(b2,clSilver); end; procedure TNetRow.DrawTrace(Dengine: TPCDrawEngine); begin _Draw(Dengine,clLime); end; function TNetRow.DuplicateNonPoints: TNetStruct; begin result := nil; result := TNetRow.Create(Net,nil,nil); result.Points.Clear; TNetRow(Result).Thick := Thick; end; function TNetRow.GetPipePoints(var aa1, aa2, bb1, bb2: TDoublePoint): Boolean; var xp1,xp2,xp3,xp4: TDoublePoint; begin result := true; GetPoints(xp1,xp2,xp3,xp4); aa1 := MPoint(xp1,xp2,(Net.WallThick/2) + 1.0); aa2 := MPoint(xp2,xp1,(Net.WallThick/2) + 1.0); bb1 := MPoint(xp4,xp3,(Net.WallThick/2) + 1.0); bb2 := MPoint(xp3,xp4,(Net.WallThick/2) + 1.0); ExtendLine(aa1,bb1,1.0); ExtendLine(aa2,bb2,1.0); end; procedure TNetRow.GetBounds(var figMaxX, figMaxY, figMinX, figMinY: Double); var xp1,xp2,xp3,xp4: TDoublePoint; begin GetPoints(xp1,xp2,xp3,xp4); figMaxX := xp1.x; figMaxY := xp1.y; figMinX := xp1.x; figMinY := xp1.y; if xp2.x > figMaxX then figMaxX := xp2.x; if xp3.x > figMaxX then figMaxX := xp3.x; if xp4.x > figMaxX then figMaxX := xp4.x; if xp2.x < figMinX then figMinX := xp2.x; if xp3.x < figMinX then figMinX := xp3.x; if xp4.x < figMinX then figMinX := xp4.x; if xp2.y > figMaxY then figMaxY := xp2.y; if xp3.y > figMaxY then figMaxY := xp3.y; if xp4.y > figMaxY then figMaxY := xp4.y; if xp2.y < figMinY then figMinY := xp2.y; if xp3.y < figMinY then figMinY := xp3.y; if xp4.y < figMinY then figMinY := xp4.y; end; function TNetRow.GetPipePoints: Boolean; begin result := false; result := GetPipePoints(a1,a2,b1,b2); end; function TNetRow.GetPoints(var ap1, ap2, ap3, ap4: TDoublePoint): Boolean; var ww: Double; begin result := false; if (not assigned(p1)) and (Points.Count > 0) then p1 := PDoublePoint(Points[0]); if (not assigned(p2)) and (Points.Count > 1) then p2 := PDoublePoint(Points[1]); if (not assigned(p1)) and (not assigned(p2)) then exit; ww := thick/2; GetParallelPoints(p1^,p2^,ap1,ap2,-ww); GetParallelPoints(p1^,p2^,ap4,ap3,ww); result := True; end; procedure TNetRow.IntersectPathPipe(Path: TnetPath); var ap1,ap2, ap3, ap4,ip,xp,ip1,ip2: TDoublePoint; radius: Double; iCnt: Integer; begin GetPipePoints(ap1,ap2,ap3,ap4); if GetIntersectionPoint(path.hl1,path.hl2,ap1,ap2,ip,false,true) then begin if path.dir = 1 then path.hl1 := ip else path.hl2 := ip; end; if GetIntersectionPoint(path.hl1,path.hl2,ap2,ap3,ip,false,true) then begin if path.dir = 1 then path.hl1 := ip else path.hl2 := ip; end; if GetIntersectionPoint(path.hl1,path.hl2,ap3,ap4,ip,false,true) then begin if path.dir = 1 then path.hl1 := ip else path.hl2 := ip; end; if GetIntersectionPoint(path.hl1,path.hl2,ap4,ap1,ip,false,true) then begin if path.dir = 1 then path.hl1 := ip else path.hl2 := ip; end; if GetIntersectionPoint(path.hr1,path.hr2,ap1,ap2,ip,false,true) then begin if path.dir = 1 then path.hr1 := ip else path.hr2 := ip; end; if GetIntersectionPoint(path.hr1,path.hr2,ap2,ap3,ip,false,true) then begin if path.dir = 1 then path.hr1 := ip else path.hr2 := ip; end; if GetIntersectionPoint(path.hr1,path.hr2,ap3,ap4,ip,false,true) then begin if path.dir = 1 then path.hr1 := ip else path.hr2 := ip; end; if GetIntersectionPoint(path.hr1,path.hr2,ap4,ap1,ip,false,true) then begin if path.dir = 1 then path.hr1 := ip else path.hr2 := ip; end; end; function TNetRow.IsPointIn(x, y: Double): Boolean; begin result := false; result := inherited isPointIn(x,y); end; function TNetRow.SnapPoints(var x, y: Double; DotsPerMil: Double): Boolean; var d1,d2,d3,d4,d: Double; p,pd:TDoublePoint; tIdx: TPCTool; fig: string; snapDist: Double; begin result := false; snapDist := 24 / dotspermil; p := DoublePoint(x,y); tIdx := TPcDrawing(net.Owner).ToolIdx; fig := TPcDrawing(net.Owner).ToolInfo; if (fig = 'TPipeLine') or (Fig = 'TPipe') then begin d1 := GetLineLenght(a1,p); d2 := GetLineLenght(a2,p); d3 := GetLineLenght(b1,p); d4 := GetLineLenght(b2,p); d := d1; pd := a1; if d2 < d then begin d := d2;pd := a2; end; if d3 < d then begin d := d3; pd := b1; end; if d4 < d then begin d := d4; pd := b2; end; if (d < snapDist) and (d<>0) then begin x := pd.x; y := pd.y; result := true; end; end; end; procedure TNetRow.WriteToStream(Stream: TStream); var rowVersion, classIndex: Byte; i: Integer; begin classIndex := 2; Stream.Write(classIndex,1); rowVersion := 2; Stream.Write(rowVersion,1); i := net.Points.IndexOf(p1); Stream.Write(i, 4); i := net.Points.IndexOf(p2); Stream.Write(i, 4); Stream.Write(Thick, 8); Stream.Write(Height, 8); end; procedure TNetRow._Draw(Dengine: TPCdrawEngine; xColor: TColor); var ap1,ap2,ap3,ap4,cp:TDoublePoint; rad: Double; begin if GetPoints(ap1,ap2,ap3,ap4) then begin if (net.DetDraw = false) and (Region <> 0) then DeleteObject(Region); if (net.DetDraw = false) then Region := 0; Dengine.drawrect(ap1,ap2,ap3,ap4,xColor,1,ord(psDashDot),0,ord(bsClear),HRGN(Region)); cp := MPoint(ap1,ap3); rad := GetRadOfLine(ap1,ap2); DEngine.DrawCenteredText(cp, xColor, 'TNetRow._Draw', 'Tahoma', 3.0, rad); end; end; function TNetRow.GetDistToPoint(p: TDoublePoint): Double; var xp,xp1,xp2,xp3,xp4: TDoublePoint; dist: Double; begin result := 0; GetPoints(xp1,xp2,xp3,xp4); xp := p; PointToLine(xp1,xp2,xp.x,xp.y); dist := GetLineLength(xp,p); result := dist; xp := p; PointToLine(xp3,xp4,xp.x,xp.y); dist := GetLineLength(xp,p); if dist < result then result := dist; end; function TNetRow.PathInter(p1, p2: TDoublePoint): Boolean; var k1, k2: Double; ip, xp, xp1, xp2, xp3, xp4: TDoublePoint; i1, i2: Boolean; begin result := false; GetPoints(xp1,xp2,xp3,xp4); result := False; k1 := Net.TopZ; k2 := Net.TopZ - Height; if (p1.z < k2) or (p2.z < k2) then exit; i1 := GetIntersectionPoint(p1,p2,xp1,xp2,ip,false,false); i2 := GetIntersectionPoint(p1,p2,xp3,xp4,ip,false,false); result := i1 or i2; end; procedure TNetRow.IntersectPath(Path: TnetPath); begin end; { TInsertRow } constructor TInsertRow.create(p1: TDoublepoint; xNet: Tnet); begin inherited create(0, dsTrace, nil); Initialize; // tolik 29/07/2021 -- pointcount := 2; SnapPoint(p1.x, p1.y); actualpoints[1] := Doublepoint(p1.x, p1.y); actualpoints[2] := Doublepoint(p1.x, p1.y); Net := xNet; Valid := False; end; class function TInsertRow.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; begin Result := nil; if assigned(TInsertRow(Shadow).Net) and (TInsertRow(Shadow).Valid) then begin TInsertRow(Shadow).Net.AddNetRow(Shadow.ap1,shadow.ap2); end; end; class function TInsertRow.CreateShadow(x, y: Double): TFigure; begin result := nil; if not assigned(ActiveNet) then exit; if ActiveNet.IsPOintOnWall(DoublePoint(x,y)) then Result := TInsertRow.create(DoublePoint(x,y), ActiveNet) else result := nil; end; procedure TInsertRow.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); begin DEngine.Canvas.pen.mode := pmXor; DEngine.drawline(ap1.x,ap1.y,ap2.x,ap2.y,clLime,1,1,0); end; function TInsertRow.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; begin Result := False; if ClickIndex = 2 then begin SnapPoint(x, y); if Net.IsPOintOnWall(DoublePoint(x,y)) then begin ActualPoints[2] := DoublePoint(x,y); Valid := True; result := true; end; end; end; function TInsertRow.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; begin result := false; SnapPoint(x,y); ActualPoints[2] := DoublePoint(x,y); end; procedure TInsertRow.SnapPoint(var x, y: Double); var dx,dy: Double; p1,p2: TDoublePoint; wt: Double; l,d,minD,dist: Double; path:TnetPath; begin if not assigned(net) then exit; if not TPowercad(Net.Owner).SnapToNearPoint then exit; if Net.SnapToKnots(x,y,4,False) then exit; p1 := actualpoints[1]; dx := abs(x - p1.x); dy := abs(y - p1.y); if (dx > dy) and (dy < 20) then dy := 0 else if (dy > dx) and (dx < 20) then dx := 0; if x > p1.x then x := p1.x + dx else x := p1.x - dx; if y > p1.y then y := p1.y + dy else y := p1.y - dy; end; { TDoorTrace } constructor TDoorTrace.Create(xNet: TNet; xPath: TNetPath; xDoor: TNetDoor); var ShowPathLengthType: TShowPathLengthType; DirectionKoeff: Integer; TmpPt: TDoublePoint; DistToLine: Double; procedure DefPointsByLenType(ap1, ap2: PDoublePoint); var DoorP1: TDoublePoint; DrawDoorP1: TDoublePoint; DrawNStart: Double; begin path.DefineInOutPoints; PathP1 := ap1^; PathP2 := ap2^; //DirectionKoeff := GetParallelPointDirectionKoeff(path.p1^, path.p2^, PathP1); //TmpPt := PathP1; //PointToLineByAngle(path.p1^, path.p2^, TmpPt); //DistToLine := GetDistToLine(path.p1^, path.p2^, PathP1); //DistToLine := GetLineLenght(TmpPt, PathP1); //GetParallelPoints(path.p1^, path.p2^, PathP1, PathP2, -1*DirectionKoeff * DistToLine); //DrawStartOffset := GetLineLenght(path.p1^, PathP1) * (-1); // Определяем на сколько смещена первая точка двери DoorP1 := MPoint(path.p1^, path.p2^, NStart); DrawDoorP1 := MPoint(PathP1, PathP2, NStart); // проецирем на основную линию PointToLineByAngle(path.p1^, path.p2^, DrawDoorP1); DrawNStart := GetLineLenght(path.p1^, DrawDoorP1); DrawStartOffset := NStart - DrawNStart; end; begin inherited Create(0, dsTrace, nil); Initialize; // tolik 29/07/2021 -- PointCount := 2; Net := xNet; Path := xPath; Opath := xPath; Door := xDoor; Start := Door.Start; //11.10.2010 //Opoint := MPoint(Door.p1, Door.p2); //ActualPoints[1] := Opoint; //ActualPoints[2] := Opoint; p1 := Door.p1; p2 := Door.p2; NLen := Door.Len; NStart := Start; DefineActualPoints; //19.04.2011 PathP1 := path.p1^; PathP2 := path.p2^; //22.05.2012 - Если смещение стороны сегмента по перпендикулярной точке if Path.FPerpendDX <> 0 then begin PathP1.x := PathP1.x + Path.FPerpendDX; PathP2.x := PathP2.x + Path.FPerpendDX; end; if Path.FPerpendDY <> 0 then begin PathP1.y := PathP1.y + Path.FPerpendDY; PathP2.y := PathP2.y + Path.FPerpendDY; end; DrawStartOffset := 0; ShowPathLengthType := sltPoints; if Assigned(path.FOnGetShowPathTraceLengthType) then ShowPathLengthType := path.FOnGetShowPathTraceLengthType(path); case ShowPathLengthType of sltInner: begin //path.DefineInOutPoints; //PathP1 := path.ip1^; //PointToLineByAngle(path.p1^, path.p2^, PathP1); //22.05.2012 PointToLine(path.p1^, path.p2^, PathP1.x, PathP1.y); //PathP2 := path.ip2^; //PointToLineByAngle(path.p1^, path.p2^, PathP2); //22.05.2012 PointToLine(path.p1^, path.p2^, PathP2.x, PathP2.y); //DrawStartOffset := GetLineLenght(path.p1^, PathP1); {path.DefineInOutPoints; PathP1 := path.ip1^; PathP2 := path.ip2^; DirectionKoeff := GetParallelPointDirectionKoeff(path.p1^, path.p2^, PathP1); TmpPt := PathP1; PointToLineByAngle(path.p1^, path.p2^, TmpPt); DistToLine := GetDistToLine(path.p1^, path.p2^, PathP1); DistToLine := GetLineLenght(TmpPt, PathP1); //GetParallelPoints(path.p1^, path.p2^, PathP1, PathP2, -1*DirectionKoeff * DistToLine); //DrawStartOffset := GetLineLenght(path.p1^, PathP1) * (-1);} path.DefineInOutPoints; DefPointsByLenType(path.ip1, path.ip2); end; sltOuter: begin //path.DefineInOutPoints; //PathP1 := path.op1^; //PointToLineByAngle(path.p1^, path.p2^, PathP1); //22.05.2012 PointToLine(path.p1^, path.p2^, PathP1.x, PathP1.y); //PathP2 := path.op2^; //PointToLineByAngle(path.p1^, path.p2^, PathP2); //22.05.2012 PointToLine(path.p1^, path.p2^, PathP2.x, PathP2.y); //DrawStartOffset := GetLineLenght(path.p1^, PathP1) * (-1); {PathP1 := path.op1^; PathP2 := path.op2^; DirectionKoeff := GetParallelPointDirectionKoeff(path.p1^, path.p2^, PathP1); TmpPt := PathP1; PointToLineByAngle(path.p1^, path.p2^, TmpPt); DistToLine := GetDistToLine(path.p1^, path.p2^, PathP1); DistToLine := GetLineLenght(TmpPt, PathP1); //GetParallelPoints(path.p1^, path.p2^, PathP1, PathP2, -1*DirectionKoeff * DistToLine); //DrawStartOffset := GetLineLenght(path.p1^, PathP1); } path.DefineInOutPoints; DefPointsByLenType(path.op1, path.op2); end; end; FIsShowLen := false; //11.10.2010 end; procedure TDoorTrace.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var l1: Double; l2: Double; lText: String; p1, p2, dp1, dp2, xp1, xp2, xp3, xp4: TDoublePoint; uText: String; aLength: string; aText: string; NewLen: Double; //11.10.2010 LenTopDraw: Boolean; //11.10.2010 LenDelta: Integer; //11.10.2010 на сколько центрировать текст PathRotated: Boolean; begin Dengine.Canvas.Pen.Mode := pmXor; dp1 := MPoint(PathP1, PathP2, NStart + DrawStartOffset); dp2 := MPoint(dp1, PathP2, NLen); //11.10.2010 dp2 := MPoint(dp1, path.p2^, Door.Len); GetParallelPoints(dp1, dp2, xp1, xp2,((path.Width / 2) + 2)); GetParallelPoints(dp1, dp2, xp3, xp4,-((path.Width / 2) + 2)); // линии от точки двери к точки TNetPath Dengine.drawline(PathP1, dp1, clLime, 1, ord(psSolid), 0); Dengine.drawline(dp2, PathP2, clLime, 1, ord(psSolid), 0); Dengine.drawline(xp1, xp3, clLime, 1, ord(psSolid), 0); Dengine.drawline(xp2, xp4, clLime, 1, ord(psSolid), 0); l1 := GetLineLenght(PathP1, dp1){ - path.Width / 2}; l2 := GetLineLenght(PathP2, dp2){ - path.Width / 2}; NewLen := NLen; if Net.WorldDim then begin l1 := l1 / 1000 * Net.MapScale; l2 := l2 / 1000 * Net.MapScale; NewLen := NewLen / 1000 * Net.MapScale; end else begin l1 := l1 / 10; l2 := l2 / 10; NewLen := NewLen / 10; end; p1 := MPoint(PathP1, dp1); p2 := MPoint(PathP2, dp2); aLength := FormatFloat(ffMask, MetreToUOM(L1)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; Dengine.TraceText(p1, clLime, aLength + aText, 'Arial', 8); aLength := FormatFloat(ffMask, MetreToUOM(L2)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; Dengine.TraceText(p2, clLime, aLength + aText, 'Arial', 8); //11.10.2010 if FIsShowLen then begin // точка посредине отступной (паралельной) линии //dp1 := MPoint(xp1, xp2); //dp1 := MPoint(xp1, xp2, (NLen/3)); //if Path.PosType = ptVertical then // dp1 := MPoint(xp3, xp4, (NLen/3)); LenTopDraw := true; LenDelta := 3; PathRotated := false; if Path.PosType = ptVertical then begin LenTopDraw := false; if PathP1.y > PathP2.y then begin LenTopDraw := true; PathRotated := true; end; LenDelta := 2; end else if Path.PosType = ptHorizontal then begin if PathP1.x > PathP2.x then begin LenTopDraw := false; LenDelta := 3; PathRotated := true; end; end; if LenTopDraw then begin if Not PathRotated then dp1 := MPoint(xp1, xp2, (NLen/LenDelta)) else dp1 := MPoint(xp2, xp1, (NLen/LenDelta)) end else begin if Not PathRotated then dp1 := MPoint(xp3, xp4, (NLen/LenDelta)) else dp1 := MPoint(xp4, xp3, (NLen/LenDelta)) end; aLength := FormatFloat(ffMask, MetreToUOM(NewLen)); Dengine.TraceText(dp1, clLime, aLength + aText, 'Arial', 8); end; end; procedure TDoorTrace.DefineActualPoints; begin Opoint := MPoint(p1, p2); ActualPoints[1] := Opoint; ActualPoints[2] := Opoint; end; procedure TDoorTrace.MovePoint(APoint: TDoublePoint; x, y: Double); var //dp1, dp2: TDoublePoint; dx, dy: Double; delta: Double; begin //dp1 := MPoint(path.p1^, path.p2^, NStart); //dp2 := MPoint(dp1, path.p2^, Len); delta := 0; dx := x - APoint.x; dy := y - APoint.y; if Path.PosType = ptVertical then begin delta := dy; if path.p1^.y > path.p2^.y then delta := -delta; end else if Path.PosType = ptHorizontal then begin delta := dx; if path.p1^.x > path.p2^.x then delta := -delta; end; if EQDP(APoint, p1) then begin if ((Door.Len - delta) > 0) and ((Start + delta)>0) then begin NStart := Start + delta; NLen := Door.Len - delta; end; //p1 := APoint; //dp1; //DefineActualPoints; end else if EQDP(APoint, p2) then begin if (Door.Len + delta) > 0 then NLen := Door.Len + delta; //p2 := APoint; //dp2; //DefineActualPoints; end else begin //NLen := NLen; end; end; procedure TDoorTrace.EndTrace; var ChangedLen: Boolean; begin if (Path <> oPath) then begin if Door.DoChangePathQuery(oPath, Path) then begin Path.Doors.Add(Door); oPath.Doors.Remove(Door); oPath.DoorIndex := -1; //27.07.2011 Net.SelType := stPath; //27.07.2011 Net.SelIndex := Net.Paths.IndexOf(Path) + 1; Net.SelectPath(Net.Paths.IndexOf(Path) + 1); end; end; ChangedLen := Abs(Door.Len - NLen) > 0.001; Door.Start := NStart; Door.Len := NLen; Door.CalculatePoints(path.p1^, path.p2^); Net.RefreshPaths; Path.DoorIndex := Path.Doors.IndexOf(Door); Door.DoResize; if ChangedLen then if Door.FComponID = 0 then GArchEngine.SetLastDoorObjSize(Door.DoorObjType, Door.Len); end; procedure TDoorTrace.Locate(x, y: Double); var delta: Double; dx, dy: Double; xPath: TnetPath; begin xPath := nil; delta := 0; //#From Oleg# //14.09.2010 ActualPoints[2] := DoublePoint(x, y); if not Path.IsPointIn(x,y) then xPath := Net.GetPathOfPoint(x, y); if assigned(xPath) and (xPath <> Path) and (not xPath.isArc) and (xPath.WType = wtWall) then begin Path := xPath; PointToLine(path.p1^, path.p2^, x, y); OPoint := DoublePoint(x, y); Start := GetLineLenght(path.p1^, Opoint) - (Door.Len / 2); end; ActualPoints[1] := DoublePoint(x, y); dx := ap1.x - opoint.x; dy := ap1.y - opoint.y; if Path.PosType = ptVertical then begin delta := dy; if path.p1^.y > path.p2^.y then delta := -delta; end else if Path.PosType = ptHorizontal then begin delta := dx; if path.p1^.x > path.p2^.x then delta := -delta; end; NStart := Start + delta; if NStart < (Path.Width / 2) then NStart := Path.Width / 2; //11.10.2010 if NStart + Door.Len > (Path.AbsLen + Path.Width - (Path.Width / 2)) then //11.10.2010 NStart := (Path.AbsLen + Path.Width - (Path.Width / 2)) - Door.Len; if NStart + NLen > (Path.AbsLen + Path.Width - (Path.Width / 2)) then NStart := (Path.AbsLen + Path.Width - (Path.Width / 2)) - NLen; end; procedure TDoorTrace.Move(dx, dy: Double); begin Locate(ap2.x + dx, ap2.y + dy); end; { TPathTrace } constructor TPathTrace.Create(xPath: TNetPath; xNet: TNet; Shift,Ctrl:Boolean); begin inherited Create(0,dsTrace,nil); Initialize; // tolik 29/07/2021 -- Clone := nil; FPathInClone := nil; PointCount := 2; Net := xNet; Path := xPath; FDrawP1 := xPath.p1^; //22.04.2011 FDrawP2 := xPath.p2^; //22.04.2011 Net.CollectBoundPoints(Path,NPoints1,NPoints2, Self); Opoint := Mpoint(xPath.p1^,xPath.p2^); p1 := xPath.p1^; p2 := xPath.p2^; op1 := p1; op2 := p2; xp1 := p1; xp2 := p2; ShiftP := shift; CtrlP := ctrl; repair := false; // if (shiftP = True) and (ctrlP = True) then relocate := false; // else // relocate := True; if Relocate = True then begin if (ctrlP = true) or (shiftP = True) then deleteOld := False else deleteOld := true; if (shiftP = true) or ((shiftP = false) and (ctrlP = false)) then repair := True; end; Actualpoints[1] := opoint; ActualPoints[2] := opoint; // Arc props IsArc := xPath.IsArc; ArcCenter := xPath.ArcCenter; l1 := xPath.l1; l2 := xPath.l2; r1 := xPath.r1; r2 := xPath.r2; Inverted := xPath.Inverted; FRelatedTraces := TList.Create; FRelatedNets := TList.Create; FIsRelated := false; FRelatedOwner := nil; end; destructor TPathTrace.Destroy; var i: Integer; begin try if FRelatedTraces <> nil then begin for i := 0 to FRelatedTraces.Count - 1 do TObject(FRelatedTraces[i]).Free; FreeAndNil(FRelatedTraces); end; if FRelatedNets <> nil then begin for i := 0 to FRelatedNets.Count - 1 do TObject(FRelatedNets[i]).Free; FreeAndNil(FRelatedNets); end; Net.FFigureModification := false; Net.ClearRels; if Assigned(Clone) then FreeAndNil(Clone); FPathInClone := nil; except on E: Exception do AddExceptionToLogEx('Destroy', E.Message); end; inherited; end; procedure TPathTrace.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var i: Integer; len:Double; Style: Integer; ShowPathLengthType: TShowPathLengthType; CanDraw: Boolean; Procedure DrawLen(tp1,tp2: TDoublePoint); var uText,lText: String; tp: TDoublePoint; aLength: string; aText: string; begin // uText := ' m'; // if len < 1 then begin // len := len*100; // uText := ' cm'; // end; //if not snapped then // len := Trunc(len*100)/100; // lText := FloatToStr(len)+uText; aLength := FormatFloat(ffMask, MetreToUOM(Len)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; tp := MPoint(tp1, tp2); if EQD(tp1.x, tp2.x) then tp := MovePoint(tp, 3, 0) else tp := MovePoint(tp, 0, 3); Dengine.TraceText(tp, clLime, aLength + aText, 'Arial', 8); end; // AFromPoint - точка находится на самой PathTrace // op - точка посредине (исходная) // ANPoints - крайние точки (от исходной в противоположную сторону) procedure DrawNPoints(ANumPt: Integer; AFromPoint, ADrawFromPoint, op: TDoublePoint; var ANPoints: TDoublePointArr); //21.10.2010 var i: Integer; MiddleLineDrawed: Boolean; LineDrawLater: Boolean; CanDrawMiddleLine: Boolean; WDelta: Double; begin MiddleLineDrawed := false; if Not FIsRelated then begin //Dengine.drawline(AFromPoint, op,clLime,1,ord(psSolid),0); len := (GetLineLenght(ADrawFromPoint, op)*Net.MapScale)/1000; DrawLen(AFromPoint, op); end; CanDrawMiddleLine := true; //Not FIsRelated; // Линия от крайней точки до новой for i := 0 to Length(ANPoints)-1 do begin if (not Relocate) or (EQD(ADrawFromPoint.x, ANPoints[i].x)) or (EQD(ADrawFromPoint.y, ANPoints[i].y)) then begin //LineDrawLater := false; //if IsPointInLine(AFromPoint, op, ANPoints[i], 1) then // LineDrawLater := true; //if Not LineDrawLater then Dengine.drawline(AFromPoint, ANPoints[i],clLime,1,ord(psSolid),0); //15.04.2011 len := ((GetLineLenght(AFromPoint, ANPoints[i])-path.Width)*Net.MapScale)/1000; len := GetLineLenght(ADrawFromPoint, ANPoints[i]); if ShowPathLengthType <> sltPoints then begin WDelta := path.Width; //case ANumPt of // 1: // WDelta := Abs(WidthOut1 - WidthInner1) / 4; // 2: // WDelta := Abs(WidthOut2 - WidthInner2) / 4; //end; //WDelta := path.Width / 2; //case ShowPathLengthType of // sltInner: // len := len - WDelta; // sltOuter: // len := len + WDelta; //end; end; len := (len * Net.MapScale)/1000; DrawLen(AFromPoint, ANPoints[i]); //if CanDrawMiddleLine and Not LineDrawLater then // // Если средняя линия (от исходной точки до новой) попадает в промежутки только что отрисованой // if IsPointInLine(AFromPoint, ANPoints[i], op, 1) then // CanDrawMiddleLine := false; end; end; if CanDrawMiddleLine then begin // линия от исходной точки до новой Dengine.drawline(AFromPoint, op,clLime,1,ord(psSolid),0); end; end; begin ShowPathLengthType := sltInner; if Assigned(Path.FOnGetShowPathTraceLengthType) then ShowPathLengthType := Path.FOnGetShowPathTraceLengthType(Path); if Not Assigned(Clone) then begin if Not FIsRelated then begin Dengine.Canvas.Pen.Mode := pmXor; Style := Ord(psSolid); //22.10.2010 if IsArc then Style := Ord(psDot); Dengine.drawline(p1,p2,clWhite xor clRed,1, Style,0); //21.10.2010 //Dengine.drawline(p1,op1,clLime,1,ord(psSolid),0); //len := (GetLineLenght(p1,op1)*Net.MapScale)/1000; //DrawLen(p1,op1); //Dengine.drawline(p2,op2,clLime,1,ord(psSolid),0); //len := (GetLineLenght(p2,op2)*Net.MapScale)/1000; //DrawLen(p2,op2); //22.10.2010 if IsArc then begin //Dengine.Canvas.Pen.Mode := pmCopy; DrawArc(DEngine, clLime, Ord(psSolid)); //Dengine.Canvas.Pen.Mode := pmXor; end; end; //21.10.2010 //for i := 0 to Length(Npoints1)-1 do begin // if (not Relocate) or (EQD(p1.x,Npoints1[i].x)) or (EQD(p1.y,Npoints1[i].y)) then // begin // Dengine.drawline(p1,Npoints1[i],clLime,1,ord(psSolid),0); // len := ((GetLineLenght(p1,Npoints1[i])-path.Width)*Net.MapScale)/1000; // DrawLen(p1,Npoints1[i]); // end; //end; //for i := 0 to Length(Npoints2)-1 do begin // if (not Relocate) or (EQD(p2.x,Npoints2[i].x)) or (EQD(p2.y,Npoints2[i].y)) then // begin // Dengine.drawline(p2,Npoints2[i],clLime,1,ord(psSolid),0); // len := ((GetLineLenght(p2,Npoints2[i])-path.Width)*Net.MapScale)/1000; // DrawLen(p2,Npoints2[i]); // end; //end; DrawNPoints(1, p1, FDrawP1, op1, NDrawPoints1); //21.10.2010 DrawNPoints(2, p2, FDrawP2, op2, NDrawPoints2); //21.10.2010 end else Clone.draw(DEngine, isGrayed); DrawRelated(DEngine, isGrayed); end; procedure TPathTrace.DrawArc(Dengine: TPCDrawEngine;Color:Tcolor; style:Integer); var rgn: HRGN; rad1,rad2,ang1,ang2: Double; px,py:TDoublePoint; begin rad1 := GetLineLenght(ArcCenter,l1); if Inverted then begin ang1 := GetRadOfLine(ArcCenter,l1); ang2 := GetRadOfLine(ArcCenter,l2); end else begin ang1 := GetRadOfLine(ArcCenter,l2); ang2 := GetRadOfLine(ArcCenter,l1); end; if ang2 = 0 then ang2 := 2 * pi; Dengine.drawbezarc(ArcCenter.x,ArcCenter.y,rad1,ang1,ang2,color,1,style,0,0,0,rgn,px,py,true,0); rad1 := GetLineLenght(ArcCenter,r1); if Inverted then begin ang1 := GetRadOfLine(ArcCenter,r1); ang2 := GetRadOfLine(ArcCenter,r2); end else begin ang1 := GetRadOfLine(ArcCenter,r2); ang2 := GetRadOfLine(ArcCenter,r1); end; if ang2 = 0 then ang2 := 2 * pi; rgn := 1; Dengine.drawbezarc(ArcCenter.x,ArcCenter.y,rad1,ang1,ang2,color,1,style,0,0,0,rgn,px,py,true,0); // линии от центральной точки до точек сегмента //if isGrayed then // Color := Grayedcolor; //DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p1.x,p1.y, Color, 1, ord(psSolid), 0); //DEngine.DrawLine(ArcCenter.x,ArcCenter.y, p2.x,p2.y, Color, 1, ord(psSolid), 0); // Линия между точками //DEngine.DrawLine(p1.x,p1.y, p2.x,p2.y, Color, 1, ord(psSolid), 0); end; Procedure TPathTrace.DrawRelated(DEngine:TPCDrawEngine;isGrayed:Boolean); var i: Integer; begin for i := 0 to FRelatedTraces.Count - 1 do TPathTrace(FRelatedTraces[i]).Draw(DEngine, isGrayed); for i := 0 to FRelatedNets.Count - 1 do TNet(FRelatedNets[i]).Draw(DEngine, isGrayed); end; function TPathTrace.IsRelatedTo(Apt1, Apt2: PDoublePoint): Boolean; function IsRelBySide(p: PDoublePoint; var APoints: TDoublePointArr): Boolean; var i: Integer; begin Result := false; for i := 0 to Length(APoints) - 1 do begin if path.Net.CmpIntersectPaths(Apt1, Apt2, p, @APoints[i]) = citEqual then begin Result := true; Break; //// BREAK //// end; end; end; begin Result := IsRelBySide(@p1, NPoints1) or IsRelBySide(@p2, NPoints2); end; procedure TPathTrace.EndTrace; var dx, dy, delta: Double; repair: Boolean; NetList: TList; i: Integer; DefinedMoveObjs: Boolean; begin dx := p1.x - path.p1^.x; dy := p1.y - path.p1^.y; FEDeltaX := dx; FEDeltaY := dy; delta := dx; if abs(dy) > abs(dx) then delta := -dy; // if (shiftP = True) and (ctrlP = True) then relocate := false; { else relocate := True; if Relocate = True then begin if abs(delta) < 5 then begin Net.MovePath(Path, dx, dy); end else begin if (ctrlP = true) or (shiftP = True) then deleteOld := False else deleteOld := true; repair := false; if (shiftP = true) or ((shiftP = false) and (ctrlP = false)) then repair := True; Net.LocateSelPath(delta, deleteOld, repair); end; end else } {//22.09.2011 Net.MovePath(Path,dx,dy); EndTraceRelated; //19.10.2010 //25.05.2011 if Not FIsRelated then begin if Assigned(Net.FOnDefineMoveObjects) and Net.CanMoveJoined then begin NetList := TList.Create; NetList.Assign(Self.Net.FRelatedNets); NetList.Insert(0, Self.Net); if Net.FOnDefineMoveObjects(Net, nil, Path, NetList) then begin for i := 0 to NetList.Count - 1 do TNet(NetList[i]).MoveJoinedPoints(dx, dy, false); end; NetList.Free; end; end;} NetList := nil; DefinedMoveObjs := false; //25.05.2011 if Not FIsRelated then begin if Assigned(Net.FOnDefineMoveObjects) and Net.CanMoveJoined then begin NetList := TList.Create; NetList.Assign(Self.Net.FRelatedNets); NetList.Insert(0, Self.Net); DefinedMoveObjs := Net.FOnDefineMoveObjects(Net, nil, Path, NetList); end; end; Net.MovePath(Path,dx,dy); EndTraceRelated; //19.10.2010 if NetList <> nil then begin if DefinedMoveObjs then for i := 0 to NetList.Count - 1 do TNet(NetList[i]).MoveJoinedPoints(dx, dy, false); NetList.Free; end; end; Procedure TPathTrace.EndTraceRelated; var i: Integer; RelNets: TList; RelNet: TNet; RelPath: TNetPath; RelTrace: TPathTrace; CanSnap: Boolean; //TempPt: TDoublePoint; TempPt1, TempPt2: TDoublePoint; Pt1InLine, Pt2InLine: Boolean; MarginDelta: Double; MovedToPath: TNetPath; // Сегмент к которому примагничен begin RelNets := nil; MovedToPath := nil; MarginDelta := 2; //0.7; // Сдвигам текущие смежные стены (которые были смежными до перетаскивания) for i := 0 to FRelatedTraces.Count - 1 do begin RelTrace := TPathTrace(FRelatedTraces[i]); //if RelTrace.Path <> MovedToPath then begin // Точки подтягиваем к линии, чтобы все было как можно ровнее PointToLine(p1, p2, RelTrace.p1.x, RelTrace.p1.y); PointToLine(p1, p2, RelTrace.p2.x, RelTrace.p2.y); RelTrace.EndTrace; end; end; //24.05.2011 for i := 0 to FRelatedNets.Count - 1 do begin RelNet := TNet(FRelatedNets[i]); if (RelNet.FRelatedMPath <> nil) and (RelNet.FRelatedMPath is TNetPath) and Assigned(RelNet.FSrcNet) and Assigned(RelNet.FSrcNet.FRelatedMPath) then begin //10.06.2011 if Not Assigned(RelNet.FRelatedMPath) or (Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPath.p1) and Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPath.p2)) then RelNet.FSrcNet.MovePath(RelNet.FSrcNet.FRelatedMPath, FEDeltaX, FEDeltaY); end; end; // Ставим поинты связанных Net if (Net <> nil) and (Net.FRelatedNets.Count > 0) then for i := 0 to Net.FRelatedNets.Count - 1 do begin RelNet := TNet(Net.FRelatedNets[i]); if (RelNet.FRelatedMPoint <> nil) and (RelNet.FPathTracePoint <> nil) {and ((RelNet.FRelatedObject = nil) or (RelNet.FRelatedObject <> MovedToPath))} then begin if Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPoint) then RelNet.LocatePoint(RelNet.FRelatedMPoint, RelNet.FPathTracePoint^.x, RelNet.FPathTracePoint^.y); end; end; if Not FIsRelated then begin // подтягиваем к найденному смежному RelNets := Net.GetRelatedNetsByPoints(Path.p1, Path.p2, citEntry); //RelNets := Net.GetRelatedNetsByPoints(Path.p1, Path.p2); 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) and Not TNetPath(RelNet.FRelatedObject).IsArc then begin RelPath := TNetPath(RelNet.FRelatedObject); {//28.12.2010 if PointNear(RelPath.p1^, Path.p1^) and PointNear(RelPath.p2^, Path.p2^) then begin Path.p1.x := RelPath.p1.x; Path.p1.y := RelPath.p1.y; Path.p2.x := RelPath.p2.x; Path.p2.y := RelPath.p2.y; end else if PointNear(RelPath.p2^, Path.p1^) and PointNear(RelPath.p1^, Path.p2^) then begin Path.p1.x := RelPath.p2.x; Path.p1.y := RelPath.p2.y; Path.p2.x := RelPath.p1.x; Path.p2.y := RelPath.p1.y; end;} if Not RelNet.CheckPtInJoinedMove(RelPath.p1) and Not RelNet.CheckPtInJoinedMove(RelPath.p2) then begin if Path.CmpIntersectPath(RelPath, MarginDelta) in [citEqual, citEntry] then begin CanSnap := true; if CanSnap then begin TempPt1 := Path.p1^; PointToLine(RelPath.p1^, RelPath.p2^, TempPt1.x, TempPt1.y); Pt1InLine := isPointinLine(RelPath.p1^, RelPath.p2^,TempPt1,1, MarginDelta); TempPt2 := Path.p2^; PointToLine(RelPath.p1^, RelPath.p2^, TempPt2.x, TempPt2.y); Pt2InLine := isPointinLine(RelPath.p1^, RelPath.p2^,TempPt2,1, MarginDelta); if Pt1InLine and Pt2InLine then begin Path.p1^ := TempPt1; Path.p2^ := TempPt2; MovedToPath := RelPath; if Assigned(Net.FOnMergePaths) then RelNet.FOnMergePaths(RelPath, Path); Break; //// BREAK //// end; end; end; end; end; end; RelNets.Free; end; end; end; procedure TPathTrace.Move(dx, dy: Double); var wt: Double; l, d, minD, dist: Double; lx, ly: Double; i: integer; Guide: TGuideLine; GuideDistX, GuideDistY: Double; Cad: TPowerCad; OldPt1, OldPt2: TDoublePoint; //DeltaX, DeltaY: Double; begin OldPt1 := p1; OldPt2 := p2; if assigned(Net.Owner) then Cad := TPowerCad(Net.Owner) else Cad := nil; if Path.PosType = ptVertical then dy := 0 else dx := 0; xp1 := MovePoint(xp1, dx, dy); xp2 := MovePoint(xp2, dx, dy); if SnappedGrid then begin minD := Cad.GridStep; wt := Net.WallThick; lx := abs(xp1.x - op1.x); ly := abs(xp1.y - op1.y); // перемещение по вертикали if lx <> 0 then begin d := lx; d := d + wt; l := Trunc(d / minD) * mind; dist := d - l; if dist >= (mind / 2) then begin l := l + MinD; end; l := l - wt; if xp1.x > op1.x then p1.x := op1.x + l else p1.x := op1.x - l; if xp2.x > op2.x then p2.x := op2.x+l else p2.x := op2.x-l; end; // перемещение по горизонтали if (ly <> 0) then begin d := ly; d := d + wt; l := Trunc(d / minD) * mind; dist := d - l; if dist >= (mind / 2) then begin l := l + MinD; end; l := l - wt; if xp1.y > op1.y then p1.y := op1.y + l else p1.y := op1.y - l; if xp2.y > op2.y then p2.y := op2.y + l else p2.y := op2.y - l; end; end else if SnappedGuide then begin lx := abs(xp1.x - op1.x); ly := abs(xp1.y - op1.y); GuideDistX := 12 / Cad.DotsPerMil; GuideDistY := 12 / Cad.DotsPerMil; // при перемещении по вертикали if lx <> 0 then begin for i := 0 to Cad.Guides.count - 1 do begin Guide := TGuideLine(Cad.Guides[i]); if Guide.gType = gtVert then begin If abs(Guide.coord - xp1.x) < GuideDistX then begin GuideDistX := abs(Guide.coord - xp1.x); if xp1.x > p1.x then xp1.x := xp1.x + GuideDistX else xp1.x := xp1.x - GuideDistX; if xp2.x > p2.x then xp2.x := xp2.x + GuideDistX else xp2.x := xp2.x - GuideDistX; end else If abs(Guide.coord - xp2.x) < GuideDistX then begin GuideDistX := abs(Guide.coord - xp2.x); if xp1.x > p1.x then xp1.x := xp1.x + GuideDistX else xp1.x := xp1.x - GuideDistX; if xp2.x > p2.x then xp2.x := xp2.x + GuideDistX else xp2.x := xp2.x - GuideDistX; end; end; end; end; // при перемещении по горизонтали if ly <> 0 then begin for i := 0 to Cad.Guides.count - 1 do begin Guide := TGuideLine(Cad.Guides[i]); if Guide.gType = gtHorz then begin If abs(Guide.coord - xp1.y) < GuideDistY then begin GuideDistY := abs(Guide.coord - xp1.y); if xp1.y > p1.y then xp1.y := xp1.y + GuideDistY else xp1.y := xp1.y - GuideDistY; if xp2.y > p2.y then xp2.y := xp2.y + GuideDistY else xp2.y := xp2.y - GuideDistY; end else If abs(Guide.coord - xp2.y) < GuideDistY then begin GuideDistY := abs(Guide.coord - xp2.y); if xp1.y > p1.y then xp1.y := xp1.y + GuideDistY else xp1.y := xp1.y - GuideDistY; if xp2.y > p2.y then xp2.y := xp2.y + GuideDistY else xp2.y := xp2.y - GuideDistY; end; end; end; end; p1 := xp1; p2 := xp2; end else begin p1 := xp1; p2 := xp2; end; FDrawP1.x := FDrawP1.x + (p1.x-OldPt1.x); FDrawP1.y := FDrawP1.y + (p1.y-OldPt1.y); FDrawP2.x := FDrawP2.x + (p2.x-OldPt2.x); FDrawP2.y := FDrawP2.y + (p2.y-OldPt2.y); FMDeltaX := p1.x - OldPt1.x; FMDeltaY := p1.y - OldPt1.y; //22.10.2010 if isArc then begin ArcCenter.x := ArcCenter.x + FMDeltaX; ArcCenter.y := ArcCenter.y + FMDeltaY; l1.x := l1.x + FMDeltaX; l1.y := l1.y + FMDeltaY; l2.x := l2.x + FMDeltaX; l2.y := l2.y + FMDeltaY; r1.x := r1.x + FMDeltaX; r1.y := r1.y + FMDeltaY; r2.x := r2.x + FMDeltaX; r2.y := r2.y + FMDeltaY; end; if (Clone <> nil) and (FPathInClone <> nil) then begin if FPathInCloneInversePt then begin FPathInClone.p1^ := p2; FPathInClone.p2^ := p1; end else begin FPathInClone.p1^ := p1; FPathInClone.p2^ := p2; end; if Net.CanMoveJoined then Clone.MoveJoinedPoints(FMDeltaX, FMDeltaY, false); // Обновляем точки для расчета длин в зависимости от режима Clone.RefreshPaths; //Clone.DefineInOutPoints; //Clone.CollectBoundPoints(Path,NPoints1,NPoints2, Self); end; MoveRelated(dx, dy); //19.10.2010 end; Procedure TPathTrace.MoveRelated(dx, dy: Double); var i: Integer; RelNet: TNet; begin for i := 0 to FRelatedTraces.Count - 1 do TPathTrace(FRelatedTraces[i]).Move(dx, dy); for i := 0 to FRelatedNets.Count - 1 do begin RelNet := TNet(FRelatedNets[i]); if (RelNet.FRelatedMPoint <> nil) and (RelNet.FPathTracePoint <> nil) then if Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPoint) then //10.06.2011 RelNet.FRelatedMPoint^ := RelNet.FPathTracePoint^; if (RelNet.FRelatedMPath <> nil) and (RelNet.FRelatedMPath is TNetPath) then begin if Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPath.p1) then //10.06.2011 begin RelNet.FRelatedMPath.p1.x := RelNet.FRelatedMPath.p1.x + FMDeltaX; RelNet.FRelatedMPath.p1.y := RelNet.FRelatedMPath.p1.y + FMDeltaY; end; if Not RelNet.CheckPtInJoinedMove(RelNet.FRelatedMPath.p2) then //10.06.2011 begin RelNet.FRelatedMPath.p2.x := RelNet.FRelatedMPath.p2.x + FMDeltaX; RelNet.FRelatedMPath.p2.y := RelNet.FRelatedMPath.p2.y + FMDeltaY; end; end; if Net.CanMoveJoined then RelNet.MoveJoinedPoints(FMDeltaX, FMDeltaY, false); RelNet.RefreshPaths; //13.05.2011 end; end; { TWallRect } constructor TWallRect.create(p1: TDoublepoint; xNet: Tnet); begin inherited create(0, dsTrace, nil); Initialize; // tolik 29/07/2021 -- pointcount := 2; actualpoints[1] := Doublepoint(p1.x, p1.y); actualpoints[2] := Doublepoint(p1.x, p1.y); Net := xNet; Valid := True; RefPaths := TList.Create; FStarted := False; CIndex := 0; end; class function TWallRect.CreateFromShadow(aOwner: TComponent; LHandle: Integer; Shadow: TFigure): TFigure; var points: TDoublePointArr; i: Integer; begin result := nil; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; if TWallRect(Shadow).valid and assigned(ActiveNet) then begin SetLength(Points, 5); Points[0] := Shadow.ap1; Points[1] := DoublePoint(Shadow.ap2.x, Shadow.ap1.Y); Points[2] := Shadow.ap2; Points[3] := DoublePoint(Shadow.ap1.x, Shadow.ap2.Y); Points[4] := Shadow.ap1; ActiveNet.MakePathOnShadow(points, false); //03.06.2013 ActiveNet.MakePath(points, false); end; // *UNDO* // Tolik 07/05/2019 -- if not GProjectChanged then SetProjectChanged(true); GCadForm.FCanSaveForUndo := True; end; class function TWallRect.CreateShadow(x, y: Double): TFigure; var cad: TPowerCad; Shift: TShiftState; begin result := nil; if assigned(ActiveNet) then CreateShadow := TWallRect.create(Doublepoint(x, y), ActiveNet) else CreateShadow := nil; end; destructor TWallRect.Destroy; begin RefPaths.Free; inherited; end; procedure TWallRect.draw(DEngine: TPCDrawEngine; isGrayed: Boolean); var i: Integer; mp, p1: TDoublePoint; p2: TDoublePoint; l: Double; ltext, uText: String; xp1, xp2, xp3, xp4: TDoublePoint; xPath: TNetPath; d1, d2: Double; aLength: string; aText: string; begin DEngine.Canvas.pen.mode := pmXor; for i := 0 to RefPaths.Count - 1 do begin xPath := TNetPath(RefPaths[i]); xP1 := ap1; PointToLine(xPath.p1^, xPath.p2^, xp1.x, xp1.y); if CIndex = 1 then begin xp2 := ap2; PointToLine(xPath.p1^, xPath.p2^, xp2.x, xp2.y); d1 := GetLineLength(xp1, ap1); d2 := GetLineLength(xp2, ap2); if d1 < d2 then begin p1 := xp1; p2 := ap1; end else begin p1 := xp2; p2 := ap2; end; end else begin p1 := xp1; p2 := ap1; end; Dengine.drawline(p1, p2, clLime, 1, ord(psSOlid), 0); mp := MPoint(p1, p2); l := GetLen(p1, p2); if l > 0 then begin aLength := FormatFloat(ffMask, MetreToUOM(l)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8); end; end; p1 := ActualPoints[1]; p2 := ActualPoints[2]; Dengine.drawrect(p1, p2, clLime, 1, ord(psSolid), 0, ord(bsClear)); xp1 := ap1; xp2 := DoublePoint(ap2.x, ap1.Y); xp3 := ap2; xp4 := DoublePoint(ap1.x, ap2.Y); mp := MPoint(xp1, xp2); l := GetLen(xp1, xp2); if l > 0 then begin aLength := FormatFloat(ffMask, MetreToUOM(l)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; if EQD(xp1.x, xp2.x) then mp := MovePoint(mp, 2, 0) else mp := MovePoint(mp, 0, 2); Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8); end; mp := MPoint(xp2, xp3); l := GetLen(xp2, xp3); if l > 0 then begin aLength := FormatFloat(ffMask, MetreToUOM(l)); if Net.WorldDim then aText := GetUOMString(GCurrProjUnitOfMeasure) else aText := cCadClasses_Mes6; if EQD(xp2.x, xp3.x) then mp := MovePoint(mp, 2, 0) else mp := MovePoint(mp, 0, 2); Dengine.TraceText(mp, clLime, aLength + aText, 'Arial', 8); end; end; function TWallRect.GetLen(p1, p2: TDoublePoint): Double; var wt: Double; l: Double; begin result := 0; l := GetLineLenght(p1, p2); if l = 0 then begin result := 0; exit; end; wt := net.WallThick; Result := l{ - wt}; if Net.WorldDim then Result := Result / 1000 * Net.MapScale else Result := Result / 10; end; procedure TWallRect.LockTrace; var dx, dy: Double; begin if CIndex = 1 then begin if xLocked or yLocked then begin UnLockTrace; end else begin dx := abs(ap1.x - ap2.x); dy := abs(ap1.y - ap2.y); if dx > dy then begin XLocked := True; end else begin YLocked := True; end; end; end; end; function TWallRect.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean; var Cad: TPowercad; xPath: TnetPath; begin Result := false; Shift := []; if assigned(Net.Owner) then begin Cad := Tpowercad(Net.Owner); Shift := Cad.CurrentShift; end; if (not FStarted) and (not (ssShift in Shift)) then FStarted := True; if not FStarted then begin xPath := Net.GetPathOfPoint(x, y); if assigned(xPath) then RefPaths.Add(xPath); end; if FStarted then CIndex := CIndex + 1; if CIndex = 1 then begin SnapPoint(x, y); if xLocked then x := ap2.x; if yLocked then y := ap2.y; actualPoints[1] := DoublePoint(x, y); end else if CIndex = 2 then begin SnapPoint(x, y); if xLocked then x := ap2.x; if yLocked then y := ap2.y; actualPoints[2] := DoublePoint(x, y); Result := True; end; end; function TWallRect.ShadowKeyStroke(var ClickIndex,KeyCode: Integer; Shift: TShiftState;var Fnished:Boolean): Boolean; var res: String; sArr: TStringArray; a, b: Double; begin result := False; if (ClickIndex = 1) and (keyCode = vk_F11) then begin res := inputBox('TWallRect.ShadowKeyStroke', '', ''); if res <> '' then begin res := stringreplace(res,'X', 'x', []); SplitStr(res, sArr, 'x'); if Length(sArr) = 2 then begin a := StrToInt64Def(Trim(sArr[0]), -1); b := StrToInt64Def(Trim(sArr[1]), -1); a := a + 0.2; b := b + 0.2; if (a > 0) and (b > 0) then begin a := (a * 1000) / Net.MapScale; b := (b * 1000) / Net.MapScale; ActualPoints[2] := MovePoint(ap1, a, b); result := True; Fnished := true; end; end; end; end; end; function TWallRect.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean; var ox: Double; oy: Double; begin result := false; SnapPoint(x, y); if xLocked then x := ap2.x; if yLocked then y := ap2.y; if CIndex = 0 then begin actualpoints[1] := DoublePoint(x, y); actualpoints[2] := DoublePoint(x, y); end else if CIndex = 1 then begin actualpoints[2] := DoublePoint(x, y); end; end; procedure TWallRect.SnapPoint(var x, y: Double); var wt: Double; l, d, minD, dist: Double; p1, p2: TDoublePOint; begin if not assigned(net) then exit; if not TPowercad(Net.Owner).SnapToNearPoint then exit; if Net.SnapToKnots(x, y, 4, False) then exit; p1 := actualpoints[1]; minD := 100 / Net.MapScale; wt := net.WallThick; d := abs(x - p1.x); d := d + wt; l := Trunc(d / minD) * mind; dist := d - l; if dist >= (mind / 2) then begin l := l + MinD; end; l := l - wt; if x > p1.x then x := p1.x + l else x := p1.x - l; d := abs(y - p1.y); d := d + wt; l := Trunc(d / minD) * mind; dist := d - l; if dist >= (mind / 2) then begin l := l + MinD; end; l := l - wt; if y > p1.y then y := p1.y + l else y := p1.y - l; end; procedure TWallRect.UnLockTrace; begin xLocked := False; yLocked := False; end; // Tolik - 10/07/2019 - это может подъебнуть (проверено!), так что ... старая закомменчена - см. ниже // здесь результат вычислений разбит на несколько частей, т.к. одним выражением Delphi почему-то вычисляет неправильно // (т.е. от слова совсем, т.к. при больших величинах в 100 000 или от 50000 неявно выдаст, что там ошибка, что при // работе приложения, кстати, не выказывается никак, кроме неправильного результата функции) // поэтому введено еще 2 переменные (s1, s2) для промежуточных результатов. function PtInPoly(const poly: TDoublePointArr; p: TDoublePoint) : Boolean; var i,j : integer; s1, s2: double; Begin result := false; j := High(poly); For i := Low(poly) to High(poly) do begin s1 := (poly[j].x - poly[i].x); s2 := (p.y - poly[i].y) / (poly[j].y - poly[i].y); if ( ( ((poly[i].y <= p.y) and (p.y < poly[j].y)) or ((poly[j].y <= p.y) and (p.y < poly[i].y)) ) and (p.x < ( s1 * s2 + poly[i].x ) ) ) then result := not result; j := i end; End; (* /////////////////////////// Митяй Д.В 30.12.2013 /////////////////////////////// ////////////////////// Проверка попадания точки в полигон //////////////////// function PtInPoly(const poly: TDoublePointArr; p: TDoublePoint) : Boolean; var i,j : integer; Begin result := false; j := High(poly); For i := Low(poly) to High(poly) do begin if ( ( ((poly[i].y <= p.y) and (p.y < poly[j].y)) or ((poly[j].y <= p.y) and (p.y < poly[i].y)) ) and (p.x < ((poly[j].x - poly[i].x) * (p.y - poly[i].y) / (poly[j].y - poly[i].y) + poly[i].x)) ) then result := not result; j := i end; { if not result then begin For i := Low(poly) to High(poly) do begin if IsPointInLine(Poly[i], Poly[i+1], p, 1, 1) then begin Result := true; Break; //// BREAK //// end; end; end; } End; //////////////////////////////////////////////////////////////////////////////// *) function IfFiguraIsRoof(AFigure: TObject): boolean; const JdiMenya = 9379992; var CSCCompon: TSCSComponent; i: integer; begin result := false; CSCCompon := nil; if not (AFigure is TSCSComponent) then CSCCompon := GetArchObjByCADObj(AFigure) else CSCCompon := TSCSComponent(AFigure); if CSCCompon <> nil then for i := 0 to CSCCompon.Properties.Count - 1 do begin if PProperty(CSCCompon.Properties[i]).SysName = 'MATERIAL_TYPE' then begin Result := true; Break; end; if PProperty(CSCCompon.Properties[i]).SysName = 'RESIDUE' then begin Result := true; Break; end; if PProperty(CSCCompon.Properties[i]).SysName = 'ROOF_HIP_TYPE' then begin Result := true; Break; end; end; end; function CheckContrureEntry(AOuterConture, AInnerConture: PDoublePointArr; ACheckNoInBorder: Boolean=false; ACheckNoAdjacent: Boolean=false; IsRoof: boolean=false): Boolean; var i, j: Integer; HavePtNoInBorder: Boolean; AllPtInBorder: Boolean; PtExists, AllPtExists: Boolean; TmpConture: TDoublePointArr; begin Result := false; if (Length(AOuterConture^) >= 3) and (Length(AInnerConture^) >= 3) then begin Result := true; // Проверяем находится ли хоть одна точка в средине контура не на границе if ACheckNoInBorder then begin //HavePtNoInBorder := false; //for i := 0 to Length(AInnerConture^) - 1 do //begin // //if IsPtInPolygon(AInnerConture^[i], AOuterConture^, false, false) then // //begin // // HavePtNoInBorder := true; // // Break; //// BREAK //// // //end; // for j := 1 to Length(AOuterConture^) - 1 do // if Not IsPointInLine(AOuterConture^[j-1], AOuterConture^[j], AInnerConture^[i], 1) then // begin // HavePtNoInBorder := true; // Break; //// BREAK //// // end; // if HavePtNoInBorder then // Break; //// BREAK //// //end; //if Not HavePtNoInBorder then //begin // Result := false; // Exit; ///// EXIT ///// //end; // если все точки AInnerConture на одной грани в AOuterConture, for i := 1 to Length(AOuterConture^) - 1 do begin AllPtInBorder := true; for j := 0 to Length(AInnerConture^) - 1 do if Not IsPointInLine(AOuterConture^[i-1], AOuterConture^[i], AInnerConture^[j], 1) then begin AllPtInBorder := false; Break; //// BREAK //// end; if AllPtInBorder then begin Result := false; Exit; ///// EXIT ///// end; end; end; // Проверить не смежные ли контуры - тоесть один четко под другим if ACheckNoAdjacent then begin if Length(AInnerConture^) = Length(AOuterConture^) then begin //TmpConture := AOuterConture^; AllPtExists := true; // Проверяем есть ли соответствие каждой точки одного сегмента в другом for i := 0 to Length(AInnerConture^) - 1 do begin PtExists := false; for j := 0 to Length(AOuterConture^) - 1 do if EQDP(AInnerConture^[i], AOuterConture^[j]) then begin PtExists := true; //DeletePointFromArray(TmpConture, j); Break; //// BREAK //// end; if Not PtExists then begin AllPtExists := false; Break; //// BREAK //// end; end; if AllPtExists then Result := false; end; end; if Result then begin for i := 0 to Length(AInnerConture^) - 1 do begin //Если не крыша, тогда делать так, как и раньше иначе,по новому if not IsRoof then begin //Если хотя бы одна точка не входит в полигон if Not IsPtInPolygon(AInnerConture^[i], AOuterConture^, false, true) then begin //Тогда, получается, что контур не входит... Result := false; Break; //// BREAK //// end; end else begin if not PtInPoly(AOuterConture^, AInnerConture^[i]) then begin //Тогда, получается, что контур не входит... Result := false; Break; //// BREAK //// end; end; end; end; end; end; function CheckConturesEqual(AConture1, AConture2: PDoublePointArr): Boolean; var i: Integer; begin Result := false; if Length(AConture1^) = Length(AConture2^) then begin Result := True; for i := 0 to Length(AConture1^) - 1 do begin if Not EQDP(AConture1^[i], AConture2^[i]) then begin Result := false; Break; //// BREAK //// end; end; end; end; function CheckPtInNetConture(APoints: Pointer; ANet: TNet; AAnyPoint: Boolean): Boolean; var OutConture: TDoublePointArr; InnConture: TDoublePointArr; i: integer; InCnt: integer; begin Result := false; InCnt := 0; // Получаем контур для ANet GetPathsConturePoints(ANet.Paths, @OutConture, @InnConture, {nil, nil,} false, nil, nil, nil, nil); for i := 0 to Length(TDoublePointArr(Apoints^)) do if IsPtInPolygon(TDoublePointArr(Apoints^)[i], @InnConture, false) then begin if AAnyPoint then begin Result := true; Break; //// BREAK //// end; Inc(InCnt); end else begin if Not AAnyPoint then begin Result := false; Break; //// BREAK //// end; end; SetLength(OutConture, 0); SetLength(InnConture, 0); if Not AAnyPoint and (InCnt = Length(TDoublePointArr(Apoints^))) then Result := true; end; procedure CleanSamePointsArr(var Arr: TDoublePointArr); var i,j: integer; begin for i := Length(Arr) - 1 downto 0 do for j := i - 1 downto 0 do begin if EQDP(Arr[i], Arr[j]) then begin DeletePointFromArray(Arr, i); Break; //// BREAK //// end; end; end; procedure GetPathsConturePoints(ANetPaths: TList; AResultOuter, AResultInner{, AOuterHeights, AInnerHeights}: Pointer; AWithHeights: Boolean; AOutPaths, AInnPaths: TList; AOutPointIDs, AInnPointIDs: TList); var ConturePoints1: TDoublePointArr; //ConturePointsHeights1: PDoubleArray; ConturePointsID1: TList; ContureLen1: Double; ConturePoints2: TDoublePointArr; //ConturePointsHeights2: PDoubleArray; ConturePointsID2: TList; ContureLen2: Double; ConturePointsP: TDoublePointArr; ConturePaths: TList; ContureLenP: Double; PCad: TPowerCad; Area1, Area2, AreaP: Double; FirstPath, LastPath: TNetPath; DeltaCheckConture: Double; StartPoint: TDoublePoint; 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; function GetPathPerpendPointByCoordType(APath: TNetPath; ACoordType: Integer): PDoublePoint; begin Result := nil; case ACoordType of crtL1: Result := APath.epl1; crtL2: Result := APath.epl2; crtR1: Result := APath.epr1; crtR2: Result := APath.epr2; end; end; function GetPathMiddlePtByCoordType(APath: TNetPath; ACoordType: Integer): PDoublePoint; begin Result := nil; case ACoordType of crtL1, crtR1, crtP1: Result := APath.p1; crtL2, crtR2, crtP2: Result := APath.p2 end; end; procedure AddPointToArray(APoint: TDoublePoint; AHeight: Double; var AArray: TDoublePointArr{; AHeightsArray: PDoubleArray}); begin SetLength(AArray, Length(AArray)+1); AArray[Length(AArray)-1] := APoint; //if AHeightsArray <> nil then //begin // SetLength(AHeightsArray^, Length(AHeightsArray^)+1); // AHeightsArray^[Length(AHeightsArray^)-1] := AHeight; //end; if AWithHeights then AArray[Length(AArray)-1].z := AHeight * (1000/ PCad.MapScale); end; // точки лежащие на самом сегменте (для типа арка) // ABeginPoint - начальная точка, добавлена перед внутренними // AEndPoint - конченая точки которая будет добавлена после внутренних procedure GetPathPoints(APatch: TNetPath; var AConturePoints: TDoublePointArr; APointsID: TList; {AContureHeights: PDoubleArray;} 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; PathH: Double; 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 //29.06.2012 FPointsInOrder := EQDP(ABeginPoint, DoublePoint(FPoints[0].x, FPoints[0].y)); FPointsInOrder := GetLineLength(ABeginPoint, DoublePoint(FPoints[0].x, FPoints[0].y)) < GetLineLength(ABeginPoint, DoublePoint(FPoints[Cnt-1].x, FPoints[Cnt-1].y)); PathH := 0; if AWithHeights then //if AContureHeights <> nil then PathH := APatch.GetHeight; 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), 0, AConturePoints, AContureHeights); AddPointToArray(DoublePoint(FPoints[idx].x, FPoints[idx].y), PathH, AConturePoints{, AContureHeights}); if APointsID <> nil then APointsID.Add(0); end; end; end; end; // function CmpPointsWithPerpend(p1, p1Perpend, p2, p2Perpend: PDoublePoint; var aUsedPrependPt: PDoublePoint): Boolean; begin Result := CmpPoints(p1^, p2^); if Not Result then begin if p1Perpend <> nil then begin Result := CmpPoints(p1Perpend^, p2^); // Здесь не устанавливаем aUsedPrependPt, так как в последнем элементе массиве уже есть //if Result then // aUsedPrependPt := p1Perpend; //01.06.2012 ставим p1, так как сюда попали из перпендикулярной точки p1Perpend if Result then aUsedPrependPt := p1; end; if Not Result and (p2Perpend <> nil) then begin Result := CmpPoints(p1^, p2Perpend^); if Result then aUsedPrependPt := p2Perpend; end; end; end; function GetConnectedPathByCoordType(APath: TNetPath; APathList: TList; ACoordType: Integer; AConnCoordType: PInteger; var aUsedPrependPt: PDoublePoint): TNetPath; var PathPoint: TDoublePoint; PathPerpendPoint: PDoublePoint; UsedPrependPt: PDoublePoint; i, j: Integer; SPath: TNetPath; RelCoordTypeAtSide: Integer; RelPointAtSide: TDoublePoint; ConnCoordType: Integer; ResFromRel: Boolean; ResLenToStartPt, LenToStartPt: Double; LastIsResFromRel: Boolean; SPathEList: TList; SPathEPList: TList; SPathCoordType: TList; begin Result := nil; SPathEList := nil; SPathEPList := nil; SPathCoordType := nil; ResFromRel := false; LastIsResFromRel := false; ResLenToStartPt := 0; PathPoint := GetPathPointByCoordType(APath, ACoordType); PathPerpendPoint := nil; if Not APath.isArc then PathPerpendPoint := GetPathPerpendPointByCoordType(APath, ACoordType) else begin SPathEList := TList.Create; SPathEPList := TList.Create; SPathCoordType := TList.Create; APath.FillArcJoinPoints(SPathEList, SPathEPList); for i := 0 to SPathEList.Count - 1 do begin if CmpPoints(PDoublePoint(SPathEList[i])^, PathPoint) then begin if Not EQDP(PDoublePoint(SPathEList[i])^, PDoublePoint(SPathEPList[i])^) then begin PathPerpendPoint := SPathEPList[i]; Break; //// BREAK //// end; end else if CmpPoints(PDoublePoint(SPathEPList[i])^, PathPoint) then begin if Not EQDP(PDoublePoint(SPathEPList[i])^, PDoublePoint(SPathEList[i])^) then begin EmptyProcedure; // PathPerpendPoint := SPathEList[i]; // Break; //// BREAK //// end; end; end; end; // Другой тип точки на этой же стороне RelCoordTypeAtSide := GetRelCoordTypeAtSide(ACoordType); // Другая точка на этой же стороне RelPointAtSide := GetPathPointByCoordType(APath, RelCoordTypeAtSide); aUsedPrependPt := nil; for i := 0 to APathList.Count - 1 do begin SPath := TNetPath(APathList[i]); if SPath <> APath then if APath.Connected(SPath) then begin if EQDP(SPath.p1^, SPath.p2^) then begin EmptyProcedure; Continue; //// CONTINUE //// end; ConnCoordType := -1; UsedPrependPt := nil; if ACoordType in [crtL1, crtL2, crtR1, crtR2] then begin { ////if ACoordType in [crtL1, crtL2] then ////begin if CmpPointsWithPerpend(@SPath.el1, SPath.epl1, @PathPoint, PathPerpendPoint, UsedPrependPt) then begin ConnCoordType := crtL1; ResFromRel := false; end else if CmpPointsWithPerpend(@SPath.el2, SPath.epl2, @PathPoint, PathPerpendPoint, UsedPrependPt) then begin ConnCoordType := crtL2; ResFromRel := false; end // else if CmpPoints(SPath.er1, RelPointAtSide) then // begin // ConnCoordType := crtR1; //20.09.2011 GetRelCoordTypeAtSide(crtR1); // ResFromRel := true; // end // else if CmpPoints(SPath.er2, RelPointAtSide) then // begin // ConnCoordType := crtR2; //20.09.2011 GetRelCoordTypeAtSide(crtR2); // ResFromRel := true; // end ////end ////else if ACoordType in [crtR1, crtR2] then ////begin else if CmpPointsWithPerpend(@SPath.er1, SPath.epr1, @PathPoint, PathPerpendPoint, UsedPrependPt) then begin ConnCoordType := crtR1; ResFromRel := false; end else if CmpPointsWithPerpend(@SPath.er2, SPath.epr2, @PathPoint, PathPerpendPoint, UsedPrependPt) then begin ConnCoordType := crtR2; ResFromRel := false; end; //else if CmpPoints(SPath.el1, RelPointAtSide) then //begin // ConnCoordType := crtL1; //20.09.2011 GetRelCoordTypeAtSide(crtL1); // ResFromRel := true; //end //else if CmpPoints(SPath.el2, RelPointAtSide) then //begin // ConnCoordType := crtL2; //20.09.2011 GetRelCoordTypeAtSide(crtL2); // ResFromRel := true; //end; } if SPathEList = nil then begin SPathEList := TList.Create; SPathEPList := TList.Create; SPathCoordType := TList.Create; end; SPathEList.Clear; SPathEPList.Clear; SPathCoordType.Clear; // L1 SPathEList.Add(@SPath.el1); SPathEPList.Add(SPath.epl1); SPathCoordType.Add(Pointer(crtL1)); // L2 SPathEList.Add(@SPath.el2); SPathEPList.Add(SPath.epl2); SPathCoordType.Add(Pointer(crtL2)); // R1 SPathEList.Add(@SPath.er1); SPathEPList.Add(SPath.epr1); SPathCoordType.Add(Pointer(crtR1)); // R2 SPathEList.Add(@SPath.eR2); SPathEPList.Add(SPath.epR2); SPathCoordType.Add(Pointer(crtR2)); for j := 0 to SPathEList.Count - 1 do begin if CmpPointsWithPerpend(SPathEList[j], SPathEPList[j], @PathPoint, PathPerpendPoint, UsedPrependPt) then begin ConnCoordType := Integer(SPathCoordType[j]); ResFromRel := false; Break; //// BREAK //// end end; if ConnCoordType = -1 then begin if SPath.isArc then begin SPath.FillArcJoinPoints(SPathEList, SPathEPList); for j := 0 to SPathEList.Count - 1 do begin if CmpPoints(PDoublePoint(SPathEList[j])^, PathPoint) then begin UsedPrependPt := SPathEPList[j]; ConnCoordType := GetCoordTypeByPt(SPathEPList[j], SPath); Break; //// BREAK //// end else if CmpPoints(PDoublePoint(SPathEPList[j])^, PathPoint) then begin UsedPrependPt := SPathEList[j]; ConnCoordType := GetCoordTypeByPt(SPathEList[j], SPath); Break; //// BREAK //// end end; end; end; 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 UsedPrependPt <> nil then ResFromRel := true; if ConnCoordType <> -1 then begin //LenToStartPt := GetLineLenght(StartPoint, GetPathPointByCoordType(SPath, ConnCoordType)); if (Result = nil) or (LenToStartPt < ResLenToStartPt) or (LastIsResFromRel and EQD(LenToStartPt, ResLenToStartPt)) then begin ResLenToStartPt := LenToStartPt; aUsedPrependPt := UsedPrependPt; Result := SPath; if AConnCoordType <> nil then AConnCoordType^ := ConnCoordType; LastIsResFromRel := ResFromRel; if Not ResFromRel then //if Not EQDP(SPath.p1^, SPath.p2^) then begin Break; //// BREAK //// end; //else // EmptyProcedure; end; end; end; end; if SPathEList <> nil then begin SPathEList.Free; SPathEPList.Free; SPathCoordType.Free; end; if Result = nil then EmptyProcedure; end; procedure DefineContureFromPoint(var AConturePoints: TDoublePointArr; APointsID: TList; {AContureHeights: PDoubleArray;} AStartPath: TNetPath; ACoordType: Integer); var NetPaths: TList; CurrPath, PrevPath: TNetPath; CurrPathCoordType: Integer; CurrPathPoint: TDoublePoint; CurrPathRelCoordType: Integer; CurrPathRelPoint: TDoublePoint; ConnPathCoordType: Integer; MPt: PDoublePoint; StartPathPtH, PathPtH: Double; StartPrependPt, UsedPrependPt: PDoublePoint; RelPrependPt: PDoublePoint; ContureLen: Integer; begin SetLength(AConturePoints, 0); //DefineContureStep(AStartPath, ACoordType); if ConturePaths <> nil then ConturePaths.Clear; NetPaths := TList.Create; NetPaths.Assign(ANetPaths); CurrPathCoordType := ACoordType; StartPrependPt := nil; CurrPathPoint := GetPathPointByCoordType(AStartPath, ACoordType); if AStartPath.isArc then StartPrependPt := AStartPath.GetArcLPointByPt(@CurrPathPoint) else StartPrependPt := GetPathPerpendPointByCoordType(AStartPath, ACoordType); CurrPath := AStartPath; PrevPath := nil; StartPoint := CurrPathPoint; MPt := GetPathMiddlePtByCoordType(AStartPath, ACoordType); StartPathPtH := 0; PathPtH := 0; if AWithHeights then //if AContureHeights <> nil then PathPtH := AStartPath.GetHeightOfPt(MPt); if APointsID <> nil then APointsID.Add(Pointer(AStartPath.Net.GetPointID(MPt))); if StartPrependPt <> nil then begin StartPoint := StartPrependPt^; StartPathPtH := PathPtH; AddPointToArray(StartPrependPt^, PathPtH, AConturePoints); end; AddPointToArray(CurrPathPoint, PathPtH, AConturePoints{, AContureHeights}); while CurrPath <> nil do begin if ConturePaths <> nil then ConturePaths.Add(CurrPath); //if (CurrPath.epl1 = nil) and (CurrPath.epl2 = nil) and (CurrPath.epr1 = nil) and (CurrPath.epr2 = nil) then NetPaths.Remove(CurrPath); // находим вторую точку сегмента, и добавляем ее в массив CurrPathRelCoordType := GetRelCoordType(CurrPathCoordType); CurrPathRelPoint := GetPathPointByCoordType(CurrPath, CurrPathRelCoordType); // Внутренние точки //GetPathPoints(CurrPath, CurrPathPoint, CurrPathRelPoint, CurrPathRelCoordType); GetPathPoints(CurrPath, AConturePoints, APointsID, {AContureHeights, }CurrPathPoint, CurrPathRelPoint, CurrPathRelCoordType); MPt := GetPathMiddlePtByCoordType(CurrPath, CurrPathRelCoordType); PathPtH := 0; if AWithHeights then //if AContureHeights <> nil then PathPtH := CurrPath.GetHeightOfPt(MPt); if APointsID <> nil then APointsID.Add(Pointer(AStartPath.Net.GetPointID(MPt))); AddPointToArray(CurrPathRelPoint, PathPtH, AConturePoints {, AContureHeights}); if EQDPZ(StartPoint, CurrPathRelPoint) then begin Break; //// BREAK //// end else begin PrevPath := CurrPath; CurrPath := GetConnectedPathByCoordType(CurrPath, NetPaths, CurrPathRelCoordType, @ConnPathCoordType, UsedPrependPt); if CurrPath <> nil then begin CurrPathCoordType := ConnPathCoordType; //CurrPathRelCoordType; // Удаляем сегмент из списка для поиска // AStartPath - будет удален последним, если контур замкнутый - чтобы в конце на него опять пришли //NetPaths.Remove(CurrPath); //01.06.2012 - Если на новый сегмент CurrPath вышли через перпендикулярную точку, то проверить небыло ли перпендикулярной точки в начале этого сегмента //if UsedPrependPt <> nil then //begin // RelPrependPt := GetPathPerpendPointByCoordType(CurrPath, GetRelCoordType(CurrPathCoordType)); // if RelPrependPt <> nil then // AddPointToArray(RelPrependPt^, PathPtH, AConturePoints); //end; //21.05.2012 - Если связь через перпендикулярную точку, то сысоту берем по предыдущей точке, так как она почти на том же месте end else if UsedPrependPt = nil then // Если не вышли на путь истенный, то смотрим нет ли перпендикулярной точки UsedPrependPt := GetPathPerpendPointByCoordType(PrevPath, CurrPathRelCoordType); if UsedPrependPt <> nil then begin AddPointToArray(UsedPrependPt^, PathPtH, AConturePoints); if EQDP(StartPoint, UsedPrependPt^) then Break; //// BREAK //// end; CurrPathPoint := CurrPathRelPoint; //26.10.2010 end; end; //07.06.2012 Если начали с перпендикулярной точки, то добавляем ее в конец, чтобы проходила проверка на валидность замкнутого контура if StartPrependPt <> nil then begin ContureLen := Length(AConturePoints); //AddPointToArray(StartPrependPt^, StartPathPtH, AConturePoints); if (ContureLen >= 3) and EQDP(AConturePoints[1], AConturePoints[ContureLen-1]) then AConturePoints[ContureLen-1] := AConturePoints[0]; end; FreeAndNil(NetPaths); end; function IsValidConture(var AConturePoints: TDoublePointArr): Boolean; begin Result := false; if Length(AConturePoints) > 2 then //18.04.2011 if CmpPoints(AConturePoints[0], AConturePoints[length(AConturePoints)-1]) then if PointNear(AConturePoints[0], AConturePoints[length(AConturePoints)-1], DeltaCheckConture) 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); //if AOuterHeights <> nil then // SetLength(TDoubleArray(AOuterHeights^), 0); //if AInnerHeights <> nil then // SetLength(TDoubleArray(AInnerHeights^), 0); ConturePaths := nil; if ANetPaths.Count > 0 then begin PCad := TPowerCad(TNetPath(ANetPaths[0]).Net.Owner); if Assigned(AOutPaths) or Assigned(AInnPaths) then ConturePaths := TList.Create; FirstPath := TNetPath(ANetPaths[0]); LastPath := TNetPath(ANetPaths[ANetPaths.Count-1]); DeltaCheckConture := 1; if FirstPath.isArc or LastPath.isArc then DeltaCheckConture := Max(FirstPath.Width, LastPath.Width); //ConturePointsHeights1 := nil; //ConturePointsHeights2 := nil; //if (AOuterHeights <> nil) or (AInnerHeights <> nil) then //begin // ConturePointsHeights1 := AllocMem(SizeOf(TDoubleArray)); // ConturePointsHeights2 := AllocMem(SizeOf(TDoubleArray)); //end; ConturePointsID1 := nil; ConturePointsID2 := nil; if (AOutPointIDs <> nil) or (AInnPointIDs <> nil) then begin ConturePointsID1 := TList.Create; ConturePointsID2 := TList.Create; end; DefineContureFromPoint(ConturePoints1, ConturePointsID1, {ConturePointsHeights1, }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 AOuterHeights <> nil then // TDoubleArray(AOuterHeights^) := ConturePointsHeights1^; //if AInnerHeights <> nil then // TDoubleArray(AInnerHeights^) := ConturePointsHeights1^; if AOutPointIDs <> nil then AOutPointIDs.Assign(ConturePointsID1); if AInnPointIDs <> nil then AInnPointIDs.Assign(ConturePointsID1); if Assigned(AOutPaths) then AOutPaths.Assign(ConturePaths); if Assigned(AInnPaths) then AInnPaths.Assign(ConturePaths); end; DefineContureFromPoint(ConturePoints2, ConturePointsID2, {ConturePointsHeights2,} 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 AOuterHeights <> nil then // TDoubleArray(AOuterHeights^) := ConturePointsHeights2^; if AOutPointIDs <> nil then AOutPointIDs.Assign(ConturePointsID2); if ConturePaths <> nil then AOutPaths.Assign(ConturePaths); end; if (AResultInner <> nil) and ((ContureLen2 < ContureLen1) or (ContureLen1 = 0)) then begin TDoublePointArr(AResultInner^) := ConturePoints2; //if AInnerHeights <> nil then // TDoubleArray(AInnerHeights^) := ConturePointsHeights2^; if AInnPointIDs <> nil then AInnPointIDs.Assign(ConturePointsID2); if ConturePaths <> nil then AInnPaths.Assign(ConturePaths); end; end; //if (AOuterHeights <> nil) or (AInnerHeights <> nil) then //begin // FreeMem(ConturePointsHeights1); // FreeMem(ConturePointsHeights2); // ConturePointsHeights1 := nil; // ConturePointsHeights2 := nil; //end; if (AOutPointIDs <> nil) or (AInnPointIDs <> nil) then begin FreeAndNil(ConturePointsID1); FreeAndNil(ConturePointsID2); 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; procedure ClearJoinedParamsInNets(ANetList: TList); var i: Integer; Net: TNet; begin for i := 0 to ANetList.Count - 1 do begin Net := ANetList[i]; Net.FJoinedMovePoints.Clear; Net.FJoinedMovePointsDirections.Clear; Net.FJoinedMovePointsFixedState.Clear; Net.FJoinedMovePaths.Clear; Net.FJoinedMovePathsDirections.Clear; end; end; function CreatePolygonRgnByPoints(DEngine: TPCDrawEngine; p1,p2,p3,p4: PDoublePoint): HRGN; var pArr:TPointArr; i: Integer; xx,yy,z:Double; Points: TList; reg: Integer; begin Points := TList.Create; Points.Add(p1); Points.Add(p2); Points.Add(p3); Points.Add(p4); SetLength(pArr, 4); for i := 0 to Points.Count - 1 do begin z := 0; xx := PDoublePOint(Points[i]).x; yy := PDoublePOint(Points[i]).y; DEngine.ConvertPoint(xx,yy,z); PArr[i] := Point(round(xx),round(yy)); end; Result := Dengine.PolygonRegion(pArr); Points.Free; //Tolik SetLength(pArr,0); // end; function GetAllNets(aPCad: TPowerCad): TList; procedure LookFigures(aFigures: TList); var i: Integer; Figure: TFigure; begin for i := 0 to aFigures.Count - 1 do begin Figure := TFigure(aFigures[i]); if (Figure is TNet) then Result.Add(Figure) else if Figure is TfigureGrp then LookFigures(TFigureGrp(Figure).InFigures); end; end; begin Result := TList.Create; LookFigures(aPCad.Figures); end; function GetCoordTypeByPt(aPt: PDoublePoint; aPath: TNetPath): Integer; begin Result := -1; if EQDP(aPt^, aPath.er1) then Result := crtR1 else if EQDP(aPt^, aPath.er2) then Result := crtR2 else if EQDP(aPt^, aPath.el1) then Result := crtL1 else if EQDP(aPt^, aPath.el2) then Result := crtL2; end; function GetNetsByPoints(aPCad: TPowerCad; p1, p2: PDoublePoint; aNetsPath: TList=nil): TList; var i, j: Integer; Nets: TList; Net: TNet; Path: TNetPath; PointsInPath: Boolean; begin Result := TList.Create; if aNetsPath <> nil then aNetsPath.Clear; Nets := GetAllNets(aPCad); for i := 0 to Nets.Count - 1 do begin Net := TNet(Nets[i]); for j := 0 to Net.Paths.Count - 1 do begin Path := TNetPath(Net.Paths[j]); PointsInPath := Path.IsPointIn(p1^.x, p1.y, false); if PointsInPath and (p2 <> nil) then PointsInPath := Path.IsPointIn(p2^.x, p2.y, false); if PointsInPath then begin Result.Add(Net); if aNetsPath <> nil then aNetsPath.Add(Path); Break; //// BREAK //// end; end; end; Nets.Free; end; function GetOtherSide(aSide: Integer): Integer; begin if aSide = 1 then Result := 2 else Result := 1 end; // Вернет тип координаты на другой стороне сегмента function GetRelCoordType(ACoordType: Integer): Integer; begin Result := 0; case ACoordType of crtL1: Result := crtL2; crtL2: Result := crtL1; crtR1: Result := crtR2; crtR2: Result := crtR1; crtP1: Result := crtP2; crtP2: Result := crtP1; end; end; // Вернет тип координаты на этой стороне сегмента function GetRelCoordTypeAtSide(ACoordType: Integer): Integer; begin Result := 0; case ACoordType of crtL1: Result := crtR1; crtL2: Result := crtR2; crtR1: Result := crtL1; crtR2: Result := crtL2; crtP1: Result := crtP1; crtP2: Result := crtP2; end; end; function IsPtInArray(APt: TDoublePoint; APointArray: PDoublePointArr): Boolean; var i: Integer; begin Result := false; for i := 0 to Length(APointArray^) - 1 do begin if EQDP(APt, APointArray^[i]) then begin Result := true; Break; //// BREAK //// end; end; end; // APointsAsLines=true говорит что в массиве для каждой линии точки отдельно, // тоесть одна точка в которой сходятся линии в массиве два раза function IsPtInPolygon(APt: TDoublePoint; APollygonPaths: TDoublePointArr; APointsAsLines:Boolean=true; AllowCommonPoint:Boolean=false; AMul: Integer=0): Boolean; var MaxX: Double; //Максимальный Х полигона VPoint: TDoublePoint; //Точка, которая больше максимального Х на 100 i: Integer; CrossCount: Integer; //Количество пересечений линии Apt-VPoint с другими линиями ip: TDoublePoint; //Сама точка пересечения WhileTo: Integer; //Количество точек полигона NextPtIdx: Integer; //Индекс следующей точки CrossPoints: TDoublePointArr; //Массив точек пересечения CanAddCross: Boolean; begin Result := false; // Находится ли точка внутри многоугольника, определяем метотом поиска количества линий // которое пересекается с виртуальной линией (от точки в право до бесконечности) // если кол-во пересечение 0 или четное, то не входит, а если нечетное - то входит if Length(APollygonPaths) > 0 then begin if AMul <> 0 then begin APt.x := APt.x * AMul; APt.y := APt.y * AMul; end; // Определяем наибольший X MaxX := APt.x; for i := 0 to Length(APollygonPaths) - 1 do begin if AMul <> 0 then begin APollygonPaths[i].x := APollygonPaths[i].x * AMul; APollygonPaths[i].y := APollygonPaths[i].y * AMul; end; if APollygonPaths[i].x > MaxX then MaxX := APollygonPaths[i].x; end; VPoint.x := MaxX + 100; VPoint.y := APt.y; CrossCount := 0; i := 0; WhileTo := 0; if APointsAsLines then WhileTo := (Length(APollygonPaths) - 2) else WhileTo := (Length(APollygonPaths) - 1); SetLength(CrossPoints, 0); while i <= WhileTo do begin NextPtIdx := i+1; // Если смотрим на последнюю точку, то следующей будет первая if i = (Length(APollygonPaths)-1) then NextPtIdx := 0; if Not EQDP(APollygonPaths[i], APollygonPaths[NextPtIdx]) then //PCTypesUtils.Intersect(APt, VPoint, APollygonPaths[i], APollygonPaths[i+1]); //02.08.2011 if LinesCross(APt, VPoint, APollygonPaths[i], APollygonPaths[i+1], AllowCommonPoint) then //Если линии А(APt.x, APt.y)В(VPoint.x, VPoint.y) и //С(APollygonPaths[i].x,APollygonPaths[i].y)Н(APollygonPaths[NextPtIdx].x,APollygonPaths[NextPtIdx].y) //пересекаются if LinesCross(APt, VPoint, APollygonPaths[i], APollygonPaths[NextPtIdx], false) then begin CanAddCross := true; //находим точку пересечения if GetInterSectionPoint(APt, VPoint, APollygonPaths[i], APollygonPaths[NextPtIdx], ip, false) then begin //проверка вхождения самой себя {if IsPtInArray(APollygonPaths[i], @CrossPoints) then CrossCount := CrossCount + 1;} { if IsPtInArray(ip, @APollygonPaths)then //Если точка пересечения ip пренадлежит полигону APollygonPaths begin if IsPtInArray(APt, @APollygonPaths) then //Если проверяемая точка APt пренадлежит этому полигону begin if AllowCommonPoint then //Если указано разрешить общую точку begin CrossCount := 1; Break; end; end end else begin } // Если была такая точка пересечения if IsPtInArray(ip, @CrossPoints) then CanAddCross := false else begin SetLength(CrossPoints, Length(CrossPoints)+1); CrossPoints[Length(CrossPoints)-1] := ip; end; if CanAddCross then CrossCount := CrossCount + 1; // end; end; end; if APointsAsLines then i := i+2 else i := i+1; end; SetLength(CrossPoints, 0); Result := (CrossCount <> 0) and ((CrossCount mod 2) <> 0); //02.08.2011 Если пересечений не нашли и допускается если пересечение впритык if Not Result and AllowCommonPoint then begin i := 0; //Если не нашли пересечений, проверяем, не лежит ли точка на прямой // Tolik 18/11/2019 -- а вот это - проеб, т.к. когда i = WhileTo, APollygonPaths[i+1] - уже за пределами массива, // потому что массив берем с нуля... //while i <= WhileTo do if Length(APollygonPaths) > 1 then // Tolik 18/11/2019 -- на всякий ... begin while i <= WhileTo do // Tolik 18/11/2019 -- оставляем так, чтобы проскочило первый раз, если элементов //массива вдруг всего лишь два, а массив представлен линиями // begin if IsPointInLine(APollygonPaths[i], APollygonPaths[i+1], APt, 1, 1) then begin Result := true; Break; //// BREAK //// end; if APointsAsLines then i := i+2 else i := i+1; if i = WhileTo then // Tolik 18/11/2019 -- вот здесь сбросим, чтобы не выскочить за пределы массива... break; end; end; end; end; end; function GetNetObjInPoint(PCAD: TPCDrawing; LayerNbr:Integer; x,y: Double; OnlyNet: Boolean=false): TObject; var i, a: Integer; Figure: TFigure; invis: boolean; begin Result := nil; for i := 0 to PCAD.Figures.Count - 1 do begin a := PCAD.figures.count - 1 - i; Figure := TFigure(PCAD.figures[a]); if Figure is TNet then begin invis := false; if (Figure.LayerHandle <> 0) then invis := (TLayer(Figure.LayerHandle).Visible = lost); if (not invis) and ((LayerNbr = 0) or (Figure.LayerHandle = LongInt(PCAD.Layers[LayerNbr]))) then begin Result := TNet(Figure).GetObjInPoint(x,y); if Result <> nil then begin if OnlyNet then Result := Figure; Break; //// BREAK //// end; end; end; end; end; Function PointNear(p1,p2: TDoublePoint; delta: Double=1):Boolean; begin //result := (abs(p1.x - p2.x) <= 1) and (abs(p1.y - p2.y) <= 1); result := (abs(p1.x - p2.x) <= delta) and (abs(p1.y - p2.y) <= delta); end; function ScaleConturePoints(var APoints: TDoublePointArr; ASize: Double): Boolean; var PointCnt: Integer; Net: TNet; Path: TNetPath; PathWidth: Double; PathPoints: TDoublePointArr; i: integer; OutPoints: TDoublePointArr; InnPoints: TDoublePointArr; isroof: boolean; begin Result := false; PointCnt := Length(APoints); // первая и последняя точки должны совпадать if (PointCnt > 0) and (ASize <> 0) and EQDP(APoints[0], APoints[PointCnt-1]) then begin Net := TNet.Create(0, mydsNormal, nil); try SetLength(PathPoints, 2); PathWidth := ASize * 2; for i := 1 to Length(APoints)-1 do //14.10.2010 for i := 1 to 4 do begin PathPoints[0] := APoints[i-1]; PathPoints[1] := APoints[i]; Path := Net.MakePath(PathPoints, false); if Path <> nil then Path.Width := PathWidth; end; Net.RefreshPaths; Net.SetModified; //03.02.2012 Net.ResetRegion; // Получаем внешн/внутр контуры GetPathsConturePoints(Net.Paths, @OutPoints, @InnPoints, {nil, nil,} false, nil, nil, nil, nil); // Проверяем, входит ли один контур во второй if (Length(OutPoints) > 0) and (Length(InnPoints) > 0) then begin isroof := iffiguraisroof(net); if CheckContrureEntry(@OutPoints, @InnPoints,false,false,isroof) then begin SetLength(APoints, 0); if ASize > 0 then APoints := OutPoints else APoints := InnPoints; end; end; SetLength(OutPoints, 0); SetLength(InnPoints, 0); finally Net.Free; end; end; end; initialization if FigureClasses.IndexOf(TNet) = -1 then FigureClasses.Add(TNet); if FigureClasses.IndexOf(TWallPath) = -1 then FigureClasses.Add(TWallPath); if FigureClasses.IndexOf(TWallRect) = -1 then FigureClasses.Add(TWallRect); if FigureClasses.IndexOf(TInsertCol) = -1 then FigureClasses.Add(TInsertCol); if FigureClasses.IndexOf(TInsertRow) = -1 then FigureClasses.Add(TInsertRow); end.