From 1a5ebfcff8bfc1200111a83920ccd03603dd3e7e Mon Sep 17 00:00:00 2001 From: Anatoly Date: Mon, 25 Aug 2025 09:51:59 +0300 Subject: [PATCH] First commit --- POWERCAD30/UNITS/form3d.dfm | 35 ++++------ POWERCAD30/UNITS/form3d.pas | 118 ++++++++++++++++++++++++++++++++- SRC/Main/USCS_Main.dfm | 59 +++++++++++------ SRC/Main/USCS_Main.pas | 26 +++++++- SRC/Main/U_CAD.dfm | 1 + SRC/Main/U_CAD.pas | 15 +++++ SRC/Main/U_Common.pas | 126 +++++++++++++++++++++++++++++++++++- 7 files changed, 334 insertions(+), 46 deletions(-) diff --git a/POWERCAD30/UNITS/form3d.dfm b/POWERCAD30/UNITS/form3d.dfm index 8fde548..7922210 100644 --- a/POWERCAD30/UNITS/form3d.dfm +++ b/POWERCAD30/UNITS/form3d.dfm @@ -40,8 +40,6 @@ object frm3D: Tfrm3D Align = alClient Caption = 'Panel2' TabOrder = 0 - ExplicitWidth = 1360 - ExplicitHeight = 705 object Splitter1: TSplitter Left = 1338 Top = 42 @@ -61,7 +59,6 @@ object frm3D: Tfrm3D BevelOuter = bvNone Color = 15329769 TabOrder = 0 - ExplicitWidth = 1358 DesignSize = ( 1340 41) @@ -219,8 +216,6 @@ object frm3D: Tfrm3D Align = alClient BevelInner = bvLowered TabOrder = 1 - ExplicitWidth = 1035 - ExplicitHeight = 662 object Panel3: TPanel Left = 2 Top = 2 @@ -231,8 +226,6 @@ object frm3D: Tfrm3D Ctl3D = False ParentCtl3D = False TabOrder = 0 - ExplicitWidth = 1031 - ExplicitHeight = 658 object GLSceneViewer: TGLSceneViewer Left = 0 Top = 0 @@ -249,8 +242,6 @@ object frm3D: Tfrm3D OnMouseMove = GLSceneViewerMouseMove OnMouseUp = GLSceneViewerMouseUp TabOrder = 0 - ExplicitWidth = 1031 - ExplicitHeight = 613 end object StatusBar1: TStatusBar Left = 0 @@ -263,8 +254,6 @@ object frm3D: Tfrm3D Width = 50 end> OnDrawPanel = StatusBar1DrawPanel - ExplicitTop = 633 - ExplicitWidth = 1031 end object sbView: TPanel Left = 0 @@ -276,8 +265,6 @@ object frm3D: Tfrm3D BevelInner = bvLowered Locked = True TabOrder = 2 - ExplicitTop = 613 - ExplicitWidth = 1031 end end end @@ -292,8 +279,6 @@ object frm3D: Tfrm3D SizeBarWidth = 7 TabOrder = 2 VisualStyle = vsClassic - ExplicitLeft = 1036 - ExplicitHeight = 662 object RzPageControl1: TRzPageControl AlignWithMargins = True Left = 16 @@ -306,11 +291,9 @@ object frm3D: Tfrm3D TabIndex = 0 TabOrder = 0 TabStyle = tsSquareCorners - ExplicitHeight = 654 FixedDimension = 19 object TabSheet1: TRzTabSheet Caption = #1052#1086#1076#1077#1083#1100 - ExplicitHeight = 628 object panObjects: TPanel Left = 0 Top = 0 @@ -325,7 +308,6 @@ object frm3D: Tfrm3D Font.Style = [] ParentFont = False TabOrder = 0 - ExplicitHeight = 628 object Splitter2: TSplitter Left = 2 Top = 155 @@ -349,10 +331,12 @@ object frm3D: Tfrm3D TabOrder = 0 TabStyle = tsRoundCorners OnTabClick = pcTreeTabClick - ExplicitHeight = 171 FixedDimension = 19 object TabArchModel: TRzTabSheet Caption = #1040#1088#1093'. '#1084#1086#1076#1077#1083#1100 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 ExplicitHeight = 145 object cxGroupBox1: TcxGroupBox Left = 0 @@ -435,12 +419,10 @@ object frm3D: Tfrm3D 000000000000000000000001067200650072006500720065002C000000000000 0000000000FFFFFFFFFFFFFFFF00000000000000000000000001077200650072 007200650072006500} - ExplicitHeight = 98 end end object TabScsModel: TRzTabSheet Caption = #1057#1050#1057' '#1084#1086#1076#1077#1083#1100 - ExplicitHeight = 145 object cxGroupBox2: TcxGroupBox Left = 0 Top = 0 @@ -522,7 +504,6 @@ object frm3D: Tfrm3D 000000000000000000000001067200650072006500720065002C000000000000 0000000000FFFFFFFFFFFFFFFF00000000000000000000000001077200650072 007200650072006500} - ExplicitHeight = 98 end object DuplicateNodeTree: TTreeView Left = 160 @@ -544,10 +525,13 @@ object frm3D: Tfrm3D TabIndex = 1 TabOrder = 1 TabStyle = tsRoundCorners - ExplicitTop = 176 FixedDimension = 19 object TabArchProps: TRzTabSheet Caption = #1040#1088#1093'. '#1089#1074#1086#1081#1089#1090#1074#1072 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 + ExplicitHeight = 0 object Panel1: TPanel Left = 0 Top = 0 @@ -2158,6 +2142,9 @@ object frm3D: Tfrm3D end object TabSheet2: TRzTabSheet Caption = #1053#1072#1089#1090#1088#1086#1081#1082#1080 + ExplicitLeft = 0 + ExplicitTop = 0 + ExplicitWidth = 0 ExplicitHeight = 628 object Label10: TLabel Left = 5 @@ -3418,7 +3405,7 @@ object frm3D: Tfrm3D Left = 100 Top = 57 Bitmap = { - 494C01013A00B000000310001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01013A00B000080310001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000040000000F0000000010020000000000000F0 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 diff --git a/POWERCAD30/UNITS/form3d.pas b/POWERCAD30/UNITS/form3d.pas index 638db9a..4cc4a57 100644 --- a/POWERCAD30/UNITS/form3d.pas +++ b/POWERCAD30/UNITS/form3d.pas @@ -23190,6 +23190,120 @@ var SCSLineList.Free; end; + Procedure CheckRecreateWireTrays; + var i, j: integer; + SCSLinesList, LineNodesList, WireTrayList, ObjList, Compon3DList: TList; + SCSConn: TConnectorObject; + SCsLine: TOrthoLine; + SCSList: TSCSList; + SCSCatalog: TSCSCatalog; + WireTrayCompon: TSCSComponent; + Compon3D: T3DLineComponent; + + begin + if xConn.FSCSObject <> nil then + begin + SCSConn := xConn.FSCSObject; + SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_Cad(TPowerCad(SCSConn.Owner).Owner).FCADListID); + if SCSList <> nil then + begin + if SCSConn.ConnectorType = ct_Clear then + begin + // 1. С присоединенных трасс собрать все с лотками и лотки тоже ... если есть труба раньше лотка - трассу не берем + SCSLinesList := TList.Create; + LineNodesList := TList.Create; + WireTrayList := TList.Create; + + for i := 0 to xConn.FSCSObject.JoinedOrtholinesList.Count - 1 do + begin + SCSLine := TOrthoLine(xConn.FSCSObject.JoinedOrtholinesList[i]); + SCSCatalog := SCSList.GetCatalogFromSortedRefBySCSID(SCSLine.ID); + if SCSCatalog <> nil then + begin + for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do + begin + if SCSCatalog.ComponentReferences[j].ComponentType.SysName = ctsnTube then + break; + if SCScatalog.ComponentReferences[j].ComponentType.SysName = ctsnWireTray then + begin + + if WireTrayList.IndexOf(SCScatalog.ComponentReferences[j]) = -1 then + begin + WireTrayList.Add(SCScatalog.ComponentReferences[j]); //лоток + SCSLinesList.Add(SCSLine); //трасса + end; + break; + end; + end; + end; + end; + // 2.Удалить лотки (в дереве, на сцене) + ObjList := TList.Create; + Compon3DList := TList.Create; + for i := 0 to WireTrayList.Count - 1 do + begin + WireTrayCompon := TSCSComponent(WireTrayList[i]); // лоток + //основное дерево + Self.ScsModelTree.Items.BeginUpdate; + for j := 0 to Self.ScsModelTree.Items.Count - 1 do + begin + if TObject(Self.SCSModelTree.Items[j].data).ClassName = 'T3DLineComponent' then + begin + if T3DLineComponent(Self.SCSModelTree.Items[j].data).FSCSComponID = WireTrayCompon.id then + begin + Compon3D := T3DLineComponent(Self.SCSModelTree.Items[j].data); + Compon3DList.Add(Compon3D); + + if T3DLineComponent(Self.SCSModelTree.Items[j].data).FGLObject <> nil then + begin + //отловить 3Д объект + if ObjList.IndexOf(T3DLineComponent(Self.SCSModelTree.Items[j].data).FGLObject) = -1 then + ObjList.Add(T3DLineComponent(Self.SCSModelTree.Items[j].data).FGLObject); + //удалить нод(тут будет только один) + Self.SCSModelTree.Items[j].data := nil; + Self.ScsModelTree.Items.Delete(Self.SCSModelTree.Items[j]); + break; + end; + end; + end; + end; + Self.ScsModelTree.Items.EndUpdate; + //дубликат () + Self.DuplicateNodeTree.Items.BeginUpdate; + for j := Self.DuplicateNodeTree.Items.Count - 1 downto 0 do + begin + if TObject(Self.SCSModelTree.Items[j].data).ClassName = 'T3DLineComponent' then + begin + if T3DLineComponent(Self.DuplicateNodeTree.Items[j].data).FSCSComponID = WireTrayCompon.id then + begin + + if T3DLineComponent(Self.DuplicateNodeTree.Items[j].data).FGLObject <> nil then + begin + //отловить 3Д объект + if ObjList.IndexOf(T3DLineComponent(Self.DuplicateNodeTree.Items[j].data).FGLObject) = -1 then + ObjList.Add(T3DLineComponent(Self.DuplicateNodeTree.Items[j].data).FGLObject); + //удалить нод(тут будет только один) + Self.ScsModelTree.Items.Delete(Self.DuplicateNodeTree.Items[j]); + end; + end; + end; + end; + Self.DuplicateNodeTree.Items.EndUpdate; + end; + //Удалить объекты 3Д со сцены + DummyCube.BeginUpdate; + for i := 0 to ObjList.Count - 1 do + begin + DummyCube.Remove(TGLBaseSceneObject(ObjList[i]), false); + TGLBaseSceneObject(ObjList[i]).Free; + end; + DummyCube.EndUpdate; + ObjList.Clear; + end; + end; + end; + end; + (* Procedure CheckRecreateWireTrays; var SavedGCadForm: TF_Cad; SCSLine, JoinedLine: TOrthoLine; @@ -23520,6 +23634,8 @@ var GCadForm := SavedGCadForm; GisChangeFrom3D := True; // 11/07/2025 -- выставить флаг, чтоб были изменения в проекте из 3Д ... end; + *) + (* // //Tolik 21/05/2025-- @@ -24831,7 +24947,7 @@ begin end; AlignPipeObjects; AlignRelatedConns; - //CheckRecreateWireTrays;//лоток проволочный + CheckRecreateWireTrays;//лоток проволочный MovedLineList.free; OtherSideConnList.free; RelatedPipeConns.free; diff --git a/SRC/Main/USCS_Main.dfm b/SRC/Main/USCS_Main.dfm index 3c5afc6..066b317 100644 --- a/SRC/Main/USCS_Main.dfm +++ b/SRC/Main/USCS_Main.dfm @@ -1,7 +1,7 @@ object FSCS_Main: TFSCS_Main Left = 1 Top = 1 - Width = 1358 + Width = 1380 Height = 726 HorzScrollBar.Color = clBtnFace HorzScrollBar.ParentColor = False @@ -46,7 +46,7 @@ object FSCS_Main: TFSCS_Main ExplicitHeight = 641 end object sDiv2: TSplitter - Left = 1334 + Left = 1356 Top = 188 Height = 456 Align = alRight @@ -80,10 +80,9 @@ object FSCS_Main: TFSCS_Main OnDockOver = PDock1DockOver OnResize = PDock1Resize OnUnDock = PDock1UnDock - ExplicitHeight = 474 end object pDock2: TPanel - Left = 1337 + Left = 1359 Top = 188 Width = 5 Height = 456 @@ -99,24 +98,22 @@ object FSCS_Main: TFSCS_Main OnDockDrop = PDock1DockDrop OnDockOver = PDock1DockOver OnUnDock = PDock1UnDock - ExplicitLeft = 1359 - ExplicitHeight = 474 + ExplicitLeft = 1337 end object pCADList: TPanel Left = 0 Top = 644 - Width = 1342 + Width = 1364 Height = 23 Align = alBottom BevelOuter = bvNone BorderStyle = bsSingle TabOrder = 2 - ExplicitTop = 662 - ExplicitWidth = 1364 + ExplicitWidth = 1342 object pageCADList: TPageControl Left = 0 Top = 0 - Width = 1340 + Width = 1362 Height = 21 Align = alClient Font.Charset = RUSSIAN_CHARSET @@ -128,14 +125,14 @@ object FSCS_Main: TFSCS_Main Style = tsFlatButtons TabOrder = 0 OnChange = pageCADListChange - ExplicitWidth = 1362 + ExplicitWidth = 1340 end end object cbMainPanel: TControlBar AlignWithMargins = True Left = 3 Top = 0 - Width = 1336 + Width = 1358 Height = 136 HelpContext = 76000 Margins.Top = 0 @@ -159,7 +156,7 @@ object FSCS_Main: TFSCS_Main OnBandPaint = cbMainPanelBandPaint OnDockOver = cbMainPanelDockOver OnMouseDown = cbMainPanelMouseDown - ExplicitWidth = 1358 + ExplicitWidth = 1336 object tbFile: TToolBar Left = 11 Top = 2 @@ -1221,7 +1218,7 @@ object FSCS_Main: TFSCS_Main object pnHintBar: TRzSizePanel Left = 0 Top = 136 - Width = 1342 + Width = 1364 Height = 52 Align = alTop BorderHighlight = clBtnFace @@ -1231,7 +1228,7 @@ object FSCS_Main: TFSCS_Main TabOrder = 4 VisualStyle = vsClassic OnHotSpotClick = pnHintBarHotSpotClick - ExplicitWidth = 1364 + ExplicitWidth = 1342 end object ActionManager: TActionManager ActionBars.SessionCount = 1080 @@ -4174,6 +4171,21 @@ object FSCS_Main: TFSCS_Main Caption = #1057#1093#1077#1084#1072' '#1084#1086#1085#1090#1072#1078#1085#1072#1103 OnExecute = aShieldAssemblySchemeExecute end + object aCreateBFMagistral: TAction + Category = #1052#1077#1085#1102' '#1057#1050#1057' '#1086#1073#1100#1077#1082#1090#1086#1074 + Caption = #1057#1086#1079#1076#1072#1090#1100' '#1089#1087#1083#1086#1096#1085#1091#1102' '#1084#1077#1078#1101#1090#1072#1078#1085#1091#1102' '#1074#1077#1088#1090#1080#1082#1072#1083#1100 + OnExecute = aCreateBFMagistralExecute + end + object aCreateBFMagistralDown: TAction + Category = #1052#1077#1085#1102' '#1057#1050#1057' '#1086#1073#1100#1077#1082#1090#1086#1074 + Caption = #1057#1086#1079#1076#1072#1090#1100' '#1084#1077#1078#1101#1090#1072#1078#1085#1091#1102' '#1074#1077#1088#1090#1080#1082#1072#1083#1100' '#1076#1086#1085#1080#1079#1091 + OnExecute = aCreateBFMagistralDownExecute + end + object aCreateBFMagistralUp: TAction + Category = #1052#1077#1085#1102' '#1057#1050#1057' '#1086#1073#1100#1077#1082#1090#1086#1074 + Caption = #1057#1086#1079#1076#1072#1090#1100' '#1084#1077#1078#1101#1090#1072#1078#1085#1091#1102' '#1074#1077#1088#1090#1080#1082#1072#1083#1100' '#1076#1086#1074#1077#1088#1093#1091 + OnExecute = aCreateBFMagistralUpExecute + end end object PrintDialog: TPrintDialog Left = 352 @@ -5598,6 +5610,15 @@ object FSCS_Main: TFSCS_Main object pmiListDesignBoxParams: TMenuItem Action = aDestroyRaise end + object pmCreateBFMagistral: TMenuItem + Action = aCreateBFMagistral + end + object pmCreateBFMagistralDown: TMenuItem + Action = aCreateBFMagistralDown + end + object pmCreateBFMagistralUp: TMenuItem + Action = aCreateBFMagistralUp + end object pmiListRefreshDesignList: TMenuItem Action = aRefreshDesignList end @@ -5868,7 +5889,7 @@ object FSCS_Main: TFSCS_Main Left = 496 Top = 232 Bitmap = { - 494C0101D2008C01B80310001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C0101D2008C01C00310001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000005003000001002000000000000050 0300000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -12878,7 +12899,7 @@ object FSCS_Main: TFSCS_Main Left = 248 Top = 280 Bitmap = { - 494C010123008C01D00320001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010123008C01D80320001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000800000009000000001002000000000000020 0100000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -15450,7 +15471,7 @@ object FSCS_Main: TFSCS_Main Left = 240 Top = 408 Bitmap = { - 494C010112008C01C4030E000E00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010112008C01CC030E000E00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 000000000000360000002800000038000000460000000100200000000000403D 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -19953,7 +19974,7 @@ object FSCS_Main: TFSCS_Main Left = 240 Top = 344 Bitmap = { - 494C0101DE008C01AC0618001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C0101DE008C01B40618001800FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 00000000000036000000280000006000000040050000010020000000000000E0 070000000000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF009D9188003D2413003D241300FFFF diff --git a/SRC/Main/USCS_Main.pas b/SRC/Main/USCS_Main.pas index 2a60ee4..a47d46b 100644 --- a/SRC/Main/USCS_Main.pas +++ b/SRC/Main/USCS_Main.pas @@ -1184,6 +1184,12 @@ type aShieldAssemblyScheme: TAction; TimerTracingInterval: TTimer; mnuReserv: TMenuItem; + pmCreateBFMagistral: TMenuItem; + aCreateBFMagistral: TAction; + pmCreateBFMagistralDown: TMenuItem; + pmCreateBFMagistralUp: TMenuItem; + aCreateBFMagistralDown: TAction; + aCreateBFMagistralUp: TAction; // ACTIONs // создать новый проект @@ -1998,6 +2004,9 @@ type procedure aShieldAssemblySchemeExecute(Sender: TObject); procedure TimerTracingIntervalTimer(Sender: TObject); procedure mnuReservClick(Sender: TObject); + procedure aCreateBFMagistralExecute(Sender: TObject); + procedure aCreateBFMagistralDownExecute(Sender: TObject); + procedure aCreateBFMagistralUpExecute(Sender: TObject); { procedure SelectAllLineObjsHint(var HintStr: String; var CanShow: Boolean); @@ -16609,13 +16618,28 @@ end; procedure TFSCS_Main.aMasterCableTracingExecute(Sender: TObject); begin try - MasterCableTracing; + MasterCableTracing; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMasterCableTracingExecute', E.Message); end; end; +//Tolik 22/08/2025 -- создать вертикали в одной точке по всем листам проекта (высотой в высоту этажа) +procedure TFSCS_Main.aCreateBFMagistralDownExecute(Sender: TObject); +begin + CreateBFMagistralTR(false, true); +end; +procedure TFSCS_Main.aCreateBFMagistralExecute(Sender: TObject); +begin + CreateBFMagistralTR; +end; +procedure TFSCS_Main.aCreateBFMagistralUpExecute(Sender: TObject); +begin + CreateBFMagistralTR(false, false, true); +end; + +// procedure TFSCS_Main.aCreateBlockToFileExecute(Sender: TObject); var BlkName: string; diff --git a/SRC/Main/U_CAD.dfm b/SRC/Main/U_CAD.dfm index 6c18b46..4a97031 100644 --- a/SRC/Main/U_CAD.dfm +++ b/SRC/Main/U_CAD.dfm @@ -134,6 +134,7 @@ object F_CAD: TF_CAD OnPopMenuClicked = PCadPopMenuClicked OnGUIEvent = PCadGUIEvent OnToolChanged = PCadToolChanged + ExplicitTop = -1 object HorScroll: TScrollBar Left = 0 Top = 449 diff --git a/SRC/Main/U_CAD.pas b/SRC/Main/U_CAD.pas index 93632a5..d56577c 100644 --- a/SRC/Main/U_CAD.pas +++ b/SRC/Main/U_CAD.pas @@ -7106,6 +7106,21 @@ var end; // begin + //Tolik 24/08/2025 -- + if Self.FListType = lt_Normal then + begin + FSCS_Main.pmCreateBFMagistral.Visible := True; + FSCS_Main.pmCreateBFMagistralUp.Visible := True; + FSCS_Main.pmCreateBFMagistralDown.Visible := True; + end + else + begin + FSCS_Main.pmCreateBFMagistral.Visible := False; + FSCS_Main.pmCreateBFMagistralUp.Visible := False; + FSCS_Main.pmCreateBFMagistralDown.Visible := False; + end; + // + //Tolik 16/06/2021 -- FSCS_Main.Pmi_CopyCurrList.Visible := False; FSCS_Main.Pmi_CopyCurrListWCompon.Visible := False; diff --git a/SRC/Main/U_Common.pas b/SRC/Main/U_Common.pas index 199775c..4e57fc5 100644 --- a/SRC/Main/U_Common.pas +++ b/SRC/Main/U_Common.pas @@ -1353,7 +1353,9 @@ type function StrToFloatDef_My(const S: string; const Default: Extended): Extended; overload; //Tolik 17/02/2022 -- Procedure ShowInvoice; - + //Tolik 24/08/2025 -- + Procedure CreateBFMagistralTr(aFull: Boolean = true; aDown: Boolean = False; aUp: Boolean = False; aCompon: TSCSComponent = nil); + // const {$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)} urlSupport = 'http://cableproject.net/chat.php'; @@ -1766,6 +1768,128 @@ uses USCS_Main, Menus, U_main, U_MasterNewList, U_MasterNewListLite, U_AutoTrace U_InputRadio, U_BaseConstants, cxSpinEdit, Printers, PCPanel, U_InputMark, U_PEAutotraceDialog{Tolik}, U_SCSClasses, U_MakeEditCrossConnection, U_DimLineDialog, U_ResourceReport; + //Tolik 24/08/2025 -- + Procedure CreateBFMagistralTR(aFull: Boolean = true; aDown: Boolean = False; aUp: Boolean = False; aCompon: TSCSComponent = nil); + var i, ListIndex: integer; + x,y: Double; + FCad, SavedGcadForm: TF_Cad; + CadList: TList; + CreatedLine: TOrthoLine; + p1, p2: TDoublePoint; + SavedMoveWithRaise, SSGrid, SSN, SSG: Boolean; + SCSList: TSCSList; + begin + CadList := TList.Create; + //Full + if aFull then + begin + for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do + begin + if F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].Setting.ListType = lt_Normal then + begin + FCad := GetListByID(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].SCSID); + if FCad <> nil then + CadList.Add(FCad); + end; + end; + end + else + begin + SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID); + if SCSList <> nil then + begin + ListIndex := F_ProjMan.GSCSBase.CurrProject.ProjectLists.IndexOf(SCSList); + //UP + if aUP then + begin + for i := ListIndex to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do + begin + if F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].Setting.ListType = lt_Normal then + begin + FCad := GetListByID(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].SCSID); + if FCad <> nil then + CadList.Add(FCad); + end; + end; + end + else + //Down + if aDown then + begin + for i := ListIndex Downto 0 do + begin + if F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].Setting.ListType = lt_Normal then + begin + FCad := GetListByID(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].SCSID); + if FCad <> nil then + CadList.Add(FCad); + end; + end; + end; + end; + end; + + if CadList.Count > 1 then + begin + SavedGCadForm := GCadForm; + + SavedMoveWithRaise := GMoveWithRaise; + GMoveWithRaise := False; + + + p1.x := GMouseDownPos.x; + p1.y := GMouseDOwnPos.y; + p1.z := 0; + + p2.x := GMouseDownPos.x + 1; + p2.y := GMouseDOwnPos.y + 1; + p2.z := 0; + + for i := 0 to CadList.Count - 1 do + begin + GCadForm := TF_Cad(CadList[i]); + + SSGrid := GCadForm.PCad.SnapToGrids; + SSN := GCadForm.PCad.SnapToNearPoint; + SSG := GCadForm.PCad.SnapToGuides; + + GCadForm.PCad.SnapToGrids := False; + GCadForm.PCad.SnapToNearPoint := False; + GCadForm.PCad.SnapToGuides := False; + + CreatedLine := CreateTraceByPoints(GCadForm.PCad, p1, p2); + CreatedLine.ActualZOrder[1] := 0; + TConnectorObject(CreatedLine.JoinConnector1).actualzOrder[1] := 0; + + TConnectorObject(CreatedLine.JoinConnector2).MoveP(p1.x - p2.x, p1.y - p2.y, False, False); + CreatedLine.ActualZOrder[2] := GCadForm.FRoomHeight; + TConnectorObject(CreatedLine.JoinConnector2).actualzOrder[1] := GCadForm.FRoomHeight; + + CreatedLine.LengthCalc; + CreatedLine.LineLength := CreatedLine.LengthCalc; + + GCadForm.PCad.SnapToGrids := SSGrid; + GCadForm.PCad.SnapToNearPoint := SSN; + GCadForm.PCad.SnapToGuides := SSG; + if SavedGcadForm.cbManualCableTracingMode.Down then + begin + if F_NormBase.GSCSBase.SCSComponent <> nil then + begin + if F_NormBase.GSCSBase.SCSComponent.IsLine = biTrue then + begin + CopyComponentToSCSObject(CreatedLine.ID, F_NormBase.GSCSBase.SCSComponent.ID); + end; + end; + end; + end; + + GCadForm := SavedGCadForm; + GMoveWithRaise := SavedMoveWithRaise; + CadList.Free; + end; + CadList.Free; + end; + //Tolik 16/02/2022 -- Procedure ShowInvoice; var RepParams: TReportItemParams;