//{$A+,B-,C+,D+,E-,F-,G+,H+,I-,J-,K-,L+,M-,N+,O-,P+,Q-,R-,S-,T-,U+,V+,W-,X+,Y+,Z1} //{$MINSTACKSIZE $00004000} //{$MAXSTACKSIZE $00100000} //{$IMAGEBASE $00400000} //{$APPTYPE GUI} //{$J+} unit U_Common; interface uses Windows, Forms, StdCtrls, Classes, ComCtrls, Controls, DrawEngine, PCTypesUtils, SysUtils, Dialogs, Contnrs, DrawObjects, PCDrawBox, PCDrawing, PowerCad, Graphics, U_Cad, U_ESCadClasess, U_SCSLists, U_SCSComponent, ActnList, U_SCSEngineTest, U_BaseCommon, U_Progress, U_Splash, Math, U_Navigator, Messages, LibJpeg, ClipBrd, ExtCtrls, U_HouseClasses; const // Polly Line Type pltNone = 0; pltConvex = 1; // Выпуклый pltConcave = 2; // Вогнутый cnstPi180 = pi / 180; type TListFormatType = record PageLayout: TPageLayout; PageOrient: TPageOrient; PageWidth: Double; PageHeight: Double; StampLang: TStampLang; StampType: TStampType; ShowMainStamp: Boolean; ShowUpperStamp: Boolean; ShowSideStamp: Boolean; ListCountX: Integer; ListCountY: Integer; {CADStampMargins: TDoubleRect; CADStampDeveloper: string[255]; //15.11.2011 - разработал CADStampChecker: string[255]; //15.11.2011 - проверил CADStampMainEngineer: string[255]; //02.10.2012 - Главный инженер проекта CADStampApproved: string[255]; //02.10.2012 - Утвердил CADStampDesignStage: string[255]; //02.10.2012 - Стадия проектир.} StampFields: TListStampFields; end; type // настройки листа, для сравнения с примененными настройками TCADParams = record // Вкладка "Общие" CADHeightRoom: Double; // для потолка CADHeightFalseFloor: Double; // для фальш потолка CADHeightConns: Double; // для коннекторов CADHeightLines: Double; // для трасс CADIndexPointObjects: Integer; // индекс для новых РТ CADIndexConnector: Integer; // индекс для новых коннекторов CADIndexLine: Integer; // индекс для новых трасс // Вкладка "CAD" CADPageSizeIndex: Integer; // индекс размера листа А4 CADPageOrient: TPageOrient; // ориентация листа CADStampType: TStampType; // штамп листа CADStampLang: TStampLang; // язык рамки CADStampMargins: TDoubleRect; // отступы рамки листа //11.11.2011 CADWidth: Double; // ширина КАД CADHeight: Double; // высота КАД CADListCountX: Double; // кол-во листов данного формата по горизонтали CADListCountY: Double; // кол-во листов данного формата по вертикали CADFontName: string[255]; // шрифт КАДа CADGridStep: Double; // шаг сетки CADMapScale: Double; // настройка линейки CADTraceColor: TColor; // цвет трассы CADTraceStyle: TPenStyle; // стиль трассы CADTraceWidth: Integer; // ширина трассы CADBlockStep: Double; // шаг блока CADObjectCaptions: TShowType; // вид подписи к объектам CADLinesCaptions: TShowKind; // вид подписей к линиям CADObjectNotes: TShowType; // вид выносок к объектам CADLinesNotes: TShowKind; // вид выносок к линиям CADNotePrefix: string[1]; // префикс отображения CADShowLineObjectCaption: Boolean; // Отображать подписи к линейным объектам CADShowLineObjectLength: Boolean; // Отображать длину линейных объектов CADShowLineObjectNote: Boolean; // Отображать выноски к линейным объектам CADShowConnObjectCaption: Boolean; // Отображать подписи к точечным объектам CADShowConnObjectNote: Boolean; // Отображать выноски к точечным объектам CADShowRaise: Boolean; // отображать символы с-п CADPutCableInTrace: Boolean; // Ложить кабель на трассу CADLinesCaptionsColor: Integer; // цвет подписей трасс CADConnectorsCaptionsColor: Integer; // цвет подписей коннекторов CADLinesNotesColor: Integer; // цвет выносок трасс CADConnectorsNotesColor: Integer; // цвет выносок коннекторов CADLinesCaptionsFontSize: Integer; // размер шрифта подписей трасс CADConnectorsCaptionsFontSize: Integer; // размер шрифта подписей коннекторов CADLinesNotesFontSize: Integer; // размер шрифта выносок трасс CADConnectorsNotesFontSize: Integer; // размер шрифта выносок коннекторов CADLinesCaptionsFontBold: Boolean; // жирный шрифт подписей трасс CADCrossATSFontSize: Integer; // размер шрифта для Кросс АТС CADDistribCabFontSize: Integer; // размер шрифта для РШ CADCrossATSFontBold: Boolean; // жирный шрифт для Кросс АТС CADDistribCabFontBold: Boolean; // жирный шрифт для РШ CADPrintType: TPrintType; // тип печати SCSType: TSCSType; // тип листа СКС CADTraceStepRotate: Integer; // шаг угла поворота трассы AutoCadMouse: Boolean; // мышь Автокад ScaleByCursor: Boolean; // масштабировать по положению курсора AutoPosTraceBetweenRM: Boolean; // трассу между двумя РМ размещать на высоте этих РМ... CADShowMainStamp: Boolean; // показывать основной штамп на рамке листа CADShowUpperStamp: Boolean; // показывать верхний штамп на рамке листа CADShowSideStamp: Boolean; // показывать боковой штамп на рамке листа CADSaveUndoCount: Integer; // кол-во действий после которого следует делать слепок CADAllowSupplieskind: Boolean; // учитывать вид поставки при прокладки КК CADNewTraceLengthType: Byte; CADShowRaiseDrawFigure: Boolean; end; PCADParams = ^TCADParams; // Для схемы проекта // Здание - проект TPlanProject = record FSizeX: Double; FSizeY: Double; FBounds: TDoubleRect; FFloors: TList; end; PPlanProject = ^TPlanProject; // Этаж в здании TPlanFloor = record FSizeX: Double; FSizeY: Double; FBounds: TDoubleRect; FCabinets: TList; end; PPlanFloor = ^TPlanFloor; // Кабинет в этаже TPlanCabinet = record FSizeX: Double; FSizeY: Double; FBounds: TDoubleRect; FObjects: TList; end; PPlanCabinet = ^TPlanCabinet; TNormColumn = record IDNormStruct: Integer; FCableName: string[255]; FColumns: TStringList; end; PNormColumn = ^TNormColumn; TNormStruct = record ID: Integer; FNumber: string[10]; FName: string[255]; FIzm: string[20]; FCount: string[50]; FNormColumns: TList; end; PNormStruct = ^TNormStruct; // тип объекта для отображения групповых свойств TObjectsTypeProp = (otp_Single, otp_ConnObjects, otp_ConnConnectors, otp_ConnRaises, otp_LineTraces, otp_LineRaises); TAngleType = (at_Horizontal, at_Vertical); // получить лист по его ID function GetListByID(AID_List: Integer): TF_CAD; // **** привязки объектов **** // коннектор к трассе procedure SnapConnectorToOrtholine(AConnector: TConnectorObject; ASnapLine: TOrtholine); // объект к трассе procedure SnapPointObjectToOrthoLine(APointObject: TConnectorObject; ASnapLine: TOrthoLine); // коннектор к коннектору procedure SnapConnectorToConnector(AConnector, ASnapConnector: TConnectorObject; AOnRaise: Boolean = false); // коннектор к объекту procedure SnapConnectorToPointObject(AConnector, APointObject: TConnectorObject; AOnRaise: Boolean = false; ASnapObjectToLine: Boolean = false); // объект к коннектору procedure SnapPointObjectToConnector(APointObject, AConnector: TConnectorObject; AOnRaise: Boolean = false); // коннектор к Дому procedure SnapConnectorToHouse(aConnector: TConnectorObject; aSnapHouse: THouse); // коннектор к вертикальной трассе procedure SnapConnectorToVertical(AConnector: TConnectorObject; ASnapLine: TOrtholine); // объект к вертикальной трассе procedure SnapPointObjectToVertical(APointObject: TConnectorObject; ASnapLine: TOrthoLine); // **** выполнить привязку по определенному закону **** // коннектор к трассе procedure CheckingSnapConnectorToOrtholine(AConnector: TConnectorObject; ASnapLine: TOrtholine); // объект к трассе procedure CheckingSnapPointObjectToOrthoLine(APointObject: TConnectorObject; ASnapLine: TOrthoLine); // коннектор к коннектору procedure CheckingSnapConnectorToConnector(AConnector, ASnapConnector: TConnectorObject); // коннектор к объекту procedure CheckingSnapConnectorToPointObject(AConnector, APointObject: TConnectorObject; aUseBaseConnector: Boolean); // объект к коннектору procedure CheckingSnapPointObjectToConnector(APointObject, AConnector: TConnectorObject); // c-п // создать ... // на объекте Procedure CreateRaiseOnPointObject(APointObject: TConnectorObject; AHeight: Double; aBaseConnector: TConnectorObject = nil); // на коннекторе Procedure CreateRaiseOnConnector(AConnector: TConnectorObject; AHeight: Double); // на связующем коннекторе/объекте от трассы Procedure CreateRaiseOnNextObject(AConnector: TConnectorObject; AJoinedLine: TOrthoLine; AHeight: Double); // пересоединение компонент через с-п Procedure AutoConnectOverRaiseInCAD(AObjFromRaise, ARaiseObj: TConnectorObject); // изменить положение ... // на объекте Procedure ChangeRaiseOnPointObject(APointObject: TConnectorObject; AHeight: Double); // на коннекторе Procedure ChangeRaiseOnConnector(AConnector: TConnectorObject; AHeight: Double); // на связующем коннекторе/объекте от трассы Procedure ChangeRaiseOnNextObject(AConnector: TConnectorObject; AJoinedLine: TOrthoLine; AHeight: Double); // удалить ... // с объекта Procedure DestroyRaiseOnPointObject(APointObject: TConnectorObject); // с коннектора Procedure DestroyRaiseOnConnector(AConnector: TConnectorObject); // поднять линию на высоту Procedure RaiseLineOnHeight(ALine: TOrthoLine; AHeight: Double; ATracesList: TList); // нужно ли создавать с-п при подъеме трассы Function CheckNeedCreateRaiseOnRaiseTrace(ALine: TOrthoLine; AJoinedConn: TConnectorObject; ATracesList: TList): Boolean; // c-п межэтажные ... // создать м-э с-п на объекте Function CreateBetweenFloorRaiseOnPointObject(APointObject: TConnectorObject; ARaiseType: TLineRaiseType): TConnectorObject; // создать м-э с-п на коннекторе Function CreateBetweenFloorRaiseOnConnector(AConnector: TConnectorObject; ARaiseType: TLineRaiseType): TConnectorObject; // c-п магистральные ... // создать магистральный с-п на объекте Function CreateTrunkRaiseOnPointObject(APointObject: TConnectorObject; ARaiseType: TLineRaiseType; aTrunkLength: Double): TConnectorObject; // создать магистральный с-п на коннекторе Function CreateTrunkRaiseOnConnector(AConnector: TConnectorObject; ARaiseType: TLineRaiseType; aTrunkLength: Double): TConnectorObject; // отвязать коннектор от объекта procedure UnsnapConnectorFromPointObject(AConnector, APointObject: TConnectorObject; AOnRaise: Boolean = false); // определеть точку привязки коннектора к объекту при одинаковой высоте (красная точка) function GetCrossPoint(X1_Line, Y1_Line, X2_Line, Y2_Line, X1_Object, Y1_Object, X2_Object, Y2_Object: Double): TDoublePoint; // получить УГО с НБ для объекта function GetConnectorImg(aOT: TConnectorType): TFigureGrpMod; // получить УГО с НБ для трассы function GetOrthoLineImg(aOT: TOrthoLineType): TFigureGrpMod; // параметры по дефолту для листа КАДа (только КАДовские настройки) Procedure SetDefaultPageParams; // вернуть параметры для листа КАДа (только КАДовские настройки) после переаквтивации окон КАДа Procedure ReturnListParams; // Принятие компонента из нормативной базы Function GetComponentFromNormBase(X, Y: Double; NB_Component: TSCSComponent; ASnapFigure: TFigure; CompStateType: TCompStateType): TFigure; // автопоиск объекта при DragOver Function FindAutoSnapObject(X, Y: Double; NB_Component: TSCSComponent): TFigure; // Взаимодействие Менеджера проектов и CAD`а ... // Новое имя для объекта Procedure SetNewObjectNameInCad(AID_List, AID_Figure: Integer; AOldObjName, ANewObjName: String); // удалить объект с КАДа Procedure DeleteObjectFromCad(AID_List, AID_Figure: Integer; AObjName: String); // удалить объект с SCSFigureGrp Procedure DeleteObjectFromSCSFigureGrp(ASCSFigureGrp: TSCSFigureGrp; AObjects: TFigure); // выделить объект на КАДе Procedure SelectObjectInCAD(AID_List, AID_Figure: Integer; AObjName: String); // Перемещает объек в конец списка - нужно чтобы он имел высший приоритет для выделения procedure FigureBringToFront(AFigure: TFigure); //29.09.2010 //#From Oleg# procedure FigureSendToBack(AFigure: TFigure); //19.08.2011 //#From Oleg# // Перемещает коннектор без УГО в конец списка - нужно чтобы он имел высший приоритет для выделения procedure SetConnObjectSelectHightPriority(AFigure: TConnectorObject); //29.09.2010 //#From Oleg# // Взаимодействие Листов в МП и на CAD-е ... // переключить лист Procedure SwitchListInCAD(AID_List: Integer; const ListName: String); // переименовать лист Procedure RenameListInCAD(AID_List: Integer; const OldListName, NewListName: String; AOldListParams: PListParams; ARenameOnFrame: Boolean=true); // удалить лист Procedure DeleteListInCAD(AID_List: Integer; ListName: String); // получить листы интерфейсов Procedure FindConnectionsInterfaces(AConnector1, AConnector2: TConnectorObject); // автосоединение по интерфейсам при добавлении кабеля на трассу Procedure AutoConnectOnAppendCable(AID_List, AID_Line: Integer); // автосоединение по интерфейсам при добавлении объекта на трассу Procedure AutoConnectObjectInTrace(APointObject: TConnectorObject; ATrace1, ATrace2: TOrthoLine); // автосоединение по интерфейсам при соединении коннектора/объекта к коннектору с трассами procedure AutoConnectObjectToConnectors(APointObject, AConnectedConn: TConnectorObject; AConnectorsList: TList); // добавление/удалении комплектующих в объекты ... // добавление в трассу Procedure AppendLineInterfacesToCAD(AID_List, AID_Figure: Integer; AObjName: string; aDivValue: Double); // удаление из трассы Procedure RemoveLineInterfacesFromCAD(AID_List, AID_Figure: Integer; AObjName: string); // добавление в объект Procedure AppendNoLineInterfacesToCAD(AID_List, AID_Figure: Integer; AObjName: string); // удаление из объекта Procedure RemoveNoLineInterfacesFromCAD(AID_List, AID_Figure: Integer; AObjName: string); // выделить всю трассу от точки до точки function SelectTraceInCAD(LinesList: TList): Double; // убрать выделение этой трассы от точки до точки function DeselectTraceInCAD: Boolean; // угол линии function GetLineAngle(AP1, AP2: TDoublePoint): Double; // выровнять линию по сетке Procedure ReAlignLine(aAlignedLine: TOrthoLine); // выровнять точ. объект по сетке Procedure ReAlignObject(aAlignedObject: TConnectorObject); // процедура нахождения трассы на CAD-е function GetAllTraceInCAD(AFigureServer, AFigureWS: TFigure): TList; // процедура нахождения группы путей по отмеченным трассам function GetAllTraceInCADByMarked(aAFigureServer, aAFigureWS: TFigure; SotrListByMarked: Boolean = True): TList; //Tolik function GetAllTraceInCADByMarked_New1(aAFigureServer, aAFigureWS: TFigure): TList; // function CheckConnJoinBetwFloor(aConn: TConnectorObject; CheckRaiseUpDown: boolean = False): Boolean; function CheckOtherTraceBetwFloor(Trace: TOrthoLine; CheckRaiseUpDown: boolean = False; CheckMore: boolean = false): Boolean; function GetAllNoConnectedTraces(aCAD: TF_CAD): TList; // проверка на наличие объекта в текущем листе function CheckNoFigureInList(ACheckFigure: TFigure; AList: TList): Boolean; // проверка на наличие КАД листа в текущем листе function CheckNoCadInList(ACheckCad: TF_CAD; AList: TList): Boolean; // проверка на наличие листа в листе function CheckNoListInList(AInList, AList: TList): Boolean; // выделить подсоединенные коннекторы Procedure SelectConnectedConnector(AID_List, AID_Figure: Integer); // выделить подсоединенные кабели Procedure SelectConnectedCables(AID_List: Integer; ALinesList: TIntList); // Подъемы ... function GetBasisPointByObjFromRaise(aObj: TConnectorObject): TDoublePoint; // получить подъем на объекте function GetRaiseConn(APointObject: TConnectorObject): TConnectorObject; // получить линию типа с-п на объекте function GetRaiseLine(ARaiseConn: TConnectorObject): TOrthoLine; // проверить есть ли подъем на объекте function CheckRaise(APointObject: TConnectorObject): Boolean; // получить вершину межэтажного от трассы function GetRaiseByRaiseLine(aRaiseLine: TOrthoLine): TConnectorObject; // проверить существует ли лист Function CheckListExist(AListID: integer): Boolean; // Установить новый тип заполненности интейфейсов для ... // точ. объектов Procedure SetFullnessTypeForConnector(AID_List, AID_Figure: Integer; AFullnessType: TComponInterfacesFullness); // кабелей Procedure SetFullnessTypeForCable(AID_List, AID_Figure: Integer; ASide: Integer; AFullnessType: TComponInterfacesFullness); // кабельных каналов Procedure SetFullnessTypeForCableChannel(AID_List, AID_Figure: Integer; AFullnessType: TComponInterfacesFullness); // закрытость/открытость каб.каналов Procedure SetClosedTypeForCableChannel(AID_List, AID_Figure: Integer; ASide: Integer; AClosedType: TComponInterfacesFullness); // установить стиль трассы Procedure SetTraceStyle(AID_List, AID_Figure: Integer; ATraceStyle: TTraceStyle); // сравнение двух чисел типа Double function DoubleCMP(Double1, Double2: Double): Boolean; // переместить объект на передний план procedure SetConnBringToFront(AConnector: TConnectorObject); // получить указатель на лист где мэ переход Function GetListOfPassage(AListID: Integer): TF_CAD; function GetAllFiguresByClass(ACADForm: TF_CAD; aClass: TClass): TList; function GetAllFiguresByClassFromProj(aClass: TClass): TList; // получить объект по листу и ID объекта function GetFigureByID(ACADForm: TF_CAD; AID_Figure: Integer): TFigure; //2012-04-18 получить объект который ближе к началу координат function GetFigureByOrign(aFigureList: TList): TFigure; function GetFigureByIDProj(AID_Figure: Integer): TFigure; // получить объект по листу и ID объекта внутри SCSFigureGroups function GetFigureByIDInSCSFigureGroups(ACADForm: TF_CAD; AID_Figure: Integer): TFigure; // получить объект по ID объекта внутри SCSFigureGroup function GetFigureByIDInSCSFigureGrp(ASCSFigureGrp: TSCSFigureGrp; AID_Figure: Integer): TFigure; // получить SCSFigureGroup обьект в котором объект function GetSCSFigureGrp(ACADForm: TF_CAD; AID_Figure: Integer): TSCSFigureGrp; function AutoDivideLine(ALine: TOrthoLine): TConnectorObject; // разделить трассу, на выходе коннектор, котoрый разделил эту трассу function DivideLine(ALine: TOrthoLine): TConnectorObject; function DivideLineSimple(ALine: TOrthoLine; ADivPt: PDoublePoint=nil): TConnectorObject; // соединить трассы связующие с коннектором procedure DisconnectConn(AConn: TConnectorObject); // пересчет Z координат привязанных линий procedure ReCalcZCoordSnapObjects(AConnector: TConnectorObject); // Проверка на класс СКС ... // ортолиния Function OrthoLineDetect(AOrthoLine: TFigure): Boolean; // коннектор Function ConnectorDetect(AConnector: TFigure): Boolean; // общая проверка на один из классов СКС Function SCSClassDetect(ASCSObject: TFigure): Boolean; // создавать объекты в режиме клика на КАД-е procedure CreateOnClickMode(ASnapFigure: TFigure; ALastSCSCompon: TSCSComponent; X, Y: Double); procedure AskMarkInCreateObjectOnClick(aCAD: TF_CAD; aComponID: Integer); // установить индекс объекта procedure SetIndexToFigure(AID_List, AID_Figure: Integer; AIndex: Integer); // установить формат изображения типа краткий/полный на КАД-е procedure SetShowNameTypeInCAD(AShowType: TShowType); // проложить короб по выделенным участкам procedure TraceCableChannelBySelectedLines(CableChannelID: Integer); // проверить есть ли хоть одна выделенная линия function IsSelectedLinesExist: Boolean; function IsSelectedFigure(aListID, aFigureID: Integer): Boolean; // выдать координаты дропа объекта с учетом привязки к сетки // по оси X function GetCoordXWithSnapToGrid(X: Double): Double; // по оси Y function GetCoordYWithSnapToGrid(Y: Double): Double; // по обоим осям function GetCoordsWithSnapToGrid(X, Y: Double): TDoublePoint; // был ли клик на объекте function IsClickOnFigure: Boolean; // автотрассировать кабелем из НБ Procedure AutoTraceCableFromNB(AID_Cable: Integer; ACable: TSCSComponent; aFromDropConnObj: Boolean=false; aShowFirstMsg: Boolean=true; aSaveForUndo: Boolean=true; aNeedShowAutoTraceType: boolean = True; aFromDrop: boolean = False); // трассировать до конечной точки Function TracingToEndPoint(ACurrentWS, AEndPoint: TConnectorObject; AID_Cable: Integer; aConsiderBoxAndRack: Boolean=false): Boolean; // главный цикл автотрассировки procedure DoAutoTraceCycle(AFiguresList: TList; AID_Cable: Integer; aConsiderBoxAndRack: Boolean=false; aSaveForUndo: Boolean=true); // автосоединить с-п на межэтажных переходах Procedure AutoConnectBetweenFloorPassage(ACable: TOrthoLine; ASide: Integer; ARaise: TConnectorObject); // проверить являеться ли трасса межэтажным с-п Function GetBetweenFloorRaiseLine(ALine: TOrthoLine): TOrthoLine; // применение настроек параметров листа для всех объектов Procedure ApplyParamsForAllSCSObject(AConnHeight, ALineHeight: Double; AConnCaptionsShowType, AConnNotesShowType: TShowType; ALineCaptionsShowType, ALineNotesShowType: TShowKind; aCADParams: TCADParams); // для точечных объектов Procedure ApplyParamsForObjects(AObject: TConnectorObject; AHeight: Double); // для линейных объектов Procedure ApplyParamsForTraces(ATrace: TOrthoLine; AHeight: Double; ATracesList: TList); // применение типа уголков для всех коннекторов Procedure ApplyCornerTypeForConnectors(aCornerType: TCornerType); // проверка можно ли сменить тип уголка для объекта Function CheckCornertypeMaybeChanged(aConnector: TConnectorObject; aCornerType: TCornerType): Boolean; // получить угол между двумя трассами function GetAngleBetweenLines(AListID, AIDLine1, AIDLine2, AIDConnector: Integer; aAngleType: TAngleType): Double; Function CalcAngleBetweenLines(aLine1, aLine2: TOrthoLine; aConnector: TConnectorObject): Double; // установить тип уголка Function GetCornerTypeByConnectorID(AID_List, AID_Object: Integer): TCornerType; // получить тип уголка Procedure SetCornerTypeByConnectorID(AID_List, AID_Object: Integer; ACornerType: TCornerType); // получить тип уголка по определенным законам Function GetCheckedCornerType(aConnector: TConnectorObject): TCornerType; // получить стороны присоединенных объектов (0 - если коннектор, 1-2 - стороны трассы) Procedure GetSidesByConnectedFigures(AID_List1, AID_List2, AID_Figure1, AID_Figure2: Integer; var Side1: Integer; var Side2: Integer); // получить высоты трассы Procedure GetLineFigureHeghts(AID_List, AID_Line: Integer; var AHeight1: Double; var AHeight2: Double); // обновить слои после изменения настроек procedure UpdateForLayers; // обновить все КАДы Procedure RefreshAllLists; // передать в объект типы сетей которые в нем присутствуют Procedure SetNetworkTypesForObject(AID_List, AID_Object: Integer; ANetworkTypes: TObjectNetworkTypes); // проверить есть ли совпадения с сетями Function IsViewObjectInCurrentNetwork(AObject: TFigure): Boolean; // установить данные усл.обозначения для объекта Procedure SetBlockParamsForObject(AID_List, AID_Object: Integer; ABlockGUID: string; AObjectType: Integer; ABlockStreams, ABlockStreamsOtherType: TObjectList; aSysName: string = ''); // установить новое УГО для коннектора Procedure SetBlockForConnObject(AConnector: TConnectorObject; ABlockStreams: TObjectList; aSysName: string = ''); procedure SetLayerHandleForFigureGrp(BlockFig: TFigureGrp; LayHandle: integer); // установить новое УГО для линии Procedure SetBlockForLineObject(ALine: TOrthoLine; ABlockStreams, ABlockStreamsOtherType: TObjectList); // возможность соединения на КАДе, могу ли эти объекты соединиться на КАДе Function CheckCanConnectInCAD(AID_List1, AID_List2, AID_Object1, AID_Object2: Integer): Boolean; // Выводить имя объекта на КАД в подписи procedure SetConnNameInCaptionOnCAD(AConnector: TConnectorObject); // установить подпись к точечному обьекту procedure SetConnCaptionsInCAD(AID_List, AConnID: Integer; ACaption: TStringList); // установить выноску на точечном объекте procedure SetConnNotesInCAD(AID_List, AConnID: Integer; ANote: TStringList); // установить выноску на линейном объекте procedure SetLineNotesInCAD(AID_List, ALineID: Integer; ANote: TStringList); // установить подпись на линейном объекте procedure SetLineCaptionsInCAD(AID_List, ALineID: Integer); // краткий формат Double Function BriefFormat(ADbl: Double): Double; // проверка изменять ли поля объектов ... function CheckIsNameChanged(AID_List, AID_Figure: Integer): Boolean; // имя function CheckIsCaptionsChanged(AID_List, AID_Figure: Integer): Boolean; // подпись function CheckIsNotesChanged(AID_List, AID_Figure: Integer): Boolean; // выноска function CheckIsBlockChanged(AID_List, AID_Figure: Integer): Boolean; // изображение // получить список всех присоединенных трасс к объекту, их ID Function GetAllConnectedTracesID(AID_List, AID_Object: Integer): TIntList; // получить список всех присоединенных трасс к объекту, сами объекты Function GetAllConnectedTraces(AObject: TConnectorObject): TList; // поиск объектов (аналог CheckByPoint) Function CheckBySCSObjects(X, Y: Double; TracedFigure: TFigure = nil): TFigure; procedure CheckBySCSObjectsNear(X, Y: Double; var ResFindedFigures: TList; TracedFigure: TFigure = nil); // поиск списка объектов (аналог CheckByPoint) Function CheckBySCSObjectsList(X, Y: Double): TList; // автосдвиг точ. объекта Procedure AutoShiftObject(AObject: TConnectorObject); // получить присоединенные трассы для установки заглушек Function GetObjectsListForCork(AListID, AID_LineFigure, ALineSide: Integer; var AID_Connector: Integer): TIntList; // блокировка всех действий пока идет оброботка ... //Tolik //Procedure BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1); // начало Procedure BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1; MustShowProgress: Boolean=False); // Procedure EndProgress; // окончание procedure SetCADsProgressMode(AIsProgress: Boolean); procedure CADBeginUpdate(aCAD: TObject); //07.11.2011 procedure CADEndUpdate(aCAD: TObject); //07.11.2011 procedure StepProgress; // шаг // ProgressBar при загрузке приложения procedure StartUpProgress; // переименовка проекта - переименовать поле FCADProjectList у листов Procedure SetListsNamesInProject(AProjectName: string); // добавлять и удалять shadow объекты при DragOver c НБ procedure CreateShadowObject; procedure DestroyShadowObject; // вернуть Stream с КАДом по ИД листу function GetCADStreamByIDList(AID_List: Integer; aFileName: string = ''): TMemoryStream; // можно ли двигать DrawFigure function IfDrawFigureMoveCan(AObject: TConnectorObject; ADeltaX, ADeltaY: Double): Boolean; // переприсвоить параметры листа Навигатору procedure ReAssignNavigatorParams; {****************************************************************************} // загрузка настроек для листа Procedure LoadSettingsForList(AListID: Integer; aApplyListFormat: Boolean); // загрузка настроек для листа по параметрам procedure LoadSettingsForListByParams(AListParams: TListParams; aApplyListFormat: Boolean); // Устанавливает параметры в рамку листа procedure SetCADFrameParams(ACadForm: TF_CAD); // переоткрывать закрытый лист на CAD Procedure ReOpenListInCAD(AListID: Integer; const AListName: string); // переоткрывать закрытый лист на CAD, с проверкой Procedure ReOpenListInCADIfClosed(AListID: Integer; const AListName: string); //17.08.2012 // открыть листы в проекте procedure OpenListsInProject(AListID: Integer; AListName: string); // сделать дубликат для листа function CreateListDuplicate(AListParams: TListParams; AListStream: TMemoryStream; AFileName: string = ''; aCopySCSFigures: Boolean=true): TF_CAD; // выгрузка старого проекта Procedure UnloadCurrentProject; // загрузка нового проекта Procedure LoadNewProject(AListsID: TList; ACurrentListID: Integer); // создание/редактирование листа function MakeEditList(AMakeEdit: TMakeEdit; var AListParams: TListParams; AShowForm: Boolean; ASpravochnikKind: TViewKind = vkNone; AGUIDToLocate: String = ''): Boolean; // утсановить новые параметры для листа procedure SetNewListParams(aCADParams: TCADParams); procedure SetNewListParamsForMaster(aCADParams: TCADParams); // применить настройки к подписям и выноскам procedure ApplyCaptionNotesParams(aCADParams: TCADParams); // установить статус лимитности procedure SetTraceLimitStatus(AID_List, AID_Object: Integer; AStatus: Boolean); // STAMP // загрузить рамку листа procedure LoadFrameToList(aCad: TF_CAD; aMainStampName, aSideStampName: string; aListFormat: TListFormatType); // удалить рамку листа procedure RemoveFrameFromList(aCad: TF_CAD); // загрузить подписи на рамку листа // ACreateForLack - Создавать подпись, если отсутствует procedure LoadCaptionsOnFrame(ACAD: TF_CAD; AStampType: TStampType; ACreateForLack: Boolean=true; AEnabledCaptions: TintList=nil); // вписать подписи к рамке листа в поля function CreateStampCaptionToField(ACAD: TF_CAD; aFieldBnd: TDoubleRect; const aText: String; ATextHorzCenter: Boolean=true; ATextSize: Integer=14): TRichText; // Пересоздает подпись к рамке листа function ReCreateStampCaptionToField(ACAD: TF_CAD; ACurrStampField: TRichText; ADataID: Integer; aFieldBnd: TDoubleRect; const aText: String; ACreateForLack: Boolean=true; AEnabledCaptions: TintList=nil; ATextHorzCenter: Boolean=true; ATextSize: Integer=14): TRichText; // получить имя файла из полного пути function GetFileNameFromFullPath(aFullPath: string): string; // получить номер слоя из его Handle function GLN(aLHandle: LongInt): integer; // загрузить рамку на макет procedure LoadFrameOnMaket(aPCad: TPowerCad); // для листа Дизайна Шкафа ... // создать лист Дизайна шкафа procedure CreateDesignList(ABox: TConnectorObject); // открыть дизайнерский лист procedure OpenDesignList(ABox: TConnectorObject; AList: TF_CAD); // создать/открыть дизайн-лист из менеджера проектов procedure CreateOpenDesignListFromPM(AID_List, AID_Box: Integer); // обновить дизайнерский лист procedure UpdateDesignList(AList: TF_CAD; ABox: TConnectorObject); // обновить дизайнерский лист после изменения в объекте Шкаф procedure UpdateDesignListOnBoxChange(AListID: Integer; ABoxID: Integer); // перемасштабировать УГО procedure ReScaleImage(aBlock: TBlock; aCurrX, aCurrY, aTotalX, aTotalY: Double); // высчитать коэф. с учетом перемасшабирования по листу function CalcListFormatKoef(aBoxWidth, aBoxHeight: Double; AList: TF_CAD): Double; // нарисовать линейку к дизайну шкафа ... // в иетрах procedure DrawDesignRulerInMetres(aList: TF_CAD; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint); // в юнитах procedure DrawDesignRulerInUnits(aList: TF_CAD; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint); // опции для типов листов (запрет/разрешение пунктов меню)... // для обычного листа procedure EnableOptionsForNormalList; procedure DisableActForReadOnlyMode; // для Дизайна шкафа procedure DisableOptionsForDesignList; // для Схемы проекта procedure DisableOptionsForProjectPlan; // выдать присоединенные Обьекты к трассе procedure GetConnObjectsByLine(AIDList, AIDLine: Integer; var AConnAtSide1: Integer; var AConnAtSide2: Integer); // переименовать названия проекта в рамке листа procedure RenameProjectOnFrame(AOldProjParams: TProjectParams); // переименовать названия листа в рамке листа procedure RenameListOnFrame(ACadForm: TF_CAD; AOldProjParams: TProjectParams; AOldListParams: TListParams); // проверка на отсоединение коннектора от объекта function CheckByBreakConnector(aClearConn, aPointObject: TConnectorObject): Boolean; // проверка на отсоединение коннектора от объекта по координатам коннектора function CheckByBreakConnectorByCoords(aConnPoints: TDoublePoint; aPointObject: TConnectorObject): Boolean; // Обновление КАДа (REFRESH) procedure RefreshCAD(aPCAD: TPowerCad); // обычный procedure RefreshCAD_T(aPCAD: TPowerCad; AExecPrev: Boolean=false); // по таймеру procedure RefreshCADs(aCADs: TList); //17.01.2011 Обновить список листов // усовершенствованный ProcessMessages procedure ProcessMessagesEx; // удаление внутри объектов FigureGrp (для корректрой очисти объектов данного класса) procedure RemoveInFigureGrp(aFigureGrp: TFigureGrp); // перерисовать тек. Шадоу текущего листа procedure ReDrawCurrShadowOnCAD; // Unselect объектов на SelectionChange (убирается селект с с-п и вершин с-п) procedure UnSelectFiguresOnSelectedChange(aSelectedList: TList); // пересчитать длинны линий на изменении Mapscale procedure ReCalcAllLinesLength; // поднять ActiveNet после поднятия листа procedure RaiseActiveNet(aCad: TF_CAD); // Устанавливает параметры с КАДа на объект procedure SetCADParamsToNet(aCad: TF_CAD; ANetObj: TObject); procedure SetMapScaleToNets(aCad: TF_CAD); // получить все внутренние фигуры с Stamp ... // установить видимость для внутренних штампов procedure SetAllInFiguresVisible(AGroup: TFigureGrp; AVisible: Boolean); // установить все внутр. объектам слой самого объекта procedure SetAllStampFiguresLayer(AGroup: TFigureGrp; ALHandle: Integer); // установить всем внутр. текстам текущий шрифт procedure SetAllStampTextsFont(AGroup: TFigureGrp; aFontName: string); // установить всем текстовым объектам на КАде текущий шрифт procedure UpdateForTexts(aFontName: string); // Смена ID листа procedure ChangeObjectID(aListID, aOldID, aNewID: Integer); // Смена ID кабинета procedure ChangeCabinetID(aListID, aOldID, aNewID: Integer); // вернуть ID межэтажных переходов с листа (линии) function GetBetweenFloorObjectsID(AID_List: Integer; aClearJoins: Boolean = False): TIntList; // удалять фигуры с листа перед удалением листа procedure ClearFiguresonListDelete(aCAD: TF_CAD); // запрос на перемещение листов в менеджере проектов function CanListsInterchange(AIDMoveList, AID_List2: Integer; aMessRes: PInteger=nil; aMsg: Boolean=true): Boolean; // Есть ли на листе м.э переходы function CheckListWithFloorRaise(aListID: Integer): Boolean; // выдать лист со всеми типами трасс function GetTraceInfo(AID_List: Integer): TList; // Сравнить TStringList и TStrings Function IsStringListsDifferent(aStringList: TStringList; aStrings: TStrings): Boolean; // Конвертация TFigureGrpNotMod в TRichTextMod ... // поиск объектов для конвертации procedure FindObjectsForConvertClasses; // конвертировать подписи Function ConvertCaptionsGroupToRichText(aCaptionsGroup: TFigureGrpNotMod; aIsLine: Boolean): TRichTextMod; // конвертировать выноски Function ConvertNotesGroupToRichText(aNotesGroup: TFigureGrpNotMod; aIsLine: Boolean): TFigureGrpNotMod; // получить лист объектов одного уровня Function GetFiguresByLevel(aFigure: TFigure; X, Y: Double; aSameType: Boolean; ASort: Boolean=false): TList; // получить лист объектов на одной вертикале Function GetObjectsByVertical(aSelf, aSnapConnector: TConnectorObject): TList; Function GetLinesByVertical(aSelf: TConnectorObject; aSnapLine: TOrthoLine): TList; Function CheckVerticalInInterval(aVertical: TOrthoLine; aZ: Double): Boolean; // удалить м-э с другого этажа Procedure DeleteRaiseOtherFloor(aItRaise: TConnectorObject); // доложить кабели к противоположной трассе Function MirrorCables(aClearConn: TConnectorObject; aNearTracedLine: TOrthoLine): Integer; // получить лист м-э с-п для трассировки через несколько этажей ... // проверить можно ли трассировать между этажами Function CheckCanTracingBetweenFloor(aLists: TIntList; aRaises: TList): Boolean; // получить список этажей для трассировки между ними Function GetSortedListOfRaises(var aLists: TIntList; aRaiseType: TConnRaiseType; aEndPoint, aBeginPoint: TConnectorObject): TList; // получить список этажей для трассировки между ними начиная от текущего Function GetSortedListOfRaisesFromCurr(var aLists: TIntList; aRaiseType: TConnRaiseType; aBeginPoint, aEndPoint: TConnectorObject): TList; // получить трассу от м-э на другом этаже Function IsBetweenFloorObject(AListID, AIDFigure: Integer; var AIDOtherFloorFigure: Integer): Boolean; // установить структуру КАД параметров Function SetCADParamsStruct(aListParams: TListParams): TCADParams; // функции для свойств подписей и выносок ... // проверить клик в области подписи/выноски Procedure CheckByCaptionsNotes(X, Y: Double); // открыть подпись от данного объекта в свойствах СКС объекта Procedure OpenCaptionAtPos(aObject: TFigure; aCaption: TRichTextMod; X, Y: Double); // открыть выноску от данного объекта в свойствах СКС объекта Procedure OpenNoteAtPos(aObject: TFigure; aNote: TRichTextMod; X, Y: Double); // модификация выносок после перемещения ... // для коннекторов procedure ModifyConnNoteAfterMove(aConn: TConnectorObject; aDeltaX, aDeltaY: Double); // для трасс procedure ModifyLineNoteAfterMove(aLine: TOrthoLine; aDeltaX, aDeltaY: Double); // установить высоту размещения объекта procedure SetFigureCoordZ(AIDList, AIDFigure: Integer; ACoordZ: Double); // получить тип спуска-подъема (подъем или спуск) Function GetRaiseType(aObjFromRaise, aRaise: TConnectorObject): TLineRaiseType; // получить формат подписи к линии function GetLineCaptionFormat(aLine: TOrthoLine; aShowKind: TShowKind): string; // получить полное имя объекта Function GetFullFigureName(aFigure: TFigure; x: Double=-1; y: Double=-1): string; function GetFullFigureLenName(aFigure: TFigure; x: Double=-1; y: Double=-1): string; // авто разрыв соединения соеднинения через с-п после удаления с-п Procedure AutoDisconnectOverRaiseInCAD(AConnector, ARaiseConnector: TConnectorObject; ARaiseLine: TOrthoLine); // редактирование условного обозначения Procedure EditBlockOnCAD(aActiveBlockStream, aProjectBlockStream: TMemoryStream); // функции переноса объекта на высоту основания/вершины // смена высот между РМ и РМ procedure RemoveRMWithRM(aRM1, aRM2: TConnectorObject); // смена высот между РМ и пустым соединителем procedure RemoveRMWithClear(aRM, aClear: TConnectorObject); // реверсировать вершину с-п (ТО) с основанием (пустой) procedure ReverseRaise(aPointObject: TConnectorObject); // проверить, что лист обычного типа function CheckListNormalType(aListID: Integer): Boolean; // вызвать схему проекта из НБ procedure CallProjectPlanFromNB; // Кабинеты ... // создать кабинет на КАДе procedure CreateCabinetOnCAD(aSCSID, aIndex: Integer); // удалить кабинет на КАДе procedure DeleteCabinetOnCAD(AID_List, aSCSID: Integer); // выделить кабинет на КАДе procedure ActivateCabinetOnCAD(AID_List, aSCSID: Integer); // убрать выделение с кабинета на КАДе procedure DeactivateCabinetOnCAD(AID_List, aSCSID: Integer); // найти кабинет по его ID function FindCabinetBySCSID(aList: TF_CAD; aSCSID: Integer): TFigure; // создать объект номер кабинета для кабинета на КАДе function CreateNumberObjectOnCAD(aCabinet: TFigure; aVisible: Boolean): TCabinetNumber; // изменить параметры кабинета procedure ChangeCabinetParams(AID_List: Integer; AObjectParams: TObjectParams); // установка видимости/невидимости номеров кабинетов procedure SetVisibleCabinetsNumbers(aVisible: Boolean); // установка видимости/невидимости границ кабинетов procedure SetVisibleCabinetsBounds(aVisible: Boolean); // получить кабинет в котором находится указанный объект function GetCabinetWhereObject(aObject: TFigure): TFigure; // получить кабинет в данной точке КАДа function GetCabinetAtPos(aX, aY: double; aCheckAllFigInside: boolean = True; aMovedFigure: TFigure = nil): TFigure; // переместить объекты на КАДе в кабинет при создании procedure MoveObjectsToCabinetOnCreate(aCabinet: TFigure); // переместить объекты на КАДе в кабинет при перемещении procedure MoveObjectsToCabinetOnMove(aCabinet: TFigure); // найти виртуальный кабинет function GetVirtualCabinet: TFigure; // показывать ли выноску (если она пустая то она не отображается) function IsNoteExist(aNoteObject: TFigureGrpNotMod): Boolean; // утилиты для удаления с-п после некоторых изменений в случаях когда они пустые и не присоединенные ... // проверить все с-п на КАДе procedure CheckDeleteAllRaises(aPCad: TPowerCad); // удалить данный с-п если это следует делать procedure CheckDeleteRaise(aRaiseLine: TOrthoLine); // проверка можно пустой и не нужный ли С/П function isRaiseEmptyAndNotNeed(aRaiseLine: TOrthoLine): boolean; // выделен ли объкт на КАДе function CheckCADObjectSelect(AID_List, AID_Object: Integer): Boolean; // выдать список всех путей от всех РМ на листе (для конфигуратора) function GetPointObjectsRelations(AID_List: Integer): TObjectList; // после изменения Mapscale на КАДе изененить данные всех измерительных линий Procedure ReScaleAllDimLines; // проверка, удален ли объект Function CheckObjectDeleted(AID_List, AID_Object: Integer): Boolean; // модификация подписи после смены типа подписи procedure ReverseCaptionAfterTypeChange(aLine: TOrthoLine; aOldType, aNewType: TShowKind); // установка типа размерных линий procedure SetDimLinesType(aType: TDimLinesType); // проверка на тип объекта Кросс АТС или РШ function CheckTrunkObject(aObject: TConnectorObject): Boolean; // создание дубликатов из цепи выделенных СКС объектов function CreateSCSObjectDuplicates(ACad: TF_CAD; aObjects: TList): TList; // получить привязанный коннектор для восстановления привязки после дублирования цепи function GetJoinedConnForDuplicate(aClearConns: TList; aParentDupID: Integer): TConnectorObject; // авто соединение интерфейсов после разделения трассы Procedure AutoConnectOverDivideLine(AConnDivider, AConnOther: TConnectorObject; ADividedLine, ANewLine: TOrthoLine); // авто рассоединение интерфейсов после слияния трассы Procedure AutoDisconnectOverDivideLine(AConn1, AConn2: TConnectorObject; ALine: TOrthoLine); // получить объекта на КАДе по ID в виде TObject function GetFigureObjectByID(aListID, aObjectID: Integer): TFigure; // установить новые ID для объектов procedure SetNewObjectsIDs(aObjects: TObjectList; aIDs: TIntList); // можно ли удалять объект с МП function CanDeleteObjectFromPM(aListID, aObjectID: Integer): Boolean; // установить все трассы в нужный режим отображения длины ... // установить всем трассам авто длинну procedure SetAllTracesAutoLength; // установить всем трассам пользовательскую длинну procedure SetAllTracesUserLength; // проверка объекта на имя класса function CheckFigureByClassName(aFigure: TFigure; const aClassName: string): Boolean; function CheckFigureByClassIdx(aFigure: TFigure; const aClassIdx: Integer): Boolean; // установка объекту присутствует или нет другой тип комплектующей procedure SetExistOtherObjectType(aListID, aObjectID: Integer; aExist: Boolean); // получение номера магистрали на кросс АТС для трассы (внешние СКС) function GetTrunkNumber(aLine: TOrthoLine): string; // Группировка выделенных СКС объектов function SCSGroupSelection: TSCSFigureGrp; // Группировка заданных СКС объектов function SCSGroupObjects(aObjects: TList): TSCSFigureGrp; // Разгруппировка СКС объектов Procedure SCSUngroupSelection; // залочен ли объект function IsLockedObject(aListID, aObjectID: Integer): Boolean; // рассоединение трасс procedure DisconnectTraces(aConn: TConnectorObject); // отсоединение ТО procedure DisconnectPointObject(aObject: TConnectorObject); // удаление всех трасс на листе procedure DeleteAllTraces; // удаление SCSFigureGrp procedure DeleteSCSFigureGrps(aListID: Integer); // проверить есть ли что то кроме группировки function CheckAnyButFigureGrp(aFiguresList: TList): Boolean; // применить процент размера УГО для объекта procedure ChangeDrawFigurePercentForObject(aObject: TConnectorObject; aPercent: Double); // применить процент размера УГО для трассы procedure ChangeDrawFigurePercentForLine(aLine: TOrthoLine; aPercent: Double); // отдать длинну трассы function GetTraceLength(aListID, aTraceID: Integer): Double; // закрыть форму КАДа procedure CloseCad(aListID: Integer); // установка режима наличия изменений в проекте procedure SetProjectChanged(aChanged: Boolean); // получить структуру параметров УГО объекта function GetFigureIconParams(aListID, aObjectID: Integer): TFigureIconParams; // утилита сортировки РМ для автотрассировки function GetSortedListForAutoTrace(aFiguresList: TList): TList; // получение УГО объекта по ID function GetObjectBlockbyID(aListID, aObjectID: Integer; aCanLoadIcons: Boolean): TObjectIconParams; // получение Stream УГО от обьекта function GetObjectBlockStream(aListID, aObjectID: Integer): TMemoryStream; // Установит УГО объекта в подложку function GetObjectBlockToSubstrateLayer(aListID, aObjectID: Integer): Boolean; // при автотрассировке окно порядка выбора подключений к панелям function ChoiceAutoTraceConnectOrder(AProjectSetting: PProjectSettingRecord = nil; AIsTracing: Boolean = true; ATraceCompon: TSCSComponent=nil; aFromDropConnObj: Boolean=false; aTracingFigInfo: Pointer=nil): Boolean; // убрать Шадоу со всем трасс procedure SkipAllLinesShadows(aForm: TF_CAD); // печать нескольких листов procedure PrintCADLists(aAllLists, aCheckedLists: TIntList); // авторазмещение трасс на высоту РМ мжду ними procedure AutoPosTracesBetweenRM(aConns, aTraces, aSnaps: TList); // авторазмещение трасс на высоту РМ мжду ними после всех привязок procedure AutoPosTracesBetweenRMAfterSnap(aTraces: TList); // установить высоту фальш-потолка для кабинета procedure SetCabinetFalseFloor(aCabinet: TFigure); // проверить все высоты кабинетов на предмет превышения высоты фальш потолка относительно высота этажа procedure CheckAllCabinetsFalseFloorHeights; // установить формат КАД листа procedure SetCadListFormat(aListFormat: TListFormatType); // установить высоту фальш-потолка для кабинета из МП procedure SetCabinetFalseFloorHeightFromPM(aListID, aCabinetID: Integer; aSettings: TRoomSettingRecord); // проверить изменялись ли какие то параметры листа function CheckListFormatChanged(aCad: TF_CAD; aListFormat: TListFormatType): Boolean; // восстоновление визибл/инвизибл для штампов и надписей рамки листа после загрузки procedure CorrectStampView; // если трасса горизонтальная function IfTraceHorizontal(aTrace: TOrthoLine): Boolean; // если трасса вертикальная function IfTraceVertical(aTrace: TOrthoLine): Boolean; // получение кол-ва м-э вершин у присоединенной к заданной трассе function GetRaiseCountConnectedToFigure(AIDList, AIDFigure: Integer): Integer; // переставить все высоты межэтажных подъемов после изменения высота этажа procedure SetAllBetweenFloorRaises; // сейчас идет создание трассы function IsNowTracingByUser: Boolean; // сейчас на КАДе нажата левая кнопка мыши //function IsMousedPressed: Boolean; // процедуры для сдвига УГО для обьектов и трасс // УГО объекта вверх procedure ObjectsShiftUp(aObjList: TList); // УГО объекта вниз procedure ObjectsShiftDown(aObjList: TList); // УГО объекта влево procedure ObjectsShiftLeft(aObjList: TList); // УГО объекта вправо procedure ObjectsShiftRight(aObjList: TList); // УГО трассы вверх procedure LinesShiftUp(aLinesList: TList); // УГО трассы вниз procedure LinesShiftDown(aLinesList: TList); // УГО трассы влево procedure LinesShiftLeft(aLinesList: TList); // УГО трассы вправо procedure LinesShiftRight(aLinesList: TList); // установка значения "Есть кабельный канал" procedure SetIsCableChannel(aListID, aLineID: Integer; aFlag: Boolean); // UNDO для проекта ... procedure SaveForProjectUndo(aLists: TList; aSavePM: Boolean; aIsProject: Boolean); // удалить всю цепочку Undo в связке с другими этажами procedure DeleteProjectUndoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction); // поднять всю цепочку UNdo в связке с другими этажами procedure LoadProjectUndoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction); // вызов сохранения листа или нескольких листов для Undo из Менеджера проектов procedure SaveForUndoFromPM(aListsIDs: TIntList; aIsProject: Boolean = False); // REDO для проекта ... procedure SaveForProjectRedo(aLists: TList; aSavePM: Boolean; aIsProject: Boolean); // удалить всю цепочку Undo в связке с другими этажами procedure DeleteProjectRedoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction); // поднять всю цепочку UNdo в связке с другими этажами procedure LoadProjectRedoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction); // вызов сохранения листа или нескольких листов для Undo из Менеджера проектов procedure SaveForRedoFromPM(aListsIDs: TIntList; aIsProject: Boolean = False); // получить ИД другого листа на котором связь с межэтажным function GetOtherListRelatedToFigure(AListID, AFigureID: Integer): Integer; // при перемещении и удалении проверить задействованы ли другие листы, выдать список листов function GetRelatedListsBySelected(aObjects: TList; aCheckBySelectedType: TCheckBySelectedType): TList; // проверить что это один из СКС слоев (2, 3, 4, 5, 6, 8, 9) function CheckOneOfSCSlayers(aLNbr: Integer): Boolean; // убрать выделение со всех СКС объектов на указанном листа procedure DeselectAllSCSObjectsInCAD(AListID: Integer); // убрать выделение со всех СКС объектов на всех листах procedure DeselectAllSCSObjectsInProject; // убрать выделение с неотрисованых объектов procedure DeselectNoDrawed(aPCAD: TPowerCad); // выделить группу объектов procedure SelectObjectsInCADByIDs(aListID: Integer; aObjectsID: TIntList); // получить интлист с выделенными объектами на КАДе function GetObjectsListWithSelectedInCAD(aListID: Integer): TIntList; // получение новостей function Get_News(ParentWin : THandle; gpid, gURL_p, gURL_a, gfil : string; func : byte; var timr :word): byte; // автоподгонка изображения под формат листа procedure ReScaleDrawingToListFormat(aOldListW, aOldListH: double); // создание виртуального кабинета на КАДе procedure CreateVirtualCabinetInCAD(vList: TF_CAD); // удаление дхф слоев procedure DeleteDxfLayers(aPCad: TPowerCad); // проверить что обьект находится на одном из ДХФ слоев function CheckFigureInDXFLayer(aFigure: TFigure): Boolean; // применить систему измерений procedure ApplyUOMForProject(aOldUOM, aNewUOM: Integer); // получить обозначение стригновое системы измерений function GetUOMString(aUOM: Integer): string; // перевести метры в текущую систему измерений function MetreToUOM(aValue: Double): Double; // перевести текущую систему измерений в метры function UOMToMetre(aValue: Double): Double; // обновить все длины трасс на всех листах после смены СИ procedure UpdateAllTracesLengthOnAllLists; // получить площать и объем кабинета в метрах function GetRoomSquare(AListID, ARoomID: Integer; RecalcSquare: Boolean = False): Double; //Tolik //function GetRoomVolume(AListID, ARoomID: Integer ): Double; function GetRoomVolume(AListID, ARoomID: Integer; ARoomSquare: Double): Double; // преобразование TList в TIntList и наоборот для списка листов КАДа function CadsToIntCads(aList: TList): TIntList; function IntCadsToCads(aIntList: TIntList): TList; function FiguresToIntFigures(aList: TList): TIntList; function IntFiguresToFigures(aIntList: TIntList): TList; // проверить есть ли м-э с-п на листе function CheckExistBetweenFloorOnList(aCad: TF_CAD): Boolean; // временная функция для ДХФ (есть ли TTEXT в блоке) function CheckTTextExistForDXF(aBlock: TBlock): Boolean; // ПОЛУЧИТЬ БМП с подложкой и арх. планом procedure SaveSubstrateArchPlan(aFileName: string); procedure ConvertBMPToJpeg(aBmp: TBitmap; aFileName: string); // Для Дома Procedure SelectHouseInCAD(AID_List, AID_Figure: Integer); Procedure SelectApproachInCAD(aListID, aHouseID, AComponID: Integer); procedure DeleteHouseOnCAD(aListID, AObjectID: Integer); procedure DeleteApproachOnCAD(aListID, aHouseID, AComponID: Integer); function GetIDElementFromComplexObjByTrace(AID_List, AIDComplexFigure, AIDTrace: Integer): Integer; function GetHouseByID(ACADForm: TF_CAD; AID_Figure: Integer): THouse; function GetApproachByComponID(ACADForm: TF_CAD; AID_Compon: Integer): TConnectorObject; function GetEndPointByHouse(aHouse: THouse; aCurrentWA: TConnectorObject): TConnectorObject; // From BaseCommon function GetConnectedTracesToConnetorByID(AIDList, AIDConnectorFigure: Integer): TIntList; // Получить список подсоединенных объетов // (AClearConnToRes = true) ? В результат попадут соединители трассы : подключенные трассы function GetConnectedFigures(AFigure: TFigure; AClearConnToRes: Boolean=false; ASkipList: TList=nil): TList; //#From Oleg# //15.09.2010 //24.07.2013 Вернет соединители с других сторон соединенніх страсс от соединителя function GetConnectorsOtherSides(aConnector: TConnectorObject): TList; procedure SetLineStatusInfo(aLineParams: PLineFigureParams); procedure SetConnStatusInfo(aConnParams: PConnFigureParams); procedure SetLiteStatus(aStatus: Boolean); procedure LoadSubWithMaster(aFName: string); procedure CreateVerticalOnConnector(aConnector: TConnectorObject; aHeight: Double); procedure CreateVerticalOnPointObject(aPointObject: TConnectorObject; aHeight: Double); // Tolik // вертикальная линия по двум точкам procedure CreateVerticalOnTwoPointObjects(aPointObject1, APointObject2: TConnectorObject; aHeight: Double); function CheckOtherConnectorsOnLevel(aSelf: TConnectorObject; X, Y: Double): TList; function CheckJoinVertical(aObject: TConnectorObject): Boolean; procedure PutObjectOnHeight(aObject: TConnectorObject; aHeight: Double); // Ищет список объектов по вертикали, подключенные через AObject function GetJoinedVerticalObjects(AObject: TFigure; AOnlyConnectorCoordZ: PDouble=nil): TList; //#From Oleg# //15.09.2010 function GetJoinedVerticalConnectorByCoordZ(AStartConnector: TConnectorObject; ACoordZ: Double): TConnectorObject; // Вернет номер слоя для компонента function GetCADLayerNumByComponIsLine(AIsLine: Integer): Integer; procedure DefineCurrLayerByCompon; procedure DropCreateObjectOnClickMode; // Для блоков procedure BlockToNormalSize(ABlock: TBlock; AMaxSideSize: Integer); procedure Remove3DModelStream; // Создает трассу с соединителями function CreateTraceByPoints(APCAD: TPowerCad; AP1, AP2: TDoublePoint; aPosTraceBetweenPM: boolean = false; aH1: double = 0; aH2: double = 0): TOrtholine; function CreateTraceByConnectors(aCAD: TF_CAD; aConn1, aConn2: TConnectorObject; aOrthogonally: Boolean=false; aTraceBetweenPM: Boolean = False): TOrtholine; // Разделить трассу в точке function DivTraceOnPt(ATrace: TOrtholine; APt: TDoublePoint; ATraceList: TList): TConnectorObject; // Вернет соединитель который ближе к началу координат function GetMinConnector(AConn1, AConn2: TConnectorObject): TConnectorObject; procedure ChangeObjZ(aObject: TConnectorObject; aZ: Double); // Создает трассы между точ.объектами function AutoCreateTraces(aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer; function AutoCreateTracesParallel(aSrcFigure: TFigure; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer; function AutoCreateTracesToTraceList(aTraces: TList; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer; function AutoCreateTracesMaster(aSrcFigure: TFigure): Boolean; function GetConnFiguresForAutoCreateTraces(aCad: TF_CAD; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): TList; // Разделяет трассы на стенах кабинетах procedure DivideTracesOnRoowWalls(aCad: TF_CAD); //15.03.2014 - Применить свойство "размер отрезка" procedure ApplySectionSideForTraces(aCad: TF_CAD); // Устанавливает точ.компоненты на трассы с шагом procedure SetConnComponToTraces(aCad: TF_CAD; ACompon: TSCSComponent; AStep: Double; ASetToConnectors: Boolean); procedure MirrorFigure(AFigure: TFigure); // Сдвигает объекты из списка procedure MoveFigures(AFigures: TList; x, y: Double); procedure RotateFigure(AFigure: TFigure; Angle: Double); procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor); // Длина дуги function GetArcLen(Radius, RadAngle: Double): Double; overload; function GetArcLen(CenterPoint, LinePoint: TDoublePoint; RadAngle: Double): Double; overload; function GetArcLenByPoints(p1, p2, ArcCenter: TDoublePoint; AInverted: Boolean): Double; function GetPolylineFromArc(ACornerCount: Integer; cp:TdoublePoint; radius, ArcAng: Double; p1, p2: PDoublePoint): TDoublePointArr; // Угол между линиями function GetLinesAngle(AP1, AP2, AP3, AP4: TDoublePoint): Double; function GetAreaFromPolygon3D(APoints: PDoublePointArr): Double; function GetPerimetrFromPolygon(APoints: PDoublePointArr): Double; procedure GetLinesNearPoints(ap1, ap2, bp1, bp2: PDoublePoint; var ap, bp: TDoublePoint); function IsConvexPolygon(APoints: PDoublePointArr; ALastPtInFirst: Boolean): Integer; function OverlapDoubleRects(const R1, R2: TDoubleRect): Boolean; function CorrectAngle(aAngle: Double; AStep: Integer=360): Double; function GetTextHeight(FontHandle: HWND; AFont: TFont): Double; procedure GetTextSize(AFontSize: Integer; AStyles: TFontStyles; const AFontName, AText: String; AStrings: TStrings; var h, w: Double; AStrH: Pointer=nil); function DefineFrameByPrinter(aRect: TDoubleRect): TDoubleRect; function RoundN(Num: Extended; Dig: integer): Extended;//Extended; Function CheckAssignedPCAD(aPcad: TPCDrawing): Boolean; // From Dimon ;) //Отсоединяем нужные нам соединения... Procedure ClearLineInterfaces(APointObject, AConnector: TConnectorObject; var CurrLine: TOrtholine; FindFreeInterfac: Boolean); //Проверяем, чтоб параметри былы одинаковыми Function CheckInterfacesSideSection(APointObject, AConnector: TConnectorObject; CurrLine: TOrtholine): Boolean; //Проверяем текущую Ортолинию на наличие свободных интерфейсов Function CheckCurrLine(CurrLineInterf: TSCSInterfaces; APointObject: TConnectorObject):Boolean; //Функция сравнивает параметры выбранного компонента из дерева с тем, что уже имеется на каде Function CheckComponentsForSideSection(CurrCompon: TSCSComponent):Boolean; //From Dimon ;) function GetMultipleFromNB:Boolean; //From Dimon ;) const {$IF Defined(SCS_PANDUIT) or Defined(SCS_PE)} urlSupport = 'http://cableproject.net/chat.php'; {$ELSE} urlSupport = 'http://support.expertsoft.com.ua/index/index/type/question'; {$IFEND} epsilon: Double = 0.000001; {$if Defined(ES_GRAPH_SC)} VersionEXE = '2.0.0'; {$else} //28.03.2011 VersionEXE = '1.5.7 alfa'; //16.03.2011 '1.5.6'; VersionEXE = '2.2.0'; //27.12.2011 '1.5.7'; {$ifend} {$IF Defined(SCS_RF) or Defined(SCS_PE) or Defined(SCS_SPA)} {$IF Defined(SCS_PE)} PROG_NEWSID = '-1'; SiteUrlNews = 'http://www.cableproject.net/'; {$ELSEIF Defined(SCS_SPA)} PROG_NEWSID = '-1'; SiteUrlNews = 'http://www.telcocad.net/'; {$ELSE} PROG_NEWSID = '-1'; SiteUrlNews = 'http://www.expertsoft.ru/'; {$IFEND} {$ELSE} {$IF Defined(TELECOM)} PROG_NEWSID = '22'; SiteUrlNews = 'http://www.expertsoft.com.ua/'; {$ELSE} {$if Defined(ES_GRAPH_SC)} PROG_NEWSID = '-1'; {$else} PROG_NEWSID = '3'; {$ifend} SiteUrlNews = 'http://www.expertsoft.com.ua/'; {$IFEND} {$IFEND} // форматы листов cA0x = 1189; cA0y = 841; cA1x = 841; cA1y = 594; cA2x = 594; cA2y = 421; cA3x = 421; cA3y = 297; cA4x = 297; cA4y = 210; cA5x = 210; cA5y = 148; cA6x = 105; cA6y = 74; cB4x = 353; cB4y = 250; cB5x = 250; cB5y = 176; cLetterx = 279; cLettery = 215; cTabloidx = 431; cTabloidy = 279; cSCSExpert = 120; cCADNoobAdd = 94; cCADNoob_PE = 840+cCADNoobAdd; cSCSNoob_PE = 240; cCADNoob_SCS = 940+cCADNoobAdd; cSCSNoob_SCS = 200; cCADNoob_TEL = 890+cCADNoobAdd; // Индексы классов ciOrthoLine = 01; ciConnectorObject = 02; ciTextMod = 03; ciFigureGrpMod = 04; ciFigureGrpNotMod = 05; ciFrame = 06; ciSCSHDimLine = 07; ciSCSVDimLine = 08; ciRichTextMod = 09; ciCabinet = 10; ciCabinetExt = 11; ciCabinetNumber = 12; ciPlanObject = 13; ciPlanConnector = 14; ciPlanTrace = 15; ciCadNorms = 16; ciSCSFigureGrp = 17; ciHouse = 18; ciApproach = 19; ciFigureGrp = 20; // Номера слоев lnSubstrate = 1; lnSCSCommon = 2; lnArch = 8; lnRoom = 9; // Направление сдвига объектов - shift direction sdUp = 1; sdDown = 2; sdLeft = 3; sdRight = 4; // Типы объектов рамки ftProjectName = 100; ftListName = 200; ftCodeName = 300; ftIndexName = 400; ftDeveloperName = 500; ftCheckerName = 600; //03.10.2012 ftMainEngineer = 700; ftApproved = 800; ftDesignStage = 900; ftOrgName = 1000; ftListDescription = 1100; ctFrameTypeCount = 11; ctCoordNearDelta = 0.8; //1.5; //23.04.2012 1.1; var GCheckAccessory: Boolean = False; GReadOnlyMode: Boolean = False; Newshandle : THandle; GNowRefresh: Boolean = False; // флаг обновления КАД при PCad.Refresh GExitProg: Boolean = False; // флаг выхода их приложения GTraceStatus: Boolean = False; // флаг статуса трассы (режим трейса/нормальный) GObjectStatus: Boolean = False; // флаг статуса РТ (режим трейса/нормальный) GIsLastShadowCleared: Boolean = False; // флаг был ли очищен последний Shadow при восстоновлении трассы GTraceNotMove: Boolean = False; // флаг был ли перемещен РТ в режиме трейса GNormalNotMove: Boolean = False; // флаг был ли перемещен РТ в норм. режиме GIsConnMoved: Boolean = False; // флаг РТ был перемещен GIsMousePressed: Boolean = False; // флаг левая кнопка мыши сейчас нажата GIsDrawShadow: Boolean = False; // флаг рисования Shadow на DragOver GReDrawAfterRefresh: Boolean = False; // флаг перерисовать Shadow трассы после обновления КАДа GIsProgress: Boolean = False; // флаг наличие прогресс-бара в данный момент GMoveWithRaise: Boolean = True; // флаг перемещать Рт вместе с с-п GAppMinim: Boolean = False; // флаг приложение минимизировано GAutoDelete: Boolean = False; // флаг - удалить объекты без вопросов // GWasDeleteQuery: Boolean = False; // флаг был ли выдан запрос на удаление объектов GCanDeleteFigures: Boolean = False; // флаг удалять ли объекты по запросу GMoveByArrow: Boolean = False; // флаг - перемещение курсором на клаве GIsProgressHandling: Boolean = False; // флаг прогресс-баг сейчас активен (на экране) GtmpIsRaise: Boolean = False; // сохр. свойства с-п или не с-п для текущей трассы GListRaiseWithErrors: Boolean = False; // флаг - лист был поднят с ошибками GDisableMove: Boolean = False; // запрещать все связанные перемещения (для сгруппированных) GMovedByLine: Boolean = False; // флаг, что перемещение идет через линию GMovedByOtherObject: Boolean = False; // флаг, что перемещение идет через другой объект GMovedBySelf: Boolean = False; // флаг, что перемещение идет через себя GProjectChanged: Boolean = False; // в текущем проекте были изменения GCanRefreshProperties: Boolean = True; // можно обновлять свойства на обработчике ShowCreateRaiseQuery: Boolean = True; // выдавать запрос на подтверждение создания м-э с-п GOrthoStatus: Boolean = False; // статус ортогональности по дефолту GLastClickOrtho: Boolean = False; // последний клик орто GNotNeedCheckRaisesBeforeClose: Boolean = False; // не проверять лист на наличие м-э с-п перед закрытием GPreview: Boolean = False; // запуск с превью, установить формат листа принудительно GCloseProg: Boolean = False; GDefaultAngle: Integer = 90; // угол ортогонального поворота трассы по дефолту GDefaultNum: Integer = 1; // кол-во линий в трассе по дефолту GClickIndex: Integer = 0; // кол-во кликов в режиме создания трассы GIsProgressCount: Integer = 0; // кол-во созданных прогресс-баров в цикле GSavedScrollPosX: Integer = -1; // сохр. позиция скролла по Х GSavedScrollPosY: Integer = -1; // сохр. позиция скролла по Х GSavedZoomScale: Integer = 100; // сохр. масштаб КАДа GSaveUndoCount: Integer = 1; // кол-во действий после которого следует делать слепок для Ctrl+Z GDefaultGap: Double = 4; // расстояние между линиями у мультилайна по дефолту GDraggedFigureZOrder: Double = -1; // высота создаваемого объекта из НБ в режиме DragOver GCurrShadowTraceX: Double = -1; // текущее положение по X линии в режиме ShadowTrace GCurrShadowTraceY: Double = -1; // текущее положение по Y линии в режиме ShadowTrace GRoomHeight: Double = 2.5; // высота комнаты по дефолту GFalseFloorHeight: Double = 0.15; // высота фальш-потолка по дефолту GConnHeight: Double = 0.3; // высота РТ по дефолту GLineHeight: Double = 2.35; // высота трасс по дефолту GAddDeltaX: Double = 0; // расстояние по X на которое был сдвинут курсор при клике на РТ (отнимаеться от deltax на Move) GAddDeltaY: Double = 0; // расстояние по Y на которое был сдвинут курсор при клике на РТ (отнимаеться от deltay на Move) GLastSurfaceMoveX: Double = 0; // последнее положение КАДа по Х при панорамировании GLastSurfaceMoveY: Double = 0; // последнее положение КАДа по Y при панорамировании // положение трассируемой линии ActualPoints[1] & ActualPoints[2] GLastTracedLinePoints1: TDoublePoint; GLastTracedLinePoints2: TDoublePoint; // начальное положение объекта перед трассированием GBeforeDragConnectorPoints: TDoublePoint; // ap для коннектора GBeforeDragOrthoLinesPoints1: TDoublePoint; // ap1 для трассы GBeforeDragOrthoLinesPoints2: TDoublePoint; // ap2 для трассы GOrthoLinePoints1: TDoublePoint; // сохр. точек ортолинии в Stream - ap1 GOrthoLinePoints2: TDoublePoint; // сохр. точек ортолинии в Stream - ap2 GConnectorPoints: TDoublePoint; // сохр. точки РТ в Stream GCurrMousePos: TDoublePoint; // текущее положение мыши на КАДе GMouseDownPos: TDoublePoint; // положение мыши на КАДе в момент клика GTempActualPoints: array of TDoublePoint; // сохр. массив точек для создания трассы GTempDrawFigureAP: array of TDoublePoint; // сохр. массив точек для DrawFigure объекта GGlobalShiftState: TShiftState; // состояние клавиш Shift, Ctrl, Alt на КАДе GCurrentConnectorType: TConnectorType; // текущий тип создаваемого коннектора SCSEngine: TSCSEngine = nil; // класс, для получения УГО из НБ для РТ и трасс GtmpObjectFromRaisedLine: TConnectorObject = nil; // сохр. Объект на основании от с-п GDeletedFromPMFigure: TFigure = nil; // удаленный из ПМ объект GPopupFigure: TFigure = nil; // текущая Popup фигура GFigureSnap: TFigure = nil; // текущий объект для привязывания GPrevFigureSnap: TFigure = nil; // предыдущий объект для привязывания GFigureTraceTo: TFigure = nil; // текущий объект для привязывания в режиме трейса CheckFigure: TFigure = nil; // фигура, найденная при клике или при дропе GPrevFigureTraceTo: TFigure = nil; // предыдущий объект для привязывания в режиме трейса GPropertiesObject: TFigure = nil; // текущая фигура для вызова свойств GShadowObject: TFigureGrpNotMod = nil; // Shadow для оотображения в режиме GLastConnector: TConnectorObject = nil; // последний модифицированный коннектор GEndPoint: TFigure = nil; // текущая конечная точка GRefreshCad: TPowerCad = nil; // КАД для вызова Refresh GCadForm: TF_CAD = nil; // указатель на текущий КАД GLastCadForm: TF_CAD = nil; // указатель на последний КАД GListWithEndPoint: TF_CAD = nil; // указатель на КАД на котором обозначена конечная точка GSaveNavigatorFigures: TList = nil; // лист с сохр. фигур Навигатора GTempJoinedOrtholinesList: TList = nil; // лист с сохр. привязанными орлиниями (для режима трейса) GTempJoinedConnectorsList: TList = nil; // лист с сохр. привязанными коннекторами (для режима трейса) GTempJoinedLinesConnectors: TList = nil; // лист с сохр. привязанными коннекторами через привязанную линию (для режима трейса) GSnapFiguresList: TList = nil; // сохр. список привязанных объектов в режиме создания линии GUndoList: TList = nil; // Undo лист для проекта GRedoList: TList = nil; // Redo лист для проекта GAutoTraceCount: integer; GMyLog: TStringList; Gt_matrix: boolean = false; GAutoAddCableAfterDragDrop: Boolean = false; GCableStartDrag: Boolean = False; GCurrentRoom3DView: TSCSComponent = nil; GSaved3DModelExist: Boolean = True; // *************************************************************************** GLiteVersion: Boolean = True; GUseLiteFunctional: Boolean = True; GAllowConvertInterfToUniversal: Boolean = False; GIfMasterUsed: Boolean = False; GSCStream: TMemoryStream; // 2011-05-10 G3DModelForProject: Boolean = False; {$IF Defined(ES_GRAPH_SC)} GUseArhOnlyMode: Boolean = True; {$ELSE} GUseArhOnlyMode: Boolean = False; {$IFEND} // *************************************************************************** GAllowExternalListCoordZ: Boolean = true; //22.08.2012 false - позволять использовать разные высоты объектов на распределительном листе GRaizeDownKoeff: Double = 4; //************* Hot Keys ********************* hkCtrlN, hkCtrlL, hkCtrlO, hkCtrlF4, hkCtrlS, hkCtrlP, hkCtrlE, hkF1, hkCtrlM, hkCtrlB, hkCtrlG, hkADD, hkSUBTRACT, hkCtrlF1, hkCtrlD, hkCtrlDIVIDE, hkCtrlSUBTRACT, hkCtrlDECIMAL, hkCtrl4, hkCtrlShiftO, hkCtrlShiftS, hkCtrlShiftN: word; // Зарегистрировать с целью блокировки ! (на КАДе) hkCtrlZ, hkCtrlY, hkCtrlX, hkCtrlC, hkCtrlV: word; //******************************************** GTestCopyMode: TCopyMode = cmSrcCopy; implementation uses USCS_Main, Menus, U_main, U_MasterNewList, U_MasterNewListLite, U_AutoTraceType, U_Layers, FPlan, U_SCSObjectsProp, cxMemo, U_ChooseComponTypes, U_EndPoints, U_TrunkSCS, U_Constants, U_ChooseDesignBoxParams, U_AutoTraceConnectOrder, U_Protection, cxCheckBox, U_PrintLists, U_ArchCommon, U_ImportDXF, U_ProtectionCommon, U_InputRadio, U_BaseConstants, cxSpinEdit, Printers, PCPanel, U_InputMark, U_PEAutotraceDialog; function RoundN(Num: Extended; Dig: integer): Extended;//Extended; var Fakt: Extended; Vrem: Extended; pw: Extended; begin // SetPrecisionMode(pmExtended); // Set8087CW(Default8087CW); if false then begin if Dig < 5 then begin Num := Num * 1000000; Num := Trunc(Num)+0.0000000; // trunc returns Int64, so we must made extended Num := Num / 1000000; end; end; pw := Power(10, Dig); try // при ничтожно малых значениях типа 1Е+4000 возникает ошибка Fakt := Frac(Num); except Fakt := 0; end; Fakt := pw * Fakt; try // при ничтожно малых значениях типа 1Е+4000 возникает ошибка Vrem := Frac(Fakt); except Vrem := 0; end; Fakt := Int(Fakt); if (Vrem - 0.5) >= -epsilon then Fakt := Fakt + 1 else if (Vrem + 0.5) <= -epsilon then Fakt := Fakt - 1; try Result := Int(Num) + Fakt/pw; except Result := Int(Num); end; end; Function CheckAssignedPCAD(aPcad: TPCDrawing): Boolean; begin Result := false; if (aPcad.Owner <> nil) and (aPcad.Owner is TF_Cad) and( TF_Cad(aPcad.Owner).FCheckedFigures <> nil) then begin Result := True; end; end; // картинка на конектор function GetConnectorImg(aOT: TConnectorType): TFigureGrpMod; begin Result := nil; try Result := SCSEngine.GetConnectorImg(aOT); except on E: Exception do addExceptionToLogEx('U_Common.GetConnectorImg', E.Message); end; end; function GetOrthoLineImg(aOT: TOrthoLineType): TFigureGrpMod; begin Result := nil; try Result := SCSEngine.GetOrthoLineImg(aOT); except on E: Exception do addExceptionToLogEx('U_Common.GetOrthoLineImg', E.Message); end; end; // процедура для установки параметров нового CAD по умолчанию procedure SetDefaultPageParams; begin try //// задать параметры по умолчанию для CAD FSCS_Main.a100.Execute; // вид - 100% FSCS_Main.apsSolid.Execute; // Стиль линии - сплошная FSCS_Main.aPenw1.Execute; // Ширина линии - 1 FSCS_Main.arsNone.Execute; // Стиль стрелки - нет FSCS_Main.absClear.Execute; // Стиль заливки - очистка FSCS_Main.aDEFAULT_CHARSET.Execute; // Набор символов - DEFAULT FSCS_Main.aTextFont.Execute; // Шрифт - MS Sans Serif FSCS_Main.aTextSize.Execute; // Размер шрифта - 8 FSCS_Main.aLineGrid.Execute; // Тип сетки - линейная FSCS_Main.aAngularNone.Execute; // Направляющие под углом - нет // FSCS_Main.aMetric.Execute; // Система линейки - метровая FSCS_Main.aWorldMode.Execute; // Режим линейки - реальная FSCS_Main.aSetDefaultColors.Execute; // Установка цвета для: // Цвет линии - черный // Цвет заливки - черный // Цвет текста - черный // Цвет сетки - серый // Цвет направляющих - зеленый // Цвет фона - серый // Цвет листа - белый except on E: Exception do addExceptionToLogEx('U_Common.SetDefaultPageParams', E.Message); end; end; Procedure ReturnListParams; var SavedProjectChanged: Boolean; begin SavedProjectChanged := GProjectChanged; try FSCS_Main.aA0.Checked := False; FSCS_Main.aA1.Checked := False; FSCS_Main.aA2.Checked := False; FSCS_Main.aA3.Checked := False; FSCS_Main.aA4.Checked := False; FSCS_Main.aA5.Checked := False; FSCS_Main.aA6.Checked := False; FSCS_Main.aB4.Checked := False; FSCS_Main.aB5.Checked := False; FSCS_Main.aTabloid.Checked := False; FSCS_Main.aLetter.Checked := False; FSCS_Main.aCustom.Checked := False; FSCS_Main.aPortrait.Checked := False; FSCS_Main.aLandscape.Checked := False; // Размер страницы if GCadForm.PCad.PageLayout = plA0 then FSCS_Main.aA0.Checked := True; if GCadForm.PCad.PageLayout = plA1 then FSCS_Main.aA1.Checked := True; if GCadForm.PCad.PageLayout = plA2 then FSCS_Main.aA2.Checked := True; if GCadForm.PCad.PageLayout = plA3 then FSCS_Main.aA3.Checked := True; if GCadForm.PCad.PageLayout = plA4 then FSCS_Main.aA4.Checked := True; if GCadForm.PCad.PageLayout = plA5 then FSCS_Main.aA5.Checked := True; if GCadForm.PCad.PageLayout = plA6 then FSCS_Main.aA6.Checked := True; if GCadForm.PCad.PageLayout = plB4 then FSCS_Main.aB4.Checked := True; if GCadForm.PCad.PageLayout = plB5 then FSCS_Main.aB5.Checked := True; if GCadForm.PCad.PageLayout = plTabloid then FSCS_Main.aTabloid.Checked := True; if GCadForm.PCad.PageLayout = plLetter then FSCS_Main.aLetter.Checked := True; if GCadForm.PCad.PageLayout = plCustom then FSCS_Main.aCustom.Checked := True; // Ориентация страницы if GCadForm.PCad.PageOrient = PCTypesUtils.poPortrait then FSCS_Main.aPortrait.Checked := True; if GCadForm.PCad.PageOrient = PCTypesUtils.poLandscape then FSCS_Main.aLandscape.Checked := True; if FSCS_Main.ActiveMDIChild <> nil then begin // Система линейки if GCadForm.PCad.RulerSystem = rsMetric then FSCS_Main.aMetric.Execute; if GCadForm.PCad.RulerSystem = rsWhitworth then FSCS_Main.aWitworth.Execute; // Режим линейки if GCadForm.PCad.RulerMode = rmPage then FSCS_Main.aPageMode.Execute; if GCadForm.PCad.RulerMode = rmWorld then FSCS_Main.aWorldMode.Execute; // Тип сетки if GCadForm.PCad.GridType = grtLine then FSCS_Main.aLineGrid.Execute; if GCadForm.PCad.GridType = grtCross then FSCS_Main.aCrossGrid.Execute; if GCadForm.PCad.GridType = grtPoint then FSCS_Main.aPointGrid.Execute; // Направляющие под углом if GCadForm.PCad.GuideTrace = gtNone then FSCS_Main.aAngularNone.Execute; if GCadForm.PCad.GuideTrace = gtThirty then FSCS_Main.aAngular30.Execute; if GCadForm.PCad.GuideTrace = gtFortyfive then FSCS_Main.aAngular45.Execute; if GCadForm.PCad.GuideTrace = gtSixty then FSCS_Main.aAngular60.Execute; if GCadForm.PCad.GuideTrace = gtNinty then FSCS_Main.aAngular90.Execute; end; // Переподнять флаги // показывать линейки FSCS_Main.aShowRuler.Checked := GCadForm.PCad.RulerVisible; GCadForm.tbShowRuler.Down := GCadForm.PCad.RulerVisible; // показывать сетку FSCS_Main.aShowGrid.Checked := GCadForm.PCad.Grids; GCadForm.tbShowGrid.Down := GCadForm.PCad.Grids; // показывать центр. направляющие FSCS_Main.aShowCenterGuides.Checked := GCadForm.PCad.CenterGuide; // показывать направляющие FSCS_Main.aShowGuideLines.Checked := GCadForm.PCad.GuidesVisible; GCadForm.tbShowGuides.Down := GCadForm.PCad.GuidesVisible; // привязка к сетке FSCS_Main.aSnaptoGrid.Checked := GCadForm.PCad.SnapToGrids; GCadForm.tbSnapGrid.Down := GCadForm.PCad.SnapToGrids; GCadForm.LastSnapGridStatus := GCadForm.PCad.SnapToGrids; // привязка к направляющим FSCS_Main.aSnaptoGuides.Checked := GCadForm.PCad.SnapToGuides; GCadForm.tbSnapGuides.Down := GCadForm.PCad.SnapToGuides; // привязка к ближ. объекту FSCS_Main.aSnaptoNearObject.Checked := GCadForm.PCad.SnapToNearPoint; GCadForm.tbSnapNearObject.Down := GCadForm.PCad.SnapToNearPoint; // Переподнять флаги !!! FSCS_Main.aAutoSelectTrace.Checked := GCadForm.FAutoSelectTrace; // GCadForm.tbAutoSelectTrace.Down := GCadForm.FAutoSelectTrace; FSCS_Main.aShowTracesLengthLimit.Checked := GCadForm.FShowTracesLengthLimit; GCadForm.tbShowTracesLengthLimit.Down := GCadForm.FShowTracesLengthLimit; FSCS_Main.aShowConnFullness.Checked := GCadForm.FShowConnFullness; GCadForm.tbShowConnFullness.Down := GCadForm.FShowConnFullness; FSCS_Main.aShowCableFullness.Checked := GCadForm.FShowCableFullness; GCadForm.tbShowCableFullness.Down := GCadForm.FShowCableFullness; FSCS_Main.aShowCableChannelFullness.Checked := GCadForm.FShowCableChannelFullness; GCadForm.tbShowCableChannelFullness.Down := GCadForm.FShowCableChannelFullness; FSCS_Main.aNoMoveConnectedObjects.Checked := GCadForm.FNoMoveConnectedObjects; GCadForm.tbNoMoveConnectedObjects.Down := GCadForm.FNoMoveConnectedObjects; except on E: Exception do addExceptionToLogEx('U_Common.ReturnListParams', E.Message); end; GProjectChanged := SavedProjectChanged; end; Function GetComponentFromNormBase(X, Y: Double; NB_Component: TSCSComponent; ASnapFigure: TFigure; CompStateType: TCompStateType): TFigure; var PointObject: TConnectorObject; ClearObject1: TConnectorObject; ClearObject2: TConnectorObject; LineObject: TOrthoLine; LineLength: Double; PropCount: integer; LHandle: integer; Prop: PProperty; GetCoords: TDoublePoint; Z: Double; //Tolik vx, vy, vz, xx1, xx2, yy1, yy2, zz1, zz2, TempZ : Double; SprComponentType: TNBComponentType; // вычисляет Z - координату "падения" точечного компонента на наклонную линию, // если координаты X, Y - известны Function GetCoordZ(ASnapFigure: TFigure; CoordX, CoordY: Double): Double; Var vx, vy, vz, xx1, xx2, yy1, yy2, zz1, zz2, TempZ : Double; Begin Result := 0; //первая точка прямой xx1 := RounDX(TOrthoLine(ASnapFigure).JoinConnector1.ActualPoints[1].x,2); yy1 := RounDX(TOrthoLine(ASnapFigure).JoinConnector1.ActualPoints[1].y,2); zz1 := RounDX(TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector1).ActualZOrder[1],2); //вторая точка прямой xx2 := RounDX(TOrthoLine(ASnapFigure).JoinConnector2.ActualPoints[1].x,2); yy2 := RounDX(TOrthoLine(ASnapFigure).JoinConnector2.ActualPoints[1].y,2); zz2 := RounDX(TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector2).ActualZOrder[1],2); // направляющий вектор для прямой (координаты) vx := xx2 - xx1; vy := yy2 - yy1; vz := zz2 - zz1; if (vx <> 0) then begin Result := Roundx(((CoordX - xx1)/vx)*vz + zz1, 2); end else begin if (vy <> 0) then Result := RoundX(((CoordY - yy1)/vy)*vz + zz1, 2); end; End; // begin Result := nil; try //29.06.2010 GCadForm.CurrentLayer := 2; GCadForm.CurrentLayer := GetCADLayerNumByComponIsLine(NB_Component.IsLine); LHandle := GCadForm.PCad.GetLayerHandle(GCadForm.PCad.ActiveLayer); Result := nil; if NB_Component <> Nil then begin // если точечный обьект (коннектор) if NB_Component.IsLine = 0 then begin if CheckFigureByClassName(ASnapFigure, cTConnectorObject) and (TConnectorObject(ASnapFigure).ConnectorType <> ct_Clear) then begin Result := nil; end else begin GCurrentConnectorType := ct_NB; if (ASnapFigure <> nil) and CheckFigureByClassName(ASnapFigure, cTConnectorObject) then begin X := TConnectorObject(ASnapFigure).ActualPoints[1].x; Y := TConnectorObject(ASnapFigure).ActualPoints[1].y; end else if ASnapFigure = Nil then begin //if GCadForm.PCad.SnapToGrids then // привязка к направляющим if (GCadForm.PCad.SnapToGuides)or(GCadForm.PCad.SnapToGrids) then begin GetCoords := GetCoordsWithSnapToGrid(X, Y); X := GetCoords.x; Y := GetCoords.y; end; end; //Tolik // if Z = 0 then // Z := GCadForm.FConnHeight; Z := 0; TempZ := 0; if NB_Component.GetPropertyBySysName(pnHeightOfPlacing) <> nil then Z := NB_Component.GetPropertyValueAsFloat(pnHeightOfPlacing); // высота размещения не задана if NB_Component.GetPropertyBySysName(pnHeightOfPlacing) = nil then begin // автоприменение высот включено if F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.UseComponTypeHeights then begin SprComponentType := nil; SprComponentType := F_ProjMan.GSCSBase.CurrProject.CurrList.Spravochnik.GetComponentTypeByGUID(NB_Component.GUIDComponentType); if SprComponentType <> nil then begin // если задана высота размещения объектов данного типа, то берем высоту там if SprComponentType.ComponentType.CoordZ <> -1 then begin Z := SprComponentType.ComponentType.CoordZ; end else // если не задана высота размещения объектов данного типа, то размещаем на высоте точечных по листу begin Z := GCadForm.FConnHeight; end; end; TempZ := 0; end // автоприменение высот выключено else begin // на пустое место if ASnapFigure = nil then begin z:= 0; end else begin // на линию if ASnapFigure.ClassName = 'TOrthoLine' then begin // если линия не наклонная (высоты начала и конца сходятся) if TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector1).ActualzOrder[1] = TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector2).ActualzOrder[1] then begin Z := Tortholine(ASnapFigure).ActualZOrder[1]; end else // линия наклонная, вычисляем высоту begin Z := GetCoordZ(ASnapFigure, X, Y); end; end; // на коннектор if ASnapFigure.ClassName = 'TConnectorObject' then begin Z := TConnectorObject(ASnapFigure).ActualZOrder[1]; end; TempZ := 999; end; end; end; // высота размещения задана if NB_Component.GetPropertyBySysName(pnHeightOfPlacing) <> nil then begin if z = 999 then begin // на пустое место if ASnapFigure = nil then begin // на высоту линейных по листу Z := GCadForm.FLineHeight; end else begin // на линию if ASnapFigure.ClassName = 'TOrthoLine' then begin // если линия не наклонная (высоты начала и конца сходятся) if TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector1).ActualzOrder[1] = TConnectorObject(TOrthoLine(ASnapFigure).JoinConnector2).ActualzOrder[1] then begin Z := Tortholine(ASnapFigure).ActualZOrder[1]; end else // линия наклонная, вычисляем высоту begin Z := GetCoordZ(ASnapFigure, X, Y); end; end; // на коннектор if ASnapFigure.ClassName = 'TConnectorObject' then begin Z := TConnectorObject(ASnapFigure).ActualZOrder[1]; end; end; TempZ := 999; end else TempZ := 0; end; PointObject := TConnectorObject.Create(X, Y, Z, LHandle, mydsNormal, GCadForm.PCad); //Tolik // если Z = 999 или не задана высота размещения - нужно будет посадить объект на трассу, // не создавая спуска-подъема, потому заюзаем свойство радиуса, для передачи параметра чтобы дяльше его "увидеть" if TempZ = 999 then PointObject.Radius := 999 + 11000000; if ASnapFigure <> nil then begin if ASnapFigure.ClassName = 'TOrthoLine' then begin if TOrthoLine(ASnapFigure).ActualZOrder[1] <> TOrthoLine(ASnapFigure).ActualZOrder[2] then { PointObject.Urc := -1;} end; end; PointObject.ConnectorType := GCurrentConnectorType; GCadForm.PCad.AddCustomFigure (GLN(LHandle), PointObject, False); Result := TFigure(PointObject); end; end else // если линейный обьект (ортолиния) if NB_Component.IsLine = 1 then //29.06.2010 if NB_Component.IsLine <> 0 then begin // НЕ создавать линию так как она вливаеться в трассу!!! end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetComponentFromNormBase', E.Message); end; end; Function FindAutoSnapObject(X, Y: Double; NB_Component: TSCSComponent): TFigure; var FindFigure: TFigure; RaiseConn: TConnectorObject; begin Result := Nil; try //07.06.2010 GCadForm.CurrentLayer := 2; GCadForm.CurrentLayer := GetCADLayerNumByComponIsLine(NB_Component.IsLine); //Result := Nil; // тянеться конектор if NB_Component.IsLine = 0 then begin try FindFigure := CheckBySCSObjects(X, Y); except FindFigure := nil; end; if FindFigure <> Nil then begin if CheckFigureByClassName(FindFigure, cTConnectorObject) then begin // Check FindFigure On Connector if (TConnectorObject(FindFigure).ConnectorType = ct_Clear) and (TConnectorObject(FindFigure).JoinedConnectorsList.Count > 0) then Result := nil else Result := FindFigure; if (TConnectorObject(FindFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FindFigure).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(FindFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FindFigure).FConnRaiseType = crt_TrunkDown) then Result := Nil; if not GCadForm.FShowRaise then if TConnectorObject(FindFigure).FConnRaiseType = crt_OnFloor then Result := Nil; end else if CheckFigureByClassName(FindFigure, cTOrthoLine) then begin if not TOrthoLine(FindFigure).FIsRaiseUpDown then begin if not TOrthoLine(FindFigure).FConnectingLine then Result := FindFigure else Result := Nil; end else Result := Nil; end; end; end; // тянеться ортолиния if NB_Component.IsLine = 1 then begin try FindFigure := CheckBySCSObjects(X, Y); except FindFigure := nil; end; if FindFigure <> Nil then begin if CheckFigureByClassName(FindFigure, cTOrthoLine) then begin if GCadForm.FPutCableOnTrace then Result := FindFigure else Result := nil; end else if CheckFigureByClassName(FindFigure, cTConnectorObject) then begin if (TConnectorObject(FindFigure).ConnectorType = ct_Clear) and (TConnectorObject(FindFigure).JoinedConnectorsList.Count > 0) then Result := nil else Result := FindFigure; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.FindAutoSnapObject', E.Message); end; end; // УСТАНОВКА НОВОГО ИМЕНИ ОБЬЕКТА В CAD-e Procedure SetNewObjectNameInCad(AID_List, AID_Figure: Integer; AOldObjName, ANewObjName: String); var i: integer; vList: TF_CAD; CadFigure: TFigure; SavedCadForm: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin CadFigure := GetFigureByID(vList, AID_Figure); if CadFigure <> nil then begin CadFigure.Name := ANewObjName; if CheckFigureByClassName(CadFigure, cTConnectorObject) then begin if not TConnectorObject(CadFigure).FIsNameChanged then begin SavedCadForm := GCadForm; GCadForm := vList; SetConnNameInCaptionOnCAD(TConnectorObject(CadFigure)); GCadForm := SavedCadForm; end; RefreshCAD(vList.PCad); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetNewObjectNameInCad', E.Message); end; end; // УДАЛИТЬ ОБЬЕКТ ИЗ CAD (ПРИ УДАЛЕНИИ ЕГО ИЗ МП) Procedure DeleteObjectFromCad(AID_List, AID_Figure: Integer; AObjName: String); var FList: TF_CAD; i: integer; DelFigure: TFigure; SCSFigureGrp: TSCSFigureGrp; SavedCadList: TF_CAD; begin try FList := GetListByID(AID_List); if FList <> nil then begin DelFigure := GetFigureByID(FList, AID_Figure); // на КАДе if DelFigure <> nil then begin SavedCadList := GCadForm; GCadForm := FList; GDeletedFromPMFigure := DelFigure; if CheckFigureByClassName(DelFigure, cTConnectorObject) then TConnectorObject(DelFigure).Delete(True) else if CheckFigureByClassName(DelFigure, cTOrthoLine) then TOrthoLine(DelFigure).Delete else if CheckFigureByClassName(DelFigure, cTHouse) then THouse(DelFigure).Delete else if CheckFigureByClassName(DelFigure, cTCabinet) then TCabinet(DelFigure).Delete else if CheckFigureByClassName(DelFigure, cTCabinetExt) then TCabinetExt(DelFigure).Delete; GDeletedFromPMFigure := Nil; RefreshCAD(FList.PCad); GCadForm := SavedCadList; end else // в группе begin SCSFigureGrp := GetSCSFigureGrp(FList, AID_Figure); if SCSFigureGrp <> nil then begin DelFigure := GetFigureByIDInSCSFigureGrp(SCSFigureGrp, AID_Figure); if DelFigure <> nil then begin SavedCadList := GCadForm; GCadForm := FList; GDeletedFromPMFigure := DelFigure; DeleteObjectFromSCSFigureGrp(SCSFigureGrp, DelFigure); GCadForm := SavedCadList; end end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.DeleteObjectFromCad', E.Message); end; end; Procedure DeleteObjectFromSCSFigureGrp(ASCSFigureGrp: TSCSFigureGrp; AObjects: TFigure); var i: integer; GrpList: TList; begin try // разгруппировать, чтобы удалить GrpList := TList.Create; for i := 0 to ASCSFigureGrp.InFigures.Count - 1 do GrpList.Add(TFigure(ASCSFigureGrp.InFigures[i])); ASCSFigureGrp.UnGroup; GCadForm.PCad.Figures.Remove(ASCSFigureGrp); RefreshCAD(GCadForm.PCad); // if CheckFigureByClassName(AObjects, cTConnectorObject) then TConnectorObject(AObjects).Delete(True) else if CheckFigureByClassName(AObjects, cTOrthoLine) then TOrthoLine(AObjects).Delete; GDeletedFromPMFigure := Nil; RefreshCAD(GCadForm.PCad); // сгруппировать назад SCSGroupObjects(GrpList); FreeAndNil(GrpList); except on E: Exception do addExceptionToLogEx('U_Common.DeleteObjectFromSCSFigureGrp', E.Message); end; end; // ОТКРЫТЫЙ ОБЬЕКТ В МП ВЫДЕЛИТЬ НА CAD-е Procedure SelectObjectInCAD(AID_List, AID_Figure: Integer; AObjName: String); var i: integer; LHandle: Integer; ActLayer: Integer; vList: TF_CAD; CADFigure: TFigure; begin try vList := GetListByID(AID_List); if vList <> nil then begin vList.PCad.DeselectAll(0); CADFigure := GetFigureByID(vList, AID_Figure); if CADFigure <> nil then begin if (not CADFigure.LockSelect) and (vList.PCad.ActiveLayer = 2) then begin GCanRefreshProperties := True; if vList.CurrentLayer <> 2 then vList.CurrentLayer := 2; CADFigure.Select; RefreshCAD(vList.PCad); vList.SetZoomScale(vList.PCad.ZoomScale + 0); RefreshCAD(vList.PCad); //GetSCSComponByCADObj(CADFigure); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SelectObjectInCAD', E.Message); end; end; procedure FigureBringToFront(AFigure: TFigure); var CurrIndex: integer; begin if (AFigure.Owner <> nil) and (AFigure.Owner is TPCDrawing) then begin CurrIndex := TPCDrawing(AFigure.Owner).Figures.IndexOf(AFigure); if CurrIndex <> -1 then TPCDrawing(AFigure.Owner).Figures.Move(CurrIndex, TPCDrawing(AFigure.Owner).Figures.Count-1); end; end; procedure FigureSendToBack(AFigure: TFigure); var CurrIndex: integer; begin if (AFigure.Owner <> nil) and (AFigure.Owner is TPCDrawing) then begin CurrIndex := TPCDrawing(AFigure.Owner).Figures.IndexOf(AFigure); if CurrIndex <> -1 then TPCDrawing(AFigure.Owner).Figures.Move(CurrIndex, 0); end; end; procedure SetConnObjectSelectHightPriority(AFigure: TConnectorObject); begin if AFigure.FBlockGUID = '' then FigureBringToFront(AFigure); end; Procedure SelectHouseInCAD(AID_List, AID_Figure: Integer); var i: integer; LHandle: Integer; ActLayer: Integer; vList: TF_CAD; House: TFigure; begin try vList := GetListByID(AID_List); if vList <> nil then begin vList.PCad.DeselectAll(0); House := GetHouseByID(vList, AID_Figure); if House <> nil then begin if (not House.LockSelect) and (vList.PCad.ActiveLayer = 2) then begin GCanRefreshProperties := True; if vList.CurrentLayer <> 2 then vList.CurrentLayer := 2; House.Select; RefreshCAD(vList.PCad); vList.SetZoomScale(vList.PCad.ZoomScale + 0); RefreshCAD(vList.PCad); end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.SelectHouseInCAD', E.Message); end; end; Procedure SelectApproachInCAD(aListID, aHouseID, AComponID: Integer); var i: integer; LHandle: Integer; ActLayer: Integer; vList: TF_CAD; House: THouse; Approach: TConnectorObject; begin try vList := GetListByID(aListID); if vList <> nil then begin vList.PCad.DeselectAll(0); Approach := GetApproachByComponID(vList, AComponID); if Approach <> nil then begin if (not Approach.LockSelect) and (vList.PCad.ActiveLayer = 2) then begin GCanRefreshProperties := True; if vList.CurrentLayer <> 2 then vList.CurrentLayer := 2; Approach.Select; RefreshCAD(vList.PCad); vList.SetZoomScale(vList.PCad.ZoomScale + 0); RefreshCAD(vList.PCad); end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.SelectApproachInCAD', E.Message); end; end; // ПРИ ПЕРЕКЛЮЧЕНИИ ЛИСТА В МП ПЕРЕКЛЮЧИТЬ ЕГО НА CAD-е Procedure SwitchListInCAD(AID_List: Integer; const ListName: String); var i: integer; OldList: TF_CAD; OldListAutoRefresh: Boolean; vList: TF_CAD; vListAutoRefresh: Boolean; begin try vList := GetListByID(AID_List); if vList <> nil then begin OldList := nil; if GCadForm <> vList then OldList := GCadForm; //vList.DisableAlign; //vList.PCad.DisableAlign; vListAutoRefresh := vList.PCad.AutoRefresh; vList.PCad.AutoRefresh := false; vList.PCad.Locked := true; vList.PCad.BeginUpdate; if OldList <> nil then begin OldList.PCad.BeginUpdate; OldListAutoRefresh := OldList.PCad.AutoRefresh; OldList.PCad.AutoRefresh := false; OldList.PCad.Locked := true; end; try vList.BringToFront; finally //vList.PCad.EnableAlign; vList.PCad.Locked := false; vList.PCad.AutoRefresh := vListAutoRefresh; //vList.EnableAlign; vList.PCad.EndUpdate; if OldList <> nil then begin OldList.PCad.Locked := false; OldList.PCad.EndUpdate(false); OldList.PCad.AutoRefresh := OldListAutoRefresh; end; vList.OnResize(vList); end; if vList.WindowState <> wsMaximized then vList.WindowState := wsMaximized; //vList.PCad.ResetRegions; end; except on E: Exception do addExceptionToLogEx('U_Common.SwitchListInCAD', E.Message); end; end; // ПРИ ПЕРЕИМЕНОВАНИИ ЛИСТА В МП ПЕРЕИМЕНОВАТЬ ЕГО НА CAD-е Procedure RenameListInCAD(AID_List: Integer; const OldListName, NewListName: String; AOldListParams: PListParams; ARenameOnFrame: Boolean=true); var i, j: integer; GetTag: integer; vList: TF_CAD; // 2011-05-10 fullname: string; begin try vList := GetListByID(AID_List); if vList <> nil then begin // изменить название самого листа // 2011-05-10 fullname := NewListName; //02.04.2013 AOldListParams^.Name + ' ' + IntToStr(AOldListParams^.MarkID); vList.FCADListName := NewListName; //02.04.2013 AOldListParams^.Name;//NewListName; vList.Caption := fullname; GetTag := vList.Tag; // изменить название в переключателе листов for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do begin if FSCS_Main.pageCADList.Pages[j].Tag = GetTag then begin // 2011-05-10 FSCS_Main.pageCADList.Pages[j].Caption := fullname; break; end; end; // изменить название в меню листов for j := 0 to FSCS_Main.mainWindow.Count - 1 do begin if FSCS_Main.mainWindow.Items[j].Tag = GetTag then begin // 2011-05-10 FSCS_Main.mainWindow.Items[j].Caption := fullname; break; end; end; // RenameListOnFrame(vList); // 2011-05-10 if ARenameOnFrame and Assigned(AOldListParams) then RenameListOnFrame(vList, GetCurrProjectParams(false), AOldListParams^); end; except on E: Exception do addExceptionToLogEx('U_Common.RenameListInCAD', E.Message); end; end; // ПРИ УДАЛЕНИИ ЛИСТА В МП УДАЛИТЬ ЕГО НА CAD-е Procedure DeleteListInCAD(AID_List: Integer; ListName: String); var i: integer; BoxID: Integer; BoxListID: Integer; BoxObject: TConnectorObject; BoxListObject: TF_CAD; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin if vList.FListType = lt_DesignBox then begin BoxID := vList.FJoinedBoxIDForDesignList; BoxListID := vList.FJoinedListIDForDesignList; BoxListObject := GetListByID(BoxListID); BoxObject := TConnectorObject(GetFigureByID(BoxListObject, BoxID)); if BoxObject <> nil then BoxObject.FJoinedListIDForBox := -1; end; GCurrentCADListID := AID_List; vList.FNeedDelete := True; GNotNeedCheckRaisesBeforeClose := True; vList.Close; GNotNeedCheckRaisesBeforeClose := False; vList.FNeedDelete := False; GCurrentCADListID := 0; end; except on E: Exception do addExceptionToLogEx('U_Common.DeleteListInCAD', E.Message); end; end; Procedure FindConnectionsInterfaces(AConnector1, AConnector2: TConnectorObject); var i: integer; isConnected: Boolean; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; begin try ParamsList1 := TList.create; ParamsList2 := TList.create; // 1 соединитель for i := 0 to AConnector1.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector1.JoinedOrtholinesList[i]); New(ptrInterfRecord1); ptrInterfRecord1.IDObject := JoinedLine.ID; if AConnector1 = JoinedLine.JoinConnector1 then ptrInterfRecord1.Side := 1; if AConnector1 = JoinedLine.JoinConnector2 then ptrInterfRecord1.Side := 2; ParamsList1.Add(ptrInterfRecord1); end; // два соединителя - соединения их кабелей if (AConnector1.ConnectorType = ct_Clear) and (AConnector2.ConnectorType = ct_Clear) then begin for i := 0 to AConnector2.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector2.JoinedOrtholinesList[i]); New(ptrInterfRecord2); ptrInterfRecord2.IDObject := JoinedLine.ID; if AConnector2 = JoinedLine.JoinConnector1 then ptrInterfRecord2.Side := 1; if AConnector2 = JoinedLine.JoinConnector2 then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; // соединитель с обьектом - соединение кабелей с обьектом if (AConnector1.ConnectorType = Ct_Clear) and (AConnector2.ConnectorType <> Ct_Clear) then begin New(ptrInterfRecord2); ptrInterfRecord2.IDObject := AConnector2.ID; ptrInterfRecord2.Side := -1; ParamsList2.Add(ptrInterfRecord2); end; // Соединить isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2); except on E: Exception do addExceptionToLogEx('U_Common.FindConnectionsInterfaces', E.Message); end; end; {******************************************************************************} procedure AutoConnectOnAppendCable(AID_List, AID_Line: Integer); var i, j: integer; JoinedConn1, JoinedConn2: TConnectorObject; JoinedObject: TConnectorObject; JoinedLine: TOrthoLine; isConnected: Boolean; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; ACable: TOrthoLine; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin ACable := TOrthoLine(GetFigureByID(vList, AID_Line)); if ACable = Nil then Exit; if not CheckFigureByClassName(ACable, cTOrthoLine) then Exit; ParamsList1 := TList.Create; ParamsList2 := TList.Create; // интерфейсы кабеля New(ptrInterfRecord1); ptrInterfRecord1.IDObject := ACable.ID; ptrInterfRecord1.Side := 1; ParamsList1.Add(ptrInterfRecord1); {***** 1 конектор! *****} JoinedConn1 := TConnectorObject(ACable.JoinConnector1); // ===== проверить все подсоединенные ортолинии ===== for i := 0 to JoinedConn1.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn1.JoinedOrtholinesList[i]); if JoinedLine <> ACable then begin New(ptrInterfRecord2); ptrInterfRecord2.IDObject := JoinedLine.ID; if JoinedConn1 = JoinedLine.JoinConnector1 then ptrInterfRecord2.Side := 1; if JoinedConn1 = JoinedLine.JoinConnector2 then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; // ===== проверить все подсоединенные обьекты ===== for i := 0 to JoinedConn1.JoinedConnectorsList.Count - 1 do begin JoinedObject := JoinedConn1.JoinedConnectorsList[i]; New(ptrInterfRecord2); ptrInterfRecord2.IDObject := JoinedObject.ID; ptrInterfRecord2.Side := -1; ParamsList2.Add(ptrInterfRecord2); end; isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2); ParamsList1 := TList.Create; ParamsList2 := TList.Create; // интерфейсы кабеля New(ptrInterfRecord1); ptrInterfRecord1.IDObject := ACable.ID; ptrInterfRecord1.Side := 2; ParamsList1.Add(ptrInterfRecord1); {***** 2 конектор! *****} JoinedConn2 := TConnectorObject(ACable.JoinConnector2); // ===== проверить все подсоединенные ортолинии ===== for i := 0 to JoinedConn2.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn2.JoinedOrtholinesList[i]); if JoinedLine <> ACable then begin New(ptrInterfRecord2); ptrInterfRecord2.IDObject := JoinedLine.ID; if JoinedConn2 = JoinedLine.JoinConnector1 then ptrInterfRecord2.Side := 1; if JoinedConn2 = JoinedLine.JoinConnector2 then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; // ===== проверить все подсоединенные обьекты ===== for i := 0 to JoinedConn2.JoinedConnectorsList.Count - 1 do begin JoinedObject := JoinedConn2.JoinedConnectorsList[i]; New(ptrInterfRecord2); ptrInterfRecord2.IDObject := JoinedObject.ID; ptrInterfRecord2.Side := -1; ParamsList2.Add(ptrInterfRecord2); end; isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2); end; except on E: Exception do addExceptionToLogEx('U_Common.AutoConnectOnAppendCable', E.Message); end; end; procedure AutoConnectObjectInTrace(APointObject: TConnectorObject; ATrace1, ATrace2: TOrthoLine); var i: integer; isConnected: Boolean; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; begin try ParamsList1 := TList.create; ParamsList2 := TList.create; FreeLineFigureInterfaces(ATrace1.ID, 2); New(ptrInterfRecord1); ptrInterfRecord1.IDObject := APointObject.ID; ptrInterfRecord1.Side := -1; ParamsList1.Add(ptrInterfRecord1); New(ptrInterfRecord2); ptrInterfRecord2.IDObject := ATrace1.ID; ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2); except on E: Exception do addExceptionToLogEx('U_Common.AutoConnectObjectInTrace', E.Message); end; end; procedure AutoConnectObjectToConnectors(APointObject, AConnectedConn: TConnectorObject; AConnectorsList: TList); var i, j: integer; ConnectorsCount: integer; isConnected: Boolean; CurrentConn: TConnectorObject; Joinedline: TOrthoLine; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; begin BaseBeginUpdate; try // очистить интерфейсы кабелей for i := 0 to AConnectorsList.Count - 1 do begin CurrentConn := TConnectorObject(AConnectorsList[i]); for j := 0 to CurrentConn.JoinedOrtholinesList.Count - 1 do begin Joinedline := TOrthoLine(CurrentConn.JoinedOrtholinesList[j]); if Joinedline.JoinConnector1 = CurrentConn then FreeLineFigureInterfaces(Joinedline.ID, 1); if Joinedline.JoinConnector2 = CurrentConn then FreeLineFigureInterfaces(Joinedline.ID, 2); end; end; CurrentConn := AConnectedConn; for j := 0 to CurrentConn.JoinedOrtholinesList.Count - 1 do // begin // Joinedline := TOrthoLine(CurrentConn.JoinedOrtholinesList[j]); // if Joinedline.JoinConnector1 = CurrentConn then //Нахер этот кусок кода тут не нужен. FreeLineFigureInterfaces(Joinedline.ID, 1); // if Joinedline.JoinConnector2 = CurrentConn then // FreeLineFigureInterfaces(Joinedline.ID, 2); // end; // ParamsList1 := TList.create; ParamsList2 := TList.create; // первый параметр - присоединяемый коннектор New(ptrInterfRecord1); for i := 0 to AConnectedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnectedConn.JoinedOrtholinesList[i]); ptrInterfRecord1.IDObject := Joinedline.ID; if Joinedline.JoinConnector1 = CurrentConn then ptrInterfRecord1.Side := 1; if Joinedline.JoinConnector2 = CurrentConn then ptrInterfRecord1.Side := 2; ParamsList1.Add(ptrInterfRecord1); end; New(ptrInterfRecord2); ptrInterfRecord2.IDObject := APointObject.ID; ptrInterfRecord2.Side := -1; ParamsList2.Add(ptrInterfRecord2); for ConnectorsCount := 0 to AConnectorsList.Count - 1 do begin CurrentConn := TConnectorObject(AConnectorsList[ConnectorsCount]); for i := 0 to CurrentConn.JoinedOrtholinesList.Count - 1 do begin Joinedline := TOrthoLine(CurrentConn.JoinedOrtholinesList[i]); New(ptrInterfRecord2); ptrInterfRecord2.IDObject := Joinedline.ID; if Joinedline.JoinConnector1 = CurrentConn then ptrInterfRecord2.Side := 1; if Joinedline.JoinConnector2 = CurrentConn then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2); except on E: Exception do addExceptionToLogEx('U_Common.AutoConnectObjectToConnectors', E.Message); end; BaseEndUpdate; end; Procedure AppendLineInterfacesToCAD(AID_List, AID_Figure: Integer; AObjName: string; aDivValue: Double); var vList: TF_CAD; vLine: TOrthoLine; SavedSnapFigure: TFigure; begin try vList := getListByID(AID_List); if vList <> nil then begin if vList.FAllowSuppliesKind then begin if vList.FSCSType = st_Internal then begin vLine := TOrthoLine(GetFigureByID(vList, AID_Figure)); if (vLine <> nil) and (not vLine.FIsRaiseUpDown) then begin if aDivValue > 0 then begin SavedSnapFigure := GFigureSnap; vList.AutoDivideTraceOnAppendCable(vLine, aDivValue); GFigureSnap := SavedSnapFigure; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.AppendLineInterfacesToCAD', E.Message); end; end; Procedure RemoveLineInterfacesFromCAD(AID_List, AID_Figure: Integer; AObjName: string); begin end; // ВБРОС НЕЛИНЕЙНОГО КОМПОНЕНТА В ПМ Procedure AppendNoLineInterfacesToCAD(AID_List, AID_Figure: Integer; AObjName: string); var i: integer; CADFigure: TConnectorObject; isEmpty: Boolean; NewConn: TConnectorObject; LHandle: integer; GetConn: TConnectorObject; // RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; ObjFromRaise: TConnectorObject; ObjParams: TObjectParams; vList: TF_CAD; SavedCadForm: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; LHandle := vList.PCad.GetLayerHandle(2); // Find Figure In CAD CADFigure := TConnectorObject(GetFigureByID(vList, AID_Figure)); if CADFigure = nil then Exit; isEmpty := IsEmptyFigure(CADFigure.ID); //Tolik if (CADFigure.ConnectorType = ct_Clear) and (isEmpty = False) and GDragOnCAD then begin NewConn := TConnectorObject.Create(CADFigure.ActualPoints[1].x, CADFigure.ActualPoints[1].y, vList.FConnHeight, LHandle, mydsNormal, vList.PCad); NewConn.ConnectorType := ct_Clear; NewConn.ActualZOrder[1] := CADFigure.ActualZOrder[1]; vList.PCad.AddCustomFigure (GLN(LHandle), NewConn, False); for i := 0 to CADFigure.JoinedOrtholinesList.Count - 1 do begin GetConn := TConnectorObject(TOrthoLine(CADFigure.JoinedOrtholinesList[i]).JoinConnector1); if GetConn = CADFigure then TOrthoLine(CADFigure.JoinedOrtholinesList[i]).SetJConnector1(NewConn); GetConn := TConnectorObject(TOrthoLine(CADFigure.JoinedOrtholinesList[i]).JoinConnector2); if GetConn = CADFigure then TOrthoLine(CADFigure.JoinedOrtholinesList[i]).SetJConnector2(NewConn); end; NewConn.FConnRaiseType := CADFigure.FConnRaiseType; NewConn.FObjectFromRaise := CADFigure.FObjectFromRaise; NewConn.FID_ListToPassage := CADFigure.FID_ListToPassage; NewConn.FID_ConnToPassage := CADFigure.FID_ConnToPassage; CADFigure.FConnRaiseType := crt_None; CADFigure.FObjectFromRaise := nil; CADFigure.JoinedOrtholinesList.Clear; CADFigure.ConnectorType := ct_NB; ObjParams := GetFigureParams(CADFigure.ID); CADFigure.Name := ObjParams.Name; CADFigure.FIndex := ObjParams.MarkID; if not HaveObjectCorkComponent(AID_Figure) then CADFigure.ActualZOrder[1] := vList.FConnHeight; CheckingSnapPointObjectToConnector(CADFigure, NewConn); SetConnObjectSelectHightPriority(CADFigure); //#From Oleg# //29.09.2010 end; RefreshCAD(vList.PCad); GCadForm := SavedCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.AppendNoLineInterfacesToCAD', E.Message); end; end; // УДАЛИТЬ НЕЛИНЕЙНОГО КОМПОНЕНТА ИЗ ПМ Procedure RemoveNoLineInterfacesFromCAD(AID_List, AID_Figure: Integer; AObjName: string); var i, j: integer; CADFigure: TConnectorObject; isEmpty: Boolean; NewConn: TConnectorObject; GetConn: TConnectorObject; GetLine: TOrthoLine; LHandle: integer; ObjParams: TObjectParams; vList: TF_CAD; SavedCadForm: TF_CAD; //Tolik CADFigureParentCatalog: TSCSCatalog; CanDelRaise: Boolean; connectorDeleted: Boolean; joinConnCount: Integer; DelFigure: TConnectorObject; // begin //Tolik CanDelRaise := False; CADFigureParentCatalog := nil; connectorDeleted := False; DelFigure := nil; // try vList := GetListByID(AID_List); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; LHandle := vList.PCad.GetLayerHandle(2); CADFigure := TConnectorObject(GetFigureByID(vList, AID_Figure)); if CADFigure = nil then Exit; isEmpty := IsEmptyFigure(CADFigure.ID); //Tolik CADFigureParentCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(CadFigure.ID); if CADFigureParentCatalog <> nil then begin if CADFigureParentCatalog.ComponentReferences.Count = 0 then CanDelRaise := true; end; joinConnCount := CADFigure.JoinedConnectorsList.Count; // if (CADFigure.ConnectorType <> ct_Clear) and (isEmpty = True) then begin if GTempJoinedLinesConnectors <> nil then GTempJoinedLinesConnectors.Clear; for i := 0 to CADFigure.JoinedConnectorsList.Count - 1 do begin GetConn := TConnectorObject(CADFigure.JoinedConnectorsList[i]); GTempJoinedLinesConnectors.Add(GetConn); for j := 0 to GetConn.JoinedOrtholinesList.Count - 1 do begin GetLine := TOrthoLine(GetConn.JoinedOrtholinesList[j]); // Tolik if GetLine.FIsRaiseUpDown then begin if CanDelRaise and (GetConn.JoinedOrtholinesList.Count = 1) and (CADFigure.JoinedConnectorsList.Count = 1) then //GetLine.Delete; //GetConn.Delete(True, False); //connectorDeleted := true; end else begin // if GetLine.JoinConnector1 = GetConn then begin GetLine.SetJConnector1(CADFigure); GetLine.ActualPoints[1] := CADFigure.ActualPoints[1]; end; if GetLine.JoinConnector2 = GetConn then begin GetLine.SetJConnector2(CADFigure); GetLine.ActualPoints[2] := CADFigure.ActualPoints[1]; end; //Tolik end; // end; GetConn.JoinedOrtholinesList.Clear; GetConn.JoinedConnectorsList.Clear; end; CADFigure.JoinedConnectorsList.Clear; CADFigure.ConnectorType := ct_Clear; if CADFigure.FConnRaiseType = crt_None then CADFigure.Name := cCadClasses_Mes12 else CADFigure.Name := cCadClasses_Mes24; SetNewObjectNameInPM(CADFigure.ID, CADFigure.Name); ObjParams := GetFigureParams(CADFigure.ID); CADFigure.Name := ObjParams.Name; CADFigure.FIndex := ObjParams.MarkID; { for i := 0 to GTempJoinedLinesConnectors.Count - 1 do TConnectorObject(GTempJoinedLinesConnectors[i]).Delete(False);} end; //Tolik if not connectorDeleted then for i := 0 to GTempJoinedLinesConnectors.Count - 1 do TConnectorObject(GTempJoinedLinesConnectors[i]).Delete(False) else GTempJoinedLinesConnectors.Clear; //Tolik if (connectorDeleted or (JoinConnCount = 0)) then //CADFigureParentCatalog.Delete; // так делать не будем, потому, что если есть С/П на коннекторе, // то его требуется оставить (хз, что надо клиенту), так что // будем удалять конкретно через фигуру (тут читай - TConnecotrObject) с // параметром "не удалять С/П" begin for i := 0 to vList.PCad.Figures.Count - 1 do begin if Tfigure(vList.PCad.Figures[i]).ID = CADFigureParentCatalog.SCSID then begin DelFigure := TConnectorObject(vList.PCad.Figures[i]); break; end; end; end; if DelFigure <> nil then DelFigure.Delete(True, False); // RefreshCAD(vList.PCad); GCadForm := SavedCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.RemoveNoLineInterfacesFromCAD', E.Message); end; end; // ВЫДЕЛИТЬ ТРАССУ НА CAD-е function SelectTraceInCAD(LinesList: TList): Double; var i, j: integer; IDInterf: ^Integer; ID: Integer; vFigure: TFigure; vList: TF_CAD; CadsToRefresh: TList; //17.01.2011 //Figures: TList; //15.02.2011 CurrTick, OldTick: Cardinal; begin Result := 0; try CadsToRefresh := nil; DeselectTraceInCAD; //15.02.2011 OldTick := GetTickCount; for i := 0 to LinesList.Count - 1 do begin IDInterf := LinesList[i]; ID := IDInterf^; for j := 0 to FSCS_Main.MDIChildCount - 1 do begin vList := TF_CAD(FSCS_Main.MDIChildren[j]); if (vList <> nil) and (vList.PCad <> nil) and (vList.FAutoSelectTrace) and (vList.FListType = lt_Normal) then begin vFigure := TFigure(vList.FSCSFigures.GetObject(ID)); //17.01.2013 vFigure := GetFigureByID(vList, ID); if (vFigure <> nil) and CheckFigureByClassName(vFigure, cTOrthoLine) then begin TOrthoLine(vFigure).isTraceShow := True; Result := Result + TOrthoLine(vFigure).LineLength; //17.01.2011 - Список листов для перерисовки if CadsToRefresh = nil then CadsToRefresh := TList.Create; if CadsToRefresh.IndexOf(vList) = -1 then CadsToRefresh.Add(vList); end; end; end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; if CadsToRefresh <> nil then begin RefreshCADs(CadsToRefresh); CadsToRefresh.Free; end; except on E: Exception do addExceptionToLogEx('U_Common.SelectTraceInCAD', E.Message); end; end; // УБРАТЬ ВЫДЕЛЕНИЕ ТРАССЫ НА CAD-е function DeselectTraceInCAD: Boolean; var i, j: integer; IDInterf: ^Integer; ID: Integer; vFigure: TFigure; vList: TF_CAD; begin Result := false; try for i := 0 to FSCS_Main.MDIChildCount - 1 do begin vList := TF_CAD(FSCS_Main.MDIChildren[i]); if (vList <> nil) and (vList.PCad <> nil) and (vList.FAutoSelectTrace) and (vList.FListType = lt_Normal) then begin if vList.FNeedUpdateCheckedFigures then vList.UpdateCheckedFigures; for j := 0 to vList.FCheckedFigures.Count - 1 do //for j := 0 to vList.PCad.FigureCount - 1 do begin //vFigure := TFigure(vList.PCad.Figures[j]); vFigure := TFigure(vList.FCheckedFigures[j]); if CheckFigureByClassName(vFigure, cTOrthoLine) then if TOrthoLine(vFigure).isTraceShow then begin TOrthoLine(vFigure).isTraceShow := False; Result := true; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.DeselectTraceInCAD', E.Message); end; end; function GetLineAngle(AP1, AP2: TDoublePoint): Double; var Len_X, Len_Y: Double; AngleRad: Double; AddAngle: Double; begin Result := 0; try Len_X := Abs(AP1.x - AP2.x); Len_Y := Abs(AP1.y - AP2.y); // проверки и вычиление угла в градусах AddAngle := 0; AngleRad := 0; // для неортогональных линий if (AP1.x < AP2.x) and (AP1.y < AP2.y) then // 1 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 0; end; if (AP1.x > Ap2.x) and (AP1.y < AP2.y) then //2 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 90; end; if (AP1.x > AP2.x) and (AP1.y > AP2.y) then //3 begin AngleRad := ArcTan2(Len_Y, Len_X); // угол в радианах AddAngle := 180; end; if (AP1.x < AP2.x) and (AP1.y > AP2.y) then //4 begin AngleRad := ArcTan2(Len_X, Len_Y); // угол в радианах AddAngle := 270; end; Result := Round(AngleRad * 180 / pi) + AddAngle; // для ортогональных линий if (AP1.y = AP2.y) and (AP1.x < AP2.x) then Result := 0; if (AP1.y = AP2.y) and (AP1.x > AP2.x) then Result := 180; if (AP1.x = AP2.x) and (AP1.y < AP2.y) then Result := 90; if (AP1.x = AP2.x) and (AP1.y > AP2.y) then Result := 270; except on E: Exception do addExceptionToLogEx('U_Common.TF_OrthoLineProperties.GetAngle', E.Message); end; end; // ВЫРОВНЯТЬ ЛИНИЮ Procedure ReAlignLine(aAlignedLine: TOrthoLine); var AcceptDelta: Double; JoinedConn1, JoinedConn2: TConnectorObject; Points1, Points2: TDoublePoint; SnapPoint1, SnapPoint2: Double; delta1, delta2: Double; ReAlignX, ReAlignY: Boolean; begin try JoinedConn1 := TConnectorObject(aAlignedLine.JoinConnector1); JoinedConn2 := TConnectorObject(aAlignedLine.JoinConnector2); Points1 := JoinedConn1.ActualPoints[1]; Points2 := JoinedConn2.ActualPoints[2]; AcceptDelta := GCadForm.PCad.GridStep; ReAlignX := False; ReAlignY := False; if abs(Points1.x - Points2.x) < AcceptDelta then ReAlignX := True; if abs(Points1.y - Points2.y) < AcceptDelta then ReAlignY := True; if (ReAlignX = True) and (ReAlignY = True) then ReAlignY := False; if (ReAlignX = False) and (ReAlignY = False) then begin exit; end; // выравнивание по горизонтали if ReAlignX then begin SnapPoint1 := GetCoordsWithSnapToGrid(Points1.x, Points1.y).x; SnapPoint2 := GetCoordsWithSnapToGrid(Points2.x, Points2.y).x; if SnapPoint1 = SnapPoint2 then begin JoinedConn1.MoveConnector(SnapPoint1 - Points1.x, 0, False); JoinedConn2.MoveConnector(SnapPoint2 - Points2.x, 0, False); end else begin delta1 := abs(SnapPoint1 - Points1.x); delta2 := abs(SnapPoint2 - Points2.x); if delta1 >= delta2 then begin JoinedConn1.MoveConnector(SnapPoint1 - Points1.x, 0, False); JoinedConn2.MoveConnector(SnapPoint1 - Points2.x, 0, False); end else begin JoinedConn1.MoveConnector(SnapPoint2 - Points1.x, 0, False); JoinedConn2.MoveConnector(SnapPoint2 - Points2.x, 0, False); end; end; end; // выравнивание по вертикали if ReAlignY then begin SnapPoint1 := GetCoordsWithSnapToGrid(Points1.x, Points1.y).y; SnapPoint2 := GetCoordsWithSnapToGrid(Points2.x, Points2.y).y; if SnapPoint1 = SnapPoint2 then begin JoinedConn1.MoveConnector(0, SnapPoint1 - Points1.y, False); JoinedConn2.MoveConnector(0, SnapPoint2 - Points2.y, False); end else begin delta1 := abs(SnapPoint1 - Points1.y); delta2 := abs(SnapPoint2 - Points2.y); if delta1 >= delta2 then begin JoinedConn1.MoveConnector(0, SnapPoint1 - Points1.y, False); JoinedConn2.MoveConnector(0, SnapPoint1 - Points2.y, False); end else begin JoinedConn1.MoveConnector(0, SnapPoint2 - Points1.y, False); JoinedConn2.MoveConnector(0, SnapPoint2 - Points2.y, False); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ReAlignLine', E.Message); end; end; Procedure ReAlignObject(aAlignedObject: TConnectorObject); var i: integer; x, y: Double; Coords: TDoublePoint; pt: TDoublePoint; begin try x := aAlignedObject.ActualPoints[1].x; y := aAlignedObject.ActualPoints[1].y; Coords := GetCoordsWithSnapToGrid(x, y); if aAlignedObject.FIsHouseJoined then begin for i := 0 to aAlignedObject.FHouse.PointCount - 1 do begin pt := aAlignedObject.FHouse.ActualPoints[i]; if aAlignedObject.IsPointIn(pt.x, pt.y) then begin aAlignedObject.FHouse.ActualPoints[i] := DoublePoint(Coords.x, Coords.y); break; end; end; end; aAlignedObject.MoveConnector(Coords.x - x, Coords.y - y, False); except on E: Exception do addExceptionToLogEx('U_Common.ReAlignObject', E.Message); end; end; // ПОЛУЧИТЬ ВСЮ ТРАССУ function GetAllTraceInCAD(AFigureServer, AFigureWS: TFigure): TList; var CurrLength: Double; LastLength: Double; IDAutoTracingPropertyStr: String; CurrFigure: TFigure; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; IDCompon: ^Integer; Res: Boolean; ptrIDCompon: ^Integer; i: Integer; CurrIDPathList: TList; LastIDPathList: TList; ResultList: TList; ////////////////////////////////////////////////////////////////////////////// Procedure GetStepInCAD(ASourceWS: TFigure; AInOrder: TList; ATraveledIndex: Integer); var i, j: Integer; //IDConn: ^Integer; ComponLength: Double; ConnectedIDList: TList; InOrder: TList; //New begin ComponLength := 0; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then begin if TConnectorObject(ASourceWS).FDisableTracing then Exit; end else if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin if TOrthoLine(ASourceWS).FDisableTracing then Exit; ComponLength := TOrthoLine(ASourceWS).LineLength; if (CurrLength + ComponLength >= LastLength) and (LastLength > 0) then Exit; end; CurrLength := CurrLength + ComponLength; CurrIDPathList.Add(ASourceWS); if (ASourceWS = AFigureWS) and ((CurrLength <= LastLength) or (LastLength = 0)) then begin //*** Переприсвоить кратчайшый путь LastIDPathList.Clear; for i := 0 to CurrIDPathList.Count - 1 do begin CurrFigure := TFigure(CurrIDPathList[i]); LastIDPathList.Add(CurrFigure); end; //*** Переприсвоить кратчайшую длину LastLength := CurrLength; end else {************************************************************************} begin ConnectedIDList := TList.Create; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then begin // OBJECT if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin for i := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end; end // Connector else if TConnectorObject(ASourceWS).ConnectorType = ct_Clear then begin for j := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[j]); ConnectedIDList.Add(JoinedConn); end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end; end else if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector1); ConnectedIDList.Add(JoinedConn); JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector2); ConnectedIDList.Add(JoinedConn); end; InOrder := TList.Create; if AInOrder <> nil then InOrder.Assign(AInOrder); InOrder.Assign(ConnectedIDList, laOr); for i := 0 to ConnectedIDList.Count - 1 do begin CurrFigure := TFigure(ConnectedIDList[i]); //if CheckNoFigureinList(CurrFigure, AInOrder) and CheckNoFigureinList(CurrFigure, CurrIDPathList) then //GetStepInCAD(CurrFigure, ConnectedIDList, ATraveledIndex + 1); //Old if ((AInOrder = nil) or ((AInOrder <> nil) and (AInOrder.IndexOf(CurrFigure) = -1))) and (CurrIDPathList.IndexOf(CurrFigure) = -1) then GetStepInCAD(CurrFigure, InOrder, ATraveledIndex + 1); end; FreeAndNil(InOrder); if ConnectedIDList <> nil then FreeAndNil(ConnectedIDList); end; CurrLength := CurrLength - ComponLength; CurrIDPathList.Delete(ATraveledIndex); end; ////////////////////////////////////////////////////////////////////////////// begin Result := nil; try CurrIDPathList := Tlist.Create; CurrLength := 0; LastIDPathList := Tlist.Create; LastLength := 0; GetStepInCAD(AFigureServer, nil, 0); begin ResultList := TList.Create; for i := 0 to LastIDPathList.Count - 1 do begin CurrFigure := TFigure(LastIDPathList[i]); if CheckFigureByClassName(CurrFigure, cTOrthoLine) then ResultList.Add(CurrFigure) else if CheckFigureByClassName(CurrFigure, cTConnectorObject) then begin if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then ResultList.Add(CurrFigure); /// **** NEW if (TConnectorObject(CurrFigure).ConnectorType = ct_Clear) and (TConnectorObject(CurrFigure).FIsHouseJoined) then ResultList.Add(TConnectorObject(CurrFigure).FHouse); /// **** NEW end; end; if ResultList.Count = 0 then FreeAndNil(ResultList) else Result := ResultList; end; if CurrIDPathList <> nil then FreeAndNil(CurrIDPathList); if LastIDPathList <> nil then FreeAndNil(LastIDPathList); except on E: Exception do addExceptionToLogEx('U_Common.GetAllTraceInCAD', E.Message); end; end; // Added by Tolik // Stolen from Igor but a little bit fully remaked yet Function GetAllTraceInCADByMarked_New1(aAFigureServer, aAFigureWS: TFigure): TList; Var i, j, k: Integer; CurrPath, PassedPath, LineList: TList; ServerAssigned: boolean; PathLength: double; currLine: TOrtholine; Conn, Conn1: TConnectorObject; Line: TOrthoLine; ServerLineConnections, WSLineConnections: Boolean; DistToServer: array of Double; LineMoved: Boolean; currLineLen: double; CurrTick, OldTick: TDateTime; Function GetPathLength(aCurrList: TList): Double; Var i: Integer; vFigure: TFigure; Begin Result := 0; for i := 0 to aCurrList.Count - 1 do begin vFigure := TFigure(aCurrList[i]); if CheckFigureByClassName(vFigure, cTOrthoLine) then Result := Result + TOrthoLine(vFigure).LineLength; end; End; Procedure FindPathToServer(Figure: TFigure; aCurrPath, aPassedPath: TList); Var i, j, k: Integer; TmpPath, TmpPassedPath: TList; TmpLength: double; TmpLineList: TList; DistToServer: array of Double; LineMoved: boolean; currLineLen: double; Conn, Conn1: TConnectorObject; Function CheckFigureInList(aFigure: TFigure; AList: TList): Boolean; Var i: Integer; Begin Result := false; for i := 0 to AList.Count - 1 do begin if aFigure.id = TFigure(AList[i]).id then begin result := true; break; end; end; End; Begin try try { TODO: Доделать здесь проверку запрещенных для прокладки кабеля объектов по аналогии со старой функцией. Пока будет юзаться старая. Эта будет по Shift только пока TODO: Доделать возможность возвращать 1 самый короткий путь и парочку других путей. TODO: доделать счетчик вызова рекурсии для возможности ее прерывания подобие ATraveledIndex } CurrTick := Now - OldTick; if CurrTick > 0.00010 then begin if CurrPath.Count > 0 then begin //ATraveledIndex := ATraveledIndex; exit; end; end; if CurrTick > 0.00017 then begin //ATraveledIndex := ATraveledIndex; exit; end; //if ATraveledIndex > 60 then {40} // if CurrPath.Count > 0 then //begin //ATraveledIndex := ATraveledIndex; // exit; //end; if ((Figure <> nil) and Assigned(Figure)) then begin TmpPath := TList.Create; TmpLineList := TList.Create; TmpPassedPath := TList.Create; SetLength(DistToServer, 0); for i := 0 to aCurrPath.Count - 1 do TmpPath.Add(aCurrPath[i]); for i := 0 to aPassedPath.Count - 1 do TmpPassedPath.Add(aPassedPath[i]); if not CheckFigureInList(Figure, TmpPath) then begin TmpPath.Add(Figure); //Ortholines only TmpLength := GetPathLength(TmpPath); if ((PathLength <> 0) and (TmpLength > PathLength)) then begin FreeAndNil(TmpPath); FreeAndNil(TmpLineList); FreeAndNil(TmpPassedPath); SetLength(DistToServer, 0); Exit; end else begin if CheckFigureByClassName(Figure, cTOrthoLine) then begin Line := TOrthoLine(Figure); Conn := TConnectorObject(Line.JoinConnector1); if TmpPassedPath.IndexOf(Conn) <> - 1 then Conn := TConnectorObject(Line.JoinConnector2); TmpPassedPath.Add(Conn); for i := 0 to Conn.JoinedConnectorsList.Count - 1 do begin TmpPassedPath.Add(TConnectorObject(Conn.JoinedConnectorsList[i])); if TConnectorObject(Conn.JoinedConnectorsList[i]).ID = TConnectorObject(aAFigureServer).ID then begin ServerAssigned := true; if ((PathLength = 0) or (PathLength > TmpLength )) then begin PathLength := TmpLength; CurrPath.Clear; for j := 0 to TmpPath.Count - 1 do begin CurrPath.Add(TmpPath[j]); end; end; FreeAndNil(TmpPath); FreeAndNil(TmpLineList); FreeAndNil(TmpPassedPath); SetLength(DistToServer, 0); exit; end else begin if TConnectorObject(Conn.JoinedConnectorsList[i]).ConnectorType = ct_clear then begin for j := 0 to TConnectorObject(Conn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TmpPath.IndexOf(TOrthoLine(TConnectorObject(Conn.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then begin if TmpLineList.IndexOf(TOrthoLine(TConnectorObject(Conn.JoinedConnectorsList[i]).JoinedOrtholinesList[j])) = -1 then TmpLineList.Add(TorthoLine(TConnectorObject(Conn.JoinedConnectorsList[i]).JoinedOrtholinesList[j])); end; end; end else if TConnectorObject(Conn.JoinedConnectorsList[i]).ConnectorType = ct_NB then begin Conn1 := TConnectorObject(Conn.JoinedConnectorsList[i]); for j := 0 to TConnectorObject(Conn1).JoinedConnectorsList.Count - 1 do begin if TmpPassedPath.IndexOf(TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j])) = -1 then TmpPassedPath.Add(TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j])); if TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j]).ConnectorType = ct_clear then begin for k := 0 to TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j]).JoinedOrtholinesList.Count - 1 do begin Line := TConnectorObject(TConnectorObject(Conn1).JoinedConnectorsList[j]).JoinedOrtholinesList[k]; if TmpPath.IndexOf(Line) = -1 then begin if TmpLineList.IndexOf(Line) = -1 then TmpLineList.Add(Line); end; end; end; end; end; end; end; for i := 0 to Conn.JoinedOrtholinesList.Count - 1 do begin Line := TOrthoLine(Conn.JoinedOrtholinesList[i]); if TmpPath.IndexOf(Line) = -1 then begin if TmpLineList.IndexOf(Line) = -1 then TmpLineList.Add(Line); end; end; end; if TmpLineList.Count > 1 then begin for j := 0 to TmpLineList.Count - 1 do begin Line := TOrthoLine(TmpLineList[j]); conn := TConnectorObject(Line.JoinConnector1); if TmpPassedPath.IndexOf(Conn) <> -1 then conn := TConnectorObject(Line.JoinConnector2); SetLength(DistToServer, Length(DistToServer) + 1); // :( ?? не совпадают координаты коннектора линии(с/п) и сервера (как бы ни брал...) {currLineLen := Sqrt( Sqr(Conn.ActualZOrder[1] - TConnectorObject(aAFigureServer).ActualZOrder[1]) + Sqr(conn.ActualPoints[1].x - TConnectorObject(aAFigureServer).ap1.x) + Sqr(conn.ActualPoints[1].y - TConnectorObject(aAFigureServer).ap1.y) );} currLineLen := Sqrt( Sqr(Conn.ActualZOrder[1] - TConnectorObject(aAFigureServer).ActualZOrder[1]) + Sqr(conn.ap1.x - TConnectorObject(aAFigureServer).ap1.x) + Sqr(conn.ap1.y - TConnectorObject(aAFigureServer).ap1.y) ); DistToServer[Length(DistToServer) - 1] := currLineLen;//GetLineLength(aAFigureServer.ap1, conn.ap1, false); end; LineMoved := True; while LineMoved do begin LineMoved := false; for j := 0 to TmpLineList.Count - 2 do begin if DistToServer[j] > DistToServer[j + 1] then begin LineMoved := true; currLineLen := DistToServer[j]; DistToServer[j] := DistToServer[j + 1]; DistToServer[j + 1] := currLineLen; Line := TOrthoLine(TmpLineList[j]); TmpLineList[j] := TmpLineList[j + 1]; TmpLineList[j + 1] := Line; end; end; end; end; if TmpLineList.Count > 0 then begin for i := 0 to TmpLineList.Count - 1 do FindPathToServer(TmpLineList[i], TmpPath, TmpPassedPath); end; FreeAndNil(TmpPath); FreeAndNil(TmpLineList); FreeAndNil(TmpPassedPath); SetLength(DistToServer, 0); end; end; end; Except on E: Exception do addExceptionToLogEx('U_Common.GetAllTraceInCADByMarked_New1.FindPathToServer', E.Message); end; Finally if TmpPath <> nil then FreeAndNil(TmpPath); if TmpLineList <> nil then FreeAndNil(TmpLineList); if TmpPassedPath <> nil then FreeAndNil(TmpPassedPath); SetLength(DistToServer, 0); end; End; Begin OldTick := Now; try try Result := TList.Create; // пустой список (для начала) // если все есть if ((aAFigureServer <> nil) and (aAFigureWS <> nil)) then begin // если сервер и станция точечные if (CheckFigureByClassName(aAFigureWS, cTConnectorObject) and CheckFigureByClassName(aAFigureServer, cTConnectorObject)) then begin // если сервер и станция - не одно и тоже if TConnectorObject(aaFigureWS) <> TConnectorObject(aAFigureServer) then begin // ищем линейные соединения у станции и сервера (если их не будет - нет смысла продолжать поиск) // сначала станция WSLineConnections := false; if TConnectorObject(aAFigureWS).JoinedOrtholinesList.Count > 0 then WSLineConnections := true; if not WSLineConnections then begin for i := 0 to TConnectorObject(aAfigureWS).JoinedConnectorsList.Count - 1 do begin Conn := TConnectorObject(TConnectorObject(aAFigureWS).JoinedConnectorsList[i]); if Conn.ConnectorType = ct_clear then begin if Conn.JoinedOrtholinesList.Count > 0 then begin WSLineConnections := true; break; end; end; end; end; ServerLineConnections := false; if TConnectorObject(aAFigureServer).JoinedOrtholinesList.Count > 0 then ServerLineConnections := true; if not ServerLineConnections then begin for i := 0 to TConnectorObject(aAFigureServer).JoinedConnectorsList.Count - 1 do begin Conn := TConnectorObject(aAFigureServer).JoinedConnectorsList[i]; if Conn.ConnectorType = ct_clear then begin if Conn.JoinedOrtholinesList.Count > 0 then begin ServerLineConnections := True; break; end; end; end; end; //ищем путь (Если объекты(оба) имеют линейные подключения) if (ServerLineConnections and WSLineConnections) then begin ServerAssigned := false; CurrPath := TList.Create; PassedPath := TList.Create; LineList := TList.Create; PathLength := 0; Conn := TConnectorObject(aAFigureWS); PassedPath.Add(Conn); // Check direct connected Lines for i := 0 to TConnectorObject(aAFigureWS).JoinedOrtholinesList.Count - 1 do begin Line := TOrthoLine(TConnectorObject(aAFigureWS).JoinedOrtholinesList[i]); LineList.Add(Line); Conn := TConnectorObject(Line.JoinConnector1); if PassedPath.IndexOf(conn) <> - 1 then Conn := TConnectorObject(Line.JoinConnector2); for j := 0 to Conn.JoinedConnectorsList.Count - 1 do begin if TConnectorObject(Conn.JoinedConnectorsList[j]).ConnectorType = ct_NB then begin if TConnectorObject(Conn.JoinedConnectorsList[j]).ID = aAFigureServer.ID then begin ServerAssigned := true; CurrPath.Add(Line); break; end; end end; if ServerAssigned then break; end; if not ServerAssigned then begin // Check Lines connected by connector (to WS) for i := 0 to TConnectorObject(aAFigureWS).JoinedConnectorsList.Count - 1 do begin Conn := TConnectorObject(TConnectorObject(aAFigureWS).JoinedConnectorsList[i]); PassedPath.Add(Conn); if Conn.ConnectorType = ct_Clear then begin for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do begin Line := TOrthoLine(Conn.JoinedOrtholinesList[j]); LineList.Add(Line); Conn1 := TConnectorObject(Line.JoinConnector1); if PassedPath.IndexOf(Conn1) <> -1 then Conn1 := TConnectorObject(Line.JoinConnector2); // Look for Server connection for k := 0 to Conn1.JoinedConnectorsList.Count - 1 do begin if ( (TConnectorObject(Conn1.JoinedConnectorsList[k]).ConnectorType = ct_NB) and (TConnectorObject(Conn1.JoinedConnectorsList[k]).ID = aAFigureServer.ID)) then begin ServerAssigned := true; CurrPath.Add(Line); Break; end; end; if ServerAssigned then break; end; end; if ServerAssigned then break; end; end; if not ServerAssigned then begin // Sorting Lines by Distance to Server if LineList.Count > 1 then begin for j := 0 to LineList.Count - 1 do begin Line := TOrthoLine(LineList[j]); conn := TConnectorObject(Line.JoinConnector1); if PassedPath.IndexOf(Conn) <> -1 then conn := TConnectorObject(Line.JoinConnector2); SetLength(DistToServer, Length(DistToServer) + 1); DistToServer[Length(DistToServer) - 1] := GetLineLength(aAFigureServer.ap1, conn.ap1); end; LineMoved := True; while LineMoved do begin LineMoved := false; for j := 0 to LineList.Count - 2 do begin if DistToServer[j] > DistToServer[j + 1] then begin LineMoved := true; currLineLen := DistToServer[j]; DistToServer[j] := DistToServer[j + 1]; DistToServer[j + 1] := currLineLen; Line := TOrthoLine(LineList[j]); LineList[j] := LineList[j + 1]; LineList[j + 1] := Line; end; end; end; end; for i := 0 to LineList.Count - 1 do FindPathToServer(LineList[i], CurrPath, PassedPath); end; if not ServerAssigned then begin Result.Clear; FreeAndNil(CurrPath); end else begin Result.Add(currPath); end; FreeAndNil(PassedPath); FreeAndNil(LineList); SetLength(DistToServer,0); end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetAllTraceInCADByMarked_New1', E.Message); end; Finally if Result = nil then begin if CurrPath <> nil then FreeAndNil(CurrPath); end; if PassedPath <> nil then FreeAndNil(PassedPath); if LineList <> nil then FreeAndNil(LineList); end; End; function GetAllTraceInCADByMarked(aAFigureServer, aAFigureWS: TFigure; SotrListByMarked: Boolean = True): TList; var CurrLength: Double; MinLength: Double; CurrFigure: TFigure; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; i, j, k: Integer; CurrIDPathList: TList; CurrPathList: TList; ResultList: TList; tmpResult: TList; vList1, vList2: TList; CurrTick, OldTick: TDateTime; AFigureServer, AFigureWS: TFigure; ////////////////////////////////////////////////////////////////////////////// Procedure GetStepInCAD(ASourceWS: TFigure; AInOrder: TList; ATraveledIndex: Integer); var i, j: Integer; ConnectedIDList: TList; InOrder: TList; begin if CheckFigureByClassName(ASourceWS, cTConnectorObject) then begin if TConnectorObject(ASourceWS).FDisableTracing then Exit; end else if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin if TOrthoLine(ASourceWS).FDisableTracing then Exit; end; CurrTick := Now - OldTick; if CurrTick > 0.00009 then begin if ResultList.Count > 0 then begin ATraveledIndex := ATraveledIndex; exit; end; end; if CurrTick > 0.00013 then begin ATraveledIndex := ATraveledIndex; exit; end; if ATraveledIndex > 60 then {40} if ResultList.Count > 2 then begin ATraveledIndex := ATraveledIndex; exit; end else if ResultList.Count > 100 then begin if CurrTick > 0.00006 then begin ATraveledIndex := ATraveledIndex; exit; end; end; CurrIDPathList.Add(ASourceWS); if (ASourceWS = AFigureWS) then begin //*** Переприсвоить кратчайший путь CurrPathList := TList.Create; for i := 0 to CurrIDPathList.Count - 1 do begin CurrFigure := TFigure(CurrIDPathList[i]); // добавить в лист текущего пути if CheckFigureByClassName(CurrFigure, cTOrthoLine) then CurrPathList.Add(CurrFigure) else if CheckFigureByClassName(CurrFigure, cTConnectorObject) then begin if TConnectorObject(CurrFigure).ConnectorType <> ct_Clear then CurrPathList.Add(CurrFigure); /// **** NEW if (TConnectorObject(CurrFigure).ConnectorType = ct_Clear) and (TConnectorObject(CurrFigure).FIsHouseJoined) then CurrPathList.Add(TConnectorObject(CurrFigure).FHouse); /// **** NEW end; end; // добавить с лист всех путей ResultList.Add(CurrPathList); end else {************************************************************************} begin ConnectedIDList := TList.Create; if CheckFigureByClassName(ASourceWS, cTConnectorObject) then begin // OBJECT if TConnectorObject(ASourceWS).ConnectorType <> ct_Clear then begin for i := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end; end // Connector else if TConnectorObject(ASourceWS).ConnectorType = ct_Clear then begin for j := 0 to TConnectorObject(ASourceWS).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(ASourceWS).JoinedConnectorsList[j]); ConnectedIDList.Add(JoinedConn); end; for j := 0 to TConnectorObject(ASourceWS).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ASourceWS).JoinedOrtholinesList[j]); ConnectedIDList.Add(JoinedLine); end; end; end // Trace else if CheckFigureByClassName(ASourceWS, cTOrthoLine) then begin JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector1); ConnectedIDList.Add(JoinedConn); JoinedConn := TConnectorObject(TOrthoLine(ASourceWS).JoinConnector2); ConnectedIDList.Add(JoinedConn); end; InOrder := TList.Create; if AInOrder <> nil then InOrder.Assign(AInOrder); InOrder.Assign(ConnectedIDList, laOr); for i := 0 to ConnectedIDList.Count - 1 do begin CurrFigure := TFigure(ConnectedIDList[i]); if ((AInOrder = nil) or ((AInOrder <> nil) and (AInOrder.IndexOf(CurrFigure) = -1))) and (CurrIDPathList.IndexOf(CurrFigure) = -1) then GetStepInCAD(CurrFigure, InOrder, ATraveledIndex + 1); end; FreeAndNil(InOrder); if ConnectedIDList <> nil then FreeAndNil(ConnectedIDList); end; // CurrLength := CurrLength - ComponLength; CurrIDPathList.Delete(ATraveledIndex); end; ////////////////////////////////////////////////////////////////////////////// function GetMarkedCount(aCurrList: TList): Integer; var i: Integer; vFigure: TFigure; begin Result := 0; for i := 0 to aCurrList.Count - 1 do begin vFigure := TFigure(aCurrList[i]); if CheckFigureByClassName(vFigure, cTOrthoLine) then if TOrthoLine(vFigure).FMarkTracing then Result := Result + 1; end; end; function GetPathLength(aCurrList: TList): Double; var i: Integer; vFigure: TFigure; begin Result := 0; for i := 0 to aCurrList.Count - 1 do begin vFigure := TFigure(aCurrList[i]); if CheckFigureByClassName(vFigure, cTOrthoLine) then Result := Result + TOrthoLine(vFigure).LineLength; end; end; // ***** GET SORTED LIST ***************************************************** function GetSortedResultList(aResList: TList): TList; var i, j: Integer; vList: TList; vFigure: TFigure; vLine: TOrthoLine; vConn: TConnectorObject; vLength: Double; vCount: Integer; ShortestIndex: Integer; ShortestList: TList; AllMarkedCount: Integer; CurrMaxCount: Integer; MaxIndex: Integer; begin Result := TList.Create; // получить кол-во отмеченных на листе AllMarkedCount := 0; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin vFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(vFigure, cTOrthoLine) then if TOrthoLine(vFigure).FMarkTracing then AllMarkedCount := AllMarkedCount + 1; end; // получение листа с найкратчайшим путем ShortestList := nil; for i := 0 to aResList.Count - 1 do begin vList := TList(aResList[i]); vLength := GetPathLength(vList); if i = 0 then begin MinLength := vLength; ShortestList := vList; end else if vLength < MinLength then begin MinLength := vLength; ShortestList := vList; end; end; // сортировка листов с отмеченными трассами i := 0; while i < aResList.Count do begin vList := TList(aResList[i]); vCount := GetMarkedCount(vList); vLength := GetPathLength(vList); CurrMaxCount := vCount; MinLength := vLength; MaxIndex := 0; for j := 1 to aResList.Count - 1 do begin vList := TList(aResList[j]); vCount := GetMarkedCount(vList); vLength := GetPathLength(vList); // найден лист с большим кол-вом отмеченных if vCount > CurrMaxCount then begin CurrMaxCount := vCount; MaxIndex := j; end else // кол-во отмеченных совпадает, но длинна пути меньше if (vCount = CurrMaxCount) and (vLength < MinLength) then begin MinLength := vLength; MaxIndex := j; end; end; if CurrMaxCount > 0 then Result.Add(aResList[MaxIndex]); aResList.Delete(MaxIndex); end; if Result.IndexOf(ShortestList) = - 1 then begin if CheckNoListInList(ShortestList, Result) then Result.Add(ShortestList); end; end; //function ReverseOrderInLists(aList: TList): TList; //begin //end; begin OldTick := Now; AFigureServer := aAFigureWS; AFigureWS := aAFigureServer; // AFigureServer := aAFigureServer; // AFigureWS := aAFigureWS; Result := nil; try ResultList := TList.Create; // получить путь по отмеченным CurrIDPathList := TList.Create; GetStepInCAD(AFigureServer, nil, 0); if ResultList.Count = 0 then Result := ResultList else //Tolik // Result := GetSortedResultList(ResultList) begin if SotrListByMarked then Result := GetSortedResultList(ResultList) else Result := ResultList; end; // if CurrIDPathList <> nil then FreeAndNil(CurrIDPathList); // Реверсировать этот лист (нужно для правильного порядка соединений в МП, при ручной трассировки) // Result := ReverseOrderInLists(Result); except on E: Exception do addExceptionToLogEx('U_Common.GetAllTraceInCADByMarked', E.Message); end; end; function CheckConnJoinBetwFloor(aConn: TConnectorObject; CheckRaiseUpDown: boolean = False): Boolean; var RaiseConn: TConnectorObject; begin Result := false; RaiseConn := GetRaiseConn(aConn); if RaiseConn <> nil then begin if Not CheckRaiseUpDown then begin if RaiseConn.FConnRaiseType in [crt_BetweenFloorUp, crt_BetweenFloorDown] then Result := true; end else if RaiseConn.FConnRaiseType in [crt_BetweenFloorUp, crt_BetweenFloorDown, crt_TrunkUp, crt_TrunkDown] then Result := true; end; end; function CheckOtherTraceBetwFloor(Trace: TOrthoLine; CheckRaiseUpDown: boolean = False; CheckMore: boolean = false): Boolean; var isBetweenFloor: boolean; k, kk: integer; JoinTrace: TOrthoLine; JoinTrace2: TOrthoLine; begin result := False; isBetweenFloor := False; try if Trace.JoinConnector1 <> nil then begin for k := 0 to TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Count - 1 do begin JoinTrace := TOrthoLine(TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Items[k]); if ((JoinTrace.FIsRaiseUpDown or JoinTrace.FIsVertical) and CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace.JoinConnector1), CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace.JoinConnector2), CheckRaiseUpDown) then begin isBetweenFloor := True; break; end else begin if (JoinTrace.JoinConnector2 <> nil) and Not isBetweenFloor and CheckMore then begin for kk := 0 to TConnectorObject(JoinTrace.JoinConnector1).JoinedOrtholinesList.Count - 1 do begin JoinTrace2 := TOrthoLine(TConnectorObject(JoinTrace.JoinConnector1).JoinedOrtholinesList.Items[kk]); if ((JoinTrace2.FIsRaiseUpDown or JoinTrace2.FIsVertical) and CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector1), CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector2), CheckRaiseUpDown) then begin isBetweenFloor := True; break; end; end; end; if (JoinTrace.JoinConnector2 <> nil) and Not isBetweenFloor and CheckMore then begin for kk := 0 to TConnectorObject(JoinTrace.JoinConnector2).JoinedOrtholinesList.Count - 1 do begin JoinTrace2 := TOrthoLine(TConnectorObject(JoinTrace.JoinConnector2).JoinedOrtholinesList.Items[kk]); if ((JoinTrace2.FIsRaiseUpDown or JoinTrace2.FIsVertical) and CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector1), CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector2), CheckRaiseUpDown) then begin isBetweenFloor := True; break; end; end; end; end; if isBetweenFloor then break; end; end; if (Trace.JoinConnector2 <> nil) and Not isBetweenFloor then begin for k := 0 to TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Count - 1 do begin JoinTrace := TOrthoLine(TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Items[k]); if ((JoinTrace.FIsRaiseUpDown or JoinTrace.FIsVertical) and CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace.JoinConnector1), CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace.JoinConnector2), CheckRaiseUpDown) then begin isBetweenFloor := True; break; end else begin if (JoinTrace.JoinConnector2 <> nil) and Not isBetweenFloor and CheckMore then begin for kk := 0 to TConnectorObject(JoinTrace.JoinConnector1).JoinedOrtholinesList.Count - 1 do begin JoinTrace2 := TOrthoLine(TConnectorObject(JoinTrace.JoinConnector1).JoinedOrtholinesList.Items[kk]); if ((JoinTrace2.FIsRaiseUpDown or JoinTrace2.FIsVertical) and CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector1), CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector2), CheckRaiseUpDown) then begin isBetweenFloor := True; break; end; end; end; if (JoinTrace.JoinConnector2 <> nil) and Not isBetweenFloor and CheckMore then begin for kk := 0 to TConnectorObject(JoinTrace.JoinConnector2).JoinedOrtholinesList.Count - 1 do begin JoinTrace2 := TOrthoLine(TConnectorObject(JoinTrace.JoinConnector2).JoinedOrtholinesList.Items[kk]); if ((JoinTrace2.FIsRaiseUpDown or JoinTrace2.FIsVertical) and CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector1), CheckRaiseUpDown) or CheckConnJoinBetwFloor(TConnectorObject(JoinTrace2.JoinConnector2), CheckRaiseUpDown) then begin isBetweenFloor := True; break; end; end; end; end; if isBetweenFloor then break; end; end; except end; result := isBetweenFloor; end; function GetAllNoConnectedTraces(aCAD: TF_CAD): TList; var i, k, kk: Integer; Trace: TOrthoLine; isBetweenFloor: boolean; // aList: TList; //function isBetweenFloorExist(TraceCh: TOrthoLine): boolean; //var // JoinTrace: TOrthoLine; // j: integer; //begin // result := False; // if TraceCh.JoinConnector1 <> nil then // begin // for j := 0 to TConnectorObject(TraceCh.JoinConnector1).JoinedOrtholinesList.Count - 1 do // begin // JoinTrace := TOrthoLine(TConnectorObject(TraceCh.JoinConnector1).JoinedOrtholinesList.Items[j]); // if aList.IndexOf(JoinTrace) < 0 then // begin // aList.Add(JoinTrace); // if JoinTrace.JoinConnector1 <> nil then // if (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorUp) // or (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorDown) then // result := True; // if result then // break; // if JoinTrace.JoinConnector2 <> nil then // if (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorUp) // or (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorDown) then // result := True; // if result then // break; // result := isBetweenFloorExist(JoinTrace); // if result then // break; // end; // end; // end; // // if (TraceCh.JoinConnector2 <> nil) and Not Result then // begin // for j := 0 to TConnectorObject(TraceCh.JoinConnector2).JoinedOrtholinesList.Count - 1 do // begin // JoinTrace := TOrthoLine(TConnectorObject(TraceCh.JoinConnector2).JoinedOrtholinesList.Items[j]); // if aList.IndexOf(JoinTrace) < 0 then // begin // aList.Add(JoinTrace); // if JoinTrace.JoinConnector1 <> nil then // if (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorUp) // or (TConnectorObject(JoinTrace.JoinConnector1).FConnRaiseType = crt_BetweenFloorDown) then // result := True; // if result then // break; // if JoinTrace.JoinConnector2 <> nil then // if (TConnectorObject(JoinTrace.JoinConnector2).FConnRaiseType = crt_BetweenFloorUp) // or (TConnectorObject(JoinTrace.JoinConnector2).FConnRaiseType = crt_BetweenFloorDown) then // result := True; // if result then // break; // // result := isBetweenFloorExist(JoinTrace); // if result then // break; // end; // end; // end; //end; begin // Result := GetAllFiguresByClass(aCAD, TOrthoLine); // aList := TList.Create; // for i := Result.Count - 1 downto 0 do // begin // Trace := TOrthoLine(Result[i]); // aList.Clear; // isBetweenFloor := isBetweenFloorExist(Trace); // if Trace.FIsRaiseUpDown or Trace.FIsVertical then // Result.Delete(i) // else // if isBetweenFloor then // Result.Delete(i) // end; // aList.Free; Result := GetAllFiguresByClass(aCAD, TOrthoLine); for i := Result.Count - 1 downto 0 do begin Trace := TOrthoLine(Result[i]); isBetweenFloor := False; if Trace.FIsRaiseUpDown or Trace.FIsVertical or CheckConnJoinBetwFloor(TConnectorObject(Trace.JoinConnector1)) or CheckConnJoinBetwFloor(TConnectorObject(Trace.JoinConnector2)) then Result.Delete(i) else begin isBetweenFloor := CheckOtherTraceBetwFloor(Trace); if isBetweenFloor then Result.Delete(i) end; end; end; function CheckNoFigureInList(ACheckFigure: TFigure; AList: TList): Boolean; var i: Integer; begin Result := true; try if AList <> nil then begin for i := 0 to AList.Count - 1 do if ACheckFigure = TFigure(AList[i]) then begin Result := false; Break; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckNoFigureinList', E.Message); end; end; function CheckNoCadInList(ACheckCad: TF_CAD; AList: TList): Boolean; var i: Integer; begin Result := true; try if AList <> nil then begin for i := 0 to AList.Count - 1 do if ACheckCad = TF_CAD(AList[i]) then begin Result := false; Break; end; end; except on E: Exception do addExceptionToLogEx('CheckNoFigureInList', E.Message); end; end; function CheckNoListInList(AInList, AList: TList): Boolean; var i: Integer; begin Result := true; try if AList <> nil then begin for i := 0 to AList.Count - 1 do if AInList = TList(AList[i]) then begin Result := false; Break; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.CheckNoListInList', E.Message); end; end; function CheckRaise(APointObject: TConnectorObject): Boolean; var i, j: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; MinX, MaxX, MinY, MaxY: Double; begin Result := False; try // объект if APointObject.ConnectorType <> ct_Clear then begin for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.FObjectFromRaisedLine = APointObject then Result := True; end; end; end else // соединитель begin for i := 0 to APointObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(APointObject.JoinedOrtholinesList[i]); if JoinedLine.FObjectFromRaisedLine = APointObject then Result := True; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckRaise', E.Message); end; end; function GetBasisPointByObjFromRaise(aObj: TConnectorObject): TDoublePoint; begin Result := DoublePoint(0,0,0); if aObj.DrawFigure = nil then begin Result.x := aObj.ActualPoints[1].x + aObj.GrpSizeX / 2; Result.y := aObj.ActualPoints[1].y - aObj.GrpSizeY / 2; end else begin if aObj.DrawFigure.InFigures.Count = 0 then begin Result.x := aObj.ActualPoints[1].x + aObj.GrpSizeX / 2; Result.y := aObj.ActualPoints[1].y - aObj.GrpSizeY / 2; end else begin Result.x := aObj.DrawFigure.CenterPoint.x + aObj.GrpSizeX / 2 - 0.5; Result.y := aObj.DrawFigure.CenterPoint.y - aObj.GrpSizeY / 2 + 0.5; end; end; end; function GetRaiseConn(APointObject: TConnectorObject): TConnectorObject; var i, j: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; MinX, MaxX, MinY, MaxY: Double; CurConn: TConnectorObject; begin Result := nil; try if APointObject = nil then Exit; // соединитель if APointObject.ConnectorType = ct_Clear then begin for i := 0 to APointObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(APointObject.JoinedOrtholinesList[i]); if JoinedLine.FObjectFromRaisedLine = APointObject then begin // 1 CurConn := TConnectorObject(JoinedLine.JoinConnector1); if CurConn.JoinedConnectorsList.Count = 0 then begin if CurConn.FObjectFromRaise = APointObject then Result := CurConn; end else begin if TConnectorObject(CurConn.JoinedConnectorsList[0]).FObjectFromRaise = APointObject then Result := TConnectorObject(CurConn.JoinedConnectorsList[0]); end; // 2 CurConn := TConnectorObject(JoinedLine.JoinConnector2); if CurConn.JoinedConnectorsList.Count = 0 then begin if CurConn.FObjectFromRaise = APointObject then Result := CurConn; end else begin if TConnectorObject(CurConn.JoinedConnectorsList[0]).FObjectFromRaise = APointObject then Result := TConnectorObject(CurConn.JoinedConnectorsList[0]); end; end; end; end else // объект begin for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.FObjectFromRaisedLine = APointObject then begin CurConn := TConnectorObject(JoinedLine.JoinConnector1); if CurConn.JoinedConnectorsList.Count = 0 then begin if CurConn.FObjectFromRaise = APointObject then Result := CurConn; end else begin if TConnectorObject(CurConn.JoinedConnectorsList[0]).FObjectFromRaise = APointObject then Result := TConnectorObject(CurConn.JoinedConnectorsList[0]); end; // 2 CurConn := TConnectorObject(JoinedLine.JoinConnector2); if CurConn.JoinedConnectorsList.Count = 0 then begin if CurConn.FObjectFromRaise = APointObject then Result := CurConn; end else begin if TConnectorObject(CurConn.JoinedConnectorsList[0]).FObjectFromRaise = APointObject then Result := TConnectorObject(CurConn.JoinedConnectorsList[0]); end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetRaiseConn', E.Message); end; end; function GetRaiseLine(ARaiseConn: TConnectorObject): TOrthoLine; var i, j: integer; ConnectedConn: TConnectorObject; begin Result := nil; try // Вершина с-п - соединитель if ARaiseConn.ConnectorType = ct_Clear then begin for i := 0 to ARaiseConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(ARaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then Result := TOrthoLine(ARaiseConn.JoinedOrtholinesList[i]); end else // Вершина с-п - Объект begin for i := 0 to ARaiseConn.JoinedConnectorsList.Count - 1 do begin ConnectedConn := TConnectorObject(ARaiseConn.JoinedConnectorsList[i]); for j := 0 to ConnectedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(ConnectedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then Result := TOrthoLine(ConnectedConn.JoinedOrtholinesList[j]); end; end; // Correct if Result <> nil then begin if Result.FLineRaiseType = lrt_None then begin if ARaiseConn.FObjectFromRaise <> nil then Result.FLineRaiseType := GetRaiseType(ARaiseConn.FObjectFromRaise, aRaiseConn); end; end; except on E: Exception do addExceptionToLogEx('U_Common.GerRaiseLine', E.Message); end; end; function GetRaiseByRaiseLine(aRaiseLine: TOrthoLine): TConnectorObject; begin Result := nil; try if TConnectorObject(aRaiseLine.JoinConnector1).FConnRaiseType <> crt_None then Result := TConnectorObject(aRaiseLine.JoinConnector1); if TConnectorObject(aRaiseLine.JoinConnector2).FConnRaiseType <> crt_None then Result := TConnectorObject(aRaiseLine.JoinConnector2); except on E: Exception do addExceptionToLogEx('U_Common.GetRaiseByRaiseLine', E.Message); end; end; // высота комнаты Procedure SetCurrListHeightRoom(AHeight: Double); begin GCadForm.FRoomHeight := AHeight; end; // высота подвесного потолка Procedure SetCurrListHeightCeiling(AHeight: Double); //*** для потолка begin GCadForm.FFalseFloorHeight := AHeight; end; // высота розеток Procedure SetCurrListHeightSocket(AHeight: Double); //*** для розеток begin GCadForm.FConnHeight := AHeight; end; // выделить подсоединенный коннектор на CAD Procedure SelectConnectedConnector(AID_List, AID_Figure: Integer); var i: integer; CAD_Figure: TFigure; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin CAD_Figure := GetFigureByID(vList, AID_Figure); if CAD_Figure <> nil then begin vList.PCad.DeselectAll(2); CAD_Figure.Select; RefreshCAD(vList.PCad); end; end; except on E: Exception do addExceptionToLogEx('U_Common.SelectConnectedConnector', E.Message); end; end; Procedure SelectConnectedCables(AID_List: Integer; ALinesList: TIntList); var FCount: integer; LCount: integer; IDInterf: Integer; ID: Integer; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin vList.PCad.DeselectAll(2); for LCount := 0 to ALinesList.Count - 1 do begin IDInterf := ALinesList[LCount]; ID := IDInterf; for FCount := 0 to vList.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(vList.PCad.Figures[FCount]), cTOrthoLine) then if TFigure(vList.PCad.Figures[FCount]).ID = ID then TOrthoLine(vList.PCad.Figures[FCount]).Select; end; end; RefreshCAD(vList.PCad); end; except on E: Exception do addExceptionToLogEx('U_Common.SelectConnectedCables', E.Message); end; end; // СОЗДАТЬ С-П НА ОБЪЕКТЕ procedure CreateRaiseOnPointObject(APointObject: TConnectorObject; AHeight: Double; aBaseConnector: TConnectorObject = nil); var ConnectedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; x, y, z: double; i: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; JoinedConnBase: TConnectorObject; ObjParams: TObjectParams; TempRaisedConnectors: TList; CurIndex: Integer; //Tolik SetRaiseHeight: Double; RaiseHeight: Double; ObjFromRaise: TConnectorObject; begin BaseBeginUpdate; try if CheckJoinVertical(APointObject) then begin PutObjectOnHeight(APointObject, AHeight); BaseEndUpdate; exit; end; x := APointObject.ActualPoints[1].x; y := APointObject.ActualPoints[1].y; // Tolik // z := APointObject.ActualZOrder[1]; if TConnectorObject(APointObject).Radius > 10000000 then //if TConnectorObject(APointObject).Radius > 11000000 then begin if (TConnectorObject(APointObject).Radius - 11000000) <> 999 then z := TConnectorObject(APointObject).Radius - 11000000 else z := APointObject.ActualZOrder[1]; end else z := APointObject.ActualZOrder[1]; // создать присоединенный коннектор ConnectedConn := TConnectorObject.Create(x, y, AHeight, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False); ConnectedConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); ObjParams := GetFigureParams(ConnectedConn.ID); ConnectedConn.Name := ObjParams.Name; ConnectedConn.FIndex := ObjParams.MarkID; APointObject.ActualZOrder[1] := AHeight; for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do TConnectorObject(APointObject.JoinedConnectorsList[i]).ActualZOrder[1] := APointObject.ActualZOrder[1]; SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]); // создать подъем-спуск коннектор RaiseConn := TConnectorObject.Create(x + 10, y - 10, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, AHeight, x + 10, y - 10, z, 1,ord(psSolid), clBlack, 0, APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); // Tolik RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1]; // RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; if TConnectorObject(APointObject).Radius > 10000000 then begin if ((APointObject.Radius - 11000000) <> 999) and ( (APointObject.Radius - 11000000) <> 0) then RaiseLine.ActualZOrder[2] := APointObject.Radius - 11000000 else RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; end else RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; // SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]); // приконнектить подъем SnapConnectorToPointObject(ConnectedConn, APointObject, true); // Tolik RaiseLine.ActualZOrder[1] := APointObject.ActualZOrder[1]; TConnectorObject(RaiseLine.JoinConnector1).ActualZOrder[1] := APointObject.ActualZOrder[1]; // RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; { if TConnectorObject(APointObject).Radius > 10000000 then if (APointObject.Radius - 11000000) <> 999 then RaiseLine.ActualZOrder[2] := APointObject.Radius - 11000000 else RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];} //else // RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1];} // RaiseConn.MoveConnector(-10, 10, False); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseConn, False); RaiseConn.Name := cCadClasses_Mes24; // ??? RaiseConn.FConnRaiseType := crt_OnFloor; RaiseConn.FObjectFromRaise := APointObject; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes25; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := APointObject; RaiseLine.FLineRaiseType := GetRaiseType(APointObject, RaiseConn); RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; RaiseLine.LockModify := True; ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; // переподсоединить трассы к подъему TempRaisedConnectors := TList.Create; // небыло прямой привязки коннектора к ТО if aBaseConnector = nil then begin for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); if JoinedConn <> ConnectedConn then TempRaisedConnectors.Add(JoinedConn); end; end else // непосредственно привязка коннектора к ТО begin TempRaisedConnectors.Add(aBaseConnector); end; // отвязка for i := 0 to TempRaisedConnectors.Count - 1 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); UnsnapConnectorFromPointObject(JoinedConn, APointObject, true); end; // перепривязка к вершине CurIndex := TempRaisedConnectors.Count - 1; // вязать без сортировок if aBaseConnector = nil then begin for i := CurIndex downto 0 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); SnapConnectorToConnector(JoinedConn, RaiseConn, true); RaiseConn := JoinedConn; end; end else // с учтом того что должен остаться текущий коннектор, который сейчас Move begin for i := 0 to TempRaisedConnectors.Count - 1 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); if JoinedConn <> aBaseConnector then begin SnapConnectorToConnector(JoinedConn, RaiseConn, true); RaiseConn := JoinedConn; end; end; SnapConnectorToConnector(aBaseConnector, RaiseConn, true); RaiseConn := aBaseConnector; end; if TempRaisedConnectors <> nil then FreeAndNil(TempRaisedConnectors); // Tolik if (TConnectorObject(APointObject).Radius > 10000000) and ((APointObject.Radius - 11000000) <> 999) and ((APointObject.Radius - 11000000) <> 0) then begin RaiseHeight := (APointObject.Radius - 11000000); RaiseHeight := UOMToMetre(RaiseHeight); if RaiseConn.FConnRaiseType = crt_OnFloor then begin SetRaiseHeight := ObjFromRaise.ActualZOrder[1] + RaiseHeight; if SetRaiseHeight > GCadForm.FRoomHeight then SetRaiseHeight := GCadForm.FRoomHeight; if SetRaiseHeight = ObjFromRaise.ActualZOrder[1] then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else begin RaiseConn.ActualZOrder[1] := SetRaiseHeight; SetConFigureCoordZInPM(RaiseConn.ID, RaiseConn.ActualZOrder[1]); end; end else // BetweenFloor begin SetRaiseHeight := RaiseConn.ActualZOrder[1] - RaiseHeight; if SetRaiseHeight < 0 then SetRaiseHeight := 0; if SetRaiseHeight > GCadForm.FRoomHeight then SetRaiseHeight := GCadForm.FRoomHeight; if SetRaiseHeight = RaiseConn.ActualZOrder[1] then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else begin ObjFromRaise.ActualZOrder[1] := SetRaiseHeight; SetConFigureCoordZInPM(ObjFromRaise.ID, ObjFromRaise.ActualZOrder[1]); end; end; end; RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); // *** for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if JoinedLine <> RaiseLine then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, false); JoinedLine.ReCreateDrawFigureBlock; end; end; SetConnBringToFront(APointObject); SetConnBringToFront(RaiseConn); RefreshCAD(GCadForm.PCad); SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); {**************************************************************************} RaiseConn := GetRaiseConn(APointObject); if RaiseConn <> nil then AutoConnectOverRaiseInCAD(APointObject, RaiseConn); {**************************************************************************} except on E: Exception do addExceptionToLogEx('U_Common.CreateRaiseOnPointObject', E.Message); end; BaseEndUpdate; end; // ИЗМЕНИТЬ С-П НА ОБЪЕКТЕ Procedure ChangeRaiseOnPointObject(APointObject: TConnectorObject; AHeight: Double); var RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; i, j: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; ObjParams: TObjectParams; begin BaseBeginUpdate; try JoinedLine := nil; RaiseLine := nil; RaiseConn := GetRaiseConn(APointObject); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); // установить новые значения SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]); // совпадает с с-п, удалить с-п if RaiseConn.ActualZOrder[1] = AHeight then begin AutoDisconnectOverRaiseInCAD(APointObject, RaiseConn, RaiseLine); //#From Oleg# if RaiseConn <> nil then begin if RaiseConn.ConnectorType = ct_Clear then RemoveRMWithClear(APointObject, RaiseConn) else RemoveRMWithRM(APointObject, RaiseConn); end; end else // изменить высоту begin // установить новые значения APointObject.ActualZOrder[1] := AHeight; SetConnBringToFront(APointObject); for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := APointObject.JoinedConnectorsList[i]; JoinedConn.ActualZOrder[1] := APointObject.ActualZOrder[1]; for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := JoinedConn.JoinedOrtholinesList[j]; if JoinedLine.JoinConnector1 = JoinedConn then begin SetLineFigureCoordZInPM(JoinedLine.ID, 1, APointObject.ActualZOrder[1]); JoinedLine.ActualZOrder[1] := APointObject.ActualZOrder[1]; end; if JoinedLine.JoinConnector2 = JoinedConn then begin SetLineFigureCoordZInPM(JoinedLine.ID, 2, APointObject.ActualZOrder[1]); JoinedLine.ActualZOrder[2] := APointObject.ActualZOrder[1]; end; end; SetConFigureCoordZInPM(JoinedConn.ID, JoinedConn.ActualZOrder[1]); if JoinedLine <> nil then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); // Обновить поле длинны для ортолинии JoinedLine.UpdateLengthTextBox(false, true); end; end; // подъем-спуск RaiseLine.FLineRaiseType := GetRaiseType(APointObject, RaiseConn); // RaiseLine.ReCreateCaptionsGroup(True, true); RaiseLine.UpdateLengthTextBox(True, true); RaiseLine.ReCreateNotesGroup(True); SetConFigureCoordZInPM(APointObject.ID, AHeight); end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.ChangeRaiseOnPointObject', E.Message); end; BaseEndUpdate; end; // СОЗДАТЬ ОБЪЕКТ НА СОЕДИНИТЕЛЕ Procedure CreateRaiseOnConnector(AConnector: TConnectorObject; AHeight: Double); var ConnectedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; x, y, z: double; i: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ObjParams: TObjectParams; begin BaseBeginUpdate; try if CheckJoinVertical(AConnector) then begin PutObjectOnHeight(AConnector, AHeight); BaseEndUpdate; exit; end; x := AConnector.ActualPoints[1].x; y := AConnector.ActualPoints[1].y; z := AConnector.ActualZOrder[1]; // создать подъем-спуск коннектор RaiseConn := TConnectorObject.Create(x, y, AHeight, AConnector.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, AHeight, x, y, z, 1,ord(psSolid), clBlack, 0, AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(AConnector)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); RaiseLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseConn, False); RaiseConn.Name := cCadClasses_Mes24; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes25; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; RaiseConn.FConnRaiseType := crt_OnFloor; RaiseConn.FObjectFromRaise := AConnector; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := AConnector; RaiseLine.FLineRaiseType := GetRaiseType(AConnector, RaiseConn); RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); // *** for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if JoinedLine <> RaiseLine then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, false); JoinedLine.ReCreateDrawFigureBlock; end; end; RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; RaiseLine.LockModify := True; SetConnBringToFront(AConnector); SetConnBringToFront(RaiseConn); RefreshCAD(GCadForm.PCad); {**************************************************************************} RaiseConn := GetRaiseConn(AConnector); if RaiseConn <> nil then AutoConnectOverRaiseInCAD(AConnector, RaiseConn); except on E: Exception do addExceptionToLogEx('U_Common.CreateRaiseOnConnector', E.Message); end; BaseEndUpdate; end; // ИЗМЕНИТЬ С-П НА СОЕДИНИТЕЛЕ Procedure ChangeRaiseOnConnector(AConnector: TConnectorObject; AHeight: Double); var RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; i: integer; ObjParams: TObjectParams; begin BaseBeginUpdate; try RaiseLine := nil; if AConnector.FObjectFromRaise <> nil then RaiseConn := AConnector.FObjectFromRaise else RaiseConn := GetRaiseConn(AConnector); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]); // совпадает с с-п, удалить с-п if RaiseConn.ActualZOrder[1] = AHeight then begin AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg# RaiseConn.ActualZOrder[1] := AConnector.ActualZOrder[1]; AConnector.ActualZOrder[1] := AHeight; end else // изменить высоту begin // установить новые значения AConnector.ActualZOrder[1] := AHeight; SetConnBringToFront(AConnector); // подъем-спуск RaiseLine.FLineRaiseType := GetRaiseType(AConnector, RaiseConn); RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); // RaiseLine.ReCreateCaptionsGroup(True, True); RaiseLine.UpdateLengthTextBox(True, true); RaiseLine.ReCreateNotesGroup(True); end; SetConFigureCoordZInPM(AConnector.ID, AHeight); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.ChangeRaiseOnConnector', E.Message); end; BaseEndUpdate; end; // АВТОСОЗДАВАТЬ НА ПРИЛЕГАЮЩИХ ТРАССАХ Procedure CreateRaiseOnNextObject(AConnector: TConnectorObject; AJoinedLine: TOrthoLine; AHeight: Double); var PointObject: TConnectorObject; ConnectedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; x, y, z: double; i: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; NextConnector1, NextConnector2: TConnectorObject; ObjParams: TObjectParams; isDisconnected: Boolean; CurrLine: TOrthoLine; ResPointObject: TConnectorObject; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; FirstRaiseLine: TOrthoLine; begin BaseBeginUpdate; try if CheckJoinVertical(AConnector) then begin PutObjectOnHeight(AConnector, AHeight); BaseEndUpdate; exit; end; {******************** СОЕДИНИТЕЛЬ *****************************************} if AConnector.JoinedConnectorsList.Count = 0 then begin x := AConnector.ActualPoints[1].x; y := AConnector.ActualPoints[1].y; z := AConnector.ActualZOrder[1]; // создать подъем-спуск коннектор RaiseConn := TConnectorObject.Create(x, y, AHeight, AConnector.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, z, x, y, AHeight, 1,ord(psSolid), clBlack, 0, AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(AConnector)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); RaiseLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseConn, False); RaiseConn.Name := cCadClasses_Mes24; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes25; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; RaiseConn.FConnRaiseType := crt_OnFloor; RaiseConn.FObjectFromRaise := AConnector; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := AConnector; RaiseLine.FLineRaiseType := GetRaiseType(AConnector, RaiseConn); RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); // *** for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if JoinedLine <> RaiseLine then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, false); JoinedLine.ReCreateDrawFigureBlock; end; end; RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; RaiseLine.LockModify := True; ParamsList1 := TList.create; ParamsList2 := TList.create; // переподсоединить if AJoinedLine.JoinConnector1 = AConnector then begin // New(ptrInterfRecord1); ptrInterfRecord1.IDObject := AJoinedLine.ID; ptrInterfRecord1.Side := 1; ParamsList1.Add(ptrInterfRecord1); // for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); if CurrLine <> AJoinedLine then begin New(ptrInterfRecord2); ptrInterfRecord2.IDObject := CurrLine.ID; if CurrLine.JoinConnector1 = AConnector then ptrInterfRecord2.Side := 1; if CurrLine.JoinConnector2 = AConnector then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; // TConnectorObject(AJoinedLine.JoinConnector1).JoinedOrtholinesList.Remove(AJoinedLine); AJoinedLine.SetJConnector1(TConnectorObject(RaiseConn)); AJoinedLine.ActualZOrder[1] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(AJoinedLine.ID, 1, AJoinedLine.ActualZOrder[1]); end; if AJoinedLine.JoinConnector2 = AConnector then begin // New(ptrInterfRecord1); ptrInterfRecord1.IDObject := AJoinedLine.ID; ptrInterfRecord1.Side := 2; ParamsList1.Add(ptrInterfRecord1); // for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); if CurrLine <> AJoinedLine then begin New(ptrInterfRecord2); ptrInterfRecord2.IDObject := CurrLine.ID; if CurrLine.JoinConnector1 = AConnector then ptrInterfRecord2.Side := 1; if CurrLine.JoinConnector2 = AConnector then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; // TConnectorObject(AJoinedLine.JoinConnector2).JoinedOrtholinesList.Remove(AJoinedLine); AJoinedLine.SetJConnector2(TConnectorObject(RaiseConn)); AJoinedLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(AJoinedLine.ID, 2, AJoinedLine.ActualZOrder[2]); end; SetConnBringToFront(AConnector); SetConnBringToFront(RaiseConn); ResPointObject := AConnector; end else {******************** ОБЪЕКТ **********************************************} begin PointObject := TConnectorObject(AConnector.JoinedConnectorsList[0]); x := PointObject.ActualPoints[1].x; y := PointObject.ActualPoints[1].y; z := PointObject.ActualZOrder[1]; RaiseConn := GetRaiseConn(PointObject); FirstRaiseLine := nil; if RaiseConn = Nil then begin // создать присоединенный коннектор ConnectedConn := TConnectorObject.Create(x, y, z, PointObject.LayerHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(PointObject.LayerHandle), ConnectedConn, False); ConnectedConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); ObjParams := GetFigureParams(ConnectedConn.ID); ConnectedConn.Name := ObjParams.Name; ConnectedConn.FIndex := ObjParams.MarkID; // создать подъем-спуск коннектор RaiseConn := TConnectorObject.Create(x + 10, y - 10, AHeight, PointObject.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, AHeight, 1,ord(psSolid), clBlack, 0, PointObject.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1]; RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(RaiseLine.ID, 1, AJoinedLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, AJoinedLine.ActualZOrder[2]); // приконнектить подъем SnapConnectorToPointObject(ConnectedConn, PointObject, true); RaiseConn.MoveConnector(-10, 10, False); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(PointObject.LayerHandle), RaiseConn, False); // ??? RaiseConn.FConnRaiseType := crt_OnFloor; RaiseConn.FObjectFromRaise := PointObject; RaiseConn.Name := cCadClasses_Mes24; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(PointObject.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes25; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := PointObject; RaiseLine.FLineRaiseType := GetRaiseType(PointObject, RaiseConn); RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); // *** for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if JoinedLine <> RaiseLine then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, false); JoinedLine.ReCreateDrawFigureBlock; end; end; RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; // Igor - не понятно зачем оно тут было (тем более после поднятия со стрима он всегда визибл) - пока закоментил // D0000006059 //RaiseLine.Visible := False; RaiseLine.LockModify := True; ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; end else begin FirstRaiseLine := GetRaiseLine(RaiseConn); if (PointObject <> nil) and (FirstRaiseLine <> nil) then AutoDisconnectOverRaiseInCAD(PointObject, RaiseConn, FirstRaiseLine); //#From Oleg# end; // переподсоединить трассы к подъему UnsnapConnectorFromPointObject(AConnector, PointObject, true); //Tolik SnapConnectorToConnector(AConnector, RaiseConn, true); //SnapConnectorToConnector(RaiseConn, AConnector, true); // SetConnBringToFront(PointObject); SetConnBringToFront(AConnector); ResPointObject := PointObject; end; RefreshCAD(GCadForm.PCad); {**************************************************************************} RaiseConn := GetRaiseConn(ResPointObject); if RaiseConn <> nil then AutoConnectOverRaiseInCAD(ResPointObject, RaiseConn); {**************************************************************************} except on E: Exception do addExceptionToLogEx('U_Common.CreateRaiseOnNextObject', E.Message); end; BaseEndUpdate; end; // АВТОИЗМЕНЯТЬ ПОДЪЕМ НА ПРИЛЕГАЮЩИХ ОБЪЕТАХ Procedure ChangeRaiseOnNextObject(AConnector: TConnectorObject; AJoinedLine: TOrthoLine; AHeight: Double); var ObjectOnRaise: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; PointObject: TConnectorObject; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; i, j: integer; ObjParams: TObjectParams; NewConn: TConnectorObject; begin BaseBeginUpdate; try JoinedLine := nil; //#From Oleg# RaiseLine := nil; //#From Oleg# {************* СОЕДИНИТЕЛЬ ************************************************} if AConnector.JoinedConnectorsList.Count = 0 then begin if AConnector.FObjectFromRaise <> nil then RaiseConn := AConnector.FObjectFromRaise else RaiseConn := GetRaiseConn(AConnector); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); // установить новые значения SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]); // совпадает с с-п, удалить с-п ------------------------------------------ if RaiseConn.ActualZOrder[1] = AHeight then begin AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg# NewConn := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, RaiseConn.ActualZOrder[1], RaiseConn.LayerHandle, mydsNormal, GCadForm.PCad); NewConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure(2, NewConn, False); if AJoinedLine.JoinConnector1 = AConnector then AJoinedLine.SetJConnector1(NewConn); if AJoinedLine.JoinConnector2 = AConnector then AJoinedLine.SetJConnector2(NewConn); AConnector.JoinedOrtholinesList.Remove(AJoinedLine); if RaiseConn.ConnectorType = ct_Clear then SnapConnectorToConnector(NewConn, RaiseConn) else SnapConnectorToPointObject(NewConn, RaiseConn); AutoConnectOverRaiseInCAD(AConnector, RaiseConn); //#From Oleg# //AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg# end else // изменить высоту ------------------------------------------------------- begin // установить новые значения AConnector.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]); SetConnBringToFront(AConnector); for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := AConnector.JoinedOrtholinesList[i]; if JoinedLine.JoinConnector1 = AConnector then begin SetLineFigureCoordZInPM(JoinedLine.ID, 1, AConnector.ActualZOrder[1]); JoinedLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; end; if JoinedLine.JoinConnector2 = AConnector then begin SetLineFigureCoordZInPM(JoinedLine.ID, 2, AConnector.ActualZOrder[1]); JoinedLine.ActualZOrder[2] := AConnector.ActualZOrder[1]; end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); // Обновить поле длинны для ортолинии JoinedLine.UpdateLengthTextBox(false, true); end; // подъем-спуск RaiseLine.FLineRaiseType := GetRaiseType(AConnector, RaiseConn); // RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, true); RaiseLine.ReCreateNotesGroup(True); SetConFigureCoordZInPM(AConnector.ID, AHeight); end; end else {************* ОБЪЕКТ *****************************************************} begin PointObject := TConnectorObject(AConnector.JoinedConnectorsList[0]); RaiseConn := GetRaiseConn(PointObject); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); // установить новые значения PointObject.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(PointObject.ID, PointObject.ActualZOrder[1]); // совпадает с с-п, удалить с-п if RaiseConn.ActualZOrder[1] = AHeight then begin AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg# UnSnapConnectorFrompointObject(AConnector, PointObject); if RaiseConn.ConnectorType = ct_Clear then SnapConnectorToConnector(AConnector, RaiseConn) else SnapConnectorToPointObject(AConnector, RaiseConn); end else // изменить высоту begin SetConnBringToFront(PointObject); for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := PointObject.JoinedConnectorsList[i]; JoinedConn.ActualZOrder[1] := PointObject.ActualZOrder[1]; for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := JoinedConn.JoinedOrtholinesList[j]; if JoinedLine.JoinConnector1 = JoinedConn then begin SetLineFigureCoordZInPM(JoinedLine.ID, 1, PointObject.ActualZOrder[1]); JoinedLine.ActualZOrder[1] := PointObject.ActualZOrder[1]; end; if JoinedLine.JoinConnector2 = JoinedConn then begin SetLineFigureCoordZInPM(JoinedLine.ID, 2, PointObject.ActualZOrder[1]); JoinedLine.ActualZOrder[2] := PointObject.ActualZOrder[1]; end; end; SetConFigureCoordZInPM(JoinedConn.ID, JoinedConn.ActualZOrder[1]); if JoinedLine <> nil then //#From Oleg# begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); // Обновить поле длинны для ортолинии JoinedLine.UpdateLengthTextBox(false, true); end; end; // подъем-спуск RaiseLine.FLineRaiseType := GetRaiseType(PointObject, RaiseConn); // RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, true); RaiseLine.ReCreateNotesGroup(True); SetConFigureCoordZInPM(PointObject.ID, AHeight); end; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.ChangeRaiseOnNextObject', E.Message); end; BaseEndUpdate; end; // УДАЛИТЬ С-П НА ОБЪЕКТЕ procedure DestroyRaiseOnPointObject(APointObject: TConnectorObject); var i, j: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; ObjParams: TObjectParams; begin BaseBeginUpdate; try RaiseLine := nil; //#From Oleg# RaiseConn := GetRaiseConn(APointObject); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); if (RaiseLine <> nil) and (not RaiseLine.Deleted) then begin AutoDisconnectOverRaiseInCAD(APointObject, RaiseConn, RaiseLine); //#FROM Oleg# TOrthoLine(RaiseLine).Delete; RefreshCAD(GCadForm.PCad); end; if (RaiseConn <> nil) and (not RaiseConn.Deleted) then begin if RaiseConn.JoinedOrtholinesList.Count > 0 then begin if RaiseConn.ConnectorType = ct_Clear then begin SnapConnectorToPointObject(RaiseConn, APointObject, true); RaiseConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; end; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; RaiseConn.LockMove := False; RaiseConn.LockModify := False; end; end; APointObject.FConnRaiseType := crt_None; APointObject.FObjectFromRaise := nil; APointObject.LockMove := False; APointObject.LockModify := False; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.DestroyRaiseOnPointObject', E.Message); end; BaseEndUpdate; end; // УДАЛИТЬ С-П НА СОЕДИНИТЕЛЕ Procedure DestroyRaiseOnConnector(AConnector: TConnectorObject); var i, j: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; ObjParams: TObjectParams; begin BaseBeginUpdate; try RaiseLine := nil; //#From Oleg# RaiseConn := GetRaiseConn(AConnector); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); if (RaiseLine <> nil) and (not RaiseLine.Deleted) then begin AutoDisconnectOverRaiseInCAD(AConnector, RaiseConn, RaiseLine); //#From Oleg# TOrthoLine(RaiseLine).Delete; RefreshCAD(GCadForm.PCad); end; if (RaiseConn <> nil) and (not RaiseConn.Deleted) then begin if RaiseConn.ConnectorType = ct_clear then begin // SnapConnectorToConnector(RaiseConn, AConnector, true); SnapConnectorToConnector(AConnector, RaiseConn, true); RaiseConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; end; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; RaiseConn.LockMove := False; RaiseConn.LockModify := False; end; if (AConnector <> nil) and (not AConnector.Deleted) then begin AConnector.FConnRaiseType := crt_None; AConnector.FObjectFromRaise := nil; AConnector.LockMove := False; AConnector.LockModify := False; end; except on E: Exception do addExceptionToLogEx('U_Common.DestroyRaiseOnConnector', E.Message); end; BaseEndUpdate; end; // ПОДНЯТЬ ЛИНИЮ НА ВЫСОТУ Procedure RaiseLineOnHeight(ALine: TOrthoLine; AHeight: Double; ATracesList: TList); var Connector1: TConnectorObject; Connector2: TConnectorObject; RT1: TConnectorObject; RT2: TConnectorObject; RaiseConn: TConnectorObject; ObjFromRaise: TConnectorObject; begin BaseBeginUpdate; try Connector1 := TConnectorObject(ALine.JoinConnector1); Connector2 := TConnectorObject(ALine.JoinConnector2); // 1 if Connector1.ActualZOrder[1] <> AHeight then begin // не вершина с-п и на нем нет с-п if (Connector1.FConnRaiseType = crt_None) and (GetRaiseConn(Connector1) = nil) then begin if (Connector1.JoinedConnectorsList.Count > 0) or (Connector1.JoinedOrtholinesList.Count > 1) then begin // Conn if (Connector1.ConnectorType = ct_Clear) and (Connector1.JoinedOrtholinesList.Count > 1) then begin if CheckNeedCreateRaiseOnRaiseTrace(ALine, Connector1, ATracesList) then CreateRaiseOnNextObject(Connector1, ALine, AHeight) else begin Connector1.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(Connector1.ID, Connector1.ActualZOrder[1]);//24.10.2012 ALine.ActualZOrder[1] := AHeight; end; end else // RT begin // RT1 := TConnectorObject(Connector1.JoinedConnectorsList[0]); RaiseConn := GetRaiseConn(RT1); // не вершина с-п и нет с-п if (RT1.FConnRaiseType = crt_None) and (RaiseConn = nil) then CreateRaiseOnNextObject(Connector1, ALine, AHeight) else begin // есть с-п и он межэтажный if (RaiseConn <> nil) and (RaiseConn.FConnRaiseType <> crt_OnFloor) then begin ChangeRaiseOnNextObject(Connector1, ALine, AHeight); end else if (RaiseConn = nil) and (ObjFromRaise <> nil) then begin RT1.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(RT1.ID, RT1.ActualZOrder[1]); //24.10.2012 Connector1.ActualZOrder[1] := AHeight; ALine.ActualZOrder[1] := AHeight; end else begin CreateRaiseOnNextObject(Connector1, ALine, AHeight); end; end; end; end else begin Connector1.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(Connector1.ID, Connector1.ActualZOrder[1]);//24.10.2012 ALine.ActualZOrder[1] := AHeight; end; end else // это вершина с-п или не нем есть с-п begin if (Connector1.FConnRaiseType <> crt_BetweenFloorUp) and (Connector1.FConnRaiseType <> crt_BetweenFloorDown) then ChangeRaiseOnNextObject(Connector1, ALine, AHeight); end; end; // 2 if Connector2.ActualZOrder[1] <> AHeight then begin // не вершина с-п и на нем нет с-п if (Connector2.FConnRaiseType = crt_None) and (GetRaiseConn(Connector2) = nil) then begin if (Connector2.JoinedConnectorsList.Count > 0) or (Connector2.JoinedOrtholinesList.Count > 1) then begin // RT if (Connector2.ConnectorType = ct_Clear) and (Connector2.JoinedOrtholinesList.Count > 1) then begin if CheckNeedCreateRaiseOnRaiseTrace(ALine, Connector2, ATracesList) then CreateRaiseOnNextObject(Connector2, ALine, AHeight) else begin Connector2.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(Connector2.ID, Connector2.ActualZOrder[1]);//24.10.2012 ALine.ActualZOrder[2] := AHeight; end; end else begin // RT2 := TConnectorObject(Connector2.JoinedConnectorsList[0]); RaiseConn := GetRaiseConn(RT2); // не вершина с-п и нет с-п if (RT2.FConnRaiseType = crt_None) and (RaiseConn = nil) then CreateRaiseOnNextObject(Connector2, ALine, AHeight) else begin if (RaiseConn <> nil) and (RaiseConn.FConnRaiseType <> crt_OnFloor) then begin ChangeRaiseOnNextObject(Connector2, ALine, AHeight); end else if (RaiseConn = nil) and (ObjFromRaise <> nil) then begin RT2.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(RT2.ID, RT2.ActualZOrder[1]); Connector1.ActualZOrder[2] := AHeight; ALine.ActualZOrder[2] := AHeight; end else begin CreateRaiseOnNextObject(Connector2, ALine, AHeight); end; end; end; end else begin Connector2.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(Connector2.ID, Connector2.ActualZOrder[1]); //24.10.2012 ALine.ActualZOrder[2] := AHeight; end; end else // это вершина с-п или не нем есть с-п begin if (Connector2.FConnRaiseType <> crt_BetweenFloorUp) and (Connector2.FConnRaiseType <> crt_BetweenFloorDown) then ChangeRaiseOnNextObject(Connector2, ALine, AHeight); end; end; ALine.CalculLength := ALine.LengthCalc; ALine.LineLength := ALine.CalculLength; ALine.UpdateLengthTextBox(False, True); SetLineFigureCoordZInPM(ALine.ID, 1, ALine.ActualZOrder[1]); SetLineFigureCoordZInPM(ALine.ID, 2, ALine.ActualZOrder[2]); AutoDivideLine(ALine); //31.01.2011 - разделяем линию если нужно except on E: Exception do addExceptionToLogEx('U_Common.RaiseLineOnHeight', E.Message); end; BaseEndUpdate; end; Function CheckNeedCreateRaiseOnRaiseTrace(ALine: TOrthoLine; AJoinedConn: TConnectorObject; ATracesList: TList): Boolean; var i: integer; CurrLine: TOrthoLine; begin Result := False; //#From Oleg# try for i := 0 to AJoinedConn.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(AJoinedConn.JoinedOrtholinesList[i]); if CurrLine <> ALine then begin if CheckNoFigureinList(CurrLine, ATracesList) then begin Result := True; Break; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckNeedCreateRaiseOnRaiseTrace', E.Message); end; end; Function CreateBetweenFloorRaiseOnPointObject(APointObject: TConnectorObject; ARaiseType: TLineRaiseType): TConnectorObject; var ConnectedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; x, y, z: double; i: integer; RaiseLineZ: Double; RaiseConnZ: Double; ObjParams: TObjectParams; begin Result := nil; BaseBeginUpdate; try x := APointObject.ActualPoints[1].x; y := APointObject.ActualPoints[1].y; z := APointObject.ActualZOrder[1]; RaiseConnZ := 0; //#From Oleg# if ARaiseType = lrt_Up then RaiseConnZ := GCadForm.FRoomHeight; if ARaiseType = lrt_Down then RaiseConnZ := 0; // создать присоединенный коннектор ConnectedConn := TConnectorObject.Create(x, y, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False); ConnectedConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); ObjParams := GetFigureParams(ConnectedConn.ID); ConnectedConn.Name := ObjParams.Name; ConnectedConn.FIndex := ObjParams.MarkID; for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do TConnectorObject(APointObject.JoinedConnectorsList[i]).ActualZOrder[1] := APointObject.ActualZOrder[1]; SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]); // создать подъем-спуск коннектор RaiseConn := TConnectorObject.Create(x + 10, y - 10, RaiseConnZ, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, RaiseConnZ, 1,ord(psSolid), clBlack, 0, APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1]; RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]); // приконнектить подъем SnapConnectorToPointObject(ConnectedConn, APointObject); RaiseConn.MoveConnector(-10, 10, False); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseConn, False); RaiseConn.Name := cCadClasses_Mes26; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes27; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; if ARaiseType = lrt_Up then RaiseConn.FConnRaiseType := crt_BetweenFloorUp; if ARaiseType = lrt_Down then RaiseConn.FConnRaiseType := crt_BetweenFloorDown; RaiseConn.FObjectFromRaise := APointObject; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := APointObject; RaiseLine.FLineRaiseType := ARaiseType; RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); // RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; RaiseLine.LockModify := True; ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; SetConnBringToFront(APointObject); SetConnBringToFront(RaiseConn); RefreshCAD(GCadForm.PCad); Result := RaiseConn; except on E: Exception do addExceptionToLogEx('U_Common.CreateBetweenFloorRaiseOnPointObject', E.Message); end; BaseEndUpdate; end; Function CreateBetweenFloorRaiseOnConnector(AConnector: TConnectorObject; ARaiseType: TLineRaiseType): TConnectorObject; var ConnectedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; x, y, z: double; i: integer; RaiseConnZ: Double; RaiseLineZ: Double; ObjParams: TObjectParams; begin Result := nil; BaseBeginUpdate; try x := AConnector.ActualPoints[1].x; y := AConnector.ActualPoints[1].y; z := AConnector.ActualZOrder[1]; RaiseConnZ := 0; //#From Oleg# if ARaiseType = lrt_Up then RaiseConnZ := GCadForm.FRoomHeight; if ARaiseType = lrt_Down then RaiseConnZ := 0; // создать подъем-спуск коннектор RaiseConn := TConnectorObject.Create(x, y, RaiseConnZ, AConnector.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, z, x, y, RaiseConnZ, 1,ord(psSolid), clBlack, 0, AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(AConnector)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); RaiseLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseConn, False); RaiseConn.Name := cCadClasses_Mes26; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes27; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; if ARaiseType = lrt_Up then RaiseConn.FConnRaiseType := crt_BetweenFloorUp; if ARaiseType = lrt_Down then RaiseConn.FConnRaiseType := crt_BetweenFloorDown; RaiseConn.FObjectFromRaise := AConnector; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := AConnector; RaiseLine.FLineRaiseType := ARaiseType; RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); // RaiseLine.ReCreateCaptionsGroup(True, false); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; RaiseLine.LockModify := True; SetConnBringToFront(AConnector); SetConnBringToFront(RaiseConn); Result := RaiseConn; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.CreateBetweenFloorRaiseOnConnector', E.Message); end; BaseEndUpdate; end; // создать магистральный с-п на объекте Function CreateTrunkRaiseOnPointObject(APointObject: TConnectorObject; ARaiseType: TLineRaiseType; aTrunkLength: Double): TConnectorObject; var ConnectedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; x, y, z: double; i: integer; RaiseLineZ: Double; RaiseConnZ: Double; ObjParams: TObjectParams; begin Result := nil; BaseBeginUpdate; try x := APointObject.ActualPoints[1].x; y := APointObject.ActualPoints[1].y; z := APointObject.ActualZOrder[1]; RaiseConnZ := 0; //#From Oleg# if ARaiseType = lrt_Up then RaiseConnZ := GCadForm.FRoomHeight; if ARaiseType = lrt_Down then RaiseConnZ := 0; // создать присоединенный коннектор ConnectedConn := TConnectorObject.Create(x, y, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False); ConnectedConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); ObjParams := GetFigureParams(ConnectedConn.ID); ConnectedConn.Name := ObjParams.Name; ConnectedConn.FIndex := ObjParams.MarkID; for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do TConnectorObject(APointObject.JoinedConnectorsList[i]).ActualZOrder[1] := APointObject.ActualZOrder[1]; SetConFigureCoordZInPM(APointObject.ID, APointObject.ActualZOrder[1]); // создать подъем-спуск коннектор RaiseConn := TConnectorObject.Create(x + 10, y - 10, RaiseConnZ, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, RaiseConnZ, 1,ord(psSolid), clBlack, 0, APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(ConnectedConn)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); RaiseLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1]; RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]); // приконнектить подъем SnapConnectorToPointObject(ConnectedConn, APointObject); RaiseConn.MoveConnector(-10, 10, False); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseConn, False); RaiseConn.Name := cCadClasses_Mes30; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes31; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; if ARaiseType = lrt_Up then RaiseConn.FConnRaiseType := crt_TrunkUp; if ARaiseType = lrt_Down then RaiseConn.FConnRaiseType := crt_TrunkDown; RaiseConn.FObjectFromRaise := APointObject; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := APointObject; RaiseLine.FLineRaiseType := ARaiseType; // LENGTH !!! RaiseLine.CalculLength := RaiseLine.LengthCalc; // RaiseLine.LineLength := RaiseLine.CalculLength + aAddTrunkLength; RaiseLine.LineLength := aTrunkLength; RaiseLine.UserLength := aTrunkLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; RaiseLine.LockModify := True; ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; SetConnBringToFront(APointObject); SetConnBringToFront(RaiseConn); RefreshCAD(GCadForm.PCad); Result := RaiseConn; except on E: Exception do AddExceptionToLogEx('U_Common.CreateTrunkRaiseOnPointObject', E.Message); end; BaseEndUpdate; end; // создать магистральный с-п на коннекторе Function CreateTrunkRaiseOnConnector(AConnector: TConnectorObject; ARaiseType: TLineRaiseType; aTrunkLength: Double): TConnectorObject; var ConnectedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; x, y, z: double; i: integer; RaiseConnZ: Double; RaiseLineZ: Double; ObjParams: TObjectParams; begin Result := nil; BaseBeginUpdate; try x := AConnector.ActualPoints[1].x; y := AConnector.ActualPoints[1].y; z := AConnector.ActualZOrder[1]; RaiseConnZ := 0; //#From Oleg# if ARaiseType = lrt_Up then RaiseConnZ := GCadForm.FRoomHeight; if ARaiseType = lrt_Down then RaiseConnZ := 0; // создать подъем-спуск коннектор RaiseConn := TConnectorObject.Create(x, y, RaiseConnZ, AConnector.LayerHandle, mydsNormal, GCadForm.PCad); RaiseConn.ConnectorType := ct_Clear; // создать подъем-спуск линия RaiseLine := TOrthoLine.Create(x, y, z, x, y, RaiseConnZ, 1,ord(psSolid), clBlack, 0, AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False); RaiseLine.SetJConnector1(TConnectorObject(AConnector)); RaiseLine.SetJConnector2(TConnectorObject(RaiseConn)); RaiseLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; RaiseLine.ActualZOrder[2] := RaiseConn.ActualZOrder[1]; SetLineFigureCoordZInPM(RaiseLine.ID, 1, RaiseLine.ActualZOrder[1]); SetLineFigureCoordZInPM(RaiseLine.ID, 2, RaiseLine.ActualZOrder[2]); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseConn, False); RaiseConn.Name := cCadClasses_Mes30; SetNewObjectNameInPM(RaiseConn.ID, RaiseConn.Name); ObjParams := GetFigureParams(RaiseConn.ID); RaiseConn.Name := ObjParams.Name; RaiseConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), RaiseLine, False); RaiseLine.Name := cCadClasses_Mes31; SetNewObjectNameInPM(RaiseLine.ID, RaiseLine.Name); ObjParams := GetFigureParams(RaiseLine.ID); RaiseLine.Name := ObjParams.Name; RaiseLine.FIndex := ObjParams.MarkID; if ARaiseType = lrt_Up then RaiseConn.FConnRaiseType := crt_TrunkUp; if ARaiseType = lrt_Down then RaiseConn.FConnRaiseType := crt_TrunkDown; RaiseConn.FObjectFromRaise := AConnector; RaiseLine.FIsRaiseUpDown := True; RaiseLine.FObjectFromRaisedLine := AConnector; RaiseLine.FLineRaiseType := ARaiseType; // LENGTH !!! RaiseLine.CalculLength := RaiseLine.LengthCalc; // RaiseLine.LineLength := RaiseLine.CalculLength + aAddTrunkLength; RaiseLine.LineLength := aTrunkLength; RaiseLine.UserLength := aTrunkLength; SetLineFigureLengthInPM(RaiseLine.ID, RaiseLine.LineLength); RaiseLine.UpdateLengthTextBox(True, false); RaiseLine.ReCreateNotesGroup(True); RaiseConn.LockMove := True; RaiseConn.LockModify := True; RaiseLine.LockMove := False; RaiseLine.LockModify := True; SetConnBringToFront(AConnector); SetConnBringToFront(RaiseConn); Result := RaiseConn; RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('U_Common.CreateTrunkRaiseOnConnector', E.Message); end; BaseEndUpdate; end; // Переоткрыть лист на CAD Procedure ReOpenListInCAD(AListID: Integer; const AListName: string); var AddLayer: TLayer; NewTab: TTabSheet; MenuItem: TMenuItem; i, j: integer; ListStream: TMemoryStream; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; ListCaption: string; fFileName: string; Figure: TFigure; ObjIdx: Integer; ListParams: TListParams; //Tolik CadFigList: TList; // begin try ListParams := GetListParams(AListID); // создать лист в проекте TF_CAD.Create(FSCS_Main); GCadForm.FCADListID := AListID; // List ID GCadForm.FCADListName := AListName; // List name if AListName = '' then GCadForm.FCADListName := ListParams.Name; GCadForm.FCADProjectName := GetCurrProjectName; // Project Name LoadSettingsForList(AListID, False); //17.08.2012 ListCaption := GetListParams(GCadForm.FCADListID).Caption; ListCaption := ListParams.Caption; SetIsOpenedListInCADToPM(AListID, True); // Добавить переключатель в панель листов проекта NewTab := TTabSheet.Create(nil); NewTab.PageControl := FSCS_Main.pageCADList; NewTab.Tag := GCadForm.Handle; NewTab.Caption := ListCaption; FSCS_Main.pageCADList.ActivePage := NewTab; // Добавить Листы в главное меню for i := 0 to FSCS_Main.mainWindow.Count - 1 do if FSCS_Main.mainWindow.Items[i].Caption = '-' then break; j := 0; inc(i); while FSCS_Main.mainWindow.Count > i do begin MenuItem := FSCS_Main.mainWindow.Items[FSCS_Main.mainWindow.Count - 1]; FSCS_Main.mainWindow.Delete(FSCS_Main.mainWindow.Count - 1); MenuItem.Free; end; for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do begin MenuItem := TMenuItem.Create(nil); MenuItem.Caption := FSCS_Main.pageCADList.Pages[j].Caption; MenuItem.Tag := FSCS_Main.pageCADList.Pages[j].Tag; MenuItem.AutoCheck := True; MenuItem.RadioItem := True; MenuItem.Checked := FSCS_Main.pageCADList.Pages[j] = FSCS_Main.pageCADList.ActivePage; MenuItem.OnClick := FSCS_Main.SwitchWindow; FSCS_Main.mainWindow.Add(MenuItem); end; // поднять Stream с листа ListStream := GetCadDataFromPM(AListID, fFileName); if ListStream <> nil then begin TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); ListStream.SaveToFile(TempPath + 'tempCAD.pwd'); // подгрузить из файла GCadForm.PCad.OnObjectInserted := Nil; GCadForm.PCad.LoadFromFile(TempPath + 'tempCAD.pwd'); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; end else if fFileName <> '' then begin // подгрузить из файла GCadForm.PCad.OnObjectInserted := Nil; GCadForm.PCad.LoadFromFile(fFileName); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; end; if (ListStream <> nil) or (fFileName <> '') then begin // для старых проектов - пересоздать слои if GCadForm.PCad.LayerCount = 7 then begin AddLayer := TLayer.Create(cCad_Mes7); GCadForm.PCad.Layers.Add(Addlayer); end; if GCadForm.PCad.LayerCount = 8 then begin AddLayer := TLayer.create(cCad_Mes8); GCadForm.PCad.Layers.Add(AddLayer); end; RaiseActiveNet(GCadForm); if GCadForm.PCad.LayerCount = 9 then begin AddLayer := TLayer.create(cCad_Mes29); GCadForm.PCad.Layers.Add(AddLayer); end; {//17.11.2011 GCadForm.FFrameProjectName := nil; GCadForm.FFrameListName := nil; GCadForm.FFrameCodeName := nil; GCadForm.FFrameIndexName := nil;} GCadForm.ClearFrameFigures; GNeedReRaiseProperties := False; //Tolik CadFigList := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[i])); for i := 0 to GCadForm.PCad.FigureCount - 1 do begin Figure := TFigure(GCadForm.PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then TConnectorObject(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTFrame) then TFrame(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTPlanTrace) then TPlanTrace(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTPlanObject) then TPlanObject(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTPlanConnector) then TPlanConnector(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTCabinet) then TCabinet(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTCabinetExt) then TCabinetExt(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, 'TRichText') then begin {//17.11.2011 if TRichText(Figure).DataID = 100 then GCadForm.FFrameProjectName := TRichText(Figure); if TRichText(Figure).DataID = 200 then GCadForm.FFrameListName := TRichText(Figure); if TRichText(Figure).DataID = 300 then GCadForm.FFrameCodeName := TRichText(Figure); if TRichText(Figure).DataID = 400 then GCadForm.FFrameIndexName := TRichText(Figure);} ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(Figure).DataID)); if ObjIdx <> -1 then GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(Figure); end else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTHouse) then THouse(Figure).RaiseProperties(CadFigList); end; //Tolik // все сделано на райзе за один проход // поэтому рерайз пока устраним {if GNeedReRaiseProperties then begin i := 0; while i < GCadForm.PCad.FigureCount do begin Figure := TFigure(GCadForm.PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).ReRaiseProperties; end; if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).ReRaiseProperties; end; i := i + 1; end; end; } //Tolik FreeAndNil(CadFigList); // GCadForm.SetFrameFigures; CorrectStampView; SetVisibleCabinetsNumbers(GCadForm.FShowCabinetsNumbers); SetVisibleCabinetsBounds(GCadForm.FShowCabinetsBounds); FindObjectsForConvertClasses; SetCADFrameParams(GCadForm); if GListRaiseWithErrors then begin ShowLog; GListRaiseWithErrors := False; end; end; if ListStream <> nil then FreeAndNil(ListStream); GCadForm.WindowState := wsMaximized; SwitchListInPM(GCadForm.FCADListID, ''); if GCadForm.FListType = lt_Normal then begin FSCS_Main.aSetSCSLayer.Execute; EnableOptionsForNormalList; end; if GCadForm.FListType = lt_DesignBox then begin FSCS_Main.aSetSubstrateLayer.Execute; DisableOptionsForDesignList; end; if GCadForm.FListType = lt_ProjectPlan then begin FSCS_Main.aSetSubstrateLayer.Execute; DisableOptionsForDesignList; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.ReOpenListInCAD', E.Message); end; end; Procedure ReOpenListInCADIfClosed(AListID: Integer; const AListName: string); begin if Not CheckListExist(AListID) then begin ProcessMessagesEx; ReopenListInCAD(AListID, ''); ProcessMessagesEx; end; end; Function CheckListExist(AListID: integer): Boolean; begin Result := False; try if GetListByID(AListID) <> nil then Result := True; except on E: Exception do addExceptionToLogEx('U_Common.CheckListExist', E.Message); end; end; // переход по проектам (выгрузка старого) Procedure UnloadCurrentProject; begin try FSCS_Main.CloseAll; except on E: Exception do addExceptionToLogEx('U_Common.UnloadCurrentProject', E.Message); end; end; // переход по проектам (загрузка нового) Procedure LoadNewProject(AListsID: TList; ACurrentListID: Integer); var i: integer; ID: integer; IDPointer: ^Integer; LName: string; FirstListID: Integer; OldTick, CurrTick: Cardinal; begin OldTick := GetTickCount; try FirstListID := 0; //#From Oleg# for i := 0 to AListsID.Count - 1 do begin IDPointer := AListsID[i]; ID := IDPointer^; if i = 0 then FirstListID := ID; LName := GetListNameFromPM(ID); OpenListsInProject(ID, LName); end; if GetCurrProjectParams.DefListSetting.SCSType = st_Internal then FSCS_Main.aMarkingPages.Enabled := True else if GetCurrProjectParams.DefListSetting.SCSType = st_External then FSCS_Main.aMarkingPages.Enabled := False; if ACurrentListID = - 1 then SwitchListInCAD(FirstListID, '') else SwitchListInCAD(ACurrentListID, ''); except on E: Exception do addExceptionToLogEx('U_Common.LoadNewProject', E.Message); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; // сравнение двух чисел типа Double function DoubleCMP(Double1, Double2: Double): Boolean; var String1, String2: string; begin Result := false; try String1 := FormatFloat('0.00', Double1); String2 := FormatFloat('0.00', Double2); Double1 := StrToFloat_My(String1); Double2 := StrToFloat_My(String2); if Double1 = Double2 then Result := True else Result := False; except on E: Exception do addExceptionToLogEx('U_Common.DoubleCMP', E.Message); end; end; procedure SetConnBringToFront(AConnector: TConnectorObject); begin try GCadForm.PCad.DeselectAll(2); AConnector.Select; GCadForm.PCad.RecordUndo := True; GCadForm.PCad.OrderSelection(osFront); GCadForm.PCad.RecordUndo := False; AConnector.Deselect; except end; end; function GetAllFiguresByClass(ACADForm: TF_CAD; aClass: TClass): TList; var i: Integer; procedure CheckFigure(aFigure: TFigure); var i: Integer; CurrFigure: TFigure; begin if aFigure is aClass then Result.Add(aFigure) else if aFigure is TFigureGrp then for i := 0 to TFigureGrp(aFigure).InFigures.Count - 1 do CheckFigure(TFigure(TFigureGrp(aFigure).InFigures[i])); end; begin Result := TList.Create; for i := 0 to ACADForm.PCad.FigureCount - 1 do CheckFigure(TFigure(ACADForm.PCad.Figures[i])); end; function GetAllFiguresByClassFromProj(aClass: TClass): TList; var i, j: Integer; List: TForm; procedure CheckFigure(aFigure: TFigure); var i: Integer; CurrFigure: TFigure; begin if aFigure is aClass then Result.Add(aFigure) else if aFigure is TFigureGrp then for i := 0 to TFigureGrp(aFigure).InFigures.Count - 1 do CheckFigure(TFigure(TFigureGrp(aFigure).InFigures[i])); end; begin Result := TList.Create; for i := 0 to FSCS_Main.MDIChildCount - 1 do begin List := FSCS_Main.MDIChildren[i]; if List is TF_CAD then for j := 0 to TF_CAD(List).PCad.FigureCount - 1 do CheckFigure(TFigure(TF_CAD(List).PCad.Figures[j])); end; end; function GetFigureByID(ACADForm: TF_CAD; AID_Figure: Integer): TFigure; var i: integer; FFigure: TFigure; FigLayerHandle1: Integer; FigLayerHandle2: Integer; begin Result := nil; try if (ACADForm <> nil) and (ACADForm.PCad <> nil) then begin Result := TFigure(ACADForm.FSCSFigures.GetObject(AID_Figure)); if Result = nil then begin FigLayerHandle1 := ACADForm.PCad.GetLayerHandle(lnSCSCommon); FigLayerHandle2 := ACADForm.PCad.GetLayerHandle(lnRoom); for i := 0 to ACadForm.PCad.FigureCount - 1 do begin FFigure := TFigure(ACadForm.PCad.Figures[i]); if (FFigure.LayerHandle = FigLayerHandle1) or (FFigure.LayerHandle = FigLayerHandle2) then begin if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then //if CheckFigureByClassIdx(FFigure, ciTConnectorObject) or CheckFigureByClassIdx(FFigure, ciTOrthoLine) then begin if FFigure.ID = AID_Figure then begin Result := FFigure; Break; end; end else if CheckFigureByClassName(FFigure, cTCabinet) then //else if CheckFigureByClassIdx(FFigure, ciTCabinet) then begin if TCabinet(FFigure).FSCSID = AID_Figure then begin Result := FFigure; Break; end; end else if CheckFigureByClassName(FFigure, cTCabinetExt) then //else if CheckFigureByClassIdx(FFigure, ciTCabinetExt) then begin if TCabinetExt(FFigure).FSCSID = AID_Figure then begin Result := FFigure; Break; end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetFigureByID', E.Message); end; end; function GetFigureByOrign(aFigureList: TList): TFigure; var Figure: TFigure; FigurePointCount: Integer; MinFigDist: Double; MinPointDist: Double; pDist: Double; i, j: Integer; begin Result := nil; MinFigDist := -1; for i := 0 to aFigureList.Count - 1 do begin Figure := TFigure(aFigureList[i]); FigurePointCount := Figure.PointCount; if Figure.ClassName = TConnectorObject.ClassName then FigurePointCount := 4; if FigurePointCount > 0 then begin MinPointDist := -1; for j := 1 to FigurePointCount do begin pDist := GetLineLenght(Figure.ActualPoints[j], DoublePoint(0,0)); if (MinPointDist = -1) or (pDist < MinPointDist) then MinPointDist := pDist; end; if (MinFigDist = -1) or (MinPointDist < MinFigDist) then begin Result := Figure; MinFigDist := MinPointDist; end; end; end; end; function GetFigureByIDProj(AID_Figure: Integer): TFigure; var CADForm: TF_CAD; i: Integer; begin Result := nil; for i := 0 to FSCS_Main.MDIChildCount - 1 do begin CADForm := TF_CAD(FSCS_Main.MDIChildren[i]); Result := GetFigureByID(CADForm, AID_Figure); if Result <> nil then Break; //// BREAK //// end; end; function GetHouseByID(ACADForm: TF_CAD; AID_Figure: Integer): THouse; var i: integer; FFigure: TFigure; begin Result := nil; try if (ACADForm <> nil) and (ACADForm.PCad <> nil) then begin for i := 0 to ACadForm.PCad.FigureCount - 1 do begin FFigure := TFigure(ACadForm.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTHouse) then begin if FFigure.ID = AID_Figure then begin Result := THouse(FFigure); Break; end; end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.GetHouseByID', E.Message); end; end; function GetApproachByComponID(ACADForm: TF_CAD; AID_Compon: Integer): TConnectorObject; var i: integer; FFigure: TFigure; begin Result := nil; try if (ACADForm <> nil) and (ACADForm.PCad <> nil) then begin for i := 0 to ACadForm.PCad.FigureCount - 1 do begin FFigure := TFigure(ACadForm.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).FIsApproach) then begin if TConnectorObject(FFigure).FComponID = AID_Compon then begin Result := TConnectorObject(FFigure); Break; end; end; end; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; function GetFigureByIDInSCSFigureGroups(ACADForm: TF_CAD; AID_Figure: Integer): TFigure; var i, j: integer; SCSFigureGrp: TSCSFigureGrp; FFigure: TFigure; begin Result := nil; try if (ACADForm <> nil) and (ACADForm.PCad <> nil) then begin for i := 0 to ACadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(ACadForm.PCad.Figures[i]), cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(ACadForm.PCad.Figures[i]); for j := 0 to SCSFigureGrp.InFigures.Count - 1 do begin FFigure := TFigure(SCSFigureGrp.InFigures[j]); if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then begin if FFigure.ID = AID_Figure then begin Result := FFigure; Exit; end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetFigureByIDInSCSFigureGroups', E.Message); end; end; function GetFigureByIDInSCSFigureGrp(ASCSFigureGrp: TSCSFigureGrp; AID_Figure: Integer): TFigure; var i, j: integer; SCSFigureGrp: TSCSFigureGrp; FFigure: TFigure; begin Result := nil; try for i := 0 to ASCSFigureGrp.InFigures.Count - 1 do begin FFigure := TFigure(ASCSFigureGrp.InFigures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then begin if FFigure.ID = AID_Figure then begin Result := FFigure; Exit; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetFigureByIDInSCSFigureGrp', E.Message); end; end; function GetSCSFigureGrp(ACADForm: TF_CAD; AID_Figure: Integer): TSCSFigureGrp; var i, j: integer; SCSFigureGrp: TSCSFigureGrp; FFigure: TFigure; begin Result := nil; try if (ACADForm <> nil) and (ACADForm.PCad <> nil) then begin for i := 0 to ACadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(ACadForm.PCad.Figures[i]), cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(ACadForm.PCad.Figures[i]); for j := 0 to SCSFigureGrp.InFigures.Count - 1 do begin FFigure := TFigure(SCSFigureGrp.InFigures[j]); if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then begin if FFigure.ID = AID_Figure then begin Result := SCSFigureGrp; Exit; end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetSCSFigureGrp', E.Message); end; end; function GetListByID(AID_List: Integer): TF_CAD; var i: integer; begin Result := nil; try for i := 0 to FSCS_Main.MDIChildCount - 1 do begin if TF_CAD(FSCS_Main.MDIChildren[i]).FCADListID = AID_List then begin Result := TF_CAD(FSCS_Main.MDIChildren[i]); break; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetListByID', E.Message); end; end; Function GetListOfPassage(AListID: Integer): TF_CAD; begin Result := nil; try Result := GetListByID(AListID); except on E: Exception do addExceptionToLogEx('U_Common.GetListOfPassage', E.Message); end; end; // ПРИВЯЗКА КОНЕКТОРА К КОНЕКТОРУ procedure SnapConnectorToConnector(AConnector, ASnapConnector: TConnectorObject; AOnRaise: Boolean = false); var i, j: integer; NewDeltaX, NewDeltaY: double; OLine: TOrthoLine; TempFigure: TFigure; PrevLine: TOrthoLine; CurrentLine: TOrthoLine; SplitFigure: TOrthoLine; ObjectFromRaise: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; ObjParams: TObjectParams; JoinedLine: TOrthoLine; OtherList: TF_CAD; OtherRaise: TConnectorObject; // House: THouse; HouseIndex: Integer; begin try if AConnector.Deleted or ASnapConnector.Deleted then Exit; {// #Oleg Commented#} if Not AOnRaise then FindConnectionsInterfaces(AConnector, ASnapConnector); if AConnector.joinedOrtholinesList.count > 0 then begin if (ASnapConnector.ActualZOrder[1]>=TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1]) and(ASnapConnector.ActualZOrder[1]>=TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2]) then begin if TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] < TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] then AConnector.ActualZOrder[1] := TOrtholine(AConnector.joinedOrtholinesList[0]).ActualZOrder[1] else AConnector.ActualZOrder[1] := TOrtholine(AConnector.joinedOrtholinesList[0]).ActualZOrder[2]; end else begin if TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] < TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] then AConnector.ActualZOrder[1] := TOrtholine(AConnector.joinedOrtholinesList[0]).ActualZOrder[2] else AConnector.ActualZOrder[1] := TOrtholine(AConnector.joinedOrtholinesList[0]).ActualZOrder[1]; end; end else AConnector.ActualZOrder[1] := ASnapConnector.ActualZOrder[1]; //Tolik if AOnRaise then AConnector.ActualZOrder[1] := ASnapConnector.ActualZOrder[1]; // AConnector.FConnRaiseType := ASnapConnector.FConnRaiseType; AConnector.FObjectFromRaise := ASnapConnector.FObjectFromRaise; AConnector.tmpParentDupID := ASnapConnector.tmpParentDupID; // House AConnector.fHouse := ASnapConnector.fHouse; AConnector.FIsHouseJoined := ASnapConnector.FIsHouseJoined; if (ASnapConnector.FIsHouseJoined) and (ASnapConnector.fHouse <> nil) then begin House := ASnapConnector.fHouse; HouseIndex := House.fJoined.IndexOf(ASnapConnector); if HouseIndex <> -1 then House.fJoined[HouseIndex] := AConnector; end; // ***** RaiseConn := GetRaiseConn(ASnapConnector); if RaiseConn <> nil then begin RaiseConn.FObjectFromRaise := AConnector; RaiseLine := GetRaiseLine(RaiseConn); if RaiseLine <> nil then RaiseLine.FObjectFromRaisedLine := AConnector; end; if (ASnapConnector.FConnRaiseType = crt_BetweenFloorUp) or (ASnapConnector.FConnRaiseType = crt_BetweenFloorDown) or (ASnapConnector.FConnRaiseType = crt_TrunkUp) or (ASnapConnector.FConnRaiseType = crt_TrunkDown)then begin AConnector.FID_ConnToPassage := ASnapConnector.FID_ConnToPassage; AConnector.FID_ListToPassage := ASnapConnector.FID_ListToPassage; OtherList := GetListByID(ASnapConnector.FID_ListToPassage); if OtherList <> nil then begin OtherRaise := TConnectorObject(GetFigureByID(OtherList, ASnapConnector.FID_ConnToPassage)); if OtherRaise <> nil then OtherRaise.FID_ConnToPassage := AConnector.ID; end; end; AConnector.Name := ASnapConnector.Name; // вычисление разницы в координатах для соединения обьектов NewDeltaX := ASnapConnector.ActualPoints[1].x - AConnector.ActualPoints[1].x; NewDeltaY := ASnapConnector.ActualPoints[1].y - AConnector.ActualPoints[1].y; AConnector.ActualPoints[1] := DoublePoint(ASnapConnector.ActualPoints[1].x, ASnapConnector.ActualPoints[1].y); AConnector.DrawFigure.move(NewDeltaX, NewDeltaY); for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin if AConnector = TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector1 then begin TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1] := DoublePoint( TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1].x + NewDeltaX, TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1].y + NewDeltaY); end; if AConnector = TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector2 then begin TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2] := DoublePoint( TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2].x + NewDeltaX, TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2].y + NewDeltaY); end; end; // переназначаем связи от обьекта к которому присоединились обьекту который присоединяется if (AConnector.ConnectorType = ct_Clear) and (ASnapConnector.ConnectorType <> ct_Clear) then begin TConnectorObject(TempFigure) := AConnector; AConnector := ASnapConnector; ASnapConnector := TConnectorObject(TempFigure); end; for i := 0 to ASnapConnector.JoinedOrtholinesList.Count - 1 do begin OLine := TOrthoLine(ASnapConnector.JoinedOrtholinesList[i]); if OLine.JoinConnector1 = ASnapConnector then OLine.SetJConnector1(AConnector); if OLine.JoinConnector2 = ASnapConnector then OLine.SetJConnector2(AConnector); end; SplitFigure := Nil; ObjectFromRaise := AConnector.FObjectFromRaise; // если есть с-п if ObjectFromRaise <> nil then begin if AConnector.ActualZOrder[1] > ObjectFromRaise.ActualZOrder[1] then begin AConnector.Name := cCadClasses_Mes24; SetNewObjectNameInPM(AConnector.ID, AConnector.Name); ObjParams := GetFigureParams(AConnector.ID); AConnector.Name := ObjParams.Name; AConnector.FIndex := ObjParams.MarkID; end; if AConnector.ActualZOrder[1] < ObjectFromRaise.ActualZOrder[1] then begin AConnector.Name := cCadClasses_Mes24; SetNewObjectNameInPM(AConnector.ID, AConnector.Name); ObjParams := GetFigureParams(AConnector.ID); AConnector.Name := ObjParams.Name; AConnector.FIndex := ObjParams.MarkID; end; SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]); SetNewObjectNameInPM(AConnector.ID, AConnector.Name); SetConnBringToFront(ObjectFromRaise); SetConnBringToFront(AConnector); AConnector.LockMove := True; AConnector.LockModify := True; end; try ASnapConnector.FConnRaiseType := crt_None; ASnapConnector.FObjectFromRaise := Nil; ASnapConnector.Delete(False, False); except end; ReCalcZCoordSnapObjects(AConnector); // Протокол GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + AConnector.Name + cCommon_Mes1 + ASnapConnector.Name + '"'); if GCadForm.PCad.SnapToGrids then begin for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); ReAlignLine(JoinedLine); end; end; except on E: Exception do addExceptionToLogEx('U_Common.SnapConnectorToConnector', E.Message); end; end; // ПРИВЯЗКА КОНЕКТОРА К ОРТОЛИНИИ procedure SnapConnectorToOrtholine(AConnector: TConnectorObject; ASnapLine: TOrtholine); var i, j: integer; NewDeltaX, NewDeltaY: double; AddLine: TOrthoLine; NextConnector: TConnectorObject; Modx, Mody, Modz, NextModx, NextMody, NextModz: Double; TempFigure: TFigure; TempDefaultNum: integer; CurrentLine: TOrthoLine; SplitFigure: TOrthoLine; CP_Line: TDoublePoint; AngleRad: Double; SnapLine: TOrthoLine; // Koef: Double; DeltaHeight: Double; AllLengthXY: Double; CurrLengthXY: Double; MustRealign: Boolean; JoinedConn: TConnectorObject; SplitFiguresList: TList; ObjToDisconnect: TList; GetOtherConn: TConnectorObject; begin try GetOtherConn := nil; //#From Oleg# // получить лист с присоединенными объектами стороны 2 JoinedConn := TConnectorObject(ASnapLine.JoinConnector2); ObjToDisconnect := TList.Create; if JoinedConn.JoinedConnectorsList.Count > 0 then ObjToDisconnect.Add(JoinedConn.JoinedConnectorsList[0]) else begin for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[i]) <> ASnapLine then ObjToDisconnect.Add(JoinedConn.JoinedOrtholinesList[i]); end; {--------------------------------------------------------------} DeltaHeight := ASnapLine.ActualZOrder[2] - ASnapLine.ActualZOrder[1]; AllLengthXY := SQRT(SQR(ASnapLine.ActualPoints[1].x - ASnapLine.ActualPoints[2].x) + SQR(ASnapLine.ActualPoints[1].y - ASnapLine.ActualPoints[2].y)); AngleRad := GetLineAngle(ASnapLine.ActualPoints[1], ASnapLine.ActualPoints[2]); if GCadForm.PCad.SnapToGrids then begin if (AngleRad = 0) or (AngleRad = 90) or (AngleRad = 180) or (AngleRad = 270) or (AngleRad = 360) then MustRealign := true else MustRealign := false; end else MustRealign := false; SplitFiguresList := TList.Create; NextConnector := TConnectorObject(ASnapLine.JoinConnector2); if ASnapLine.ActualPoints[1].x = ASnapLine.ActualPoints[2].x then begin NewDeltaY := 0; NewDeltaX := ASnapLine.ActualPoints[1].x - AConnector.ActualPoints[1].x; AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x + NewDeltaX, AConnector.ActualPoints[1].y); end else if ASnapLine.ActualPoints[1].y = ASnapLine.ActualPoints[2].y then begin NewDeltaX := 0; NewDeltaY := ASnapLine.ActualPoints[1].y - AConnector.ActualPoints[1].y; AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x, AConnector.ActualPoints[1].y + NewDeltaY); end else begin NewDeltaX := 0; NewDeltaY := 0; AConnector.ActualPoints[1] := DoublePoint(AConnector.ActualPoints[1].x + NewDeltaX, AConnector.ActualPoints[1].y + NewDeltaY); end; AConnector.DrawFigure.move(NewDeltaX, NewDeltaY); if AConnector.CaptionsGroup <> nil then AConnector.CaptionsGroup.Move(NewDeltaX, NewDeltaY); for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin if AConnector = TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector1 then begin TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1] := DoublePoint( TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1].x + NewDeltaX, TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[1].y + NewDeltaY); end; if AConnector = TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector2 then begin TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2] := DoublePoint( TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2].x + NewDeltaX, TOrthoLine(AConnector.JoinedOrtholinesList[i]).ActualPoints[2].y + NewDeltaY); end; end; // вычисление точек модификации Modx := (AConnector.ActualPoints[1].x + AConnector.ActualPoints[2].x) / 2; Mody := (AConnector.ActualPoints[1].y + AConnector.ActualPoints[2].y) / 2; Modz := AConnector.ActualZOrder[1]; NextModx := (NextConnector.ActualPoints[1].x + NextConnector.ActualPoints[2].x) / 2; NextMody := (NextConnector.ActualPoints[1].y + NextConnector.ActualPoints[2].y) / 2; NextModz := NextConnector.ActualZOrder[1]; // При соединении конектора с линией, создается 2 линии // переназначение связей линии к которой присоединились новому коннектору ASnapLine.ActualPoints[2] := DoublePoint(Modx, Mody); ASnapLine.ActualZOrder[1] := Modz; ASnapLine.SetJConnector2(AConnector); TConnectorObject(NextConnector).JoinedOrtholinesList.Remove(ASnapLine); // добавить новую ортолинию TempDefaultNum := GDefaultNum; GDefaultNum := ASnapLine.FCount; GDefaultGap := ASnapLine.FGap; AddLine := TOrthoLine.Create(Modx, Mody, Modz, NextModx, NextMody, NextModz, 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad); GCadForm.PCad.AddCustomFigure (GLN(ASnapLine.LayerHandle), AddLine, false); GDefaultNum := TempDefaultNum; // присвоить связи новой ортолинии AddLine.SetJConnector1(AConnector); AddLine.SetJConnector2(NextConnector); // при сдвоении линий удалить FigureSnap SplitFigure := Nil; CurrLengthXY := SQRT(SQR(ASnapLine.ActualPoints[1].x - ASnapLine.ActualPoints[2].x) + SQR(ASnapLine.ActualPoints[1].y - ASnapLine.ActualPoints[2].y)); Koef := CurrLengthXY / AllLengthXY; AConnector.ActualZOrder[1] := ASnapLine.ActualZOrder[1] + DeltaHeight; ASnapLine.ActualZOrder[2] := AConnector.ActualZOrder[1]; AddLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; // перерасчет длины новой линии ASnapLine.CalculLength := ASnapLine.LengthCalc; ASnapLine.LineLength := ASnapLine.CalculLength; ASnapLine.UpdateLengthTextBox(false, true); SetLineFigureLengthInPM(ASnapLine.ID, ASnapLine.LineLength); // передвинуть TextBoxesGroup if ASnapLine.CaptionsGroup <> nil then begin CP_Line.x := (ASnapLine.ActualPoints[1].x + ASnapLine.ActualPoints[2].x) / 2; CP_Line.y := (ASnapLine.ActualPoints[1].y + ASnapLine.ActualPoints[2].y) / 2; ASnapLine.CaptionsGroup.Move(CP_Line.x - ASnapLine.CaptionsGroup.CenterPoint.x, CP_Line.y - ASnapLine.CaptionsGroup.CenterPoint.y); end; // перерасчет длины созданной линии AddLine.CalculLength := AddLine.LengthCalc; AddLine.LineLength := AddLine.CalculLength; AddLine.UpdateLengthTextBox(false, false); SetLineFigureLengthInPM(AddLine.ID, AddLine.LineLength); // передвинуть TextBoxesGroup if AddLine.CaptionsGroup <> nil then begin CP_Line.x := (AddLine.ActualPoints[1].x + AddLine.ActualPoints[2].x) / 2; CP_Line.y := (AddLine.ActualPoints[1].y + AddLine.ActualPoints[2].y) / 2; AddLine.CaptionsGroup.Move(CP_Line.x - AddLine.CaptionsGroup.CenterPoint.x, CP_Line.y - AddLine.CaptionsGroup.CenterPoint.y); end; GFigureSnap := Nil; // выровнять линии if MustRealign then begin ReAlignObject(AConnector); ReAlignLine(ASnapLine); ReAlignLine(AddLine); end; SetConnBringToFront(AConnector); if SplitFiguresList <> nil then FreeAndNil(SplitFiguresList); ReCalcZCoordSnapObjects(AConnector); // Протокол GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + AConnector.Name + cCommon_Mes1 + ASnapLine.Name + '"'); // продолжить трассу на новый отрезок if AddLine.JoinConnector1 = AConnector then begin GetOtherConn := TConnectorObject(AddLine.JoinConnector2); if GetOtherConn.JoinedConnectorsList.Count > 0 then GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]); end; if AddLine.JoinConnector2 = AConnector then begin GetOtherConn := TConnectorObject(AddLine.JoinConnector1); if GetOtherConn.JoinedConnectorsList.Count > 0 then GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]); end; AutoConnectOverDivideLine(AConnector, GetOtherConn, ASnapLine, AddLine); //AutoConnectOverDivideLine(GetOtherConn, AConnector, AddLine); // !!! AddLine.FTraceColor := ASnapLine.FTraceColor; AddLine.FTraceStyle := ASnapLine.FTraceStyle; AddLine.FTraceWidth := ASnapLine.FTraceWidth; AddLine.FLineType := ASnapLine.FLineType; AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent; AddLine.BlockStep := ASnapLine.BlockStep; AddLine.DrawFigureH := 0; AddLine.CaptionsGroupH := 0; ASnapLine.DrawFigureH := 0; ASnapLine.CaptionsGroupH := 0; ASnapLine.ReCreateCaptionsGroup(false, false); ASnapLine.ReCreateNotesGroup; ASnapLine.ReCreateDrawFigureBlock; AddLine.ReCreateCaptionsGroup(false, false); AddLine.ReCreateNotesGroup; AddLine.ReCreateDrawFigureBlock; if ObjToDisconnect <> nil then FreeAndNil(ObjToDisconnect); AddLine.FTraceColor := ASnapLine.FTraceColor; AddLine.FTraceStyle := ASnapLine.FTraceStyle; AddLine.FTraceWidth := ASnapLine.FTraceWidth; AddLine.FLineType := ASnapLine.FLineType; AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.SnapConnectorToOrtholine', E.Message); end; end; // коннектор к вертикальной трассе procedure SnapConnectorToVertical(AConnector: TConnectorObject; ASnapLine: TOrtholine); var i, j: integer; AddLine: TOrthoLine; NextConnector: TConnectorObject; Modx, Mody, Modz, NextModx, NextMody, NextModz: Double; TempDefaultNum: integer; CP_Line: TDoublePoint; // DeltaPos: Double; JoinedConn: TConnectorObject; ObjToDisconnect: TList; GetOtherConn: TConnectorObject; ObjParams: TObjectParams; begin try GetOtherConn := nil; //#From Oleg# AConnector.MoveConnector(ASnapLine.ActualPoints[1].x - AConnector.ActualPoints[1].x, ASnapLine.ActualPoints[1].y - AConnector.ActualPoints[1].y, false, true); // получить лист с присоединенными объектами стороны 2 JoinedConn := TConnectorObject(ASnapLine.JoinConnector2); ObjToDisconnect := TList.Create; if JoinedConn.JoinedConnectorsList.Count > 0 then ObjToDisconnect.Add(JoinedConn.JoinedConnectorsList[0]) else begin for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[i]) <> ASnapLine then ObjToDisconnect.Add(JoinedConn.JoinedOrtholinesList[i]); end; {--------------------------------------------------------------} if (ASnapLine.ActualZOrder[2] > AConnector.ActualZOrder[1]) and (ASnapLine.ActualZOrder[1] < AConnector.ActualZOrder[1]) then DeltaPos := AConnector.ActualZOrder[1] else DeltaPos := (ASnapLine.ActualZOrder[1] + ASnapLine.ActualZOrder[2]) / 2; NextConnector := TConnectorObject(ASnapLine.JoinConnector2); // вычисление точек модификации Modx := AConnector.ActualPoints[1].x; Mody := AConnector.ActualPoints[1].y; Modz := AConnector.ActualZOrder[1]; NextModx := NextConnector.ActualPoints[1].x; NextMody := NextConnector.ActualPoints[1].y; NextModz := NextConnector.ActualZOrder[1]; // При соединении конектора с линией, создается 2 линии // переназначение связей линии к которой присоединились новому коннектору ASnapLine.ActualPoints[2] := DoublePoint(Modx, Mody); ASnapLine.ActualZOrder[1] := Modz; ASnapLine.SetJConnector2(AConnector); TConnectorObject(NextConnector).JoinedOrtholinesList.Remove(ASnapLine); // добавить новую ортолинию TempDefaultNum := GDefaultNum; GDefaultNum := ASnapLine.FCount; GDefaultGap := ASnapLine.FGap; AddLine := TOrthoLine.Create(Modx, Mody, Modz, NextModx, NextMody, NextModz, 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad); GCadForm.PCad.AddCustomFigure (GLN(ASnapLine.LayerHandle), AddLine, false); AddLine.Name := cCadClasses_Mes32; SetNewObjectNameInPM(AddLine.ID, AddLine.Name); ObjParams := GetFigureParams(AddLine.ID); AddLine.Name := ObjParams.Name; AddLine.FIndex := ObjParams.MarkID; AddLine.FIsVertical := True; GDefaultNum := TempDefaultNum; // присвоить связи новой ортолинии AddLine.SetJConnector1(AConnector); AddLine.SetJConnector2(NextConnector); AConnector.ActualZOrder[1] := DeltaPos; ASnapLine.ActualZOrder[2] := AConnector.ActualZOrder[1]; AddLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; // перерасчет длины новой линии ASnapLine.CalculLength := ASnapLine.LengthCalc; ASnapLine.LineLength := ASnapLine.CalculLength; ASnapLine.UpdateLengthTextBox(false, true); SetLineFigureLengthInPM(ASnapLine.ID, ASnapLine.LineLength); // передвинуть TextBoxesGroup if ASnapLine.CaptionsGroup <> nil then begin CP_Line.x := (ASnapLine.ActualPoints[1].x + ASnapLine.ActualPoints[2].x) / 2; CP_Line.y := (ASnapLine.ActualPoints[1].y + ASnapLine.ActualPoints[2].y) / 2; ASnapLine.CaptionsGroup.Move(CP_Line.x - ASnapLine.CaptionsGroup.CenterPoint.x, CP_Line.y - ASnapLine.CaptionsGroup.CenterPoint.y); end; // перерасчет длины созданной линии AddLine.CalculLength := AddLine.LengthCalc; AddLine.LineLength := AddLine.CalculLength; AddLine.UpdateLengthTextBox(false, false); SetLineFigureLengthInPM(AddLine.ID, AddLine.LineLength); // передвинуть TextBoxesGroup if AddLine.CaptionsGroup <> nil then begin CP_Line.x := (AddLine.ActualPoints[1].x + AddLine.ActualPoints[2].x) / 2; CP_Line.y := (AddLine.ActualPoints[1].y + AddLine.ActualPoints[2].y) / 2; AddLine.CaptionsGroup.Move(CP_Line.x - AddLine.CaptionsGroup.CenterPoint.x, CP_Line.y - AddLine.CaptionsGroup.CenterPoint.y); end; GFigureSnap := Nil; // выровнять линии ReAlignObject(AConnector); ReAlignLine(ASnapLine); ReAlignLine(AddLine); SetConnBringToFront(AConnector); ReCalcZCoordSnapObjects(AConnector); // Протокол GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + AConnector.Name + cCommon_Mes1 + ASnapLine.Name + '"'); // продолжить трассу на новый отрезок if AddLine.JoinConnector1 = AConnector then begin GetOtherConn := TConnectorObject(AddLine.JoinConnector2); if GetOtherConn.JoinedConnectorsList.Count > 0 then GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]); end; if AddLine.JoinConnector2 = AConnector then begin GetOtherConn := TConnectorObject(AddLine.JoinConnector1); if GetOtherConn.JoinedConnectorsList.Count > 0 then GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]); end; AutoConnectOverDivideLine(AConnector, GetOtherConn, ASnapLine, AddLine); //AutoConnectOverDivideLine(GetOtherConn, AConnector, AddLine); // !!! AddLine.FTraceColor := ASnapLine.FTraceColor; AddLine.FTraceStyle := ASnapLine.FTraceStyle; AddLine.FTraceWidth := ASnapLine.FTraceWidth; AddLine.FLineType := ASnapLine.FLineType; AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent; AddLine.BlockStep := ASnapLine.BlockStep; AddLine.DrawFigureH := 0; AddLine.CaptionsGroupH := 0; ASnapLine.DrawFigureH := 0; ASnapLine.CaptionsGroupH := 0; ASnapLine.ReCreateCaptionsGroup(false, false); ASnapLine.ReCreateNotesGroup; ASnapLine.ReCreateDrawFigureBlock; AddLine.ReCreateCaptionsGroup(false, false); AddLine.ReCreateNotesGroup; AddLine.ReCreateDrawFigureBlock; AddLine.ShowCaptions := False; AddLine.ShowNotes := False; AddLine.IsShowBlock := False; AddLine.FIsVertical := True; if ObjToDisconnect <> nil then FreeAndNil(ObjToDisconnect); AddLine.FTraceColor := ASnapLine.FTraceColor; AddLine.FTraceStyle := ASnapLine.FTraceStyle; AddLine.FTraceWidth := ASnapLine.FTraceWidth; AddLine.FLineType := ASnapLine.FLineType; AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent; RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('U_Common.SnapConnectorToVertical', E.Message); end; end; // ПРИВЯЗКА ОБЬЕКТА К ЛИНИИ procedure SnapPointObjectToOrthoLine(APointObject: TConnectorObject; ASnapLine: TOrthoLine); var i, j: integer; NewDeltaX, NewDeltaY: double; AddLine: TOrthoLine; JoinedCon: TConnectorObject; ClearCon1, ClearCon2: TConnectorObject; NextConnector: TFigure; Modx, Mody, NextModx, NextMody: Double; TempDefaultNum: integer; CurrentLine: TOrthoLine; CP_Line: TDoublePoint; MustRealign: Boolean; AngleRad: double; // Koef: Double; AllLengthXY: Double; CurrLengthXY: Double; DeltaHeight: Double; JoinedConn: TConnectorObject; ObjToDisconnect: TList; GetOtherConn: TConnectorObject; begin try if (IsSpecialTraceFigure(ASnapLine)) or (ASnapLine.FIsVertical) then exit; GetOtherConn := nil; //#From Oleg# JoinedConn := TConnectorObject(ASnapLine.JoinConnector2); ObjToDisconnect := TList.Create; if JoinedConn.JoinedConnectorsList.Count > 0 then ObjToDisconnect.Add(JoinedConn.JoinedConnectorsList[0]) else begin for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[i]) <> ASnapLine then ObjToDisconnect.Add(JoinedConn.JoinedOrtholinesList[i]); end; DeltaHeight := ASnapLine.ActualZOrder[2] - ASnapLine.ActualZOrder[1]; AllLengthXY := SQRT(SQR(ASnapLine.ActualPoints[1].x - ASnapLine.ActualPoints[2].x) + SQR(ASnapLine.ActualPoints[1].y - ASnapLine.ActualPoints[2].y)); // выравнивать линию? AngleRad := GetLineAngle(ASnapLine.ActualPoints[1], ASnapLine.ActualPoints[2]); if GCadForm.PCad.SnapToGrids then begin if (AngleRad = 0) or (AngleRad = 90) or (AngleRad = 180) or (AngleRad = 270) or (AngleRad = 360) then MustRealign := true else MustRealign := false; end else MustRealign := false; NextConnector := ASnapLine.JoinConnector2; if ASnapLine.ActualPoints[1].x = ASnapLine.ActualPoints[2].x then begin NewDeltaY := 0; NewDeltaX := ASnapLine.ActualPoints[1].x - APointObject.ActualPoints[1].x; APointObject.ActualPoints[1] := DoublePoint(APointObject.ActualPoints[1].x + NewDeltaX, APointObject.ActualPoints[1].y); end else if ASnapLine.ActualPoints[1].y = ASnapLine.ActualPoints[2].y then begin NewDeltaX := 0; NewDeltaY := ASnapLine.ActualPoints[1].y - APointObject.ActualPoints[1].y; APointObject.ActualPoints[1] := DoublePoint(APointObject.ActualPoints[1].x, APointObject.ActualPoints[1].y + NewDeltaY); end else begin NewDeltaX := 0; NewDeltaY := 0; APointObject.ActualPoints[1] := DoublePoint(APointObject.ActualPoints[1].x + NewDeltaX, APointObject.ActualPoints[1].y + NewDeltaY); end; APointObject.DrawFigure.move(NewDeltaX, NewDeltaY); if APointObject.CaptionsGroup <> nil then APointObject.CaptionsGroup.Move(NewDeltaX, NewDeltaY); for i := 0 to APointObject.JoinedOrtholinesList.Count - 1 do begin if APointObject = TOrthoLine(APointObject.JoinedOrtholinesList[i]).JoinConnector1 then begin TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[1] := DoublePoint( TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[1].x + NewDeltaX, TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[1].y + NewDeltaY); end; if APointObject = TOrthoLine(APointObject.JoinedOrtholinesList[i]).JoinConnector2 then begin TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[2] := DoublePoint( TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[2].x + NewDeltaX, TOrthoLine(APointObject.JoinedOrtholinesList[i]).ActualPoints[2].y + NewDeltaY); end; end; // вычисление точек модификации Modx := APointObject.ActualPoints[1].x; Mody := APointObject.ActualPoints[1].y; NextModx := NextConnector.ActualPoints[1].x; NextMody := NextConnector.ActualPoints[1].y; // При соединении конектора с линией, создается 2 линии // переназначение связей линии к которой присоединились новому коннектору ASnapLine.ActualPoints[2] := DoublePoint(Modx, Mody); // добавить новую ортолинию TempDefaultNum := GDefaultNum; GDefaultNum := ASnapLine.FCount; GDefaultGap := ASnapLine.FGap; //Tolik // AddLine := TOrthoLine.Create(Modx, Mody, ASnapLine.ActualZOrder[2], NextModx, NextMody, ASnapLine.ActualZOrder[2], // 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad); if (TConnectorObject(APointObject).Radius > 10000000) then begin if {( (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) or} ( (TConnectorObject(APointObject).Radius - 11000000) <> 999) { )} then AddLine := TOrthoLine.Create(Modx, Mody, TConnectorObject(APointObject).Radius - 11000000{ASnapLine.ActualZOrder[2]}, NextModx, NextMody, ASnapLine.ActualZOrder[2], 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad) else AddLine := TOrthoLine.Create(Modx, Mody, APointObject.ActualZOrder[1], NextModx, NextMody, ASnapLine.ActualZOrder[2], 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad); end else begin // с APointObject.ActualZOrder[1] - с/п несоздастся //AddLine := TOrthoLine.Create(Modx, Mody, APointObject.ActualZOrder[1], NextModx, NextMody, ASnapLine.ActualZOrder[2], // 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad); AddLine := TOrthoLine.Create(Modx, Mody, ASnapLine.ActualZOrder[2], NextModx, NextMody, ASnapLine.ActualZOrder[2], 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad); end; // GCadForm.PCad.AddCustomFigure (GLN(ASnapLine.LayerHandle), AddLine, false); GDefaultNum := TempDefaultNum; // создать пустые конекторы ClearCon1 := TConnectorObject.Create(Modx, Mody, GCadForm.FConnHeight, AddLine.LayerHandle, mydsNormal, GCadForm.PCad); ClearCon1.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(AddLine.LayerHandle), ClearCon1, false); ClearCon2 := TConnectorObject.Create(Modx, Mody, GCadForm.FConnHeight, AddLine.LayerHandle, mydsNormal, GCadForm.PCad); ClearCon2.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(AddLine.LayerHandle), ClearCon2, false); ASnapLine.SetJConnector2(ClearCon1); TConnectorObject(NextConnector).JoinedOrtholinesList.Remove(ASnapLine); // присвоить связи новой ортолинии AddLine.SetJConnector1(ClearCon2); AddLine.SetJConnector2(NextConnector); GTempJoinedLinesConnectors.Clear; for i := 0 to ClearCon1.JoinedOrtholinesList.Count - 1 do begin JoinedCon := TConnectorObject(TOrthoLine(ClearCon1.JoinedOrtholinesList[i]).JoinConnector1); if JoinedCon <> ClearCon1 then GTempJoinedLinesConnectors.Add(JoinedCon); JoinedCon := TConnectorObject(TOrthoLine(ClearCon1.JoinedOrtholinesList[i]).JoinConnector2); if JoinedCon <> ClearCon1 then GTempJoinedLinesConnectors.Add(JoinedCon); end; SnapConnectorToPointObject(ClearCon1, APointObject, False, True); GTempJoinedLinesConnectors.Clear; for i := 0 to ClearCon2.JoinedOrtholinesList.Count - 1 do begin JoinedCon := TConnectorObject(TOrthoLine(ClearCon2.JoinedOrtholinesList[i]).JoinConnector1); if JoinedCon <> ClearCon2 then GTempJoinedLinesConnectors.Add(JoinedCon); JoinedCon := TConnectorObject(TOrthoLine(ClearCon2.JoinedOrtholinesList[i]).JoinConnector2); if JoinedCon <> ClearCon2 then GTempJoinedLinesConnectors.Add(JoinedCon); end; SnapConnectorToPointObject(ClearCon2, APointObject, False, True); CurrLengthXY := SQRT(SQR(ASnapLine.ActualPoints[1].x - ASnapLine.ActualPoints[2].x) + SQR(ASnapLine.ActualPoints[1].y - ASnapLine.ActualPoints[2].y)); Koef := CurrLengthXY / AllLengthXY; // Tolik // APointObject.ActualZOrder[1] := ASnapLine.ActualZOrder[1] + DeltaHeight; { if (TConnectorObject(APointObject).Radius > 10000000) then ЕСЛИ РАСКОМЕНТИТЬ - учесть -11000000 if ( (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) and ( TConnectorObject(APointObject).Radius <> 999) ) then APointObject.ActualZOrder[1] := ASnapLine.ActualZOrder[1] + DeltaHeight; } // if (TConnectorObject(APointObject).Radius > 10000000) then begin if (TConnectorObject(APointObject).Radius - 11000000) = 999 then begin ClearCon1.ActualZOrder[1] := APointObject.ActualZOrder[1]; ClearCon2.ActualZOrder[1] := APointObject.ActualZOrder[1]; ASnapLine.ActualZOrder[2] := APointObject.ActualZOrder[1]; AddLine.ActualZOrder[1] := APointObject.ActualZOrder[1]; end else begin ClearCon1.ActualZOrder[1] := TConnectorObject(APointObject).Radius - 11000000; ClearCon2.ActualZOrder[1] := TConnectorObject(APointObject).Radius - 11000000; ASnapLine.ActualZOrder[2] := TConnectorObject(APointObject).Radius - 11000000; AddLine.ActualZOrder[1] := TConnectorObject(APointObject).Radius - 11000000; end; end else begin APointObject.ActualZOrder[1] := ASnapLine.ActualZOrder[1] + DeltaHeight; ClearCon1.ActualZOrder[1] := APointObject.ActualZOrder[1]; ClearCon2.ActualZOrder[1] := APointObject.ActualZOrder[1]; ASnapLine.ActualZOrder[2] := APointObject.ActualZOrder[1]; AddLine.ActualZOrder[1] := APointObject.ActualZOrder[1]; end; // перерасчет длины новой линии ASnapLine.CalculLength := ASnapLine.LengthCalc; ASnapLine.LineLength := ASnapLine.CalculLength; ASnapLine.UpdateLengthTextBox(false, true); SetLineFigureLengthInPM(ASnapLine.ID, ASnapLine.LineLength); // передвинуть TextBoxesGroup if ASnapLine.CaptionsGroup <> nil then begin CP_Line.x := (ASnapLine.ActualPoints[1].x + ASnapLine.ActualPoints[2].x) / 2; CP_Line.y := (ASnapLine.ActualPoints[1].y + ASnapLine.ActualPoints[2].y) / 2; ASnapLine.CaptionsGroup.Move(CP_Line.x - ASnapLine.CaptionsGroup.CenterPoint.x, CP_Line.y - ASnapLine.CaptionsGroup.CenterPoint.y); end; // перерасчет длины созданной линии AddLine.CalculLength := AddLine.LengthCalc; AddLine.LineLength := AddLine.CalculLength; AddLine.UpdateLengthTextBox(false, false); SetLineFigureLengthInPM(AddLine.ID, AddLine.LineLength); // передвинуть TextBoxesGroup if AddLine.CaptionsGroup <> nil then begin CP_Line.x := (AddLine.ActualPoints[1].x + AddLine.ActualPoints[2].x) / 2; CP_Line.y := (AddLine.ActualPoints[1].y + AddLine.ActualPoints[2].y) / 2; AddLine.CaptionsGroup.Move(CP_Line.x - AddLine.CaptionsGroup.CenterPoint.x, CP_Line.y - AddLine.CaptionsGroup.CenterPoint.y); end; GFigureSnap := Nil; AutoConnectObjectInTrace(APointObject, ASnapLine, AddLine); // выровнять линии if MustRealign then begin ReAlignObject(APointObject); ReAlignLine(ASnapLine); ReAlignLine(AddLine); end; SetConnBringToFront(APointObject); ReCalcZCoordSnapObjects(APointObject); // Протокол GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + APointObject.Name + cCommon_Mes1 + ASnapLine.Name + '"'); // продолжить трассу на новый отрезок JoinedConn := TConnectorObject(AddLine.JoinConnector1); if JoinedConn.JoinedConnectorsList.Count > 0 then begin if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = APointObject then begin GetOtherConn := TConnectorObject(AddLine.JoinConnector2); if GetOtherConn.JoinedConnectorsList.Count > 0 then GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]); end; end; JoinedConn := TConnectorObject(AddLine.JoinConnector2); if JoinedConn.JoinedConnectorsList.Count > 0 then begin if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = APointObject then begin GetOtherConn := TConnectorObject(AddLine.JoinConnector1); if GetOtherConn.JoinedConnectorsList.Count > 0 then GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]); end; end; AutoConnectOverDivideLine(APointObject, GetOtherConn, ASnapLine, AddLine); //AutoConnectOverDivideLine(GetOtherConn, APointObject, AddLine); // !!! AddLine.FTraceColor := ASnapLine.FTraceColor; AddLine.FTraceStyle := ASnapLine.FTraceStyle; AddLine.FTraceWidth := ASnapLine.FTraceWidth; AddLine.FLineType := ASnapLine.FLineType; AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent; AddLine.BlockStep := ASnapLine.BlockStep; AddLine.DrawFigureH := 0; AddLine.CaptionsGroupH := 0; ASnapLine.DrawFigureH := 0; ASnapLine.CaptionsGroupH := 0; ASnapLine.ReCreateCaptionsGroup(false, false); ASnapLine.ReCreateNotesGroup; ASnapLine.ReCreateDrawFigureBlock; AddLine.ReCreateCaptionsGroup(false, false); AddLine.ReCreateNotesGroup; AddLine.ReCreateDrawFigureBlock; if ObjToDisconnect <> nil then FreeAndNil(ObjToDisconnect); except on E: Exception do addExceptionToLogEx('U_Common.SnapPointObjectToOrtholine', E.Message); end; end; // объект к вертикальной трассе procedure SnapPointObjectToVertical(APointObject: TConnectorObject; ASnapLine: TOrthoLine); var i, j: integer; NewDeltaX, NewDeltaY: double; AddLine: TOrthoLine; JoinedCon: TConnectorObject; ClearCon1, ClearCon2: TConnectorObject; NextConnector: TFigure; Modx, Mody, NextModx, NextMody: Double; TempDefaultNum: integer; CurrentLine: TOrthoLine; CP_Line: TDoublePoint; DeltaPos: Double; JoinedConn: TConnectorObject; ObjToDisconnect: TList; GetOtherConn: TConnectorObject; begin try GetOtherConn := nil; APointObject.MoveConnector(ASnapLine.ActualPoints[1].x - APointObject.ActualPoints[1].x, ASnapLine.ActualPoints[1].y - APointObject.ActualPoints[1].y, false, true); JoinedConn := TConnectorObject(ASnapLine.JoinConnector2); ObjToDisconnect := TList.Create; if JoinedConn.JoinedConnectorsList.Count > 0 then ObjToDisconnect.Add(JoinedConn.JoinedConnectorsList[0]) else begin for i := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[i]) <> ASnapLine then ObjToDisconnect.Add(JoinedConn.JoinedOrtholinesList[i]); end; if (ASnapLine.ActualZOrder[2] > APointObject.ActualZOrder[1]) and (ASnapLine.ActualZOrder[1] < APointObject.ActualZOrder[1]) then DeltaPos := APointObject.ActualZOrder[1] else DeltaPos := (ASnapLine.ActualZOrder[1] + ASnapLine.ActualZOrder[2]) / 2; // выравнивать линию? NextConnector := ASnapLine.JoinConnector2; // вычисление точек модификации Modx := APointObject.ActualPoints[1].x; Mody := APointObject.ActualPoints[1].y; NextModx := NextConnector.ActualPoints[1].x; NextMody := NextConnector.ActualPoints[1].y; // При соединении конектора с линией, создается 2 линии // переназначение связей линии к которой присоединились новому коннектору ASnapLine.ActualPoints[2] := DoublePoint(Modx, Mody); // добавить новую ортолинию TempDefaultNum := GDefaultNum; GDefaultNum := ASnapLine.FCount; GDefaultGap := ASnapLine.FGap; AddLine := TOrthoLine.Create(Modx, Mody, ASnapLine.ActualZOrder[2], NextModx, NextMody, ASnapLine.ActualZOrder[2], 1,ord(psSolid), clBlack, 0, ASnapLine.LayerHandle, mydsNormal, GCadForm.PCad); GCadForm.PCad.AddCustomFigure (GLN(ASnapLine.LayerHandle), AddLine, false); GDefaultNum := TempDefaultNum; // создать пустые конекторы ClearCon1 := TConnectorObject.Create(Modx, Mody, GCadForm.FConnHeight, AddLine.LayerHandle, mydsNormal, GCadForm.PCad); ClearCon1.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(AddLine.LayerHandle), ClearCon1, false); ClearCon2 := TConnectorObject.Create(Modx, Mody, GCadForm.FConnHeight, AddLine.LayerHandle, mydsNormal, GCadForm.PCad); ClearCon2.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(AddLine.LayerHandle), ClearCon2, false); ASnapLine.SetJConnector2(ClearCon1); TConnectorObject(NextConnector).JoinedOrtholinesList.Remove(ASnapLine); // присвоить связи новой ортолинии AddLine.SetJConnector1(ClearCon2); AddLine.SetJConnector2(NextConnector); GTempJoinedLinesConnectors.Clear; for i := 0 to ClearCon1.JoinedOrtholinesList.Count - 1 do begin JoinedCon := TConnectorObject(TOrthoLine(ClearCon1.JoinedOrtholinesList[i]).JoinConnector1); if JoinedCon <> ClearCon1 then GTempJoinedLinesConnectors.Add(JoinedCon); JoinedCon := TConnectorObject(TOrthoLine(ClearCon1.JoinedOrtholinesList[i]).JoinConnector2); if JoinedCon <> ClearCon1 then GTempJoinedLinesConnectors.Add(JoinedCon); end; SnapConnectorToPointObject(ClearCon1, APointObject); GTempJoinedLinesConnectors.Clear; for i := 0 to ClearCon2.JoinedOrtholinesList.Count - 1 do begin JoinedCon := TConnectorObject(TOrthoLine(ClearCon2.JoinedOrtholinesList[i]).JoinConnector1); if JoinedCon <> ClearCon2 then GTempJoinedLinesConnectors.Add(JoinedCon); JoinedCon := TConnectorObject(TOrthoLine(ClearCon2.JoinedOrtholinesList[i]).JoinConnector2); if JoinedCon <> ClearCon2 then GTempJoinedLinesConnectors.Add(JoinedCon); end; SnapConnectorToPointObject(ClearCon2, APointObject); APointObject.ActualZOrder[1] := DeltaPos; ClearCon1.ActualZOrder[1] := APointObject.ActualZOrder[1]; ClearCon2.ActualZOrder[1] := APointObject.ActualZOrder[1]; ASnapLine.ActualZOrder[2] := APointObject.ActualZOrder[1]; AddLine.ActualZOrder[1] := APointObject.ActualZOrder[1]; // перерасчет длины новой линии ASnapLine.CalculLength := ASnapLine.LengthCalc; ASnapLine.LineLength := ASnapLine.CalculLength; ASnapLine.UpdateLengthTextBox(false, true); SetLineFigureLengthInPM(ASnapLine.ID, ASnapLine.LineLength); // передвинуть TextBoxesGroup if ASnapLine.CaptionsGroup <> nil then begin CP_Line.x := (ASnapLine.ActualPoints[1].x + ASnapLine.ActualPoints[2].x) / 2; CP_Line.y := (ASnapLine.ActualPoints[1].y + ASnapLine.ActualPoints[2].y) / 2; ASnapLine.CaptionsGroup.Move(CP_Line.x - ASnapLine.CaptionsGroup.CenterPoint.x, CP_Line.y - ASnapLine.CaptionsGroup.CenterPoint.y); end; // перерасчет длины созданной линии AddLine.CalculLength := AddLine.LengthCalc; AddLine.LineLength := AddLine.CalculLength; AddLine.UpdateLengthTextBox(false, false); SetLineFigureLengthInPM(AddLine.ID, AddLine.LineLength); // передвинуть TextBoxesGroup if AddLine.CaptionsGroup <> nil then begin CP_Line.x := (AddLine.ActualPoints[1].x + AddLine.ActualPoints[2].x) / 2; CP_Line.y := (AddLine.ActualPoints[1].y + AddLine.ActualPoints[2].y) / 2; AddLine.CaptionsGroup.Move(CP_Line.x - AddLine.CaptionsGroup.CenterPoint.x, CP_Line.y - AddLine.CaptionsGroup.CenterPoint.y); end; GFigureSnap := Nil; AutoConnectObjectInTrace(APointObject, ASnapLine, AddLine); // выровнять линии ReAlignObject(APointObject); ReAlignLine(ASnapLine); ReAlignLine(AddLine); SetConnBringToFront(APointObject); ReCalcZCoordSnapObjects(APointObject); // Протокол GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + APointObject.Name + cCommon_Mes1 + ASnapLine.Name + '"'); // продолжить трассу на новый отрезок JoinedConn := TConnectorObject(AddLine.JoinConnector1); if JoinedConn.JoinedConnectorsList.Count > 0 then begin if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = APointObject then begin GetOtherConn := TConnectorObject(AddLine.JoinConnector2); if GetOtherConn.JoinedConnectorsList.Count > 0 then GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]); end; end; JoinedConn := TConnectorObject(AddLine.JoinConnector2); if JoinedConn.JoinedConnectorsList.Count > 0 then begin if TConnectorObject(JoinedConn.JoinedConnectorsList[0]) = APointObject then begin GetOtherConn := TConnectorObject(AddLine.JoinConnector1); if GetOtherConn.JoinedConnectorsList.Count > 0 then GetOtherConn := TConnectorObject(GetOtherConn.JoinedConnectorsList[0]); end; end; AutoConnectOverDivideLine(APointObject, GetOtherConn, ASnapLine, AddLine); //AutoConnectOverDivideLine(GetOtherConn, APointObject, AddLine); // !!! AddLine.FTraceColor := ASnapLine.FTraceColor; AddLine.FTraceStyle := ASnapLine.FTraceStyle; AddLine.FTraceWidth := ASnapLine.FTraceWidth; AddLine.FLineType := ASnapLine.FLineType; AddLine.FDrawFigurePercent := ASnapLine.FDrawFigurePercent; AddLine.BlockStep := ASnapLine.BlockStep; AddLine.DrawFigureH := 0; AddLine.CaptionsGroupH := 0; ASnapLine.DrawFigureH := 0; ASnapLine.CaptionsGroupH := 0; ASnapLine.ReCreateCaptionsGroup(false, false); ASnapLine.ReCreateNotesGroup; ASnapLine.ReCreateDrawFigureBlock; AddLine.ReCreateCaptionsGroup(false, false); AddLine.ReCreateNotesGroup; AddLine.ReCreateDrawFigureBlock; AddLine.ShowCaptions := False; AddLine.ShowNotes := False; AddLine.IsShowBlock := False; AddLine.FIsVertical := True; if ObjToDisconnect <> nil then FreeAndNil(ObjToDisconnect); except on E: Exception do AddExceptionToLogEx('U_Common.SnapPointObjectToVertical', E.Message); end; end; Procedure FillPOintsForConnect(SideConn,APointObject,ConnectedConn: TConnectorObject; AddDeltaX, AddDeltaY: Double; var Points: TDoublePointArr; var CrossPoints: array of Tdoublepoint); begin if (not APointObject.FDrawFigureMoved)and(APointObject.FDrawFigureAngle = 0) then if not HaveObjectSocketComponent(APointObject.ID) then begin CrossPoints[0] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y, APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX, APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY, APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX, APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY); CrossPoints[1] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y, APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX, APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY, APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX, APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY); CrossPoints[2] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y, APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX, APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY, APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltax, APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY); CrossPoints[3] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y, APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX, APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY, APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX, APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY); SetLength(Points, 4); Points[0].x := (APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX) - 0.1; Points[0].y := (APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY) + 0.1; Points[1].x := (APointObject.ActualPoints[1].x - APointObject.GrpSizeX / 2 + AddDeltaX) - 0.1; Points[1].y := (APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY) - 0.1; Points[2].x := (APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX) + 0.1; Points[2].y := (APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY) - 0.1; Points[3].x := (APointObject.ActualPoints[1].x + APointObject.GrpSizeX / 2 - AddDeltaX) + 0.1; Points[3].y := (APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY) + 0.1; end else begin CrossPoints[0] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y, APointObject.ActualPoints[1].x, APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY, APointObject.ActualPoints[1].x, APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY); CrossPoints[1] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y, APointObject.ActualPoints[1].x, APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY, APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2*AddDeltaX, APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY); CrossPoints[2] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y, APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2*AddDeltaX, APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY, APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2*AddDeltaX, APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY); CrossPoints[3] := GetCrossPoint(SideConn.ActualPoints[1].x, SideConn.ActualPoints[1].y, ConnectedConn.ActualPoints[1].x, ConnectedConn.ActualPoints[1].y, APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2*AddDeltaX, APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY, APointObject.ActualPoints[1].x, APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY); SetLength(Points, 4); Points[0].x := (APointObject.ActualPoints[1].x) - 0.1; Points[0].y := (APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY) + 0.1; Points[1].x := (APointObject.ActualPoints[1].x) - 0.1; Points[1].y := (APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY) - 0.1; Points[2].x := (APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2 * AddDeltaX) + 0.1; Points[2].y := (APointObject.ActualPoints[1].y - APointObject.GrpSizeY / 2 + AddDeltaY) - 0.1; Points[3].x := (APointObject.ActualPoints[1].x + APointObject.GrpSizeX - 2 * AddDeltaX) + 0.1; Points[3].y := (APointObject.ActualPoints[1].y + APointObject.GrpSizeY / 2 - AddDeltaY) + 0.1; end; end; // ПРИВЯЗКА ПУСТОГО КОНЕКТОРА К ОБЬЕКТУ procedure SnapConnectorToPointObject(AConnector, APointObject: TConnectorObject; AOnRaise: Boolean = false; ASnapObjectToLine: Boolean = false); var i, j: integer; CurrLine: TOrthoLine; isExistInList: Boolean; isInRegion: Boolean; CurrConnector: TConnectorObject; SideConn: TConnectorObject; ConnectedConn: TConnectorObject; Points: TDoublePointArr; CrossPoints: array [1..4] of TDoublePoint; RegHandle: HRGN; MinLength: Double; CurrLength: Double; ConnectToPoint: TDoublePoint; SaveFigureSnap: TFigure; SavePrevFigureSnap: TFigure; LHandle: integer; TempNewConnList: TList; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; OtherList: TF_CAD; OtherRaise: TConnectorObject; AddDeltaX, AddDeltaY: double; ComponWidth: Double; SnapGrids,SnapGuides: Boolean; begin try ConnectedConn := nil; //#From Oleg# if Not ASnapObjectToLine then begin APointObject.ActualZOrder[1] := AConnector.ActualZOrder[1]; //if (not (F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) then // AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1] end else begin // Tolik if (TConnectorObject(APointObject).Radius > 10000000) then begin if {(not (F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) or} (( (TConnectorObject(APointObject).Radius - 11000000) = 999 ) or ( (TConnectorObject(APointObject).Radius - 11000000) = 0 )) then AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1] else AConnector.ActualZOrder[1] := TConnectorObject(APointObject).Radius - 11000000;// APointObject.ActualZOrder[1]; end else AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1] end; APointObject.FConnRaiseType := AConnector.FConnRaiseType; APointObject.FObjectFromRaise := AConnector.FObjectFromRaise; RaiseConn := GetRaiseConn(AConnector); if RaiseConn <> nil then begin RaiseConn.FObjectFromRaise := APointObject; RaiseLine := GetRaiseLine(RaiseConn); if RaiseLine <> nil then RaiseLine.FObjectFromRaisedLine := APointObject; end; if (AConnector.FConnRaiseType = crt_BetweenFloorUp) or (AConnector.FConnRaiseType = crt_BetweenFloorDown) or (AConnector.FConnRaiseType = crt_TrunkUp) or (AConnector.FConnRaiseType = crt_TrunkDown) then begin APointObject.FID_ConnToPassage := AConnector.FID_ConnToPassage; APointObject.FID_ListToPassage := AConnector.FID_ListToPassage; OtherList := GetListByID(AConnector.FID_ListToPassage); if OtherList <> nil then begin OtherRaise := TConnectorObject(GetFigureByID(OtherList, AConnector.FID_ConnToPassage)); if OtherRaise <> nil then OtherRaise.FID_ConnToPassage := APointObject.ID; end; end; AConnector.FConnRaiseType := crt_None; AConnector.FObjectFromRaise := nil; AConnector.FID_ConnToPassage := -1; AConnector.FID_ListToPassage := -1; TempNewConnList := TList.Create; LHandle := GCadForm.PCad.GetLayerHandle(2); isExistInList := False; for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin CurrConnector := TConnectorObject(APointObject.JoinedConnectorsList[i]); if CurrConnector = AConnector then isExistInList := True; end; if not isExistInList then begin APointObject.JoinedConnectorslist.Add(AConnector); AConnector.JoinedConnectorslist.Add(APointObject); end; GTempJoinedLinesConnectors.Clear; for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin SideConn := TConnectorObject(TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector1); if SideConn <> AConnector then GTempJoinedLinesConnectors.Add(SideConn); SideConn := TConnectorObject(TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector2); if SideConn <> AConnector then GTempJoinedLinesConnectors.Add(SideConn); end; // если разветвление !!! if AConnector.JoinedOrtholinesList.Count > 1 then begin for i := 1 to AConnector.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); if TConnectorObject(TOrthoLine(CurrLine.JoinConnector1)) = AConnector then begin CurrLine.JoinConnector1 := nil; ConnectedConn := TConnectorObject.Create(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, AConnector.ActualZOrder[1], LHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LHandle), ConnectedConn, False); CurrLine.SetJConnector1(ConnectedConn); APointObject.JoinedConnectorsList.Add(ConnectedConn); ConnectedConn.JoinedConnectorsList.Add(APointObject); TempNewConnList.Add(ConnectedConn); end; if TConnectorObject(TOrthoLine(CurrLine.JoinConnector2)) = AConnector then begin CurrLine.JoinConnector2 := nil; ConnectedConn := TConnectorObject.Create(CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y, AConnector.ActualZOrder[1], LHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LHandle), ConnectedConn, False); CurrLine.SetJConnector2(ConnectedConn); APointObject.JoinedConnectorsList.Add(ConnectedConn); ConnectedConn.JoinedConnectorsList.Add(APointObject); TempNewConnList.Add(ConnectedConn); end; end; j := 1; while j < AConnector.JoinedOrtholinesList.Count do begin AConnector.JoinedOrtholinesList.Delete(j); end; end; // получить точки пересечения линии с обьектом for i := 0 to GTempJoinedLinesConnectors.Count - 1 do begin if i = 0 then ConnectedConn := AConnector else if i > 0 then ConnectedConn := TConnectorObject(TempNewConnList[i - 1]); SideConn := TConnectorObject(GTempJoinedLinesConnectors[i]); if (APointObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(APointObject.DrawFigure.InFigures[0]), 'TWMFObject') then begin //FormatFloat(ffMask, AObject.FDrawFigureAngle / pi * 180); ComponWidth := APointObject.DrawFigure.GetBoundRect.Right - APointObject.DrawFigure.GetBoundRect.Left; AddDeltaX := 0.04 * ComponWidth; AddDeltaY := APointObject.GrpSizeY * 0.04; end else begin AddDeltaX := 0; AddDeltaY := 0; end; //Внутри делает то, что ниже.Для экономии места, так как код повторяется ниже по коду FillPOintsForConnect(SideConn,APointObject,ConnectedConn,AddDeltaX, AddDeltaY,Points,CrossPoints); // создать регион точек точечного обьекта MinLength := 0; CurrLength := 0; ConnectToPoint.x := 0; ConnectToPoint.y := 0; isInRegion := PtInPolygon(Points, CrossPoints[1]); if isInRegion then begin CurrLength := SQRT(SQR(CrossPoints[1].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[1].y - SideConn.ActualPoints[1].y)); MinLength := CurrLength; ConnectToPoint := CrossPoints[1]; end; isInRegion := PtInPolygon(Points, CrossPoints[2]); if isInRegion then begin CurrLength := SQRT(SQR(CrossPoints[2].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[2].y - SideConn.ActualPoints[1].y)); if (CurrLength <= MinLength) or (MinLength = 0) then begin ConnectToPoint := CrossPoints[2]; MinLength := CurrLength; end; end; isInRegion := PtInPolygon(Points, CrossPoints[3]); if isInRegion then begin CurrLength := SQRT(SQR(CrossPoints[3].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[3].y - SideConn.ActualPoints[1].y)); if (CurrLength <= MinLength) or (MinLength = 0) then begin ConnectToPoint := CrossPoints[3]; MinLength := CurrLength; end; end; isInRegion := PtInPolygon(Points, CrossPoints[4]); if isInRegion then begin CurrLength := SQRT(SQR(CrossPoints[4].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[4].y - SideConn.ActualPoints[1].y)); if (CurrLength <= MinLength) or (MinLength = 0) then begin ConnectToPoint := CrossPoints[4]; MinLength := CurrLength; end; end; // подвинуть к месту соединения SaveFigureSnap := GFigureSnap; SavePrevFigureSnap := GPrevFigureSnap; GFigureSnap := nil; GPrevFigureSnap := nil; // !!! Подравнять по алгоритму если есть точка соединения if (ConnectToPoint.x <> 0) and (ConnectToPoint.y <> 0) then begin if GCadform.PCad.SnapToGrids then SnapGrids := true; if GCadform.PCad.SnapToGuides then SnapGuides := true; GCadform.PCad.SnapToGrids := false; GCadform.PCad.SnapToGuides := false; ConnectedConn.Move(ConnectToPoint.x - ConnectedConn.ActualPoints[1].x, ConnectToPoint.y - ConnectedConn.ActualPoints[1].y); if SnapGrids then GCadform.PCad.SnapToGrids := True; if SnapGuides then GCadform.PCad.SnapToGuides := True; end; if ConnectedConn.Selected then ConnectedConn.Deselect; // DELETE FROM PM DeleteObjectFromPM(ConnectedConn.ID, ConnectedConn.Name); GFigureSnap := SaveFigureSnap; GPrevFigureSnap := SavePrevFigureSnap; end; if Not AOnRaise then //#FROM Oleg# AutoConnectObjectToConnectors(APointObject, AConnector, TempNewConnList); if TempNewConnList <> nil then FreeAndNil(TempNewConnList); SetConnBringToFront(APointObject); ReCalcZCoordSnapObjects(APointObject); // Протокол GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + AConnector.Name + cCommon_Mes1 + APointObject.Name + '"'); RefreshCAD(GCadForm.PCad); if GCadForm.PCad.SnapToGrids then begin for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin // JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[j]); // ReAlignLine(JoinedLine); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SnapConnectorToPointObject', E.Message); end; end; //В общемто сама проверка на наличие свободного функционального интерфейса Function CheckCurrLine(CurrLineInterf: TSCSInterfaces; APointObject: TConnectorObject):Boolean; var i,j,k: Integer; Interfac,InterfPoint: TSCSInterface; SCSComponPoint: TSCSComponent; begin Result := False; for j := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents.Count - 1 do begin SCSComponPoint := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents[j]; for k := 0 to SCSComponPoint.Interfaces.Count - 1 do begin InterfPoint := SCSComponPoint.Interfaces[k]; if InterfPoint.TypeI = itFunctional then for i := 0 to CurrLineInterf.Count - 1 do begin Interfac := CurrLineInterf[i]; if Interfac.TypeI = itFunctional then if Interfac.IsBusy = Bifalse then begin if InterfPoint.SideSection = Interfac.SideSection then Result := true; break; end; end; end; if Result then break; end; end; //Проверка если APointObject имеет такие же параметры, как и CurrLine Function CheckInterfacesSideSection(APointObject, AConnector: TConnectorObject; CurrLine: TOrtholine): Boolean; var SCSComponLine, SCSComponPoint: TSCSComponent; LineInterf,PointInterf: TSCSInterfaces; i,j,k: integer; InterfacL,InterfacP: TSCSInterface; begin result := false; //TODO возможно нужно будет добавить цикл, так как в Каталоге может быть >1 кабелей и с APointObject может потребуется то же самоенужно будет проверить if (F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count = 0)or (F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents.Count = 0) then exit; SCSComponPoint := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents[0]; //Интерфейсы точечного объекта PointInterf := SCSComponPoint.Interfaces; for k := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count - 1 do begin SCSComponLine := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents[k]; // Интерфейсы Линии LineInterf := SCSComponLine.interfaces; IF CurrLine.JoinConnector1 = AConnector then begin for i := 0 to LineInterf.Count - 1 do begin InterfacL := LineInterf[i]; //Если нашли нужный интерфейс if InterfacL.Side = 1 then break; //брекаем end; for j := 0 to PointInterf.Count - 1 do begin InterfacP := PointInterf[j]; if InterfacL.SideSection = InterfacP.SideSection then //Если параметры линейного объекта = параметрам точечного begin result := true; break; end; end; end else IF CurrLine.JoinConnector2 = AConnector then //Все то же самое, как и со стороной № 1 begin for i := 0 to LineInterf.Count - 1 do begin InterfacL := LineInterf[i]; if InterfacL.Side = 2 then break; end; for j := 0 to PointInterf.Count - 1 do begin InterfacP := PointInterf[j]; if InterfacL.SideSection = InterfacP.SideSection then begin result := true; break; end; end; end; end; end; Procedure ClearLineInterfaces(APointObject, AConnector: TConnectorObject; var CurrLine: TOrtholine; FindFreeInterfac: Boolean); var i,j,m,n: integer; Interfac: TSCSInterface; CurrLineInterf: TSCSInterfaces; SCSComponLine,JoinCompon, SCSComponPoint: TSCSComponent; vList: TF_CAD; JoinFigure: TFigure; JoinCatalog: TSCSCatalog; Multip: Boolean; //Tolik CanClear: Boolean; currCatalog: TSCSCatalog; begin try Multip := false; //Tolik CanClear := true; //Проверяем на многократоность APointObject... SCSComponPoint := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(APointObject.ID).SCSComponents[0]; CurrLineInterf := SCSComponPoint.Interfaces; for i := 0 to CurrLineInterf.Count - 1 do begin Interfac := CurrLineInterf[i]; if Interfac.TypeI = itFunctional then if Interfac.Multiple = BiTrue then begin Multip := true; break; end; end; //Если APointObject не многократна, и найдена трасса со свободным интерфейсом или параметры не совпадают - ВЫХОД if ((not Multip)and FindFreeInterfac)or (not CheckInterfacesSideSection(APointObject, AConnector, CurrLine))or (not SCSComponPoint.IDNetType in [3,4,5,7])then exit; IF CurrLine.JoinConnector1 = AConnector then //если линия соеденена стороной №1 begin for m := 0 to APointObject.JoinedConnectorsList.Count - 1 do if APointObject.JoinedConnectorsList[m] = AConnector then begin currCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID); if currCatalog <> nil then begin //for n := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count - 1 do for n := 0 to currCatalog.SCSComponents.Count - 1 do begin //СКС-компонент SCSComponLine := currCatalog.SCSComponents[n];//F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents[n]; // Tolik // При автотрассировке электрики не все соединения в данной точке нужно разрывать, а только кабели того типа, // который прокладываем в данный момент (если игнорить проложенный кабель, то только в том случае, если кабель - последний из проложенных в трассе) if (F_PEAutoTraceDialog.FromAutoTraceDialog and (F_PEAutoTraceDialog.Cypher <> '')) then begin if ((SCSComponLine.Cypher <> F_PEAutoTraceDialog.Cypher) or ((SCSComponLine.Cypher = F_PEAutoTraceDialog.Cypher) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible) and (F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (SCSComponLine <> currCatalog.LastAddedComponent))) then CanClear := False; end; if CanClear then begin //Его интерфейсы CurrLineInterf := SCSComponLine.Interfaces; for i := 0 to CurrLineInterf.Count - 1 do begin //Текущий интерфейс Interfac := CurrLineInterf[i]; //Если он функциональный if Interfac.TypeI = itFunctional then //И если она занят if Interfac.IsBusy = BiTrue then //И его сторона = стороне подключения с AConnector if Interfac.Side = 1 then begin //Получаем Форму КАДА vList := GetListByID(SCSCOmponLine.ListID); j := 0; While j < SCSComponLine.JoinedComponents.Count do begin //Уже подключенный компоненты JoinCompon := SCSComponLine.JoinedComponents[j]; //Определяем ФИГУРУ JoinFigure := GetFigureByID(vList,JoinCompon.GetFirstParentCatalog.SCSID); if JoinFigure <> nil then begin if ((SCSComponLine.IDNetType in [3,4,5,7])and (JoinCompon.IDNetType in [3,4,5,7])) then begin //Если подключена ортолиния if JoinFigure.ClassName = 'TOrthoLine' then //TODO проверить есть ли у APointObject схожие с SCSComponLine интерфейсы //если посоедененная линия лежит одной из сторон на нужном соеденителе - Отсоеденяем if (TOrthoLine(JoinFigure).JoinConnector1 = AConnector)or(TOrthoLine(JoinFigure).JoinConnector2 = AConnector) then begin SCSComponLine.DisJoinFrom(JoinCompon); end; {else Inc(j);} if JoinFigure.ClassName = 'TConnectorObject' then if TConnectorObject(JoinFigure).JoinedConnectorsList.IndexOf(AConnector) <> -1 then begin SCSComponLine.DisJoinFrom(JoinCompon); end; {else Inc(j);} end; end; inc(j); end; end; end; end; end; end; end; end else //Тута такая же схема, только со второй стороной линии IF CurrLine.JoinConnector2 = AConnector then //Стороной №2 begin for m := 0 to APointObject.JoinedConnectorsList.Count - 1 do if APointObject.JoinedConnectorsList[m] = AConnector then begin currCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID); if currCatalog <> nil then begin // for n := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count - 1 do for n := 0 to currCatalog.SCSComponents.Count - 1 do begin SCSComponLine := currCatalog.SCSComponents[n];//F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents[n]; // Tolik // При автотрассировке электрики не все соединения в данной точке нужно разрывать, а только кабели того типа, // который прокладываем в данный момент if (F_PEAutoTraceDialog.FromAutoTraceDialog and (F_PEAutoTraceDialog.Cypher <> '')) then begin // if SCSComponLine.Cypher <> F_PEAutoTraceDialog.Cypher then if ((SCSComponLine.Cypher <> F_PEAutoTraceDialog.Cypher) or ((SCSComponLine.Cypher = F_PEAutoTraceDialog.Cypher) and (F_PEAutoTraceDialog.IgnoreExistingCable.Visible) and (F_PEAutoTraceDialog.IgnoreExistingCable.Checked) and (SCSComponLine <> currCatalog.LastAddedComponent))) then CanClear := False; end; if CanClear then begin CurrLineInterf := SCSComponLine.Interfaces; for i := 0 to CurrLineInterf.Count - 1 do begin Interfac := CurrLineInterf[i]; if Interfac.TypeI = itFunctional then if Interfac.IsBusy = BiTrue then if Interfac.Side = 2 then begin vList := GetListByID(SCSCOmponLine.ListID); j := 0; While j < SCSComponLine.JoinedComponents.Count do begin JoinCompon := SCSComponLine.JoinedComponents[j]; JoinFigure := GetFigureByID(vList,JoinCompon.GetFirstParentCatalog.SCSID); if JoinFigure <> nil then begin if ((SCSComponLine.IDNetType in [3,4,5,7])and (JoinCompon.IDNetType in [3,4,5,7])) then begin if JoinFigure.ClassName = 'TOrthoLine' then //TODO проверить есть ли у APointObject схожие с SCSComponLine интерфейсы if (TOrthoLine(JoinFigure).JoinConnector1 = AConnector)or(TOrthoLine(JoinFigure).JoinConnector2 = AConnector) then begin SCSComponLine.DisJoinFrom(JoinCompon); end; if JoinFigure.ClassName = 'TConnectorObject' then if TConnectorObject(JoinFigure).JoinedConnectorsList.IndexOf(AConnector) <> -1 then begin SCSComponLine.DisJoinFrom(JoinCompon); end; end; end; Inc(j); end; end; end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ClearLineInterfaces', E.Message); end; end; // ПРИВЯЗКА ПУСТОГО КОНЕКТОРА К ОБЬЕКТУ procedure SnapPointObjectToConnector(APointObject, AConnector: TConnectorObject; AOnRaise: Boolean = false); var i, j: integer; CurrLine: TOrthoLine; isExistInList: Boolean; isInRegion: Boolean; CurrConnector: TConnectorObject; SideConn: TConnectorObject; ConnectedConn: TConnectorObject; Points: TDoublePointArr; CrossPoints: array [1..4] of TDoublePoint; RegHandle: HRGN; MinLength: Double; CurrLength: Double; ConnectToPoint: TDoublePoint; SaveFigureSnap: TFigure; SavePrevFigureSnap: TFigure; LHandle: integer; FindRaise: TConnectorObject; TempNewConnList: TList; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; OtherList: TF_CAD; OtherRaise: TConnectorObject; AddDeltaX, AddDeltaY: Double; ComponWidth: Double; SnapGrids,SnapGuides: Boolean; FindFreeLine: Boolean; RememberI, StartCicle: Integer; begin try FindFreeLine := false; //From Dimon ;) RememberI := -1; ConnectedConn := nil; //#From Oleg# APointObject.ActualZOrder[1] := AConnector.ActualZOrder[1]; APointObject.FConnRaiseType := AConnector.FConnRaiseType; APointObject.FObjectFromRaise := AConnector.FObjectFromRaise; RaiseConn := GetRaiseConn(AConnector); if RaiseConn <> nil then begin RaiseConn.FObjectFromRaise := APointObject; RaiseLine := GetRaiseLine(RaiseConn); if RaiseLine <> nil then RaiseLine.FObjectFromRaisedLine := APointObject; end; if (AConnector.FConnRaiseType = crt_BetweenFloorUp) or (AConnector.FConnRaiseType = crt_BetweenFloorDown) or (AConnector.FConnRaiseType = crt_TrunkUp) or (AConnector.FConnRaiseType = crt_TrunkDown) then begin APointObject.FID_ConnToPassage := AConnector.FID_ConnToPassage; APointObject.FID_ListToPassage := AConnector.FID_ListToPassage; OtherList := GetListByID(AConnector.FID_ListToPassage); if OtherList <> nil then begin OtherRaise := TConnectorObject(GetFigureByID(OtherList, AConnector.FID_ConnToPassage)); if OtherRaise <> nil then OtherRaise.FID_ConnToPassage := APointObject.ID; end; end; AConnector.FConnRaiseType := crt_None; AConnector.FObjectFromRaise := nil; AConnector.FID_ConnToPassage := -1; AConnector.FID_ListToPassage := -1; FindRaise := GetRaiseConn(APointObject); if FindRaise <> nil then begin SnapConnectorToConnector(AConnector, FindRaise); Exit; end; SaveFigureSnap := GFigureSnap; SavePrevFigureSnap := GPrevFigureSnap; GFigureSnap := nil; GPrevFigureSnap := nil; APointObject.Move(AConnector.ActualPoints[1].x - APointObject.ActualPoints[1].x, AConnector.ActualPoints[1].y - APointObject.ActualPoints[1].y); GFigureSnap := SaveFigureSnap; GPrevFigureSnap := SavePrevFigureSnap; TempNewConnList := TList.Create; LHandle := GCadForm.PCad.GetLayerHandle(2); isExistInList := False; for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin CurrConnector := TConnectorObject(APointObject.JoinedConnectorsList[i]); if CurrConnector = AConnector then isExistInList := True; end; if not isExistInList then begin APointObject.JoinedConnectorslist.Add(AConnector); AConnector.JoinedConnectorslist.Add(APointObject); end; // сохранить конекторы - начальные точки присоединенных линий GTempJoinedLinesConnectors.Clear; for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin SideConn := TConnectorObject(TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector1); if SideConn <> AConnector then GTempJoinedLinesConnectors.Add(SideConn); SideConn := TConnectorObject(TOrthoLine(AConnector.JoinedOrtholinesList[i]).JoinConnector2); if SideConn <> AConnector then GTempJoinedLinesConnectors.Add(SideConn); end; // если разветвление !!! if AConnector.JoinedOrtholinesList.Count > 1 then begin //Предварительный поиска трассы со свободным интерфейсом for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); if not FindFreeLine then //From Dimon ;) begin //TODO: Тут тоже, скорей всего, нужно пройтись по всем скс-компонентам... for j := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents.Count - 1 do if CheckCurrLine(F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(CurrLine.ID).SCSComponents[j].Interfaces, APointObject)then begin RememberI := i; FindFreeLine := true; Break; end; end; if FindFreeLine then Break; end; if FindFreeLine then StartCicle := 0 else StartCicle := 1; for i := StartCicle to AConnector.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); if i = RememberI then continue; ClearLineInterfaces(APointObject, AConnector,CurrLine, FindFreeLine); if TConnectorObject(TOrthoLine(CurrLine.JoinConnector1)) = AConnector then begin CurrLine.JoinConnector1 := nil; ConnectedConn := TConnectorObject.Create(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, AConnector.ActualZOrder[1], LHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LHandle), ConnectedConn, False); CurrLine.SetJConnector1(ConnectedConn); APointObject.JoinedConnectorsList.Add(ConnectedConn); ConnectedConn.JoinedConnectorsList.Add(APointObject); TempNewConnList.Add(ConnectedConn); if CurrLine.FIsRaiseUpDown then begin ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; end; end; if TConnectorObject(TOrthoLine(CurrLine.JoinConnector2)) = AConnector then begin CurrLine.JoinConnector2 := nil; ConnectedConn := TConnectorObject.Create(CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y, AConnector.ActualZOrder[1], LHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LHandle), ConnectedConn, False); CurrLine.SetJConnector2(ConnectedConn); APointObject.JoinedConnectorsList.Add(ConnectedConn); ConnectedConn.JoinedConnectorsList.Add(APointObject); TempNewConnList.Add(ConnectedConn); if CurrLine.FIsRaiseUpDown then begin ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; end; end; end; if Assigned(CurrLine) then CurrLine := nil; if RememberI <> -1 then begin CurrLine := TOrthoLine(AConnector.JoinedOrtholinesList[RememberI]); j := 0; end else j := 1; while j < AConnector.JoinedOrtholinesList.Count do begin if TOrthoLine(AConnector.JoinedOrtholinesList[j]) <> CurrLine then AConnector.JoinedOrtholinesList.Delete(j) else inc(j); end; end; // получить точки пересечения линии с обьектом for i := 0 to GTempJoinedLinesConnectors.Count - 1 do begin if i = 0 then ConnectedConn := AConnector else if i > 0 then ConnectedConn := TConnectorObject(TempNewConnList[i - 1]); SideConn := TConnectorObject(GTempJoinedLinesConnectors[i]); if (APointObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(APointObject.DrawFigure.InFigures[0]), 'TWMFObject') then begin ComponWidth := APointObject.DrawFigure.GetBoundRect.Right - APointObject.DrawFigure.GetBoundRect.Left; AddDeltaX := 0.04 * ComponWidth; AddDeltaY := APointObject.GrpSizeY * 0.04; end else begin AddDeltaX := 0; AddDeltaY := 0; end; //Внутри делает то, что ниже FillPOintsForConnect(SideConn,APointObject,ConnectedConn,AddDeltaX, AddDeltaY,Points,CrossPoints); // создать регион точек точечного обьекта MinLength := 0; CurrLength := 0; ConnectToPoint.x := 0; ConnectToPoint.y := 0; isInRegion := PtInPolygon(Points, CrossPoints[1]); if isInRegion then begin CurrLength := SQRT(SQR(CrossPoints[1].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[1].y - SideConn.ActualPoints[1].y)); MinLength := CurrLength; ConnectToPoint := CrossPoints[1]; end; isInRegion := PtInPolygon(Points, CrossPoints[2]); if isInRegion then begin CurrLength := SQRT(SQR(CrossPoints[2].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[2].y - SideConn.ActualPoints[1].y)); if (CurrLength <= MinLength) or (MinLength = 0) then begin ConnectToPoint := CrossPoints[2]; MinLength := CurrLength; end; end; isInRegion := PtInPolygon(Points, CrossPoints[3]); if isInRegion then begin CurrLength := SQRT(SQR(CrossPoints[3].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[3].y - SideConn.ActualPoints[1].y)); if (CurrLength <= MinLength) or (MinLength = 0) then begin ConnectToPoint := CrossPoints[3]; MinLength := CurrLength; end; end; isInRegion := PtInPolygon(Points, CrossPoints[4]); if isInRegion then begin CurrLength := SQRT(SQR(CrossPoints[4].x - SideConn.ActualPoints[1].x) + SQR(CrossPoints[4].y - SideConn.ActualPoints[1].y)); if (CurrLength <= MinLength) or (MinLength = 0) then begin ConnectToPoint := CrossPoints[4]; MinLength := CurrLength; end; end; // подвинуть к месту соединения SaveFigureSnap := GFigureSnap; SavePrevFigureSnap := GPrevFigureSnap; GFigureSnap := nil; GPrevFigureSnap := nil; // !!! Подравнять по алгоритму если есть точка соединения if (ConnectToPoint.x <> 0) and (ConnectToPoint.y <> 0) then begin if GCadform.PCad.SnapToGrids then SnapGrids := true; if GCadform.PCad.SnapToGuides then SnapGuides := true; GCadform.PCad.SnapToGrids := false; GCadform.PCad.SnapToGuides := false; if not CheckJoinVertical(ConnectedConn) then ConnectedConn.Move(ConnectToPoint.x - ConnectedConn.ActualPoints[1].x, ConnectToPoint.y - ConnectedConn.ActualPoints[1].y); if SnapGrids then GCadform.PCad.SnapToGrids := True; if SnapGuides then GCadform.PCad.SnapToGuides := True; end; if ConnectedConn.Selected then ConnectedConn.Deselect; // DELETE FROM PM DeleteObjectFromPM(ConnectedConn.ID, ConnectedConn.Name); GFigureSnap := SaveFigureSnap; GPrevFigureSnap := SavePrevFigureSnap; end; AutoConnectObjectToConnectors(APointObject, AConnector, TempNewConnList); if TempNewConnList <> nil then FreeAndNil(TempNewConnList); ReCalcZCoordSnapObjects(APointObject); // Протокол GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + APointObject.Name + cCommon_Mes1 + AConnector.Name + '"'); RefreshCAD(GCadForm.PCad); if GCadForm.PCad.SnapToGrids then begin for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[j]); ReAlignLine(JoinedLine); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SnapPointObjectToConnector', E.Message); end; end; // ОТВЯЗКА ПУСТОГО КОНЕКТОРА ОТ ОБЬЕКТУ procedure UnsnapConnectorFromPointObject(AConnector, APointObject: TConnectorObject; AOnRaise: Boolean = false); var i, j: integer; SaveFigureSnap: TFigure; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; isDisconnected: Boolean; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; begin BaseBeginUpdate; try AConnector.JoinedConnectorsList.Remove(APointObject); APointObject.JoinedConnectorsList.Remove(AConnector); if Not AOnRaise then begin ParamsList1 := TList.create; ParamsList2 := TList.create; for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); JoinedLine.UpdateLengthTextBox(false, true); New(ptrInterfRecord1); ptrInterfRecord1.IDObject := JoinedLine.ID; if AConnector = JoinedLine.JoinConnector1 then ptrInterfRecord1.Side := 1; if AConnector = JoinedLine.JoinConnector2 then ptrInterfRecord1.Side := 2; ParamsList1.Add(ptrInterfRecord1); end; // занести данные с ТО New(ptrInterfRecord2); ptrInterfRecord2.IDObject := APointObject.ID; ptrInterfRecord2.Side := -1; ParamsList2.Add(ptrInterfRecord2); // занести данные с присоединенных линий for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); if JoinedConn <> AConnector then begin for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); New(ptrInterfRecord2); ptrInterfRecord2.IDObject := JoinedLine.ID; if JoinedConn = JoinedLine.JoinConnector1 then ptrInterfRecord2.Side := 1; if JoinedConn = JoinedLine.JoinConnector2 then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; end; isDisconnected := DisconnectObjectsInPM(ParamsList1, ParamsList2); end; AConnector.Name := cCadClasses_Mes12; AddConnObjectInPM(AConnector.ID, AConnector.FCabinetID, AConnector.Name); //Если к соеденителю подключена трасса, ставим ему высоту трассы if AConnector.JoinedOrtholinesList.Count > 0 then begin if (APointObject.ActualZOrder[1] >= TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1]) and(APointObject.ActualZOrder[1] >= TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2])then begin if TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] < TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] then AConnector.ActualZOrder[1] := TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] else AConnector.ActualZOrder[1] := TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2]; end else begin if TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1] < TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] then AConnector.ActualZOrder[1] := TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[2] else AConnector.ActualZOrder[1] := TOrtholine(AConnector.JoinedOrtholinesList[0]).ActualZOrder[1]; end; end else //иначе оставляем на такой же высоте AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1]; SetConFigureCoordZInPM(AConnector.ID, AConnector.ActualZOrder[1]); // удалить с-п if APointObject.FObjectFromRaise <> nil then begin // DestroyRaiseOnPointObject(APointObject.FObjectFromRaise); // APointObject.Delete; // RefreshCAD(GCadForm.PCad); end; for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; JoinedLine.UpdateLengthTextBox(false, true); end; except on E: Exception do addExceptionToLogEx('U_Common.UnsnapConnectorFromPointObject', E.Message); end; BaseEndUpdate; end; function GetCrossPoint(X1_Line, Y1_Line, X2_Line, Y2_Line, X1_Object, Y1_Object, X2_Object, Y2_Object: Double): TDoublePoint; var A1, B1, C1: Double; A2, B2, C2: Double; x, y: Double; F1, F2: Double; begin try Result := DoublePoint(0, 0); x := 0; //#From Oleg# y := 0; //#From Oleg# A1 := Y2_Line - Y1_Line; if A1 = 0 then A1 := 0.001; B1 := - (X2_Line - X1_Line); if B1 = 0 then B1 := 0.001; C1 := - A1 * X1_Line - B1 * Y1_Line; A2 := Y2_Object - Y1_Object; B2 := - (X2_Object - X1_Object); C2 := - A2 * X1_Object - B2 * Y1_Object; //14.09.2010 F1 := A1 * x + B1 * y + C1; //14.09.2010 F2 := A2 * x + B2 * y + C2; try x := (B2 * C1 - B1 * C2) / (A2 * B1 - A1 * B2); except x := (B2 * C1 - B1 * C2); end; try y := (A1 * x + C1) / (- B1); except y := (A1 * x + C1); end; Result.x := x; Result.y := y; except on E: Exception do addExceptionToLogEx('U_Common.GetCrossPoint', E.Message); end; end; procedure CheckingSnapConnectorToOrtholine(AConnector: TConnectorObject; ASnapLine: TOrtholine); var i: integer; LastObjectHeight: double; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; JoinedLine: TOrthoLine; ObjFromRaise: TConnectorObject; begin BaseBeginUpdate; try if AConnector.JoinedConnectorsList.Count = 0 then begin // пустой конектор к линии LastObjectHeight := AConnector.ActualZOrder[1]; // высоты не совпадают if LastObjectHeight <> ASnapLine.ActualZOrder[1] then begin CreateRaiseOnConnector(AConnector, ASnapLine.ActualZOrder[1]); RaiseConn := GetRaiseConn(AConnector); SnapConnectorToOrtholine(RaiseConn, ASnapLine); end else SnapConnectorToOrtholine(AConnector, ASnapLine); end; except on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapConnectorToOrtholine', E.Message); end; BaseEndUpdate; end; procedure CheckingSnapPointObjectToOrthoLine(APointObject: TConnectorObject; ASnapLine: TOrthoLine); var i: integer; LastObjectHeight: double; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; JoinedLine: TOrthoLine; ObjFromRaise: TConnectorObject; SnapConn: TConnectorObject; TracesList: TList; begin if (IsSpecialTraceFigure(ASnapLine)) or (ASnapLine.FIsVertical) then exit; BaseBeginUpdate; BeginDevideLine; try if HaveObjectCorkComponent(APointObject.ID) then APointObject.ActualZOrder[1] := ASnapLine.ActualZOrder[1]; LastObjectHeight := APointObject.ActualZOrder[1]; // обьект к линии TracesList := GetAllConnectedTraces(APointObject); SnapPointObjectToOrthoLine(APointObject, ASnapLine); // высоты не совпадают //Tolik // if LastObjectHeight <> APointObject.ActualZOrder[1] then if (TConnectorObject(APointObject).Radius > 10000000) then begin if ( (LastObjectHeight <> APointObject.ActualZOrder[1]) or (((TConnectorObject(APointObject).Radius - 11000000) <> 999) and ((TConnectorObject(APointObject).Radius - 11000000) <> APointObject.ActualZOrder[1])) ) then begin //Tolik {if ( (not F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.CADAutoPosTraceBetweenRM) and ((TConnectorObject(APointObject).Radius - 11000000) <> 999 ) ) then begin} // создать спуск/подъем // Tolik // CreateRaiseOnPointObject(APointObject, LastObjectHeight); // CreateRaiseOnPointObject(APointObject, TConnectorObject(APointObject).Radius - 11000000); CreateRaiseOnPointObject(APointObject, TConnectorObject(APointObject).ActualZOrder[1]); // вернуть ранее подключенные трассы на их высоту for i := 0 to TracesList.Count - 1 do begin JoinedLine := TOrthoLine(TracesList[i]); RaiseLineOnHeight(JoinedLine, TConnectorObject(APointObject).Radius - 11000000{LastObjectHeight}, TracesList); end; { end;} end; end else begin if LastObjectHeight <> APointObject.ActualZOrder[1] then begin CreateRaiseOnPointObject(APointObject, LastObjectHeight); // вернуть ранее подключенные трассы на их высоту for i := 0 to TracesList.Count - 1 do begin JoinedLine := TOrthoLine(TracesList[i]); RaiseLineOnHeight(JoinedLine, LastObjectHeight, TracesList); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapPointObjectToOrthoLine', E.Message); end; EndDevideLine; BaseEndUpdate; end; procedure CheckingSnapConnectorToConnector(AConnector, ASnapConnector: TConnectorObject); var i: integer; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; JoinedLine: TOrthoLine; ObjFromRaise: TConnectorObject; begin BaseBeginUpdate; try RaiseLine := nil; //#From Oleg# RaiseConn := GetRaiseConn(ASnapConnector); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); // НЕТ С-П if (ASnapConnector.FConnRaiseType = crt_None) and (RaiseConn = nil) then begin if AConnector.ActualZOrder[1] <> ASnapConnector.ActualZOrder[1] then begin //15.09.2010 CreateRaiseOnConnector(ASnapConnector, AConnector.ActualZOrder[1]); //15.09.2010 ASnapConnector := GetRaiseConn(ASnapConnector); //15.09.//#From Oleg# if Not CheckJoinVertical(ASnapConnector) then begin // Если нету подключенных вертикальных трасс, создаем С-П CreateRaiseOnConnector(ASnapConnector, AConnector.ActualZOrder[1]); ASnapConnector := GetRaiseConn(ASnapConnector); end else begin // Ищем соединитель между В-Т (вертикальн. трассами) подходящий по высоте ASnapConnector := GetJoinedVerticalConnectorByCoordZ(ASnapConnector, AConnector.ActualZOrder[1]); // Если не соединитель, то не подключаем if (ASnapConnector <> nil) and (TConnectorObject(ASnapConnector).ConnectorType <> ct_Clear) then ASnapConnector := nil; end; end; //14.09.2010 SnapConnectorToConnector(AConnector, ASnapConnector); if ASnapConnector <> nil then SnapConnectorToConnector(AConnector, ASnapConnector); end else // ЭТО ВЕРШИНА С-П if ASnapConnector.FConnRaiseType <> crt_None then begin SnapConnectorToConnector(AConnector, ASnapConnector); end else // ЭТО ОБЪЕКТ НА КОТOРОМ С-П if RaiseConn <> nil then begin if (AConnector.ActualZOrder[1] = RaiseConn.ActualZOrder[1]) then begin if RaiseConn.ConnectorType = ct_Clear then SnapConnectorToConnector(AConnector, RaiseConn) else SnapConnectorToPointObject(AConnector, RaiseConn); end else begin SnapConnectorToConnector(AConnector, ASnapConnector); if RaiseConn <> nil then RaiseConn.FObjectFromRaise := AConnector; if RaiseLine <> nil then RaiseLine.FObjectFromRaisedLine := AConnector; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapConnectorToConnector', E.Message); end; BaseEndUpdate; end; procedure CheckingSnapConnectorToPointObject(AConnector, APointObject: TConnectorObject; aUseBaseConnector: Boolean); var LastObjectHeight: double; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; i, j: integer; JoinedLine: TOrthoLine; SnapObject: TConnectorObject; begin BaseBeginUpdate; try RaiseLine := nil; //#From Oleg# RaiseConn := GetRaiseConn(APointObject); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); // НЕТ С-П if (APointObject.FConnRaiseType = crt_None) and (RaiseConn = nil) then begin LastObjectHeight := APointObject.ActualZOrder[1]; //#From Oleg# 15.09.2010 //SnapConnectorToPointObject(AConnector, APointObject); // высоты не совпадают //if LastObjectHeight <> APointObject.ActualZOrder[1] then //begin // if aUseBaseConnector then // CreateRaiseOnPointObject(APointObject, LastObjectHeight, AConnector) // else // CreateRaiseOnPointObject(APointObject, LastObjectHeight, nil); //end; //#From Oleg# //15.09.2010 SnapObject := nil; // Если не совпадают высоты и APointObject подключен к вертикальной трассе, ищем соединитель по высоте AConnector if (AConnector.ActualZOrder[1] <> APointObject.ActualZOrder[1]) then if CheckJoinVertical(APointObject) then SnapObject := GetJoinedVerticalConnectorByCoordZ(APointObject, AConnector.ActualZOrder[1]); if SnapObject = nil then begin SnapConnectorToPointObject(AConnector, APointObject); // высоты не совпадают if LastObjectHeight <> APointObject.ActualZOrder[1] then begin if aUseBaseConnector then CreateRaiseOnPointObject(APointObject, LastObjectHeight, AConnector) else CreateRaiseOnPointObject(APointObject, LastObjectHeight, nil); end; end else begin if SnapObject.ConnectorType = ct_Clear then SnapConnectorToConnector(AConnector, SnapObject) else SnapConnectorToPointObject(AConnector, SnapObject); end; end else // ЭТО ВЕРШИНА С-П if APointObject.FConnRaiseType <> crt_None then begin SnapConnectorToPointObject(AConnector, APointObject); end else // ЭТО ОБЪЕКТ НА КОТОРОМ С-П if RaiseConn <> nil then begin if (AConnector.ActualZOrder[1] = RaiseConn.ActualZOrder[1]) then begin if RaiseConn.ConnectorType = ct_Clear then SnapConnectorToConnector(AConnector, RaiseConn) else SnapConnectorToPointObject(AConnector, RaiseConn); end else begin AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1]; SnapConnectorToPointObject(AConnector, APointObject); if RaiseConn <> nil then RaiseConn.FObjectFromRaise := APointObject; if RaiseLine <> nil then RaiseLine.FObjectFromRaisedLine := APointObject; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapConnectorToPointObject', E.Message); end; BaseEndUpdate; end; procedure CheckingSnapPointObjectToConnector(APointObject, AConnector: TConnectorObject); var LastObjectHeight: double; RaiseConn: TConnectorObject; ObjFromRaise: TConnectorObject; RaiseLine: TOrthoLine; i, j: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; RaiseType: TConnRaiseType; TracesList: TList; begin BaseBeginUpdate; try RaiseLine := nil; //#From Oleg# RaiseConn := GetRaiseConn(AConnector); ObjFromRaise := AConnector.FObjectFromRaise; if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); // Заглушка if HaveObjectCorkComponent(APointObject.ID) then APointObject.ActualZOrder[1] := AConnector.ActualZOrder[1]; // НЕТ С-П if (AConnector.FConnRaiseType = crt_None) and (RaiseConn = nil) then begin LastObjectHeight := APointObject.ActualZOrder[1]; TracesList := getAllConnectedTraces(APointObject); SnapPointObjectToConnector(APointObject, AConnector); // высоты не совпадают if LastObjectHeight <> APointObject.ActualZOrder[1] then begin CreateRaiseOnPointObject(APointObject, LastObjectHeight); for i := 0 to TracesList.Count - 1 do begin JoinedLine := TOrthoLine(TracesList[i]); RaiseLineOnHeight(JoinedLine, LastObjectHeight, TracesList); end; end; end else // ЭТО ВЕРШИНА С-П if (AConnector.FConnRaiseType <> crt_None) then begin RaiseType := AConnector.FConnRaiseType; SnapPointObjectToConnector(APointObject, AConnector); ObjFromRaise.FConnRaiseType := crt_None; ObjFromRaise.FObjectFromRaise := nil; AConnector.FConnRaiseType := crt_None; AConnector.FObjectFromRaise := nil; APointObject.FConnRaiseType := RaiseType; APointObject.FObjectFromRaise := ObjFromRaise; if AConnector.LockMove = True then AConnector.LockMove := False; end else // ЭТО ОБЪЕКТ НА КОТОРОМ С-П if RaiseConn <> nil then begin if (APointObject.ActualZOrder[1] = RaiseConn.ActualZOrder[1]) then begin // пересоединить к с-п if RaiseConn.ConnectorType = ct_clear then begin SnapPointObjectToConnector(APointObject, RaiseConn); AConnector.FConnRaiseType := crt_None; AConnector.FObjectFromRaise := nil; RaiseConn.FConnRaiseType := crt_None; RaiseConn.FObjectFromRaise := nil; APointObject.FConnRaiseType := crt_OnFloor; APointObject.FObjectFromRaise := AConnector; end; end else begin AConnector.ActualZOrder[1] := APointObject.ActualZOrder[1]; SnapPointObjectToConnector(APointObject, AConnector); if RaiseConn <> nil then RaiseConn.FObjectFromRaise := APointObject; if RaiseLine <> nil then RaiseLine.FObjectFromRaisedLine := APointObject; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckingSnapPointObjectToConnector', E.Message); end; BaseEndUpdate; end; function AutoDivideLine(ALine: TOrthoLine): TConnectorObject; var Conn1, Conn2: TConnectorObject; JoinConn1, JoinConn2: TConnectorObject; begin Result := nil; Conn1 := TConnectorObject(ALine.JoinConnector1); Conn2 := TConnectorObject(ALine.JoinConnector2); if (Conn1.JoinedConnectorsList.Count > 0) and (Conn2.JoinedConnectorsList.Count > 0) then begin JoinConn1 := TConnectorObject(Conn1.JoinedConnectorsList[0]); JoinConn2 := TConnectorObject(Conn2.JoinedConnectorsList[0]); if (JoinConn1.FHouse <> nil) and (JoinConn2.FHouse <> nil) and (JoinConn1.FHouse = JoinConn2.FHouse) then Result := DivideLineSimple(ALine); end; end; function DivideLine(ALine: TOrthoLine): TConnectorObject; //var // DivideConn: TConnectorObject; // DividePoints: TDoublePoint; // i: integer; // JoinedLine: TOrthoLine; begin Result := nil; BaseBeginUpdate; BeginDevideLine; //31.01.2011 try // DividePoints.x := (ALine.ActualPoints[1].x + ALine.ActualPoints[2].x) / 2; // DividePoints.y := (ALine.ActualPoints[1].y + ALine.ActualPoints[2].y) / 2; // DivideConn := TConnectorObject.Create(DividePoints.x, DividePoints.y, ALine.ActualZOrder[1], ALine.LayerHandle, mydsNormal, GCadForm.PCad); // DivideConn.ConnectorType := ct_Clear; // GCadForm.PCad.AddCustomFigure (GLN(ALine.LayerHandle), DivideConn, false); // SnapConnectorToOrtholine(DivideConn, ALine); // ALine.CalculLength := ALine.LengthCalc; // ALine.LineLength := ALine.CalculLength; // ALine.UpdateLengthTextBox(false, true); // ALine.ReCreateNotesGroup; // ALine.ReCreateDrawFigureBlock; // RefreshCAD(GCadForm.PCad); // Result := DivideConn; // except // on E: Exception do addExceptionToLogEx('U_Common.DivideLine', E.Message); // end; Result := DivideLineSimple(ALine); EndDevideLine; BaseEndUpdate; end; function DivideLineSimple(ALine: TOrthoLine; ADivPt: PDoublePoint): TConnectorObject; var DivideConn: TConnectorObject; DividePoints: TDoublePoint; i: integer; JoinedLine: TOrthoLine; FigureSnap: TFigure; begin Result := nil; try if ADivPt <> nil then DividePoints := ADivPt^ else begin DividePoints.x := (ALine.ActualPoints[1].x + ALine.ActualPoints[2].x) / 2; DividePoints.y := (ALine.ActualPoints[1].y + ALine.ActualPoints[2].y) / 2; end; FigureSnap := GFigureSnap; DivideConn := TConnectorObject.Create(DividePoints.x, DividePoints.y, ALine.ActualZOrder[1], ALine.LayerHandle, mydsNormal, GCadForm.PCad); DivideConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(ALine.LayerHandle), DivideConn, false); SnapConnectorToOrtholine(DivideConn, ALine); ALine.CalculLength := ALine.LengthCalc; ALine.LineLength := ALine.CalculLength; ALine.UpdateLengthTextBox(false, true); ALine.ReCreateNotesGroup; ALine.ReCreateDrawFigureBlock; RefreshCAD(GCadForm.PCad); Result := DivideConn; GFigureSnap := FigureSnap; //29.07.2013 на SnapConnectorToOrtholine бівает сбрасівается GFigureSnap except on E: Exception do addExceptionToLogEx('U_Common.DivideLineSimple', E.Message); end; end; procedure ReCalcZCoordSnapObjects(AConnector: TConnectorObject); var i, j: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; begin try // соединитель if AConnector.ConnectorType = ct_Clear then begin for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); if JoinedLine.JoinConnector1 = AConnector then JoinedLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; if JoinedLine.JoinConnector2 = AConnector then JoinedLine.ActualZOrder[2] := AConnector.ActualZOrder[1]; JoinedLine.UpdateLengthTextBox(false, true); end; end else // РТ begin for i := 0 to AConnector.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(AConnector.JoinedConnectorsList[i]); // Tolik // JoinedConn.ActualZOrder[1] := AConnector.ActualZOrder[1]; JoinedConn.ActualZOrder[1] := TConnectorObject(AConnector.JoinedConnectorsList[i]).ActualZOrder[1]; for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.JoinConnector1 = JoinedConn then JoinedLine.ActualZOrder[1] := JoinedConn.ActualZOrder[1]; if JoinedLine.JoinConnector2 = JoinedConn then JoinedLine.ActualZOrder[2] := JoinedConn.ActualZOrder[1]; JoinedLine.UpdateLengthTextBox(false, true); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ReCalcZCoordSnapObjects', E.Message); end; end; Function OrthoLineDetect(AOrthoLine: TFigure): Boolean; begin //02.11.2011 try Result := False; if CheckFigureByClassName(AOrthoLine, cTOrthoLine) then Result := True; //02.11.2011 except //02.11.2011 Result := False; //02.11.2011 end; end; Function ConnectorDetect(AConnector: TFigure): Boolean; begin try Result := False; if CheckFigureByClassName(AConnector, cTConnectorObject) then Result := True; except Result := False; end; end; function SCSClassDetect(ASCSObject: TFigure): Boolean; begin Result := False; if CheckFigureByClassName(ASCSObject, cTOrthoLine) then Result := True else if CheckFigureByClassName(ASCSObject, cTConnectorObject) then Result := True else if CheckFigureByClassName(ASCSObject, cTTextMod) then Result := True else if CheckFigureByClassName(ASCSObject, cTFigureGrpMod) then Result := True else if CheckFigureByClassName(ASCSObject, cTFigureGrpNotMod) then Result := True else if CheckFigureByClassName(ASCSObject, cTFrame) then Result := True else if CheckFigureByClassName(ASCSObject, cTRichTextMod) then Result := True else if CheckFigureByClassName(ASCSObject, cTCabinet) then Result := True else if CheckFigureByClassName(ASCSObject, cTCabinetExt) then Result := True else if CheckFigureByClassName(ASCSObject, cTCabinetNumber) then Result := True else if CheckFigureByClassName(ASCSObject, cTPlanObject) then Result := True else if CheckFigureByClassName(ASCSObject, cTPlanConnector) then Result := True else if CheckFigureByClassName(ASCSObject, cTPlanTrace) then Result := True; end; // точ. объектов Procedure SetFullnessTypeForConnector(AID_List, AID_Figure: Integer; AFullnessType: TComponInterfacesFullness); var i: integer; vList: TF_CAD; vFigure: TConnectorObject; begin try vList := GetListByID(AID_List); if vList <> nil then begin vFigure := TConnectorObject(GetFigureByID(vList, AID_Figure)); if vFigure <> nil then begin vFigure.FConnFullness := AFullnessType; end else begin vFigure := TConnectorObject(GetFigureByIDInSCSFigureGroups(vList, AID_Figure)); if vFigure <> nil then vFigure.FConnFullness := AFullnessType; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetFullnessTypeForConnector', E.Message); end; end; // кабелей Procedure SetFullnessTypeForCable(AID_List, AID_Figure: Integer; ASide: Integer; AFullnessType: TComponInterfacesFullness); var i: integer; vList: TF_CAD; vFigure: TOrthoLine; begin try vList := GetListByID(AID_List); if vList <> nil then begin vFigure := TOrthoLine(GetFigureByID(vList, AID_Figure)); if vFigure <> nil then begin if ASide = 1 then vFigure.FCableFullnessSide1 := AFullnessType; if ASide = 2 then vFigure.FCableFullnessSide2 := AFullnessType; end else begin vFigure := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, AID_Figure)); if vFigure <> nil then begin if ASide = 1 then vFigure.FCableFullnessSide1 := AFullnessType; if ASide = 2 then vFigure.FCableFullnessSide2 := AFullnessType; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetFullnessTypeForCable', E.Message); end; end; Procedure SetClosedTypeForCableChannel(AID_List, AID_Figure: Integer; ASide: Integer; AClosedType: TComponInterfacesFullness); var i: integer; vList: TF_CAD; vFigure: TOrthoLine; begin try vList := GetListByID(AID_List); if vList <> nil then begin vFigure := TOrthoLine(GetFigureByID(vList, AID_Figure)); if vFigure <> nil then begin if ASide = 1 then vFigure.FCableChannelClosedSide1 := AClosedType; if ASide = 2 then vFigure.FCableChannelClosedSide2 := AClosedType; end else begin vFigure := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, AID_Figure)); if vFigure <> nil then begin if ASide = 1 then vFigure.FCableChannelClosedSide1 := AClosedType; if ASide = 2 then vFigure.FCableChannelClosedSide2 := AClosedType; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetClosedTypeForCableChannel', E.Message); end; end; Procedure SetTraceStyle(AID_List, AID_Figure: Integer; ATraceStyle: TTraceStyle); var i: integer; vLine: TOrthoLine; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin vLine := TOrthoLine(GetFigureByID(vList, AID_Figure)); if vLine <> nil then begin vLine.FLineType := ATraceStyle; end else begin vLine := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, AID_Figure)); if vLine <> nil then vLine.FLineType := ATraceStyle; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetTraceStyle', E.Message); end; end; // кабельных каналов Procedure SetFullnessTypeForCableChannel(AID_List, AID_Figure: Integer; AFullnessType: TComponInterfacesFullness); var i: integer; vList: TF_CAD; vFigure: TOrthoLine; begin try vList := GetListByID(AID_List); if vList <> nil then begin vFigure := TOrthoLine(GetFigureByID(vList, AID_Figure)); if vFigure <> nil then begin vFigure.FCableChannelFullness := AFullnessType; end else begin vFigure := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, AID_Figure)); if vFigure <> nil then vFigure.FCableChannelFullness := AFullnessType; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetFullnessTypeForCableChannel', E.Message); end; end; // РЕЖИМ КЛИКА - СОЗДАВАТЬ ОБЪЕКТ/КОМПЛЕКТУЮЩУЮ procedure CreateOnClickMode(ASnapFigure: TFigure; ALastSCSCompon: TSCSComponent; X, Y: Double); var DropFigure: TFigure; StateType: TCompStateType; ComponID: integer; i, j: integer; JoinedTrace: TOrthoLine; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; isConnected: Boolean; NBComponent: TSCSComponent; SavedDragX, SavedDragY: Double; ConnComponID: Integer; begin if GIsProgress then begin exit; end; DropFigure := nil; NBComponent := nil; StateType := stProjectible; BeginProgress; try // убрать выделеные обьекты со слоя подложки //GCadForm.PCad.DeselectAll(1); // при тпускании компоненты - воссоздать ее на CAD GListNode := Nil; ComponID := 0; ConnComponID := 0; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; NBComponent := F_NormBase.GSCSBase.SCSComponent; // создать фигуру на CAD DropFigure := GetComponentFromNormBase(X, Y, NBComponent, ASnapFigure, StateType); // скопирование компоненту NormBase -> ProjectManager if DropFigure <> nil then begin ComponID := CopyComponentToPrjManager(GListNode, DropFigure.ID, GCadForm.FCADListID, ALastSCSCompon, True, True); // Дропнулся точечный обьект! if CheckFigureByClassName(DropFigure, cTConnectorObject) then begin ConnComponID := ComponID; // положить точечный объект на другой обьект if ASnapFigure <> Nil then begin // на ортолинию if CheckFigureByClassName(ASnapFigure, cTOrthoLine) then begin CheckingSnapPointObjectToOrthoLine(TConnectorObject(DropFigure), TOrthoLine(ASnapFigure)); end // на пустой конектор else if CheckFigureByClassName(ASnapFigure, cTConnectorObject) then begin CheckingSnapPointObjectToConnector(TConnectorObject(DropFigure), TConnectorObject(ASnapFigure)); end; end; SetConnObjectSelectHightPriority(TConnectorObject(DropFigure)); //#From Oleg# //29.09.2010 end; end else // компонента(ы) (ортолиния!!!) вбрасываеться в трассу! if (DropFigure = Nil) and (ASnapFigure <> nil) then begin if CheckFigureByClassName(ASnapFigure, cTConnectorObject) and (TConnectorObject(ASnapFigure).ConnectorType <> ct_clear) then ComponID := CopyComponentToSCSObject(ASnapFigure.ID, TSCSComponent(ALastSCSCompon).ID, True); if CheckFigureByClassName(ASnapFigure, cTOrthoLine) then begin ComponID := CopyComponentToSCSObject(ASnapFigure.ID, TSCSComponent(ALastSCSCompon).ID, True); AutoConnectOnAppendCable(GCadForm.FCADListID, TOrthoLine(ASnapFigure).ID); end; end; // *UNDO* GCadForm.FCanSaveForUndo := True; // убрать выделение всех выделенных фигур! if GPrevFigureSnap <> nil then begin TConnectorObject(DropFigure).DrawSnapFigures(GPrevFigureSnap, False); for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin if SCSClassDetect(TFigure(GCadForm.PCad.Selection[i])) then if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) and (TFigure(GCadForm.PCad.Selection[i]).Selected) then TConnectorObject(DropFigure).DrawSnapFigures(TFigure(GCadForm.PCad.Selection[i]), False); end; end; if DropFigure <> nil then DropFigure.Select else if ASnapFigure <> nil then ASnapFigure.Select; ASnapFigure := Nil; GPrevFigureSnap := Nil; RefreshCAD(GCadForm.PCad); GListNode := Nil; GDraggedFigureZOrder := -1; // DestroyShadowObject; except on E: Exception do addExceptionToLogEx('U_Common.CreateOnClickMode', E.Message); end; EndProgress; if ConnComponID <> 0 then AskMarkInCreateObjectOnClick(GCadForm, ConnComponID); //30.06.2010 if (DropFigure = nil) and IsArchComponByIsLine(NBComponent.IsLine) then begin SavedDragX := GCadForm.DragX; SavedDragY := GCadForm.DragY; try GCadForm.DragX := X; GCadForm.DragY := Y; CreateArchObjWizard(GCadForm.FCADListID, NBComponent, GCadForm, nil); finally GCadForm.DragX := SavedDragX; GCadForm.DragY := SavedDragY; end; end; end; procedure AskMarkInCreateObjectOnClick(aCAD: TF_CAD; aComponID: Integer); var SCSList: TSCSList; SCSCompon: TSCSComponent; InputMarkRes: Integer; PrevMark: string; begin SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(aCAD.FCADListID); if SCSList <> nil then if SCSList.FNewComponNameMarkAsk then begin if GIsProgress then begin //PauseProgress(true); //Application.ProcessMessages; end; SCSCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(aComponID); if SCSCompon <> nil then begin PrevMark := SCSCompon.NameMark; if SCSList.FNewComponNameMarkSaved = '' then SCSList.FNewComponNameMarkSaved := PrevMark; end; try InputMarkRes := InputMark(ApplicationName, cMain_Mes141, SCSList.FNewComponNameMarkSaved); finally if GIsProgress then ;//PauseProgress(false); end; if InputMarkRes = mrOk then begin if trim(PrevMark) <> trim(SCSList.FNewComponNameMarkSaved) then begin SCSList.FNewComponNameMark := SCSList.FNewComponNameMarkSaved; //SCSCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(aComponID); if SCSCompon <> nil then begin SCSCompon.IsUserMark := biTrue; SCSCompon.NameMark := SCSList.FNewComponNameMark; SCSCompon.ApplyChanges; end; end else begin SCSList.FNewComponNameMarkSaved := ''; end; end else begin SCSList.FNewComponNameMarkSaved := ''; if InputMarkRes = mrIgnore then begin SCSList.FNewComponNameMark := ''; SCSList.FNewComponNameMarkAsk := false; end; end; end; end; procedure SetIndexToFigure(AID_List, AID_Figure: Integer; AIndex: Integer); var CAD_Figure: TFigure; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin CAD_Figure := GetFigureByID(vList, AID_Figure); if CAD_Figure <> nil then begin if CheckFigureByClassName(CAD_Figure, cTConnectorObject) then TConnectorObject(CAD_Figure).FIndex := AIndex else if CheckFigureByClassName(CAD_Figure, cTOrthoLine) then TOrthoLine(CAD_Figure).FIndex := AIndex; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetIndexToFigure', E.Message); end; end; procedure SetShowNameTypeInCAD(AShowType: TShowType); var i: integer; CADFigure: TFigure; ObjParams: TObjectParams; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin CADFigure := TFigure(GCadForm.PCad.Figures[i]); if CADFigure <> nil then begin if CheckFigureByClassName(CADFigure, cTConnectorObject) then begin ObjParams := GetFigureParams(CADFigure.ID); TConnectorObject(CADFigure).Name := ObjParams.Name; TConnectorObject(CADFigure).FIndex := ObjParams.MarkID; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetShowNameTypeInCAD', E.Message); end; end; // установить подпись к точечному обьекту procedure SetConnCaptionsInCAD(AID_List, AConnID: Integer; ACaption: TStringList); var i: integer; AFigure: TFigure; SavedCadForm: TF_CAD; vList: TF_CAD; FName: string; begin try vList := GetListByID(AID_List); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; AFigure := GetFigureByID(vList, AConnID); if AFigure <> nil then begin if CheckFigureByClassName(AFigure, cTConnectorObject) then begin // если выноска не менялась юзером if not TConnectorObject(AFigure).FIsCaptionsChanged then begin if TConnectorObject(AFigure).OutTextCaptions.Count > 0 then FName := TConnectorObject(AFigure).OutTextCaptions[0] else FName := ''; TConnectorObject(AFigure).OutTextCaptions.Clear; TConnectorObject(AFigure).OutTextCaptions.Add(FName); for i := 0 to ACaption.Count - 1 do TConnectorObject(AFigure).OutTextCaptions.Add(ACaption[i]); TConnectorObject(AFigure).ReCreateCaptionsGroup(false, true); end; end else if CheckFigureByClassName(AFigure, cTOrthoLine) then //28.08.2013 - Предусмаотриваем подписи с маркрировкой линейных компонентов begin // Запоминаем длину FName := ''; if TOrthoLine(AFigure).OutTextCaptions.Count > 0 then FName := TOrthoLine(AFigure).OutTextCaptions[0]; // TOrthoLine(AFigure).OutTextCaptions.Assign(ACaption); // Восстановить длину TOrthoLine(AFigure).OutTextCaptions.Insert(0, FName); //если пустая длина, до все равно добавляем пустую строку, чтобы не накладывался текст на УГО TOrthoLine(AFigure).ReCreateCaptionsGroup(false, true); end; end; GCadForm := SavedCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.SetConnCaptionsInCAD', E.Message); end; end; // установить выноску на точечном объекте procedure SetConnNotesInCAD(AID_List, AConnID: Integer; ANote: TStringList); var i: integer; AFigure: TFigure; vList: TF_CAD; SavedCadForm: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; AFigure := GetFigureByID(GCadForm, AConnID); if AFigure <> nil then begin if CheckFigureByClassName(AFigure, cTConnectorObject) then begin // если выноска не менялась юзером if not TConnectorObject(AFigure).FIsNotesChanged then begin TConnectorObject(AFigure).OutTextNotes.Clear; for i := 0 to ANote.Count - 1 do TConnectorObject(AFigure).OutTextNotes.Add(ANote[i]); TConnectorObject(AFigure).ReCreateNotesGroup; end; end; end; GCadForm := SavedCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.SetConnNotesInCAD', E.Message); end; end; // установить выноску на линейном объекте procedure SetLineNotesInCAD(AID_List, ALineID: Integer; ANote: TStringList); var i: integer; Line: TOrthoLine; vList: TF_CAD; SavedCadForm: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; Line := TOrthoLine(GetFigureByID(GCadForm, ALineID)); if Line <> nil then begin // если выноска не менялась юзером if not Line.FIsNotesChanged then begin Line.OutTextNotes.Clear; for i := 0 to ANote.Count - 1 do Line.OutTextNotes.Add(ANote[i]); Line.ReCreateNotesGroup; end; end; GCadForm := SavedCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.SetLineNotesInCAD', E.Message); end; end; procedure SetLineCaptionsInCAD(AID_List, ALineID: Integer); var i: integer; Line: TOrthoLine; vList: TF_CAD; SavedCadForm: TF_CAD; PairStr: string; begin try vList := GetListByID(AID_List); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; if GCadForm.FShowLineCaptionsType = skExternalSCS then begin Line := TOrthoLine(GetFigureByID(GCadForm, ALineID)); if Line <> nil then begin // если подпись не менялась юзером if not Line.FIsCaptionsChanged then begin if Line.OutTextCaptions.Count >= 1 then begin PairStr := GetPairCountFromTrace(GCadForm.FCADListID, Line.ID); Line.OutTextCaptions[0] := PairStr; end; Line.ReCreateCaptionsGroup(True, true); end; end; end; GCadForm := SavedCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.SetLineCaptionsInCAD', E.Message); end; end; procedure TraceCableChannelBySelectedLines(CableChannelID: Integer); var i, j, k, lcount: Integer; ComponID: Integer; SelFigure: TFigure; SelLine: TOrthoLine; mess: string; WithRaise: Boolean; JoinConn1, JoinConn2: TConnectorObject; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; PointObject: TConnectorObject; RaiseLine: TOrthoLine; LinesList, SelList, RaisesList, ListOfLists: TList; vList: TF_CAD; SavedGcadForm: TF_CAD; QExist: Boolean; TraceIDs: TIntList; GetRaiseLine: TOrthoLine; begin BeginProgress; try // определить список листов где есть выделенные ListOfLists := TList.Create; for i := 0 to FSCS_Main.MDIChildCount - 1 do begin vList := TF_CAD(FSCS_Main.MDIChildren[i]); if vList.FListType = lt_Normal then begin for j := 0 to vList.PCad.SelectedCount - 1 do if CheckFigureByClassName(TFigure(vList.PCad.Selection[j]), cTOrthoLine) then begin ListOfLists.Add(vList); Break; end; end; end; // *UNDO* if ListOfLists.Count > 0 then begin if GCadForm.FCanSaveForUndo then begin if ListOfLists.Count = 1 then GCadForm.SaveForUndo(uat_None, True, False) else SaveForProjectUndo(ListOfLists, True, False); end; end; // проложить по выделенным по всем листам WithRaise := False; QExist := False; for lcount := 0 to ListOfLists.Count - 1 do begin vList := TF_CAD(ListOfLists[lcount]); SavedGcadForm := GCadForm; GCadForm := vList; if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin LinesList := TList.Create; SelList := TList.Create; RaisesList := TList.Create; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); if SelFigure.Selected then //25.06.2013 - после SelectAll выполняется TF_CAD.PCadSelectionChange, с которого вызывается UnSelectFiguresOnSelectedChange, //где происходит Deselect с-п. Если SelectAll вызван по Crtl-A, то все события успевают выполнится, если вручную был вызов SelectAll, //то PCad.Selection не соответствует действителности if CheckFigureByClassName(SelFigure, cTOrthoLine) then SelList.Add(SelFigure); end; // проверить есть ли с-п через которые можно прокладывать for k := 0 to SelList.Count - 1 do begin SelLine := TOrthoLine(SelList[k]); JoinConn1 := TConnectorObject(SelLine.JoinConnector1); JoinConn2 := TConnectorObject(SelLine.JoinConnector2); // JoinConn1 for i := 0 to JoinConn1.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinConn1.JoinedOrtholinesList[i]).FIsRaiseUpDown then if CheckNoFigureInList(TOrthoLine(JoinConn1.JoinedOrtholinesList[i]), RaisesList) and CheckNoFigureInList(TOrthoLine(JoinConn1.JoinedOrtholinesList[i]), SelList) then RaisesList.Add(TOrthoLine(JoinConn1.JoinedOrtholinesList[i])); if JoinConn1.JoinedConnectorsList.Count > 0 then begin PointObject := TConnectorObject(JoinConn1.JoinedConnectorsList[0]); for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]); if JoinedConn <> JoinConn1 then begin for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then if CheckNoFigureInList(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]), RaisesList) and CheckNoFigureInList(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]), SelList) then RaisesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[j])); end; end; end; // JoinConn2 for i := 0 to JoinConn2.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinConn2.JoinedOrtholinesList[i]).FIsRaiseUpDown then if CheckNoFigureInList(TOrthoLine(JoinConn2.JoinedOrtholinesList[i]), RaisesList) and CheckNoFigureInList(TOrthoLine(JoinConn2.JoinedOrtholinesList[i]), SelList) then RaisesList.Add(TOrthoLine(JoinConn2.JoinedOrtholinesList[i])); if JoinConn2.JoinedConnectorsList.Count > 0 then begin PointObject := TConnectorObject(JoinConn2.JoinedConnectorsList[0]); for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]); if JoinedConn <> JoinConn2 then begin for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then if CheckNoFigureInList(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]), RaisesList) and CheckNoFigureInList(TOrthoLine(JoinedConn.JoinedOrtholinesList[j]), SelList) then RaisesList.Add(TOrthoLine(JoinedConn.JoinedOrtholinesList[j])); end; end; end; end; // c-п есть! if not QExist then begin if RaisesList.Count > 0 then begin mess := cCommon_Mes20; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCommon_Mes21, MB_YESNO) = IDYes then WithRaise := True else WithRaise := False; QExist := True; end; end; // вместе с с-п if WithRaise then begin for i := 0 to SelList.Count - 1 do begin SelLine := TOrthoLine(SelList[i]); LinesList.Add(SelLine); end; for i := 0 to RaisesList.Count - 1 do begin SelLine := TOrthoLine(RaisesList[i]); LinesList.Add(SelLine); end; end else begin for i := 0 to SelList.Count - 1 do begin SelLine := TOrthoLine(SelList[i]); LinesList.Add(SelLine); end; end; for i := 0 to LinesList.Count - 1 do begin ProcessMessagesEx; SelFigure := TFigure(LinesList[i]); ComponID := CopyComponentToSCSObject(SelFigure.ID, CableChannelID); AutoConnectOnAppendCable(GCadForm.FCADListID, SelFigure.ID); // если это м-э с-п, то найти трассу на другом листе if TOrthoLine(SelFigure).FIsRaiseUpDown then begin GetRaiseLine := GetBetweenFloorRaiseLine(TOrthoLine(SelFigure)); if GetRaiseLine <> nil then begin TraceIDs := TIntList.Create; TraceIDs.Add(TOrthoLine(SelFigure).ID); TraceIDs.Add(GetRaiseLine.ID); ConnectObjectsInPMByWay(TraceIDs, nil, nil, nil); FreeAndNil(TraceIDs); end; end; end; if RaisesList <> nil then FreeAndNil(RaisesList); if SelList <> nil then FreeAndNil(SelList); if LinesList <> nil then FreeAndNil(LinesList); end; GCadForm := SavedGcadForm; end; if ListOfLists <> nil then FreeAndNil(ListOfLists); except on E: Exception do addExceptionToLogEx('U_Common.TraceCableChannelBySelectedLines', E.Message); end; EndProgress; end; function IsSelectedLinesExist: Boolean; var i: integer; begin Result := False; try for i := 0 to GCadForm.PCad.SelectedCount - 1 do if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then Result := True; except on E: Exception do addExceptionToLogEx('U_Common.IsSelectedLinesExist', E.Message); end; end; function IsSelectedFigure(aListID, aFigureID: Integer): Boolean; var Fig: TFigure; begin Result := false; Fig := GetFigureObjectByID(aListID, aFigureID); if Fig <> nil then Result := Fig.Selected; end; function GetCoordXWithSnapToGrid(X: Double): Double; var BaseX: Double; GridStep: Double; begin Result := 0; try GridStep := GCadForm.PCad.GridStep; BaseX := Round(X / GridStep); Result := BaseX * GridStep; except on E: Exception do addExceptionToLogEx('U_Common.GetCoordXWithSnapToGrid', E.Message); end; end; function GetCoordYWithSnapToGrid(Y: Double): Double; var BaseY: Double; GridStep: Double; begin Result := 0; try GridStep := GCadForm.PCad.GridStep; BaseY := Round(Y / GridStep); Result := BaseY * GridStep; except on E: Exception do addExceptionToLogEx('U_Common.GetCoordYWithSnapToGrid', E.Message); end; end; function GetCoordsWithSnapToGrid(X, Y: Double): TDoublePoint; //var // BaseX, BaseY: Double; // GridStep: Double; begin try //01.10.2013 //Result := DoublePoint(0, 0); //GridStep := GCadForm.PCad.GridStep; //BaseX := Round(X / GridStep); //BaseY := Round(Y / GridStep); //Result.x := BaseX * GridStep; //Result.y := BaseY * GridStep; Result := DoublePoint(x, y); GCadForm.PCad.SnapToGrid(Result.x, Result.y); except on E: Exception do addExceptionToLogEx('U_Common.GetCoordsWithSnapToGrid', E.Message); end; end; function IsClickOnFigure: Boolean; var GridStep: Double; begin Result := False; try // нет привязки к сетке if not FSCS_Main.aSnaptoGrid.Checked then begin if (GMouseDownPos.x = GCurrMousePos.x) and (GMouseDownPos.y = GCurrMousePos.y) then Result := True; end else // есть приязка к сетке begin GridStep := GCadForm.PCad.GridStep; if (abs(GMouseDownPos.x - GCurrMousePos.x) < GridStep) and (abs(GMouseDownPos.y - GCurrMousePos.y) < GridStep) then Result := True; end; except on E: Exception do addExceptionToLogEx('U_Common.IsClickOnFigure', E.Message); end; end; procedure SetConnNameInCaptionOnCAD(AConnector: TConnectorObject); var i: integer; CaptionsLHandle: Integer; FullName: String; begin try FullName := AConnector.Name + IntToStr(AConnector.FIndex); if AConnector.OutTextCaptions.Count > 0 then AConnector.OutTextCaptions[0] := FullName else AConnector.OutTextCaptions.Add(FullName); AConnector.ReCreateCaptionsGroup(true, true); except on E: Exception do addExceptionToLogEx('U_Common.SetConnNameInCaptionOnCAD', E.Message); end; end; Procedure AutoTraceCableFromNB(AID_Cable: Integer; ACable: TSCSComponent; aFromDropConnObj: Boolean=false; aShowFirstMsg: Boolean=true; aSaveForUndo: Boolean=true; aNeedShowAutoTraceType: boolean = True; aFromDrop: boolean = False); var i, j, k: integer; ComponID: Integer; IsAnyRTSelected: Boolean; mess: String; aEndPointName: string; TracedList: TList; WasEndPoint: boolean; //02.07.2013 FiguresList: TList; //RackCount: Integer; //BoxCount: Integer; //WACount: Integer; //RackPortCount, BoxPortCount, WAPortCount: Integer; ptrTrFigInfo: PTracingFiguresInfo; ExistsBoxAndRack: Boolean; CurrentWA: TConnectorObject; WAList: TF_CAD; SCSList: TSCSList; SCSObj: TSCSCatalog; SCSCompon: TSCSComponent; //TempInterfaces: TSCSInterfaces; TmpPortCount: Integer; FigureID: integer; SCSComponTmp: TSCSComponent; SCSCatalog: TSCSCatalog; isEndObjectRack: boolean; BoxFigure: TFigure; isEndObjectBox: Boolean; isSnapObjectRack: boolean; isSnapObjectBox: Boolean; resM: integer; begin ptrTrFigInfo := nil; try try WasEndPoint := True; if GEndPoint = nil then begin // КО ВЫБРАТЬ WasEndPoint := False; if GIsProgress {and aFromDrop} then PauseProgress(True); try F_EndPoints.Execute; finally if GIsProgress {and aFromDrop} then PauseProgress(False); end; end; if GEndPoint <> nil then begin TracedList := TList.Create; // перегнать выделенные объекты в лист for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin TracedList.Add(TFigure(GCadForm.PCad.Selection[i])); end; // проверить можно ли трассировать по выбранным или только во всем IsAnyRTSelected := False; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin If CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then If TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_Clear then if TConnectorObject(GCadForm.PCad.Selection[i]) <> GEndPoint then IsAnyRTSelected := True; end; if IsAnyRTSelected then begin if aNeedShowAutoTraceType then begin if GIsProgress then PauseProgress(True); try resM := F_AutoTraceType.ShowModal; finally if GIsProgress then PauseProgress(False); end; if resM = mrOK then begin if F_AutoTraceType.rbTraceBySelected.Checked then GCadForm.FAutoTraceBySelected := True; if F_AutoTraceType.rbTraceByAll.Checked then GCadForm.FAutoTraceBySelected := False; end else Exit; end else GCadForm.FAutoTraceBySelected := True; end else begin if aShowFirstMsg then begin aEndPointName := GetFigureFirstComponentName(GEndPoint.ID); mess := cMain_Mes34 + aEndPointName + #13#10 + #13#10 + cMain_Mes35; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes36, MB_OK) = IDOk then GCadForm.FAutoTraceBySelected := False else Exit; end else GCadForm.FAutoTraceBySelected := False end; //02.07.2013 - список с обїектами для трассировки FiguresList := nil; if not GCadForm.FAutoTraceBySelected then FiguresList := GCadForm.PCad.Figures else FiguresList := TracedList; //02.07.2013 - ОПРЕДЕЛЯЕМ НАЛИЧИЕ ШКАФА И БОКСА СРЕДИ ТРАССИРУЕМЫХ ОБЪЕКТОВ ExistsBoxAndRack := false; //RackCount := 0; //BoxCount := 0; //WACount := 0; //RackPortCount := 0; //BoxPortCount := 0; //WAPortCount := 0; BoxFigure := nil; if aFromDropConnObj then begin GetZeroMem(ptrTrFigInfo, SizeOf(TTracingFiguresInfo)); for i := 0 to FiguresList.Count - 1 do begin if CheckFigureByClassName(TFigure(FiguresList[i]), cTConnectorObject) then begin CurrentWA := TConnectorObject(FiguresList[i]); if CurrentWA <> nil then begin WAList := TF_CAD(TPowerCad(CurrentWA.Owner).Owner); SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(WAList.FCADListID); if SCSList <> nil then begin SCSObj := SCSList.GetCatalogFromReferencesBySCSID(CurrentWA.ID); if SCSObj <> nil then begin for j := 0 to SCSObj.SCSComponents.Count - 1 do begin SCSCompon := SCSObj.SCSComponents[j]; //TempInterfaces := SCSCompon.GetInterfacesByIsPort(biTrue, true, biFalse); TmpPortCount := GetPortsCountReadyToConnectByInterf(SCSCompon, 0, true); if SCSCompon.ComponentType.SysName = ctsnCupboard then begin Inc(ptrTrFigInfo^.RackCount); ptrTrFigInfo^.RackPortCount := ptrTrFigInfo^.RackPortCount + TmpPortCount; //TempInterfaces.Count; end else if SCSCompon.ComponentType.SysName = ctsnBox then begin BoxFigure := CurrentWA; Inc(ptrTrFigInfo^.BoxCount); ptrTrFigInfo^.BoxPortCount := ptrTrFigInfo^.BoxPortCount + TmpPortCount; //TempInterfaces.Count; end else if (SCSCompon.ComponentType.SysName = ctsnWorkPlace) or (SCSCompon.ComponentType.SysName = ctsnSocket) or (SCSCompon.ComponentType.SysName = ctsnModule) then begin Inc(ptrTrFigInfo^.WACount); ptrTrFigInfo^.WAPortCount := ptrTrFigInfo^.WAPortCount + TmpPortCount; //TempInterfaces.Count; end; //FreeAndNil(TempInterfaces); end; end; end; end; end; end; ExistsBoxAndRack := (ptrTrFigInfo^.RackCount > 0) and (ptrTrFigInfo^.BoxCount > 0); end; //*** Выбрать порядок подключения панелей с портами if Not ChoiceAutoTraceConnectOrder(nil, true, ACable, aFromDropConnObj, ptrTrFigInfo) then //07.02.2011 if Not ChoiceAutoTraceConnectOrder then Exit; ///// EXIT ///// if ExistsBoxAndRack then begin if GEndPoint = GFigureSnap then // дропнули на КО и КО не бокс - переключить КО на бокс. begin isEndObjectBox := False; if GEndPoint <> nil then begin FigureID := TConnectorObject(GEndPoint).ID; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(GEndPoint.Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(FigureID); if SCSCatalog <> nil then begin for k := 0 to SCSCatalog.SCSComponents.Count - 1 do begin if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then begin isEndObjectBox := true; break; end end; end; end; if Not isEndObjectBox then begin //ExistsBoxAndRack := False; FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(BoxFigure)); end; end else // дроп не на КО - проверим что КО и на что дропнули // если КО - шкаф и дроп на шкаф (соединяем два шкафа) - сделать ExistsBoxAndRack := False; // если КО - бокс, и дроп на шкаф - оставим пока как есть // если КО - шкаф и дроп не на бокс - сделать ExistsBoxAndRack := False; и очистить список добавить в него только снапобжект // если КО - шкаф и дроп на бокс - сделать бокс КО; // если КО не бокс и не шкаф - оставим пока как есть тоже begin isEndObjectRack := False; isEndObjectBox := False; isSnapObjectRack := False; isSnapObjectBox := False; if GEndPoint <> nil then begin FigureID := TConnectorObject(GEndPoint).ID; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(GEndPoint.Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(FigureID); if SCSCatalog <> nil then begin for k := 0 to SCSCatalog.SCSComponents.Count - 1 do begin if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnCupboard then begin isEndObjectRack := true; break; end; if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then begin isEndObjectBox := true; break; end; end; end; end; if GFigureSnap <> nil then begin FigureID := TConnectorObject(GFigureSnap).ID; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(TF_CAD(GFigureSnap.Owner.Owner).FCADListID).GetCatalogFromReferencesBySCSID(FigureID); if SCSCatalog <> nil then begin for k := 0 to SCSCatalog.SCSComponents.Count - 1 do begin if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnCupboard then begin isSnapObjectRack := true; break; end; if SCSCatalog.SCSComponents[k].ComponentType.SysName = ctsnBox then begin isSnapObjectBox := true; break; end; end; end; end; if isEndObjectRack and isSnapObjectRack then begin ExistsBoxAndRack := False; //FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(BoxFigure)); end else if isEndObjectRack and Not isSnapObjectBox then begin ExistsBoxAndRack := False; FiguresList := TracedList; FiguresList.Clear; FiguresList.Add(GFigureSnap); //FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(BoxFigure)); end else if isEndObjectRack and isSnapObjectBox then begin //ExistsBoxAndRack := False; FSCS_Main.SetFigureAsEndObject(GCadForm, TConnectorObject(BoxFigure)); end else ExistsBoxAndRack := True; end; end; BeginProgress; try GAutoTraceCount := 0; DoAutoTraceCycle(FiguresList, AID_Cable, ExistsBoxAndRack, aSaveForUndo); finally EndProgress; end; {IGOR} //D0000006298 if GAutoTraceCount = 0 then begin //if GIsProgress then // PauseProgress(true); {$IF Defined(SCS_PE)} if MessageBox(FSCS_Main.Handle, 'Cables were not connected due to lack of free ports' + #13#10 + 'in Outlets or Boxes or Patch-panels in Telecom Cabinets' + #13#10 + 'Please add Outlets/Boxes/Patch-panels etc.' + #13#10 + #13#10 + 'Run cables anyway?', 'Warning', MB_YESNO) = IDYes then {$ELSE} if MessageBox(FSCS_Main.Handle, 'Кабель не был подключен, по причине отсутствия свободных портов ' + #13#10 + 'в розетках, боксах или патч-панелях в шкафах ' + #13#10 + 'Добавьте Розетки/Боксы/Патч-панели' + #13#10 + #13#10 + 'Автотрассировать снова?', 'Внимание', MB_YESNO) = IDYes then {$IFEND} begin //if GIsProgress then // PauseProgress(false); F_AutoTraceConnectOrder.rbTraceManualCable.Checked := True; if ChoiceAutoTraceConnectOrder(nil, false, ACable, aFromDropConnObj, ptrTrFigInfo) then begin BeginProgress; try DoAutoTraceCycle(FiguresList, AID_Cable, ExistsBoxAndRack, aSaveForUndo); finally EndProgress; end; end; end //else // if GIsProgress then // PauseProgress(false); end; //02.07.2013 // // Трассировать по всем точкам // if not GCadForm.FAutoTraceBySelected then // begin // BeginProgress; // try // DoAutoTraceCycle(GCadForm.PCad.Figures, AID_Cable); // finally // EndProgress; // end; // end // else // // Трассировать по выбранным точкам // begin // BeginProgress; // try // DoAutoTraceCycle(TracedList, AID_Cable); // finally // EndProgress; // end; // end; if TracedList <> nil then FreeAndNil(TracedList); end; except on E: Exception do addExceptionToLogEx('U_Common.AutoTraceCableFromNB', E.Message); end; finally if (Not WasEndPoint) and (GEndPoint <> nil) then begin if GFigureSnap = GEndPoint then begin TConnectorObject(GEndPoint).AsEndPoint := False; GEndPoint := Nil; GListWithEndPoint := Nil; RefreshCAD(GCadForm.PCad); end; end; if ptrTrFigInfo <> nil then FreeMem(ptrTrFigInfo); end; end; procedure DoAutoTraceCycle(AFiguresList: TList; AID_Cable: Integer; aConsiderBoxAndRack: Boolean=false; aSaveForUndo: Boolean=true); var i, j: integer; CanTracingCount: Integer; CurrentWA: TConnectorObject; CurrentServer: TConnectorObject; IsTrace: Boolean; ObjectsList: TList; ListOfLists: TIntList; vLists: TList; vList: TF_CAD; TickPrev, TickCurr: Cardinal; CableToTraceCount: integer; begin try BeginAutoTrace; TickPrev := GetTickCount; CurrentServer := nil; //#From Oleg# //14.09.2010 CanTracingCount := 1; ObjectsList := TList.Create; ObjectsList := GetSortedListForAutoTrace(aFiguresList); // получить список листов через которые будет проведена автотрассировка ListOfLists := TIntList.create; if GListWithEndPoint <> nil then begin ListOfLists := GetSortedListIDsByBounds(GListWithEndPoint.FCADListID, GCadForm.FCADListID); end else ListOfLists.Add(GCadForm.FCADListID); if aSaveForUndo then begin vLists := TList.Create; for i := 0 to ListOfLists.Count - 1 do begin vList := GetListByID(ListOfLists[i]); if vList <> nil then vLists.Add(vList); end; SaveForProjectUndo(vLists, True, False); end; try CableToTraceCount := strtoint(F_AutoTraceConnectOrder.neCableTraceCount.Text); except CableToTraceCount := 0; end; while CanTracingCount > 0 do begin CanTracingCount := 0; for i := 0 to ObjectsList.Count - 1 do begin CurrentWA := TConnectorObject(ObjectsList[i]); if CurrentWA <> nil then begin // *** if CheckFigureByClassName(GEndPoint, cTConnectorObject) then CurrentServer := TConnectorObject(GEndPoint) else if CheckFigureByClassName(GEndPoint, cTHouse) then CurrentServer := GetEndPointByHouse(THouse(GEndPoint), CurrentWA); // *** if CurrentServer <> nil then begin {IGOR} //D0000006298 (* if F_AutoTraceConnectOrder.rbTraceManualCable.Checked then begin //Inc(CanTracingCount); ProcessMessagesEx; for j := 1 to CableToTraceCount do begin GCadForm.FTracingList := GetAllTraceInCAD(CurrentWA, CurrentServer); if Assigned(GCadForm.FTracingList) then FreeAndNil(GCadForm.FTracingList); IsTrace := TracingToEndPoint(CurrentWA, CurrentServer, AID_Cable, false {aConsiderBoxAndRack}); GAutoTraceCount := GAutoTraceCount + 1; if IsTrace then begin GCadForm.mProtocol.Lines.Add(cCommon_Mes2 + CurrentWA.Name + cCommon_Mes3 + CurrentServer.Name + '"'); end end; end else *) if F_AutoTraceConnectOrder.rbTraceManualCable.Checked or F_AutoTraceConnectOrder.StreakConnect.Checked then begin //Inc(CanTracingCount); ProcessMessagesEx; //Tolik if F_AutoTraceConnectOrder.StreakConnect.Checked and not F_AutoTraceConnectOrder.rbTraceManualCable.Checked then begin while CanConnectLineComponWithConObjects(AID_Cable, CurrentWA.ID, CurrentServer.ID, aConsiderBoxAndRack) do begin GCadForm.FTracingList := GetAllTraceInCAD(CurrentWA, CurrentServer); if Assigned(GCadForm.FTracingList) then FreeAndNil(GCadForm.FTracingList); IsTrace := TracingToEndPoint(CurrentWA, CurrentServer, AID_Cable, false {aConsiderBoxAndRack}); GAutoTraceCount := GAutoTraceCount + 1; if IsTrace then begin GCadForm.mProtocol.Lines.Add(cCommon_Mes2 + CurrentWA.Name + cCommon_Mes3 + CurrentServer.Name + '"'); end else break; end; end else begin for j := 1 to CableToTraceCount do begin GCadForm.FTracingList := GetAllTraceInCAD(CurrentWA, CurrentServer); if Assigned(GCadForm.FTracingList) then FreeAndNil(GCadForm.FTracingList); IsTrace := TracingToEndPoint(CurrentWA, CurrentServer, AID_Cable, false {aConsiderBoxAndRack}); GAutoTraceCount := GAutoTraceCount + 1; if IsTrace then begin GCadForm.mProtocol.Lines.Add(cCommon_Mes2 + CurrentWA.Name + cCommon_Mes3 + CurrentServer.Name + '"'); end end; end; end else begin if CanConnectLineComponWithConObjects(AID_Cable, CurrentWA.ID, CurrentServer.ID, aConsiderBoxAndRack) then begin Inc(CanTracingCount); ProcessMessagesEx; IsTrace := TracingToEndPoint(CurrentWA, CurrentServer, AID_Cable, aConsiderBoxAndRack); if IsTrace then begin GAutoTraceCount := GAutoTraceCount + 1; GCadForm.mProtocol.Lines.Add(cCommon_Mes2 + CurrentWA.Name + cCommon_Mes3 + CurrentServer.Name + '"'); end else // в протокол begin Dec(CanTracingCount); GCadForm.mProtocol.Lines.Add(cCommon_Mes4 + CurrentWA.Name + cCommon_Mes5 + #13#10 + cCommon_Mes6); end; end else begin GCadForm.mProtocol.Lines.Add(cCommon_Mes4 + CurrentWA.Name + cCommon_Mes5 + #13#10 + cCommon_Mes6); end; end; end; end; end; end; FreeAndNil(ObjectsList); //Tolik FreeAndNil(ListOfLists); FreeAndNil(vLists); // except on E: Exception do addExceptionToLogEx('U_Common.DoAutoTraceCycle', E.Message); end; TickCurr := GetTickCount - TickPrev; TickCurr := GetTickCount - TickPrev; EndAutoTrace; end; Procedure AutoConnectBetweenFloorPassage(ACable: TOrthoLine; ASide: Integer; ARaise: TConnectorObject); var i, j: integer; JoinedConn1, JoinedConn2: TConnectorObject; JoinedObject: TConnectorObject; JoinedLine: TOrthoLine; isConnected: Boolean; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; ListOfPassage: TF_CAD; ConnOfPassage: TConnectorObject; begin try ParamsList1 := TList.Create; ParamsList2 := TList.Create; // интерфейсы кабеля New(ptrInterfRecord1); ptrInterfRecord1.IDObject := ACable.ID; if ASide = 1 then ptrInterfRecord1.Side := 1; if ASide = 2 then ptrInterfRecord1.Side := 2; ParamsList1.Add(ptrInterfRecord1); // получить объект и лист перехода ListOfPassage := GetListOfPassage(ARaise.FID_ListToPassage); if ListOfPassage <> nil then begin ConnOfPassage := TConnectorObject(GetFigureByID(ListOfPassage, ARaise.FID_ConnToPassage)); for j := 0 to ConnOfPassage.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(ConnOfPassage.JoinedOrtholinesList[j]); if JoinedLine.FIsRaiseUpDown then begin New(ptrInterfRecord2); ptrInterfRecord2.IDObject := JoinedLine.ID; if ConnOfPassage = JoinedLine.JoinConnector1 then ptrInterfRecord2.Side := 1; if ConnOfPassage = JoinedLine.JoinConnector2 then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; end; isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2); // if ParamsList1 <> nil then // FreeAndNil(ParamsList1); // if ParamsList2 <> nil then // FreeAndNil(ParamsList2); except on E: Exception do addExceptionToLogEx('U_Common.AutoConnectBetweenFloorPassage', E.Message); end; end; Function GetBetweenFloorRaiseLine(ALine: TOrthoLine): TOrthoLine; var AConnRaiseType: TConnRaiseType; i: integer; RaiseConn: TConnectorObject; RaiseConnPassage: TConnectorObject; ListOfPassage: TF_CAD; ConnOfPassage: TConnectorObject; begin Result := nil; try AConnRaiseType := TConnectorObject(ALine.JoinConnector1).FConnRaiseType; if (AConnRaiseType = crt_BetweenFloorUp) or (AConnRaiseType = crt_BetweenFloorDown) then begin RaiseConn := TConnectorObject(ALine.JoinConnector1); ListOfPassage := GetListOfPassage(RaiseConn.FID_ListToPassage); if ListOfPassage <> nil then begin RaiseConnPassage := TConnectorObject(GetFigureByID(ListOfPassage, RaiseConn.FID_ConnToPassage)); for i := 0 to RaiseConnPassage.JoinedOrtholinesList.Count - 1 do if TOrthoLine(RaiseConnPassage.JoinedOrtholinesList[i]).FIsRaiseUpDown then Result := TOrthoLine(RaiseConnPassage.JoinedOrtholinesList[i]); end; end; AConnRaiseType := TConnectorObject(ALine.JoinConnector2).FConnRaiseType; if (AConnRaiseType = crt_BetweenFloorUp) or (AConnRaiseType = crt_BetweenFloorDown) then begin RaiseConn := TConnectorObject(ALine.JoinConnector2); ListOfPassage := GetListOfPassage(RaiseConn.FID_ListToPassage); if ListOfPassage <> nil then begin RaiseConnPassage := TConnectorObject(GetFigureByID(ListOfPassage, RaiseConn.FID_ConnToPassage)); for i := 0 to RaiseConnPassage.JoinedOrtholinesList.Count - 1 do if TOrthoLine(RaiseConnPassage.JoinedOrtholinesList[i]).FIsRaiseUpDown then Result := TOrthoLine(RaiseConnPassage.JoinedOrtholinesList[i]); end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetBetweenFloorRaiseLine', E.Message); end; end; Function TracingToEndPoint(ACurrentWS, AEndPoint: TConnectorObject; AID_Cable: Integer; aConsiderBoxAndRack: Boolean=false): Boolean; var i, j: integer; RaiserThisList: TConnectorObject; RaiserOtherList: TConnectorObject; CurGCadForm: TF_CAD; ComponID: Integer; isConnected: Boolean; IDLine: Integer; IDPointer: ^Integer; AllTrace: TList; AllTraceItList: TList; AllTraceOtherList: TList; AllSCSObjs: TList; SetLinesList: TIntList; SCSObj: TSCSCatalog; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; CurrLine: TOrthoLine; CurrConn: TConnectorObject; RaiseType: TConnRaiseType; ListOfLists: TIntList; ListOfRaises: TList; CurrentCAD: TF_CAD; ConnFrom: TConnectorObject; ConnTo: TConnectorObject; PrevConn: TConnectorObject; PrevCAD: TF_CAD; begin Result := False; try if (ACurrentWS = nil) or (AEndPoint = nil) then exit; ProcessMessagesEx; if GListWithEndPoint = GCadForm then begin // если if not CheckTrunkObject(AEndPoint) or not CheckTrunkObject(AEndPoint) then begin // *** Получить текущий путь после выделения // *** его не будет если не было ручного выделения пути if GCadForm.FTracingList = nil then AllTrace := GetAllTraceInCAD(AEndPoint, ACurrentWS) else AllTrace := GCadForm.FTracingList; // выделить трассу if AllTrace <> nil then begin AllSCSObjs := TList.Create; for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; DisableMarking; //15.01.2011 - Отключаем генерацию маркировки для кабеля try // скопировать кабель туда for i := 0 to AllTrace.Count - 1 do begin //08.11.2011 ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AID_Cable); ComponID := CopyComponentToSCSObject(TFigure(AllTrace[i]).ID, AID_Cable, false, @SCSObj); AllSCSObjs.Add(SCSObj); end; finally EnableMarking; end; // убрать выделение трассы for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).DeSelect; // SetLinesList := TIntList.Create; for i := 0 to AllTrace.Count - 1 do begin IDLine := TFigure(AllTrace[i]).ID; SetLinesList.Add(IDLine); end; isConnected := ConnectObjectsInPMByWay(SetLinesList, AllTrace, AllSCSObjs, nil, aConsiderBoxAndRack); //08.11.2011 isConnected := ConnectObjectsInPMByWay(SetLinesList, AllSCSObjs); if SetLinesList <> nil then FreeAndNil(SetLinesList); if AllTrace <> nil then FreeAndNil(AllTrace); if GCadForm.FTracingList <> nil then GCadForm.FTracingList := nil; Result := True; //if aConsiderBoxAndRack then // if Not isConnected then // Result := false; AllSCSObjs.Free; end; GCadForm.FTracingListIndex := 0; end else begin TracingTrunkToEndPoint(ACurrentWS, AEndPoint, AID_Cable); end; end else if GListWithEndPoint <> nil then begin RaiseType := crt_BetweenFloorDown; //#From Oleg# //14.09.2010 // другой лист с КО if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GListWithEndPoint.FCADListID then RaiseType := crt_BetweenFloorDown; if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GCadForm.FCADListID then RaiseType := crt_BetweenFloorUp; ListOfLists := GetSortedListIDsByBounds(GListWithEndPoint.FCADListID, GCadForm.FCADListID); if ListOfLists.Count >= 2 then begin ListOfRaises := GetSortedListOfRaises(ListOfLists, RaiseType, AEndPoint, ACurrentWS); if ListOfLists.Count >= 2 then begin if CheckCanTracingBetweenFloor(ListOfLists, ListOfRaises) then begin PrevCAD := nil; PrevConn := nil; SetLinesList := TIntList.Create; DisableMarking; //15.01.2011 - Отключаем генерацию маркировки для кабеля try // CICLE for i := 0 to ListOfLists.Count - 1 do begin CurrentCAD := GetListByID(ListOfLists[i]); if i < ListOfLists.Count - 1 then ConnTo := TConnectorObject(ListOfRaises[i]) else ConnTo := ACurrentWS; CurGCadForm := GCadForm; GCadForm := CurrentCAD; if i = 0 then begin ConnFrom := AEndPoint; end else begin ConnFrom := TConnectorObject(GetFigureByID(GCadForm, PrevConn.FID_ConnToPassage)); end; if GCadForm.FTracingList = nil then AllTrace := GetAllTraceInCAD(ConnFrom, ConnTo) else AllTrace := GCadForm.FTracingList; if AllTrace <> nil then begin for j := 0 to AllTrace.Count - 1 do TFigure(AllTrace[j]).Select; for j := 0 to AllTrace.Count - 1 do ComponID := CopyComponentToSCSObject(TFigure(AllTrace[j]).ID, AID_Cable); for j := 0 to AllTrace.Count - 1 do TFigure(AllTrace[j]).DeSelect; RefreshCAD(GCadForm.PCad); for j := 0 to AllTrace.Count - 1 do begin IDLine := TOrthoLine(AllTrace[j]).ID; SetLinesList.Add(IDLine); end; end; if AllTrace <> nil then FreeAndNil(AllTrace); if GCadForm.FTracingList <> nil then GCadForm.FTracingList := nil; GCadForm.FTracingListIndex := 0; GCadForm := CurGCadForm; PrevCAD := CurrentCAD; PrevConn := ConnTo; end; finally EnableMarking; end; isConnected := ConnectObjectsInPMByWay(SetLinesList, nil, nil, nil); if SetLinesList <> nil then FreeAndNil(SetLinesList); Result := True; end; end; end; if ListOfLists <> nil then FreeAndNil(ListOfLists); if ListOfRaises <> nil then FreeAndNil(ListOfRaises); end; if ACurrentWS <> nil then if ACurrentWS.ConnectorType = ct_Clear then begin if ACurrentWS.JoinedOrtholinesList.Count > 1 then begin ParamsList1 := TList.Create; ParamsList2 := TList.Create; // интерфейсы кабеля CurrLine := TOrthoLine(ACurrentWS.JoinedOrtholinesList[0]); New(ptrInterfRecord1); ptrInterfRecord1.IDObject := CurrLine.ID; if CurrLine.JoinConnector1 = ACurrentWS then ptrInterfRecord1.Side := 1; if CurrLine.JoinConnector2 = ACurrentWS then ptrInterfRecord1.Side := 2; ParamsList1.Add(ptrInterfRecord1); for i := 1 to ACurrentWS.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(ACurrentWS.JoinedOrtholinesList[i]); New(ptrInterfRecord2); ptrInterfRecord2.IDObject := CurrLine.ID; if CurrLine.JoinConnector1 = ACurrentWS then ptrInterfRecord2.Side := 1; if CurrLine.JoinConnector2 = ACurrentWS then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; isConnected := ConnectObjectsInPM(ParamsList1, ParamsList2); FreeAndNil(ParamsList1); FreeAndNil(ParamsList2); end; end; except on E: Exception do addExceptionToLogEx('U_Common.TracingToEndPoint', E.Message); end; end; Procedure ApplyParamsForAllSCSObject(AConnHeight, ALineHeight: Double; AConnCaptionsShowType, AConnNotesShowType: TShowType; ALineCaptionsShowType, ALineNotesShowType: TShowKind; aCADParams: TCADParams); var i, k: integer; CurrObject: TConnectorObject; CurrTrace: TOrthoLine; ObjParams: TObjectParams; TracesList: TList; NotesList: TStringList; x1, y1, z1, x2, y2, z2: double; GetPointObject: TConnectorObject; LinesList: TList; ConnsList: TList; valBool: Boolean; valInteger: Integer; valDouble: Double; valString: string; valColor: TColor; Str: string; isApply: Boolean; PairCount: Integer; PairStr: string; NotesCaptions: TRichTextMod; Captions: TRichTextMod; CadCrossObject: TCadCrossObject; valPrintType: TPrintType; CurrRichText: TRichTextMod; begin try BeginProgress; valPrintType := pt_Color; TracesList := TList.Create; LinesList := TList.Create; ConnsList := TList.Create; // занесение в листы for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin CurrTrace := TOrthoLine(GCadForm.PCad.Figures[i]); if not CurrTrace.FIsRaiseUpDown then if CurrTrace.ActualZOrder[1] = CurrTrace.ActualZOrder[2] then TracesList.Add(CurrTrace); LinesList.Add(CurrTrace); end else if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin CurrObject := TConnectorObject(GCadForm.PCad.Figures[i]); ConnsList.Add(CurrObject); end; end; // ИЗМЕНЕНИЕ РАСПОЛОЖЕНИЯ ОБЪЕКТОВ // поиск всех объектов for i := 0 to ConnsList.Count - 1 do begin CurrObject := TConnectorObject(ConnsList[i]); // Selected if not F_MasterNewList.cbApplyForSelectedOnly.Checked then isApply := True else begin if CurrObject.Selected then isApply := True else isApply := False; end; // if isApply then begin if CurrObject.ConnectorType <> ct_Clear then begin if not HaveObjectCorkComponent(CurrObject.ID) then begin valDouble := UOMToMetre(StrToFloat_My(F_MasterNewList.edConnTotal.Text)); if aCADParams.CADHeightConns <> valDouble then begin if CurrObject.ActualZOrder[1] <> AConnHeight then ApplyParamsForObjects(CurrObject, AConnHeight); end; end; // Captions valBool := F_MasterNewList.cbShowConnectorsCaptions.Checked; if ((TCheckBoxState(F_MasterNewList.cbShowConnectorsCaptions.State) <> cbGrayed) and (aCADParams.CADShowConnObjectCaption <> valBool)) or (aCADParams.CADObjectCaptions <> AConnCaptionsShowType) then begin ObjParams := GetFigureParams(CurrObject.ID); CurrObject.Name := ObjParams.Name; CurrObject.FIndex := ObjParams.MarkID; SetConnNameInCaptionOnCAD(CurrObject); end; {====================================================================} // выноски valBool := F_MasterNewList.cbShowConnectorsNotes.Checked; if ((TCheckBoxState(F_MasterNewList.cbShowConnectorsNotes.State) <> cbGrayed) and (aCADParams.CADShowConnObjectNote <> valBool)) or ((aCADParams.CADObjectNotes <> AConnNotesShowType) or (aCADParams.CADLinesNotes <> ALineNotesShowType)) then begin NotesList := GetObjectNotesWithParams(CurrObject.ID); SetConnNotesInCAD(GCadForm.FCADListID, CurrObject.ID, NotesList); if NotesList <> nil then FreeAndNil(NotesList); end; {====================================================================} // цвет подписи к ТО valColor := F_MasterNewList.cbConnectorsCaptionsColor.ColorValue; if aCADParams.CADConnectorsCaptionsColor <> valColor then begin CurrObject.FCaptionsFontColor := valColor; CurrObject.ReCreateCaptionsGroup(True, True); end; // цвет выноски к ТО valColor := F_MasterNewList.cbConnectorsNotesColor.ColorValue; if aCADParams.CADConnectorsNotesColor <> valColor then begin CurrObject.FNotesFontColor := valColor; CurrObject.ReCreateNotesGroup(True); end; // размер шрифта подписи к ТО valInteger := StrToInt(F_MasterNewList.cbConnectorsCaptionsFontSize.Text); valString := F_MasterNewList.cbFontName.FontName; if (aCADParams.CADConnectorsCaptionsFontSize <> valInteger) then begin if CurrObject.FCaptionsFontSize <> valInteger then begin CurrObject.FCaptionsFontSize := valInteger; CurrObject.ReCreateCaptionsGroup(True, True); end; end else if (aCADParams.CADFontName <> valString) then begin if CurrObject.FCaptionsFontName <> valString then begin CurrObject.FCaptionsFontName := valString; CurrObject.ReCreateCaptionsGroup(True, True); end; end; // размер шрифта выноски к ТО valInteger := StrToInt(F_MasterNewList.cbConnectorsNotesFontSize.Text); valString := F_MasterNewList.cbFontName.FontName; if (aCADParams.CADConnectorsNotesFontSize <> valInteger) then begin if CurrObject.FNotesFontSize <> valInteger then begin CurrObject.FNotesFontSize := valInteger; CurrObject.ReCreateNotesGroup(True); end; end else if (aCADParams.CADFontName <> valString) then begin if CurrObject.FNotesFontName <> valString then begin CurrObject.FNotesFontName := valString; CurrObject.ReCreateNotesGroup(True); end; end; // отображение печати черно-белая/цветная if F_MasterNewList.cbBlackPrint.Checked then valPrintType := pt_Black; if F_MasterNewList.cbColorPrint.Checked then valPrintType := pt_Color; // размер и стиль шрифта для Кросс АТС if CurrObject.FTrunkName = ctsnCrossATS then begin valInteger := StrToInt(F_MasterNewList.cbCrossATSFontSize.Text); valBool := F_MasterNewList.cbCrossATSFontBold.Checked; if (aCADParams.CADCrossATSFontSize <> valInteger) or (aCADParams.CADCrossATSFontBold <> valBool) or (aCADParams.CADPrintType <> valPrintType) then begin CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, CurrObject.ID); ChangeCrossATSInterf(GCadForm.FCADListID, CurrObject.ID, CadCrossObject); end; end; // размер шрифта для РШ if CurrObject.FTrunkName = ctsnDistributionCabinet then begin valInteger := StrToInt(F_MasterNewList.cbDistribCabFontSize.Text); valBool := F_MasterNewList.cbDistribCabFontBold.Checked; if (aCADParams.CADDistribCabFontSize <> valInteger) or (aCADParams.CADDistribCabFontBold <> valBool) or (aCADParams.CADPrintType <> valPrintType) then begin CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, CurrObject.ID); ChangeDistribCabInterf(GCadForm.FCADListID, CurrObject.ID, CadCrossObject); end; end; end; end; end; for i := 0 to LinesList.Count - 1 do begin CurrTrace := TOrthoLine(LinesList[i]); // Selected if not F_MasterNewList.cbApplyForSelectedOnly.Checked then isApply := True else begin if CurrTrace.Selected then isApply := True else isApply := False; end; // if isApply then begin valDouble := UOMToMetre(StrToFloat_My(F_MasterNewList.edLineTotal.Text)); if aCADParams.CADHeightLines <> valDouble then begin if not CurrTrace.FIsRaiseUpDown then if (CurrTrace.ActualZOrder[1] <> ALineHeight) or (CurrTrace.ActualZOrder[2] <> ALineHeight) then begin ApplyParamsForTraces(CurrTrace, ALineHeight, TracesList); CurrTrace.CalculLength := CurrTrace.LengthCalc; CurrTrace.LineLength := CurrTrace.CalculLength; CurrTrace.UpdateLengthTextBox(False, True); end; end; // подпись к трассе valBool := F_MasterNewList.cbShowLinesCaptions.Checked; if ((TCheckBoxState(F_MasterNewList.cbShowLinesCaptions.State) <> cbGrayed) and (aCADParams.CADShowLineObjectCaption <> valBool)) or (aCADParams.CADLinesCaptions <> ALineCaptionsShowType) then begin // вкинуть кол-во пар в OutTextCaptions[1] или убрать оттуда ReverseCaptionAfterTypeChange(CurrTrace, aCADParams.CADLinesCaptions, ALineCaptionsShowType); CurrTrace.UpdateLengthTextBox(True, True); end; {========================================================================} // выноска к трассе valBool := F_MasterNewList.cbShowLinesNotes.Checked; // WARNING !!! if ((TCheckBoxState(F_MasterNewList.cbShowLinesNotes.State) <> cbGrayed) and (aCADParams.CADShowLineObjectNote <> valBool)) or ((aCADParams.CADObjectNotes <> AConnNotesShowType) or (aCADParams.CADLinesNotes <> ALineNotesShowType)) then begin NotesList := GetObjectNotesWithParams(CurrTrace.ID); SetLineNotesInCAD(GCadForm.FCADListID, CurrTrace.ID, NotesList); if NotesList <> nil then FreeAndNil(NotesList); end; {========================================================================} if not CurrTrace.FIsRaiseUpDown then begin // цвет трассы valColor := F_MasterNewList.cbTraceColor.ColorValue; if aCADParams.CADTraceColor <> valColor then CurrTrace.FTraceColor := F_MasterNewList.cbTraceColor.ColorValue; // стиль трассы valInteger := F_MasterNewList.cbTraceStyle.ItemIndex; if ord(aCADParams.CADTraceStyle) <> valInteger then CurrTrace.FTraceStyle := TPenStyle(F_MasterNewList.cbTraceStyle.ItemIndex); // ширина трассы valInteger := StrToInt(F_MasterNewList.edTraceWidth.Text); if aCADParams.CADTraceWidth <> valInteger then CurrTrace.FTraceWidth := StrToInt(F_MasterNewList.edTraceWidth.Text); // шаг усл. обозначения valDouble := StrToFloat_My(F_MasterNewList.edBlockStep.Text); if aCADParams.CADBlockStep <> valDouble then begin if CurrTrace.BlockStep <> StrToFloat_My(F_MasterNewList.edBlockStep.Text) then begin CurrTrace.BlockStep := StrToFloat_My(F_MasterNewList.edBlockStep.Text); CurrTrace.ReCreateDrawFigureBlock; end; end; end; // цвет подписи к трассе valColor := F_MasterNewList.cbLinesCaptionsColor.ColorValue; if aCADParams.CADLinesCaptionsColor <> valColor then begin CurrTrace.FCaptionsFontColor := valColor; CurrTrace.ReCreateCaptionsGroup(True, True); end; // цвет выноски к трассе valColor := F_MasterNewList.cbLinesNotesColor.ColorValue; if aCADParams.CADLinesNotesColor <> valColor then begin CurrTrace.FNotesFontColor := valColor; CurrTrace.ReCreateNotesGroup(True); end; // размер шрифта подписи к трассе valInteger := StrToInt(F_MasterNewList.cbLinesCaptionsFontSize.Text); valBool := F_MasterNewList.cbLinesCaptionsFontBold.Checked; valString := F_MasterNewList.cbFontName.FontName; if (aCADParams.CADLinesCaptionsFontSize <> valInteger) or (aCADParams.CADLinesCaptionsFontBold <> valBool) then begin if (CurrTrace.FCaptionsFontSize <> valInteger) or (CurrTrace.FCaptionsFontBold <> valBool) then begin CurrTrace.FCaptionsFontSize := valInteger; CurrTrace.FCaptionsFontBold := valBool; CurrTrace.ReCreateCaptionsGroup(True, True); end; end else if (aCADParams.CADFontName <> valString) then begin if CurrTrace.FCaptionsFontName <> valString then begin CurrTrace.FCaptionsFontName := valString; CurrTrace.ReCreateCaptionsGroup(True, True); end; end; // размер шрифта выноски к трассе valInteger := StrToInt(F_MasterNewList.cbLinesNotesFontSize.Text); valString := F_MasterNewList.cbFontName.FontName; if (aCADParams.CADLinesNotesFontSize <> valInteger) then begin if CurrTrace.FNotesFontSize <> valInteger then begin CurrTrace.FNotesFontSize := valInteger; CurrTrace.ReCreateNotesGroup(True); end; end else if (aCADParams.CADFontName <> valString) then begin if CurrTrace.FNotesFontName <> valString then begin CurrTrace.FNotesFontName := valString; CurrTrace.ReCreateNotesGroup(True); end; end; end; end; {**************************************************************************} if TracesList <> nil then FreeAndNil(TracesList); if LinesList <> nil then FreeAndNil(LinesList); if ConnsList <> nil then FreeAndNil(ConnsList); // создание листа if F_MasterNewList.Tag = 0 then SaveMaskTemplatesFromForm(F_MasterNewList.F_ComponTypesMarkMask, GCadForm.FCADListID, itList, True, True) // редактирование листа else SaveMaskTemplatesFromForm(F_MasterNewList.F_ComponTypesMarkMask, GCadForm.FCADListID, itList, True, False); RefreshCAD(GCadForm.PCad); // SP !!! CheckDeleteAllRaises(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.ApplyParamsForAllSCSObject', E.Message); end; EndProgress; end; Procedure ApplyParamsForObjects(AObject: TConnectorObject; AHeight: Double); begin BaseBeginUpdate; try // нет с-п if GetRaiseConn(AObject) = nil then begin if AObject.JoinedConnectorsList.Count = 0 then begin AObject.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(AObject.ID, AHeight); end else CreateRaiseOnPointObject(AObject, AHeight); end // есть с-п else // сдвинуть на высоту begin // только подъем-спуск if AObject.JoinedConnectorsList.Count = 0 then begin AObject.ActualZOrder[1] := AHeight; SetConFigureCoordZInPM(AObject.ID, AHeight); end else ChangeRaiseOnPointObject(AObject, AHeight); end; except on E: Exception do addExceptionToLogEx('U_Common.ApplyParamsForObjects', E.Message); end; BaseEndUpdate; end; Procedure ApplyParamsForTraces(ATrace: TOrthoLine; AHeight: Double; ATracesList: TList); begin BaseBeginUpdate; try RaiseLineOnHeight(ATrace, AHeight, ATracesList); except on E: Exception do addExceptionToLogEx('U_Common.ApplyParamsForTraces', E.Message); end; BaseEndUpdate; end; Procedure ApplyCornerTypeForConnectors(aCornerType: TCornerType); var i: integer; FConnector: TConnectorObject; isApply: Boolean; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin FConnector := TConnectorObject(GCadForm.PCad.Figures[i]); // Selected if not F_MasterNewList.cbApplyForSelectedOnly.Checked then isApply := True else begin if FConnector.Selected then isApply := True else isApply := False; end; // if isApply then begin if CheckCornerTypeMaybeChanged(FConnector, aCornerType) then FConnector.FCornerType := aCornerType; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ApplyCornerTypeForConnectors', E.Message); end; end; Function CheckCornertypeMaybeChanged(aConnector: TConnectorObject; aCornerType: TCornerType): Boolean; var i, j: Integer; JoinedConn1: TConnectorObject; JoinedConn2: TConnectorObject; JoinedLine1: TOrthoLine; JoinedLine2: TOrthoLine; Angle: Double; begin Result := False; try // НЕТ if aCornerType = crn_None then begin { if aConnector.ConnectorType = ct_Clear then begin if (aConnector.JoinedOrtholinesList.Count = 0) and (aConnector.JoinedOrtholinesList.Count = 1) or (aConnector.JoinedOrtholinesList.Count = 3) then Result := True; end else begin if (aConnector.JoinedConnectorsList.Count = 0) or (aConnector.JoinedConnectorsList.Count = 1) or (aConnector.JoinedConnectorsList.Count = 3) then Result := True; end; } Result := True; end; // ВНЕШНИЙ или ВНУТРЕННИЙ if (aCornerType = crn_Out) or (aCornerType = crn_In) then begin if (aConnector.FConnRaiseType = crt_None) and (GetRaiseConn(aConnector) = nil) then begin if aConnector.ConnectorType = ct_Clear then begin if aConnector.JoinedOrtholinesList.Count = 2 then begin JoinedLine1 := TOrthoLine(aConnector.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(aConnector.JoinedOrtholinesList[1]); if not JoinedLine1.FIsRaiseUpDown and not JoinedLine2.FIsRaiseUpDown then begin Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector); if (Angle <> 0) and (Angle <> 180) and (Angle <> 360) then Result := True; end; end; end else begin if aConnector.JoinedConnectorsList.Count = 2 then begin JoinedConn1 := TConnectorObject(aConnector.JoinedConnectorsList[0]); JoinedConn2 := TConnectorObject(aConnector.JoinedConnectorsList[1]); if (JoinedConn1.JoinedOrtholinesList.Count = 1) and (JoinedConn2.JoinedOrtholinesList.Count = 1) then begin JoinedLine1 := TOrthoLine(JoinedConn1.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(JoinedConn2.JoinedOrtholinesList[0]); if not JoinedLine1.FIsRaiseUpDown and not JoinedLine2.FIsRaiseUpDown then begin Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector); if (Angle <> 0) and (Angle <> 180) and (Angle <> 360) then Result := True; end; end; end; end; end; end; // ПЛОСКИЙ if aCornerType = crn_Vertical then begin if (aConnector.FConnRaiseType <> crt_None) or (GetRaiseConn(aConnector) <> nil) then begin if aConnector.ConnectorType = ct_Clear then begin if aConnector.JoinedOrtholinesList.Count = 2 then begin JoinedLine1 := TOrthoLine(aConnector.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(aConnector.JoinedOrtholinesList[1]); if JoinedLine1.FIsRaiseUpDown or JoinedLine2.FIsRaiseUpDown then begin Result := True; end; end; end else begin if aConnector.JoinedConnectorsList.Count = 2 then begin JoinedConn1 := TConnectorObject(aConnector.JoinedConnectorsList[0]); JoinedConn2 := TConnectorObject(aConnector.JoinedConnectorsList[1]); if (JoinedConn1.JoinedOrtholinesList.Count = 1) and (JoinedConn2.JoinedOrtholinesList.Count = 1) then begin JoinedLine1 := TOrthoLine(JoinedConn1.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(JoinedConn2.JoinedOrtholinesList[0]); if JoinedLine1.FIsRaiseUpDown or JoinedLine2.FIsRaiseUpDown then begin Result := True; end; end; end; end; end; end; // АДАПТЕР if aCornerType = crn_Adapter then begin if (aConnector.FConnRaiseType = crt_None) and (GetRaiseConn(aConnector) = nil) then begin if aConnector.ConnectorType = ct_Clear then begin if aConnector.JoinedOrtholinesList.Count = 2 then begin JoinedLine1 := TOrthoLine(aConnector.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(aConnector.JoinedOrtholinesList[1]); if not JoinedLine1.FIsRaiseUpDown and not JoinedLine2.FIsRaiseUpDown then begin Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector); if Angle = 180 then Result := True; end; end; end else begin if aConnector.JoinedConnectorsList.Count = 2 then begin JoinedConn1 := TConnectorObject(aConnector.JoinedConnectorsList[0]); JoinedConn2 := TConnectorObject(aConnector.JoinedConnectorsList[1]); if (JoinedConn1.JoinedOrtholinesList.Count = 1) and (JoinedConn2.JoinedOrtholinesList.Count = 1) then begin JoinedLine1 := TOrthoLine(JoinedConn1.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(JoinedConn2.JoinedOrtholinesList[0]); if not JoinedLine1.FIsRaiseUpDown and not JoinedLine2.FIsRaiseUpDown then begin Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector); if Angle = 180 then Result := True; end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckCornertypeMaybeChanged', E.Message); end; end; function GetAngleBetweenLines(AListID, AIDLine1, AIDLine2, AIDConnector: Integer; aAngleType: TAngleType): Double; var vList: TF_CAD; vLine1, vLine2: TOrthoLine; vConn: TConnectorObject; begin Result := 0; try vList := GetListByID(AListID); if vList <> nil then begin vLine1 := TOrthoLine(GetFigureByID(vList, AIDLine1)); vLine2 := TOrthoLine(GetFigureByID(vList, AIDLine2)); vConn := TConnectorObject(GetFigureByID(vList, AIDConnector)); if (vLine1 <> nil) and (vLine2 <> nil) and (vConn <> nil) then Result := CalcAngleBetweenLines(vLine1, vLine2, vConn); end; except on E: Exception do AddExceptionToLogEx('U_Common.GetAngleBetweenLines', E.Message); end; end; Function CalcAngleBetweenLines(aLine1, aLine2: TOrthoLine; aConnector: TConnectorObject): Double; var i, j: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; Angle1, Angle2: Double; begin Result := 0; try Angle1 := 0; Angle2 := 0; if aConnector.ConnectorType = ct_Clear then begin if aLine1.JoinConnector1 = aConnector then Angle1 := GetLineAngle(aLine1.ActualPoints[1], aLine1.ActualPoints[2]); if aLine1.JoinConnector2 = aConnector then Angle1 := GetLineAngle(aLine1.ActualPoints[2], aLine1.ActualPoints[1]); if aLine2.JoinConnector1 = aConnector then Angle2 := GetLineAngle(aLine2.ActualPoints[1], aLine2.ActualPoints[2]); if aLine2.JoinConnector2 = aConnector then Angle2 := GetLineAngle(aLine2.ActualPoints[2], aLine2.ActualPoints[1]); end else begin for i := 0 to aConnector.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aConnector.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine = aLine1 then begin if aLine1.JoinConnector1 = JoinedConn then Angle1 := GetLineAngle(aLine1.ActualPoints[1], aLine1.ActualPoints[2]); if aLine1.JoinConnector2 = JoinedConn then Angle1 := GetLineAngle(aLine1.ActualPoints[2], aLine1.ActualPoints[1]); end; if JoinedLine = aLine2 then begin if aLine2.JoinConnector1 = JoinedConn then Angle2 := GetLineAngle(aLine2.ActualPoints[1], aLine2.ActualPoints[2]); if aLine2.JoinConnector2 = JoinedConn then Angle2 := GetLineAngle(aLine2.ActualPoints[2], aLine2.ActualPoints[1]); end; end; end; end; Result := abs(Angle1 - Angle2); if Result > 180 then Result := 360 - Result; except on E: Exception do addExceptionToLogEx('U.Common.CalcAngleBetweenLines', E.Message); end; end; Function GetCheckedCornerType(aConnector: TConnectorObject): TCornerType; var i, j: integer; Angle: Double; CornerType: TCornerType; JoinedConn1: TConnectorObject; JoinedConn2: TConnectorObject; JoinedLine1: TOrthoLine; JoinedLine2: TOrthoLine; begin Result := crn_None; //#From Oleg# //14.09.2010 try CornerType := aConnector.FCornerType; Result := CornerType; // CLEAR if aConnector.ConnectorType = ct_Clear then begin // crn_None if (aConnector.JoinedOrtholinesList.Count = 0) or (aConnector.JoinedOrtholinesList.Count = 1) or (aConnector.JoinedOrtholinesList.Count = 3) then CornerType := crn_None; if aConnector.JoinedOrtholinesList.Count = 2 then begin JoinedLine1 := TOrthoLine(aConnector.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(aConnector.JoinedOrtholinesList[1]); // crn_Vertical if JoinedLine1.FIsRaiseUpDown or JoinedLine2.FIsRaiseUpDown then begin CornerType := crn_Vertical; end else begin Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector); // crn_Adapter if Angle = 180 then begin CornerType := crn_Adapter; end else // crn_Out, crn_In if (Angle <> 0) and (Angle <> 180) and (Angle <> 360) then begin if (CornerType <> crn_Out) and (CornerType <> crn_In) then begin // if GCadForm.FDefaultCornerType <> crn_None then // CornerType := crn_Out; end; end; end; end; end else // RT begin // crn_None if (aConnector.JoinedConnectorsList.Count = 0) or (aConnector.JoinedConnectorsList.Count = 1) or (aConnector.JoinedConnectorsList.Count = 3) then CornerType := crn_None; if aConnector.JoinedConnectorsList.Count = 2 then begin JoinedConn1 := TConnectorObject(aConnector.JoinedConnectorsList[0]); JoinedConn2 := TConnectorObject(aConnector.JoinedConnectorsList[1]); if (JoinedConn1.JoinedOrtholinesList.Count = 1) and (JoinedConn2.JoinedConnectorsList.Count = 1) then begin JoinedLine1 := TOrthoLine(JoinedConn1.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(JoinedConn2.JoinedOrtholinesList[0]); // crn_Vertical if JoinedLine1.FIsRaiseUpDown or JoinedLine2.FIsRaiseUpDown then begin CornerType := crn_Vertical; end else begin Angle := CalcAngleBetweenLines(JoinedLine1, JoinedLine2, aConnector); // crn_Adapter if Angle = 180 then begin CornerType := crn_Adapter; end else // crn_Out, crn_In if (Angle <> 0) and (Angle <> 180) and (Angle <> 360) then begin if (CornerType <> crn_Out) and (CornerType <> crn_In) then begin if GCadForm.FDefaultCornerType <> crn_None then CornerType := crn_Out; end; end; end; end; end; end; if aConnector.FCornerType <> CornerType then begin aConnector.FCornerType := CornerType; Result := CornerType; end; except on E: Exception do addExceptionToLogEx('U_Common.GetCheckedCornerType', E.Message); end; end; Function GetCornerTypeByConnectorID(AID_List, AID_Object: Integer): TCornerType; var FList: TF_CAD; FFigure: TFigure; begin Result := crn_None; //#From Oleg# //14.09.2010 try Result := GCadForm.FDefaultCornerType; FList := GetListByID(AID_List); if FList <> nil then begin FFigure := GetFigureByID(FList, AID_Object); if FFigure <> nil then if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if TConnectorObject(FFigure).FCornerTypeChangedByUser then Result := TConnectorObject(FFigure).FCornerType else Result := GetCheckedCornerType(TConnectorObject(FFigure)); end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetCornerTypeByConnectorID', E.Message); end; end; Procedure SetCornerTypeByConnectorID(AID_List, AID_Object: Integer; ACornerType: TCornerType); var FList: TF_CAD; FFigure: TFigure; begin try FList := GetListByID(AID_List); if FList <> nil then begin FFigure := GetFigureByID(FList, AID_Object); if FFigure <> nil then if CheckFigureByClassName(FFigure, cTConnectorObject) then TConnectorObject(FFigure).FCornerType := ACornerType; end; except on E: Exception do addExceptionToLogEx('U_Common.SetCornerTypeByConnectorID', E.Message); end; end; Procedure GetSidesByConnectedFigures(AID_List1, AID_List2, AID_Figure1, AID_Figure2: Integer; var Side1: Integer; var Side2: Integer); var PointObject: TConnectorObject; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; i, j, k: integer; CurrList: TF_CAD; Obj1, Obj2: TFigure; List1, List2: TF_CAD; Floor1Conn1, Floor1Conn2, Floor2Conn1, Floor2Conn2: TConnectorObject; House: THouse; Approach: TConnectorObject; begin try Side1 := -1; Side2 := -1; List1 := GetListByID(AID_List1); List2 := GetListByID(AID_List2); if (List1 = nil) or (List2 = nil) then Exit; Obj1 := GetFigureByID(List1, AID_Figure1); Obj2 := GetFigureByID(List2, AID_Figure2); // если не найдено, то может это дом if Obj1 = nil then Obj1 := GetHouseByID(List1, AID_Figure1); if Obj2 = nil then Obj2 := GetHouseByID(List2, AID_Figure2); if (Obj1 = nil) or (Obj2 = nil) then Exit; // оба коннекторы if CheckFigureByClassName(Obj1, cTConnectorObject) and CheckFigureByClassName(Obj2, cTConnectorObject) then begin Side1 := 0; Side2 := 0; end // 1-ортолиния, 2-коннектор else if CheckFigureByClassName(Obj1, cTOrthoLine) and CheckFigureByClassName(Obj2, cTConnectorObject) then begin Side2 := 0; // Side = 1 if TConnectorObject(TOrthoLine(Obj1).JoinConnector1) = Obj2 then Side1 := 1; if TConnectorObject(TOrthoLine(Obj1).JoinConnector2) = Obj2 then Side1 := 2; begin if TConnectorObject(TOrthoLine(Obj1).JoinConnector1).JoinedConnectorsList.Count > 0 then if TConnectorObject(TOrthoLine(Obj1).JoinConnector1).JoinedConnectorsList[0] = Obj2 then Side1 := 1; if TConnectorObject(TOrthoLine(Obj1).JoinConnector2).JoinedConnectorsList.Count > 0 then if TConnectorObject(TOrthoLine(Obj1).JoinConnector2).JoinedConnectorsList[0] = Obj2 then Side1 := 2; end; end // 1-коннектор, 2-ортолиния else if CheckFigureByClassName(Obj1, cTConnectorObject) and CheckFigureByClassName(Obj2, cTOrthoLine) then begin Side1 := 0; if TConnectorObject(TOrthoLine(Obj2).JoinConnector1) = Obj1 then Side2 := 1; if TConnectorObject(TOrthoLine(Obj2).JoinConnector2) = Obj1 then Side2 := 2; begin if TConnectorObject(TOrthoLine(Obj2).JoinConnector1).JoinedConnectorsList.Count > 0 then if TConnectorObject(TOrthoLine(Obj2).JoinConnector1).JoinedConnectorsList[0] = Obj1 then Side2 := 1; if TConnectorObject(TOrthoLine(Obj2).JoinConnector2).JoinedConnectorsList.Count > 0 then if TConnectorObject(TOrthoLine(Obj2).JoinConnector2).JoinedConnectorsList[0] = Obj1 then Side2 := 2; end; end // 1-ортолиния, 2-ортолиния else if CheckFigureByClassName(Obj1, cTOrthoLine) and CheckFigureByClassName(Obj2, cTOrthoLine) then begin // на одном КАДе if TOrthoLine(Obj1).JoinConnector1 = TOrthoLine(Obj2).JoinConnector1 then begin Side1 := 1; Side2 := 1; end; if TOrthoLine(Obj1).JoinConnector1 = TOrthoLine(Obj2).JoinConnector2 then begin Side1 := 1; Side2 := 2; end; if TOrthoLine(Obj1).JoinConnector2 = TOrthoLine(Obj2).JoinConnector1 then begin Side1 := 2; Side2 := 1; end; if TOrthoLine(Obj1).JoinConnector2 = TOrthoLine(Obj2).JoinConnector2 then begin Side1 := 2; Side2 := 2; end; if (Side1 = -1) or (Side2 = -1) then begin if TConnectorObject(TOrthoLine(Obj1).JoinConnector1).JoinedConnectorsList.count > 0 then begin PointObject := TConnectorObject(TConnectorObject(TOrthoLine(Obj1).JoinConnector1).JoinedConnectorsList[0]); for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = TOrthoLine(Obj2) then begin Side1 := 1; if TOrthoLine(Obj2).JoinConnector1 = JoinedConn then Side2 := 1; if TOrthoLine(Obj2).JoinConnector2 = JoinedConn then Side2 := 2; end; end; end; end; if TConnectorObject(TOrthoLine(Obj1).JoinConnector2).JoinedConnectorsList.count > 0 then begin PointObject := TConnectorObject(TConnectorObject(TOrthoLine(Obj1).JoinConnector2).JoinedConnectorsList[0]); for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = TOrthoLine(Obj2) then begin Side1 := 2; if TOrthoLine(Obj2).JoinConnector1 = JoinedConn then Side2 := 1; if TOrthoLine(Obj2).JoinConnector2 = JoinedConn then Side2 := 2; end; end; end; end; end; // с учетом межэтажных переходов Floor1Conn1 := TConnectorObject(TOrthoLine(Obj1).JoinConnector1); Floor1Conn2 := TConnectorObject(TOrthoLine(Obj1).JoinConnector2); Floor2Conn1 := TConnectorObject(TOrthoLine(Obj2).JoinConnector1); Floor2Conn2 := TConnectorObject(TOrthoLine(Obj2).JoinConnector2); if (Floor1Conn1.FID_ConnToPassage = Floor2Conn1.ID) and (Floor1Conn1.ID = Floor2Conn1.FID_ConnToPassage) then begin Side1 := 1; Side2 := 1; end; if (Floor1Conn1.FID_ConnToPassage = Floor2Conn2.ID) and (Floor1Conn1.ID = Floor2Conn2.FID_ConnToPassage) then begin Side1 := 1; Side2 := 2; end; if (Floor1Conn2.FID_ConnToPassage = Floor2Conn1.ID) and (Floor1Conn2.ID = Floor2Conn1.FID_ConnToPassage) then begin Side1 := 2; Side2 := 1; end; if (Floor1Conn2.FID_ConnToPassage = Floor2Conn2.ID) and (Floor1Conn2.ID = Floor2Conn2.FID_ConnToPassage) then begin Side1 := 2; Side2 := 2; end; end; // 1-ортолиния, 2-дом if CheckFigureByClassName(Obj1, cTOrthoLine) and CheckFigureByClassName(Obj2, cTHouse) then begin Side2 := 0; JoinedConn := TConnectorObject(TOrthoLine(Obj1).JoinConnector1); if JoinedConn.FIsHouseJoined then if JoinedConn.FHouse = Obj2 then Side1 := 1; JoinedConn := TConnectorObject(TOrthoLine(Obj1).JoinConnector2); if JoinedConn.FIsHouseJoined then if JoinedConn.FHouse = Obj2 then Side1 := 2; if Side1 = -1 then begin House := Thouse(Obj2); for i := 0 to House.fApproaches.Count - 1 do begin Approach := TConnectorObject(House.fApproaches[i]); if Approach.JoinedConnectorsList.Count > 0 then begin //if Approach.JoinedConnectorsList[0] = TOrthoLine(Obj1).JoinConnector1 then // Side1 := 1; //if Approach.JoinedConnectorsList[0] = TOrthoLine(Obj1).JoinConnector2 then // Side1 := 2; //03.12.2010 for j := 0 to Approach.JoinedConnectorsList.Count - 1 do begin if Approach.JoinedConnectorsList[j] = TOrthoLine(Obj1).JoinConnector1 then Side1 := 1; if Approach.JoinedConnectorsList[j] = TOrthoLine(Obj1).JoinConnector2 then Side1 := 2; end; end; end; end; end // 1-дом, 2-ортолиния else if CheckFigureByClassName(Obj1, cTHouse) and CheckFigureByClassName(Obj2, cTOrthoLine) then begin Side1 := 0; JoinedConn := TConnectorObject(TOrthoLine(Obj2).JoinConnector1); if JoinedConn.FIsHouseJoined then if JoinedConn.FHouse = Obj1 then Side2 := 1; JoinedConn := TConnectorObject(TOrthoLine(Obj2).JoinConnector2); if JoinedConn.FIsHouseJoined then if JoinedConn.FHouse = Obj1 then Side2 := 2; if Side2 = -1 then begin House := Thouse(Obj1); for i := 0 to House.fApproaches.Count - 1 do begin Approach := TConnectorObject(House.fApproaches[i]); if Approach.JoinedConnectorsList.Count > 0 then begin //if Approach.JoinedConnectorsList[0] = TOrthoLine(Obj2).JoinConnector1 then // Side2 := 1; //if Approach.JoinedConnectorsList[0] = TOrthoLine(Obj2).JoinConnector2 then // Side2 := 2; //03.12.2010 for j := 0 to Approach.JoinedConnectorsList.Count - 1 do begin if Approach.JoinedConnectorsList[j] = TOrthoLine(Obj2).JoinConnector1 then Side2 := 1; if Approach.JoinedConnectorsList[j] = TOrthoLine(Obj2).JoinConnector2 then Side2 := 2; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetSidesByConnectedFigures', E.Message); end; end; Procedure GetLineFigureHeghts(AID_List, AID_Line: Integer; var AHeight1: Double; var AHeight2: Double); var CurLine: TOrthoLine; vList: TF_CAD; begin try AHeight1 := -1; AHeight2 := -1; vList := GetListByID(AID_List); if vList <> nil then begin CurLine := TOrthoLine(GetFigureByID(vList, AID_Line)); if CurLine <> nil then begin AHeight1 := CurLine.ActualZOrder[1]; AHeight2 := CurLine.ActualZOrder[2]; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetLineFigureHeghts', E.Message); end; end; procedure UpdateForLayers; var i: integer; ShowLayer: TLayer; CurrentFigure: TFigure; begin try // отображение подписей к ортолиниям по умолчанию if GCadForm.FShowLinesCaptions = True then begin ShowLayer := GCadForm.Pcad.Layers.Items[3]; ShowLayer.visible := seen; end else begin ShowLayer := GCadForm.Pcad.Layers.Items[3]; ShowLayer.visible := lost; end; // отображение подписей к коннекторам по умолчанию if GCadForm.FShowConnectorsCaptions = True then begin ShowLayer := GCadForm.Pcad.Layers.Items[4]; ShowLayer.visible := seen; end else begin ShowLayer := GCadForm.Pcad.Layers.Items[4]; ShowLayer.visible := lost; end; // отображение выносок к ортолиниям по умолчанию if GCadForm.FShowLinesNotes = True then begin ShowLayer := GCadForm.Pcad.Layers.Items[5]; ShowLayer.visible := seen; end else begin ShowLayer := GCadForm.Pcad.Layers.Items[5]; ShowLayer.visible := lost; end; // отображение выносок к коннекторам по умолчанию if GCadForm.FShowConnectorsNotes = True then begin ShowLayer := GCadForm.Pcad.Layers.Items[6]; ShowLayer.visible := seen; end else begin ShowLayer := GCadForm.Pcad.Layers.Items[6]; ShowLayer.visible := lost; end; // Обновить !!! if F_LayersDialog.Showing then F_LayersDialog.UpdateLayersList; // отображать длины ортолиний по умолчанию if GCadForm.FShowLinesLength = True then begin for i := 0 to GCadForm.PCad.Figures.Count - 1 do begin CurrentFigure := TFigure(GCadForm.PCad.Figures[i]); end; end; if GCadForm.FShowLinesLength = False then begin for i := 0 to GCadForm.PCad.Figures.Count - 1 do begin CurrentFigure := TFigure(GCadForm.PCad.Figures[i]); end; end; if GCadForm.FAutoSelectTrace = True then FSCS_Main.aAutoSelectTrace.Checked := True; if GCadForm.FAutoSelectTrace = False then FSCS_Main.aAutoSelectTrace.Checked := False; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.UpdateForLayers', E.Message); end; end; Procedure RefreshAllLists; var i: integer; CurCAD: TF_CAD; begin try for i := 0 to FSCS_Main.MDIChildCount - 1 do begin CurCAD := TF_CAD(FSCS_Main.MDIChildren[i]); RefreshCAD(CurCAD.PCad); end; except on E: Exception do addExceptionToLogEx('U_Common.RefreshAllLists', E.Message); end; end; Procedure SetNetworkTypesForObject(AID_List, AID_Object: Integer; ANetworkTypes: TObjectNetworkTypes); var CurObject: TFigure; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin CurObject := GetFigureByID(vList, AID_Object); if CheckFigureByClassName(CurObject, cTConnectorObject) then begin TConnectorObject(CurObject).FNetworkTypes := ANetworkTypes; TConnectorObject(CurObject).DrawFigure.FNetworkTypes := ANetworkTypes; end else if CheckFigureByClassName(CurObject, cTOrthoLine) then begin TOrthoLine(CurObject).FNetworkTypes := ANetworkTypes; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetNetworkTypesForObject', E.Message); end; end; Function IsViewObjectInCurrentNetwork(AObject: TFigure): Boolean; var i: integer; JoinedLine: TOrthoLine; NetTypes: TObjectNetworkTypes; begin Result := False; try if (nt_All in GCadForm.FShowNetworkTypes) then Result := True else begin NetTypes := []; if CheckFigureByClassName(AObject, cTConnectorObject) then NetTypes := TConnectorObject(AObject).FNetworkTypes else if CheckFigureByClassName(AObject, cTOrthoLine) then NetTypes := TOrthoLine(AObject).FNetworkTypes else if CheckFigureByClassName(AObject, cTFigureGrpMod) then NetTypes := TFigureGrpMod(AObject).FNetworkTypes; if (nt_Computer in GCadForm.FShowNetworkTypes) and (nt_Computer in NetTypes) then result := True; if (nt_Telephon in GCadForm.FShowNetworkTypes) and (nt_Telephon in NetTypes) then result := True; if (nt_Electric in GCadForm.FShowNetworkTypes) and (nt_Electric in NetTypes) then result := True; if (nt_Television in GCadForm.FShowNetworkTypes) and (nt_Television in NetTypes) then result := True; if (nt_Gas in GCadForm.FShowNetworkTypes) and (nt_Gas in NetTypes) then result := True; end; {//01.11.2011 if CheckFigureByClassName(AObject, cTConnectorObject) then begin NetTypes := TConnectorObject(AObject).FNetworkTypes; end; if CheckFigureByClassName(AObject, cTOrthoLine) then NetTypes := TOrthoLine(AObject).FNetworkTypes; if CheckFigureByClassName(AObject, cTFigureGrpMod) then NetTypes := TFigureGrpMod(AObject).FNetworkTypes; if (nt_All in GCadForm.FShowNetworkTypes) then Result := True else begin if (nt_Computer in GCadForm.FShowNetworkTypes) and (nt_Computer in NetTypes) then result := True; if (nt_Telephon in GCadForm.FShowNetworkTypes) and (nt_Telephon in NetTypes) then result := True; if (nt_Electric in GCadForm.FShowNetworkTypes) and (nt_Electric in NetTypes) then result := True; if (nt_Television in GCadForm.FShowNetworkTypes) and (nt_Television in NetTypes) then result := True; if (nt_Gas in GCadForm.FShowNetworkTypes) and (nt_Gas in NetTypes) then result := True; end;} except on E: Exception do addExceptionToLogEx('U_Common.IsViewObjectInCurrentNetwork', E.Message); end; end; procedure SetBlockParamsForObject(AID_List, AID_Object: Integer; ABlockGUID: string; AObjectType: Integer; ABlockStreams, ABlockStreamsOtherType: TObjectList; aSysName: string = ''); var FFigure: TFigure; SavedCadForm: TF_CAD; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; FFigure := GetFigureByID(GCadForm, AID_Object); if FFigure = nil then FFigure := GetFigureByIDInSCSFigureGroups(GCadForm, AID_Object); if CheckNoFigureinList(FFigure, GCadForm.FRemFigures) then begin if FFigure <> nil then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if not TConnectorObject(FFigure).FIsBlockChanged then begin TConnectorObject(FFigure).FBlockGUID := ABlockGUID; TConnectorObject(FFigure).FObjectType := AObjectType; SetBlockForConnObject(TConnectorObject(FFigure), ABlockStreams, aSysName); end; end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if not TOrthoLine(FFigure).FIsBlockChanged then begin TOrthoLine(FFigure).FBlockGUID := ABlockGUID; TOrthoLine(FFigure).FObjectType := AObjectType; SetBlockForLineObject(TOrthoLine(FFigure), ABlockStreams, ABlockStreamsOtherType); end; end; end; end; GCadForm := SavedCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.SetBlockParamsForObject', E.Message); end; end; procedure SetLayerHandleForFigureGrp(BlockFig: TFigureGrp; LayHandle: integer); var i: integer; begin for i := 0 to BlockFig.InFigures.Count - 1 do begin TFigure(BlockFig.InFigures[i]).LayerHandle := LayHandle; if (TFigure(BlockFig.InFigures[i]) is TBlock) or (TFigure(BlockFig.InFigures[i]) is TFigureGrp) or (TFigure(BlockFig.InFigures[i]) is TFigureGrpMod) or (TFigure(BlockFig.InFigures[i]) is TFigureGrpNotMod) then SetLayerHandleForFigureGrp(TFigureGrp(BlockFig.InFigures[i]), LayHandle); end; end; // установить новое усл.обозначение для коннектора Procedure SetBlockForConnObject(AConnector: TConnectorObject; ABlockStreams: TObjectList; aSysName: string = ''); var BlockFig: TBlock; FileName: string; i, j: integer; LayHandle: integer; deltax, deltay: Double; Bnd: TDoubleRect; FigGroup: TFigureGrpMod; AngleRad: Double; AngleDeg: Double; ABlockStream: TMemoryStream; alldelta: double; curdelta: double; CadCrossObject: TCadCrossObject; tmpAngle: Double; begin try if ABlockStreams <> nil then AConnector.FBlockCount := ABlockStreams.Count else AConnector.FBlockCount := 0; // если это кросс АТС или РШ то прорисовать его if aSysName = ctsnCrossATS then begin if (AConnector.FTrunkName <> ctsnCrossATS) then begin RemoveInFigureGrp(AConnector.DrawFigure); DeleteConnectingTraces(AConnector); AConnector.FTrunkName := ctsnCrossATS; CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, AConnector.ID); CreateCadCrossATS(aConnector, CadCrossObject); // повернуть DrawFigure на нужный угол AngleRad := AConnector.FDrawFigureAngle; AngleDeg := AngleRad * 180 / pi; RotateTrunkObject(AConnector, AngleDeg); end; Exit; end else if aSysName = ctsnDistributionCabinet then begin if (AConnector.FTrunkName <> ctsnDistributionCabinet) then begin RemoveInFigureGrp(AConnector.DrawFigure); DeleteConnectingTraces(AConnector); AConnector.FTrunkName := ctsnDistributionCabinet; CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, AConnector.ID); CreateCadDistribCab(aConnector, CadCrossObject); // повернуть DrawFigure на нужный угол AngleRad := AConnector.FDrawFigureAngle; AngleDeg := AngleRad * 180 / pi; RotateTrunkObject(AConnector, AngleDeg); end; Exit; end; //RefreshCAD(GCadForm.PCad); // преобразовать в Блок {$if Defined(ES_GRAPH_SC)} FileName := ExeDir + '\.blk\TempStream.blk'; {$else} FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.blk'; {$ifend} if (ABlockStreams <> nil) and (ABlockStreams.Count > 0) then begin LayHandle := GCadForm.PCad.GetLayerHandle(2); FigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad); alldelta := 0; curdelta := 0; for i := 0 to ABlockStreams.Count - 1 do begin ABlockStream := TMemoryStream(ABlockStreams[i]); if ABlockStream <> nil then begin // ABlockStream.SaveToFile(FileName); // BlockFig := TBlock(GCadForm.PCad.InsertBlockwithFileName(2, FileName, -100, -100)); ABlockStream.Position := 0; BlockFig := TBlock(GCadForm.PCad.InsertBlockFromStream(2, ABlockStream, -100, -100)); if BlockFig <> nil then begin try SetLayerHandleForFigureGrp(TFigureGrp(BlockFig), LayHandle); except end; if i > 0 then begin Bnd := BlockFig.GetBoundRect; curdelta := abs(Bnd.Top - Bnd.Bottom) / 2; end; // установить DrawFigure for j := 0 to BlockFig.InFigures.Count - 1 do begin FigGroup.AddFigure(TFigure(BlockFig.InFigures[j])); TFigure(BlockFig.InFigures[j]).Move(0, alldelta + curdelta); end; Bnd := FigGroup.GetBoundRect; alldelta := alldelta + abs(Bnd.Top - Bnd.Bottom) / 2; GCadForm.PCad.Figures.Remove(BlockFig); end; end; end; //RefreshCAD(GCadForm.PCad); tmpAngle := AConnector.FDrawFigureAngle; AConnector.FDrawFigureAngle := 0; AConnector.DrawFigure := FigGroup; AConnector.FDrawFigureAngle := tmpAngle; // преобразовать масштаб УГО AConnector.SetDrawFigurePercent(AConnector.FDrawFigurePercent); //RefreshCAD(GCadForm.PCad); // повернуть DrawFigure на нужный угол AngleRad := AConnector.FDrawFigureAngle; AngleDeg := AngleRad * 180 / pi; AConnector.DrawFigure.Rotate(AngleRad, AConnector.ActualPoints[1]); Bnd := AConnector.DrawFigure.GetBoundRect; //RefreshCAD(GCadForm.PCad); AConnector.GrpSizeX := Bnd.Right - Bnd.Left; AConnector.GrpSizeY := Bnd.Bottom - Bnd.Top; //RefreshCAD(GCadForm.PCad); AConnector.ReCreateCaptionsGroup(True, false); AConnector.ReCreateNotesGroup(True); AConnector.DefRaizeDrawFigurePos; //29.05.2013 end else begin LayHandle := GCadForm.PCad.GetLayerHandle(2); FigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad); AConnector.DrawFigure := FigGroup; Bnd := AConnector.DrawFigure.GetBoundRect; AConnector.GrpSizeX := Bnd.Right - Bnd.Left; AConnector.GrpSizeY := Bnd.Bottom - Bnd.Top; AConnector.ReCreateCaptionsGroup(false, false); AConnector.DefRaizeDrawFigurePos; //29.05.2013 end; // RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.SetBlockForConnObject', E.Message); end; end; // установить новое усл.обозначение для линии Procedure SetBlockForLineObject(ALine: TOrthoLine; ABlockStreams, ABlockStreamsOtherType: TObjectList); var BlockFig: TBlock; FileName: string; i, j, k: integer; LayHandle: integer; deltax, deltay: Double; Bnd: TDoubleRect; InFigGroup: TFigureGrpMod; FigGroup: TFigureGrpMod; ABlockStream: TMemoryStream; // delta, alldelta, curdelta: double; begin try ALine.FSingleBlockDelta := 0; LayHandle := GCadForm.PCad.GetLayerHandle(2); //18.04.2013 if not ALine.FIsRaiseUpDown then begin FigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad); // преобразовать в Блок {$if Defined(ES_GRAPH_SC)} FileName := ExeDir + '\.blk\TempStream.blk'; {$else} FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.blk'; {$ifend} if (ABlockStreams <> nil) and (ABlockStreams.Count > 0) then begin alldelta := 0; curdelta := 0; InFigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad); for i := 0 to ABlockStreams.Count - 1 do begin ABlockStream := TMemoryStream(ABlockStreams[i]); if ABlockStream <> nil then begin ABlockStream.Position := 0; BlockFig := TBlock(GCadForm.PCad.InsertBlockFromStream(2, ABlockStream, -100, -100)); if BlockFig <> nil then begin try SetLayerHandleForFigureGrp(TFigureGrp(BlockFig), LayHandle); except end; if i > 0 then begin Bnd := BlockFig.GetBoundRect; end; // установить DrawFigure for j := 0 to BlockFig.InFigures.Count - 1 do begin InFigGroup.AddFigure(TFigure(BlockFig.InFigures[j])); end; Bnd := InFigGroup.GetBoundRect; GCadForm.PCad.Figures.Remove(BlockFig); end; end; end; FigGroup.AddFigure(InFigGroup); end else begin InFigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad); FigGroup.AddFigure(InFigGroup); end; if (ABlockStreamsOtherType <> nil) and (ABlockStreamsOtherType.Count > 0) and (GCadForm.FShowLineCaptionsType = skExternalSCS) then begin alldelta := 0; curdelta := 0; Bnd := InFigGroup.GetBoundRect; delta := abs(Bnd.Bottom - Bnd.Top); delta := delta / 2; InFigGroup := TFigureGrpMod.create(LayHandle, GCadForm.PCad); for i := 0 to ABlockStreamsOtherType.Count - 1 do begin ABlockStream := TMemoryStream(ABlockStreamsOtherType[i]); if ABlockStream <> nil then begin ABlockStream.Position := 0; BlockFig := TBlock(GCadForm.PCad.InsertBlockFromStream(2, ABlockStream, -100, -100)); if BlockFig <> nil then begin try SetLayerHandleForFigureGrp(TFigureGrp(BlockFig), LayHandle); except end; if i > 0 then begin Bnd := BlockFig.GetBoundRect; end; // установить DrawFigure for j := 0 to BlockFig.InFigures.Count - 1 do begin InFigGroup.AddFigure(TFigure(BlockFig.InFigures[j])); TFigure(BlockFig.InFigures[j]).Move(0, delta); end; Bnd := InFigGroup.GetBoundRect; GCadForm.PCad.Figures.Remove(BlockFig); end; end; end; FigGroup.AddFigure(InFigGroup); end; ALine.DrawFigure := FigGroup; //if ALine.FIsRaiseUpDown then // ALine.FDrawFigurePercent := 50; if ALine.FDrawFigurePercent <> 100 then if Not ALine.FIsRaiseUpDown then //27.04.2013 ChangeDrawFigurePercentForLine(ALine, ALine.FDrawFigurePercent); // RefreshCAD(GCadForm.PCad); end; except on E: Exception do addExceptionToLogEx('U_Common.SetBlockForLineObject', E.Message); end; end; Function CheckCanConnectInCAD(AID_List1, AID_List2, AID_Object1, AID_Object2: Integer): Boolean; var i, j: integer; FList1, FList2: TF_CAD; FFigure1, FFigure2: TFigure; JoinedConn: TConnectorObject; JoinedFromList: TConnectorObject; Floor1Conn1, Floor1Conn2, Floor2Conn1, Floor2Conn2: TConnectorObject; PointObject: TConnectorObject; House: THouse; Approach: TConnectorObject; begin Result := False; try FList1 := GetListByID(AID_List1); FList2 := GetListByID(AID_List2); if (FList1 = nil) or (FList2 = nil) then Exit; FFigure1 := GetFigureByID(FList1, AID_Object1); FFigure2 := GetFigureByID(FList2, AID_Object2); // если не найдено, то может это дом if FFigure1 = nil then FFigure1 := GetHouseByID(FList1, AID_Object1); if FFigure2 = nil then FFigure2 := GetHouseByID(FList2, AID_Object2); if (FFigure1 = nil) or (FFigure2 = nil) then Exit; // 1 - ортолиния, 2 - ортолиния if CheckFigureByClassName(FFigure1, cTOrthoLine) and CheckFigureByClassName(FFigure2, cTOrthoLine) then begin // на одном КАДе if (TOrthoLine(FFigure1).JoinConnector1 = TOrthoLine(FFigure2).JoinConnector1) or (TOrthoLine(FFigure1).JoinConnector1 = TOrthoLine(FFigure2).JoinConnector2) or (TOrthoLine(FFigure1).JoinConnector2 = TOrthoLine(FFigure2).JoinConnector1) or (TOrthoLine(FFigure1).JoinConnector2 = TOrthoLine(FFigure2).JoinConnector2) then Result := True; if TConnectorObject(TOrthoLine(FFigure1).JoinConnector1).JoinedConnectorsList.count > 0 then begin PointObject := TConnectorObject(TConnectorObject(TOrthoLine(FFigure1).JoinConnector1).JoinedConnectorsList[0]); for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = TOrthoLine(FFigure2) then Result := True; end; end; if TConnectorObject(TOrthoLine(FFigure1).JoinConnector2).JoinedConnectorsList.count > 0 then begin PointObject := TConnectorObject(TConnectorObject(TOrthoLine(FFigure1).JoinConnector2).JoinedConnectorsList[0]); for i := 0 to PointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(PointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]) = TOrthoLine(FFigure2) then Result := True; end; end; // с учетом межэтажных переходов Floor1Conn1 := TConnectorObject(TOrthoLine(FFigure1).JoinConnector1); Floor1Conn2 := TConnectorObject(TOrthoLine(FFigure1).JoinConnector2); Floor2Conn1 := TConnectorObject(TOrthoLine(FFigure2).JoinConnector1); Floor2Conn2 := TConnectorObject(TOrthoLine(FFigure2).JoinConnector2); if (Floor1Conn1.FID_ConnToPassage = Floor2Conn1.ID) and (Floor1Conn1.ID = Floor2Conn1.FID_ConnToPassage) then Result := True; if (Floor1Conn1.FID_ConnToPassage = Floor2Conn2.ID) and (Floor1Conn1.ID = Floor2Conn2.FID_ConnToPassage) then Result := True; if (Floor1Conn2.FID_ConnToPassage = Floor2Conn1.ID) and (Floor1Conn2.ID = Floor2Conn1.FID_ConnToPassage) then Result := True; if (Floor1Conn2.FID_ConnToPassage = Floor2Conn2.ID) and (Floor1Conn2.ID = Floor2Conn2.FID_ConnToPassage) then Result := True; end; // 1 - ортолиния, 2 - коннектор if CheckFigureByClassName(FFigure1, cTOrthoLine) and CheckFigureByClassName(FFigure2, cTConnectorObject) then begin JoinedConn := TConnectorObject(TOrthoLine(FFigure1).JoinConnector1); for i := 0 to TConnectorObject(FFigure2).JoinedConnectorsList.Count - 1 do begin JoinedFromList := TConnectorObject(FFigure2).JoinedConnectorsList[i]; if JoinedConn = JoinedFromList then Result := True; end; JoinedConn := TConnectorObject(TOrthoLine(FFigure1).JoinConnector2); for i := 0 to TConnectorObject(FFigure2).JoinedConnectorsList.Count - 1 do begin JoinedFromList := TConnectorObject(FFigure2).JoinedConnectorsList[i]; if JoinedConn = JoinedFromList then Result := True; end; end; // 1 - коннектор, 2 - ортолиния if CheckFigureByClassName(FFigure1, cTConnectorObject) and CheckFigureByClassName(FFigure2, cTOrthoLine) then begin JoinedConn := TConnectorObject(TOrthoLine(FFigure2).JoinConnector1); for i := 0 to TConnectorObject(FFigure1).JoinedConnectorsList.Count - 1 do begin JoinedFromList := TConnectorObject(FFigure1).JoinedConnectorsList[i]; if JoinedConn = JoinedFromList then Result := True; end; JoinedConn := TConnectorObject(TOrthoLine(FFigure2).JoinConnector2); for i := 0 to TConnectorObject(FFigure1).JoinedConnectorsList.Count - 1 do begin JoinedFromList := TConnectorObject(FFigure1).JoinedConnectorsList[i]; if JoinedConn = JoinedFromList then Result := True; end; end; // 1 - Дом, 2 - ортолиния if CheckFigureByClassName(FFigure1, cTHouse) and CheckFigureByClassName(FFigure2, cTOrthoLine) then begin JoinedConn := TConnectorObject(TOrthoLine(FFigure2).JoinConnector1); if JoinedConn.FIsHouseJoined then if JoinedConn.FHouse = THouse(FFigure1) then Result := True; if JoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FIsApproach then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FHouse = THouse(FFigure1) then Result := True; JoinedConn := TConnectorObject(TOrthoLine(FFigure2).JoinConnector2); if JoinedConn.FIsHouseJoined then if JoinedConn.FHouse = THouse(FFigure1) then Result := True; if JoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FIsApproach then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FHouse = THouse(FFigure1) then Result := True; end; // 1 - ортолиния, 2 - дом if CheckFigureByClassName(FFigure1, cTOrthoLine) and CheckFigureByClassName(FFigure2, cTHouse) then begin JoinedConn := TConnectorObject(TOrthoLine(FFigure1).JoinConnector1); if JoinedConn.FIsHouseJoined then if JoinedConn.FHouse = THouse(FFigure2) then Result := True; if JoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FIsApproach then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FHouse = THouse(FFigure2) then Result := True; JoinedConn := TConnectorObject(TOrthoLine(FFigure1).JoinConnector2); if JoinedConn.FIsHouseJoined then if JoinedConn.FHouse = THouse(FFigure2) then Result := True; if JoinedConn.JoinedConnectorsList.Count > 0 then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FIsApproach then if TConnectorObject(JoinedConn.JoinedConnectorsList[0]).FHouse = THouse(FFigure2) then Result := True; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckCanConnectInCAD', E.Message); end; end; Function BriefFormat(ADbl: Double): Double; var Str: string; begin Result := 0; try Str := FormatFloat('0.00', ADbl); Result := StrToFloat_My(Str); except on E: Exception do addExceptionToLogEx('U_Common.BriefFormat', E.Message); end; end; function CheckIsNameChanged(AID_List, AID_Figure: Integer): Boolean; var i: integer; FFigure: TFigure; vList: TF_CAD; begin Result := True; try vList := GetListByID(AID_List); if vList <> nil then begin FFigure := GetFigureByID(vList, AID_Figure); if FFigure <> nil then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then Result := TConnectorObject(FFigure).FIsNameChanged; if CheckFigureByClassName(FFigure, cTOrthoLine) then Result := TOrthoLine(FFigure).FIsNameChanged; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckIsNameChanged', E.Message); end; end; function CheckIsCaptionsChanged(AID_List, AID_Figure: Integer): Boolean; var i: integer; FFigure: TFigure; vList: TF_CAD; begin Result := True; try vList := GetListByID(AID_List); if vList <> nil then begin FFigure := GetFigureByID(vList, AID_Figure); if FFigure <> nil then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then Result := TConnectorObject(FFigure).FIsCaptionsChanged; if CheckFigureByClassName(FFigure, cTOrthoLine) then Result := TOrthoLine(FFigure).FIsCaptionsChanged; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckIsCaptionsChanged', E.Message); end; end; function CheckIsNotesChanged(AID_List, AID_Figure: Integer): Boolean; var i: integer; FFigure: TFigure; vList: TF_CAD; begin Result := True; try vList := GetListByID(AID_List); if vList <> nil then begin FFigure := GetFigureByID(vList, AID_Figure); if FFigure <> nil then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then Result := TConnectorObject(FFigure).FIsNotesChanged; if CheckFigureByClassName(FFigure, cTOrthoLine) then Result := TOrthoLine(FFigure).FIsNotesChanged; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckIsNotesChanged', E.Message); end; end; function CheckIsBlockChanged(AID_List, AID_Figure: Integer): Boolean; var i: integer; FFigure: TFigure; vList: TF_CAD; begin Result := True; try vList := GetListByID(AID_List); if vList <> nil then begin FFigure := GetFigureByID(vList, AID_Figure); if FFigure <> nil then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then Result := TConnectorObject(FFigure).FIsBlockChanged; if CheckFigureByClassName(FFigure, cTOrthoLine) then Result := TOrthoLine(FFigure).FIsBlockChanged; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckIsBlockChanged', E.Message); end; end; Function GetAllConnectedTracesID(AID_List, AID_Object: Integer): TIntList; var i, j: integer; CurrObject: TConnectorObject; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; vList: TF_CAD; begin Result := TIntList.Create; try vList := GetListByID(AID_List); if vList <> nil then begin CurrObject := TConnectorObject(GetFigureByID(vList, AID_Object)); if CurrObject <> nil then begin if CurrObject.ConnectorType = ct_Clear then begin for i := 0 to CurrObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(CurrObject.JoinedOrtholinesList[i]); Result.Add(JoinedLine.ID); end; end else begin for i := 0 to CurrObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(CurrObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); Result.Add(JoinedLine.ID); end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetAllConnectedTracesID', E.Message); end; end; Function GetAllConnectedTraces(AObject: TConnectorObject): TList; var i, j: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; begin Result := TList.Create; try if AObject <> nil then begin if AObject.ConnectorType = ct_Clear then begin for i := 0 to AObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AObject.JoinedOrtholinesList[i]); Result.Add(JoinedLine); end; end else begin for i := 0 to AObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(AObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); Result.Add(JoinedLine); end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetAllConnectedTraces', E.Message); end; end; procedure CheckBySCSObjectsNear(X, Y: Double; var ResFindedFigures: TList; TracedFigure: TFigure = nil); var i, j: integer; CurFigure: TFigure; FindedFigures: array[1..2{25}] of TList; LHSCSCommon: Integer; // Layer Handler Res: TFigure; XMod, YMod: Double; xadd, yadd: Double; adim1, adimstep05: Double; aZoomScaleCad: Double; begin Res := nil; try adim1 := 0.5; //1 adimstep05 := 0.25; //0.5 aZoomScaleCad := 0; if (GCadForm.PCad <> nil) then begin aZoomScaleCad := GCadForm.PCad.ZoomScale; if (GCadForm.PCad.ZoomScale >= 500) and (GCadForm.PCad.ZoomScale < 1000) then aZoomScaleCad := GCadForm.PCad.ZoomScale / 1.5 else if GCadForm.PCad.ZoomScale >= 1000 then aZoomScaleCad := GCadForm.PCad.ZoomScale / 2; end; if aZoomScaleCad > 0 then begin adim1 := adim1 / (aZoomScaleCad / 100); adimstep05 := adimstep05 / (aZoomScaleCad / 100); end; for j := 1 to 2 {25} do FindedFigures[j] := TList.Create; if TracedFigure <> nil then TracedFigure.Draw(GCadForm.PCad.DEngine, False); // поиск LHSCSCommon := GCadForm.PCad.GetLayerHandle(lnSCSCommon); //15.03.2012 if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; //for i := 0 to GCadForm.PCad.FigureCount - 1 do for i := 0 to GCadForm.FCheckedFigures.Count - 1 do begin //CurFigure := TFigure(GCadForm.PCad.Figures[i]); CurFigure := TFigure(GCadForm.FCheckedFigures[i]); if (CurFigure.LayerHandle = LHSCSCommon) then //15.03.2012 begin XMod := X; YMod := Y; if CheckFigureByClassName(CurFigure, cTConnectorObject) then begin xadd := -adim1; j := 1; //// ЦИКЛ ПОИСКА ОБЬЕКТОВ while xadd <= adim1 do begin yadd := -adim1; while yadd <= adim1 do begin if TConnectorObject(CurFigure).IsPointIn(XMod + xadd, YMod + yadd) then begin if FindedFigures[j].IndexOf(CurFigure) = -1 then FindedFigures[j].Add(CurFigure); end; yadd := yadd + adimstep05; end; xadd := xadd + adimstep05; end; end else if CheckFigureByClassName(CurFigure, cTOrthoLine) then begin xadd := -adim1; j := 1; //// ЦИКЛ ПОИСКА ОБЬЕКТОВ while xadd <= adim1 do begin yadd := -adim1; while yadd <= adim1 do begin if TOrthoLine(CurFigure).IsPointIn(X + xadd, Y + yadd) then begin if FindedFigures[j].IndexOf(CurFigure) = -1 then FindedFigures[j].Add(CurFigure); end; yadd := yadd + adimstep05; end; xadd := xadd + adimstep05; end; end else if CheckFigureByClassName(CurFigure, cTHouse) then begin xadd := -adim1; //// ЦИКЛ ПОИСКА ОБЬЕКТОВ while xadd <= adim1 do begin yadd := -adim1; j := 1; while yadd <= adim1 do begin if THouse(CurFigure).isPointInForSnap(X + xadd, Y + yadd) then begin if FindedFigures[j].IndexOf(CurFigure) = -1 then FindedFigures[j].Add(CurFigure); end; yadd := yadd + adimstep05; end; xadd := xadd + adimstep05; end; end; end; end; // выбор по критериям // сначала объект for j := 1 to 2 {25} do begin Res := Nil; for i := 0 to FindedFigures[j].Count - 1 do begin CurFigure := TFigure(FindedFigures[j][i]); if CheckFigureByClassName(CurFigure, cTConnectorObject) and (not TConnectorObject(CurFigure).FIsApproach) then if TConnectorObject(CurFigure).ConnectorType <> ct_Clear then Res := CurFigure; end; // потом пустой коннектор if Res = Nil then begin for i := 0 to FindedFigures[j].Count - 1 do begin CurFigure := TFigure(FindedFigures[j][i]); if CheckFigureByClassName(CurFigure, cTConnectorObject) then if TConnectorObject(CurFigure).ConnectorType = ct_Clear then Res := CurFigure; end; end; // ну тогда хотя бы ортолинию if Res = Nil then begin for i := 0 to FindedFigures[j].Count - 1 do begin CurFigure := TFigure(FindedFigures[j][i]); if CheckFigureByClassName(CurFigure, cTOrthoLine) then Res := CurFigure; end; end; // Подъезд if Res = Nil then begin for i := 0 to FindedFigures[j].Count - 1 do begin CurFigure := TFigure(FindedFigures[j][i]); if CheckFigureByClassName(CurFigure, cTConnectorObject) and (TConnectorObject(CurFigure).FIsApproach) then Res := CurFigure; end; end; // Дом if Res = Nil then begin for i := 0 to FindedFigures[j].Count - 1 do begin CurFigure := TFigure(FindedFigures[j][i]); if CheckFigureByClassName(CurFigure, cTHouse) then Res := CurFigure; end; end; if Res <> nil then begin if ResFindedFigures.IndexOf(Res) = -1 then ResFindedFigures.Add(Res); end; end; for j := 1 to 2 {25} do if FindedFigures[j] <> nil then FreeAndNil(FindedFigures[j]); if TracedFigure <> nil then TracedFigure.Draw(GCadForm.PCad.DEngine, False); except on E: Exception do addExceptionToLogEx('U_Common.CheckBySCSObjectsNear', E.Message); end; end; Function CheckBySCSObjects(X, Y: Double; TracedFigure: TFigure = nil): TFigure; var i: integer; CurFigure: TFigure; FindedFigures: TList; ProgramRegisterPro_2: boolean; addcod: integer; LHSCSCommon: Integer; // Layer Handler begin Result := nil; try {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {TODO} // пока закоментил временно - слишком часто вызывается //ProgramRegisterPro_2 := ProgProtection.IsVer2(PRO, addcod); ProgramRegisterPro_2 := True; addcod := 0; {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IF Defined(TRIAL_SCS)} addcod := 0; {$IFEND} {$IF Not Defined(FINAL_SCS)} addcod := 0; {$IFEND} {$IF Defined(FINAL_SCS) and Not Defined(TRIAL_SCS)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {TODO} // пока закоментил временно - слишком часто вызывается //if Not ProgramRegisterPro_2 then // exit; {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IFEND} {$ELSE} addcod := 0; {$IFEND} FindedFigures := TList.Create; if TracedFigure <> nil then TracedFigure.Draw(GCadForm.PCad.DEngine, False); // поиск {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {$IFEND} LHSCSCommon := GCadForm.PCad.GetLayerHandle(lnSCSCommon); //15.03.2012 if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; //for i := 0 to GCadForm.PCad.FigureCount - 1 + addcod do for i := 0 to GCadForm.FCheckedFigures.Count - 1 do begin //CurFigure := TFigure(GCadForm.PCad.Figures[i]); CurFigure := TFigure(GCadForm.FCheckedFigures[i]); if CurFigure.LayerHandle = LHSCSCommon then //15.03.2012 begin if CheckFigureByClassName(CurFigure, cTConnectorObject) then begin if TConnectorObject(CurFigure).IsPointIn(X, Y) then begin FindedFigures.Add(CurFigure); end; end else if CheckFigureByClassName(CurFigure, cTOrthoLine) then begin if TOrthoLine(CurFigure).IsPointIn(X + addcod, Y + addcod) then begin FindedFigures.Add(CurFigure); end; end else if CheckFigureByClassName(CurFigure, cTHouse) then begin if THouse(CurFigure).isPointInForSnap(X, Y) then begin FindedFigures.Add(CurFigure); end; end; end; end; // выбор по критериям {$IF Not Defined(ES_GRAPH_SC)} {TODO} // пока закоментил временно - слишком часто вызывается //ProgramRegisterPro_2 := ProgProtection.IsVer2(PRO, addcod); addcod := 0; ProgramRegisterPro_2 := True; {$IFEND} {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IF Defined(TRIAL_SCS)} addcod := 0; {$IFEND} {$IF Not Defined(FINAL_SCS)} addcod := 0; {$IFEND} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcBegin.inc} {$IFEND} {$ELSE} addcod := 0; {$IFEND} // сначала объект for i := addcod to FindedFigures.Count - 1 do begin CurFigure := TFigure(FindedFigures[i]); if CheckFigureByClassName(CurFigure, cTConnectorObject) and (not TConnectorObject(CurFigure).FIsApproach) then if TConnectorObject(CurFigure).ConnectorType <> ct_Clear then Result := CurFigure; end; {$IF Not Defined(ES_GRAPH_SC)} {$IF Not Defined(TRIAL_SCS)} {$I Inc\DelphiCrcEnd.inc} {$IFEND} {$IFEND} // потом пустой коннектор if Result = Nil then begin for i := 0 to FindedFigures.Count - 1 do begin CurFigure := TFigure(FindedFigures[i]); if CheckFigureByClassName(CurFigure, cTConnectorObject) then if TConnectorObject(CurFigure).ConnectorType = ct_Clear then Result := CurFigure; end; end; // ну тогда хотя бы ортолинию if Result = Nil then begin for i := 0 to FindedFigures.Count - 1 do begin CurFigure := TFigure(FindedFigures[i]); if CheckFigureByClassName(CurFigure, cTOrthoLine) then Result := CurFigure; end; end; // Подъезд if Result = Nil then begin for i := 0 to FindedFigures.Count - 1 do begin CurFigure := TFigure(FindedFigures[i]); if CheckFigureByClassName(CurFigure, cTConnectorObject) and (TConnectorObject(CurFigure).FIsApproach) then Result := CurFigure; end; end; // Дом if Result = Nil then begin for i := 0 to FindedFigures.Count - 1 do begin CurFigure := TFigure(FindedFigures[i]); if CheckFigureByClassName(CurFigure, cTHouse) then Result := CurFigure; end; end; if FindedFigures <> nil then FreeAndNil(FindedFigures); if TracedFigure <> nil then TracedFigure.Draw(GCadForm.PCad.DEngine, False); except on E: Exception do addExceptionToLogEx('U_Common.CheckBySCSObjects', E.Message); end; end; Function CheckBySCSObjectsList(X, Y: Double): TList; var i: integer; CurFigure: TFigure; begin Result := TList.Create; try // поиск for i := 0 to GCadForm.PCad.FigureCount - 1 do begin CurFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(CurFigure, cTConnectorObject) then begin if TConnectorObject(CurFigure).IsPointIn(X, Y) then Result.Add(CurFigure); end; if CheckFigureByClassName(CurFigure, cTOrthoLine) then begin if TOrthoLine(CurFigure).IsPointIn(X, Y) then Result.Add(CurFigure); end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckBySCSObjectsList', E.Message); end; end; Procedure AutoShiftobject(AObject: TConnectorObject); var i, UCount: integer; CanMove: Boolean; AddDelta: Double; Bnd: TDoubleRect; ComponWidth, SlotsWidth, koefX: Double; ComponsList: TObjectList; Obj: TWMFObject; begin try if not HaveObjectSocketComponent(AObject.ID) then Exit; AddDelta := 0; if BriefFormat(AObject.DrawFigure.CenterPoint.x) > BriefFormat(AObject.ActualPoints[1].x) then CanMove := False else begin if AObject.DrawFigure.InFigures.Count > 0 then begin CanMove := True; if (AObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(AObject.DrawFigure.InFigures[0]), 'TWMFObject') then begin ComponWidth := AObject.DrawFigure.GetBoundRect.Right - AObject.DrawFigure.GetBoundRect.Left; AddDelta := 0.04 * ComponWidth; end else AddDelta := 0; end else CanMove := False; end; if CanMove then begin AObject.DrawFigure.Rotate(- AObject.FDrawFigureAngle, AObject.ActualPoints[1]); Bnd := AObject.DrawFigure.GetBoundRect; AObject.GrpSizeX := abs(Bnd.Right - Bnd.Left); AObject.GrpSizeY := abs(Bnd.Bottom - Bnd.Top); AObject.DrawFigure.move(AObject.GrpSizeX / 2 - AddDelta, 0); AObject.DrawFigure.Rotate(AObject.FDrawFigureAngle, AObject.ActualPoints[1]); Bnd := AObject.DrawFigure.GetBoundRect; AObject.GrpSizeX := abs(Bnd.Right - Bnd.Left); AObject.GrpSizeY := abs(Bnd.Bottom - Bnd.Top); if AObject.CaptionsGroup <> nil then AObject.CaptionsGroup.Move(AObject.GrpSizeX / 2 - AddDelta, 0); end; except on E: Exception do addExceptionToLogEx('U_Common.AutoShiftobject', E.Message); end; end; Function GetObjectsListForCork(AListID, AID_LineFigure, ALineSide: Integer; var AID_Connector: Integer): TIntList; var i, j: integer; ASelfLine: TOrthoLine; AConnector: TConnectorObject; GetPointObject: TConnectorObject; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ID: Integer; IDLine: ^Integer; vList: TF_CAD; begin Result := TIntList.Create; try AConnector := nil; //#From Oleg# //14.09.2010 AID_Connector := -1; vList := GetListByID(AListID); if vList <> nil then begin ASelfLine := TOrthoLine(GetFigureByID(vList, AID_LineFigure)); if ASelfLine <> nil then begin if ALineSide = 1 then AConnector := TConnectorObject(ASelfLine.JoinConnector1); if ALineSide = 2 then AConnector := TConnectorObject(ASelfLine.JoinConnector2); // лист из присоединенных трасс // напрямую if AConnector.JoinedConnectorsList.Count = 0 then begin if (AConnector.FConnRaiseType <> crt_BetweenFloorUp) and (AConnector.FConnRaiseType <> crt_BetweenFloorDown) then begin // Вернуть ИД коннектора AID_Connector := AConnector.ID; for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); //New(IDLine); //ID := JoinedLine.ID; //IDLine^ := ID; //Result.Add(IDLine); Result.Add(JoinedLine.ID); end; end; end else // через точ.объект begin GetPointObject := TConnectorObject(AConnector.JoinedConnectorsList[0]); if (GetPointObject.FConnRaiseType <> crt_BetweenFloorUp) and (GetPointObject.FConnRaiseType <> crt_BetweenFloorDown) then begin AID_Connector := GetPointObject.ID; for i := 0 to GetPointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(GetPointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); //New(IDLine); //ID := JoinedLine.ID; //IDLine^ := ID; //Result.Add(IDLine); Result.Add(JoinedLine.ID); end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetObjectsListForCork', E.Message); end; end; Procedure BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1; MustShowProgress: Boolean=False); begin if GIsProgressHandling then Exit; try if GIsProgressCount = 0 then begin GIsProgress := True; GIsProgressHandling := true; try if not F_Progress.Visible then if (F_Splash = nil) or Not F_Splash.Visible then begin try F_Progress.StartProgress(ACaption, AMaxPos, MustShowProgress); except end; end; if assigned(F_Progress) then begin if F_Progress.FPauseCount = 0 then FSCS_Main.FCADsInProgress.Clear; end else FSCS_Main.FCADsInProgress.Clear; SetCADsProgressMode(true); BaseBeginUpdate; except end; GIsProgressHandling := false; end; Inc(GIsProgressCount); except on E: Exception do addExceptionToLogEx('U_Common.BeginProgress', E.Message); end; end; { Procedure BeginProgress(ACaption: String = ''; AMaxPos: Integer = -1); begin if GIsProgressHandling then Exit; try if GIsProgressCount = 0 then begin GIsProgress := True; GIsProgressHandling := true; try if not F_Progress.Visible then if (F_Splash = nil) or Not F_Splash.Visible then begin try F_Progress.StartProgress(ACaption, AMaxPos); except end; end; if assigned(F_Progress) then begin if F_Progress.FPauseCount = 0 then FSCS_Main.FCADsInProgress.Clear; end else FSCS_Main.FCADsInProgress.Clear; SetCADsProgressMode(true); BaseBeginUpdate; except end; GIsProgressHandling := false; end; Inc(GIsProgressCount); except on E: Exception do addExceptionToLogEx('U_Common.BeginProgress', E.Message); end; end; } Procedure EndProgress; var i: Integer; begin if GIsProgressHandling then Exit; try if GIsProgressCount > 0 then begin Dec(GIsProgressCount); if GIsProgressCount = 0 then begin GIsProgressHandling := true; try SetCADsProgressMode(false); BaseEndUpdate; if F_Progress.Visible then begin F_Progress.StopProgress; end; except end; GIsProgress := False; GIsProgressHandling := false; end; end; except on E: Exception do addExceptionToLogEx('U_Common.EndProgress', E.Message); end; end; procedure SetCADsProgressMode(AIsProgress: Boolean); var i: Integer; CAD: TF_CAD; begin // Очистка на BeginProgress // Очистка FSCS_Main.FCADsInProgress на BeginProgress - делается собственно в BeginProgress //if AIsProgress then // FSCS_Main.FCADsInProgress.Clear; for i := 0 to FSCS_Main.MDIChildCount - 1 do begin CAD := TF_CAD(FSCS_Main.MDIChildren[i]); if AIsProgress then begin //CAD.mProtocol.Properties.BeginUpdate; //CAD.mProtocol.Lines.BeginUpdate; //CAD.PCad.DisableAlign; CADBeginUpdate(CAD); if FSCS_Main.FCADsInProgress.IndexOf(CAD) = -1 then FSCS_Main.FCADsInProgress.Add(CAD); end else begin if FSCS_Main.FCADsInProgress.IndexOf(CAD) <> -1 then begin //CAD.mProtocol.Properties.EndUpdate; //CAD.mProtocol.Lines.EndUpdate; //CAD.PCad.EnableAlign; CADEndUpdate(CAD); //04.04.2013 - НУЖНО ЧТОБЫ НЕБЫЛО МЕРЦАНИЙ НА PauseProgress //if CAD = FSCS_Main.ActiveMDIChild then // RefreshCAD(CAD.PCad); end; end; end; // Очистка на EndProgress if Not AIsProgress then if assigned(F_Progress) then begin if F_Progress.FPauseCount = 0 then FSCS_Main.FCADsInProgress.Clear; end else FSCS_Main.FCADsInProgress.Clear; end; procedure CADBeginUpdate(aCAD: TObject); //07.11.2011 begin TF_CAD(aCAD).mProtocol.Properties.BeginUpdate; TF_CAD(aCAD).mProtocol.Lines.BeginUpdate; TF_CAD(aCAD).PCad.DisableAlign; TF_CAD(aCAD).PCad.BeginUpdate; //23.08.2012 end; procedure CADEndUpdate(aCAD: TObject); //07.11.2011 begin TF_CAD(aCAD).mProtocol.Properties.EndUpdate; TF_CAD(aCAD).mProtocol.Lines.EndUpdate; TF_CAD(aCAD).PCad.EnableAlign; TF_CAD(aCAD).PCad.EndUpdate; //23.08.2012 end; procedure StepProgress; begin try if (GIsProgressCount = 1) and F_Progress.Showing then begin F_Progress.StepProgress; ProcessMessagesEx; end; except on E: Exception do addExceptionToLogEx('StepProgress: ', E.Message); end; end; procedure StartUpProgress; begin F_Splash.ProgressBar.StepIt; Application.ProcessMessages; end; Procedure SetListsNamesInProject(AProjectName: string); var i: integer; LayerName: string; CurCadForm: TF_CAD; begin try for i := 0 to FSCS_Main.MDIChildCount - 1 do begin CurCadForm := TF_CAD(FSCS_Main.MDIChildren[i]); CurCadForm.FCADProjectName := AProjectName; LayerName := CurCadForm.PCad.GetLayerName(CurCadForm.PCad.ActiveLayer); CurCadForm.Caption := CurCadForm.FCADProjectName + ' - ' + CurCadForm.FCADListName + cCommon_Mes7 + LayerName; end; except on E: Exception do addExceptionToLogEx('U_Common.SetListsNamesInProject', E.Message); end; end; procedure CreateShadowObject; var i: integer; x, y: integer; LayHandle: integer; Obj: TFigureGrpNotMod; Line: TLine; Rect: TRectangle; VisibleRect: TDoubleRect; deltax, deltay: double; isExistShadow: boolean; Figure: TFigure; a: integer; begin try if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin isExistShadow := True; while isExistShadow do begin isExistShadow := False; For a := 0 to GCadForm.PCad.Figures.Count - 1 do begin if TFigure(GCadForm.PCad.Figures[a]) is TFigureGrpNotMod then if TFigureGrpNotMod(GCadForm.PCad.Figures[a]).InFigures.Count = 1 then begin Figure := TFigureGrpNotMod(GCadForm.PCad.Figures[a]).InFigures[0]; if Figure.ClassName = 'TLine' then begin isExistShadow := True; GIsDrawShadow := False; RemoveInFigureGrp(TFigureGrpNotMod(GCadForm.PCad.Figures[a])); GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]); break; end; end; end; end; VisibleRect := GCadForm.PCad.GetVisibleRect; deltax := VisibleRect.Left + 10; deltay := VisibleRect.Top + 10; LayHandle := GCadForm.PCad.GetLayerHandle(2); Obj := TFigureGrpNotMod.Create(LayHandle, GCadForm.PCad); Line := TLine.create(0, 0, 0, 0, 1, ord(psClear), clBlack, 0, LayHandle, mydsNormal, GCadForm.PCad); if Assigned(GShadowObject) then GShadowObject := nil; GShadowObject := TFigureGrpNotMod(GCadForm.PCad.AddCustomFigure (GLN(LayHandle), Obj, False)); GShadowObject.AddFigure(Line); GShadowObject.Move(deltax, deltay); GShadowObject.LockModify := True; GShadowObject.LockMove := True; {GShadowObject.DrawStyle := dsTrace; for i := 0 to GShadowObject.inFigures.Count - 1 do TFigure(GShadowObject.inFigures[i]).DrawStyle := dsTrace;} {Rect := TRectangle.create(0, 0, 4, 4, 2, ord(psSolid), clGray, ord(psSolid), 0, LayHandle, mydsNormal, GCadForm.PCad); GShadowObject := TFigureGrpNotMod(GCadForm.PCad.AddCustomFigure (GLN(LayHandle), Obj, False)); GShadowObject.AddFigure(Rect); GShadowObject.Move(deltax, deltay); GShadowObject.LockModify := True; GShadowObject.LockMove := True; GShadowObject.ShadowCP.x := deltax + 4; GShadowObject.ShadowCP.y := deltay + 4; Rect.DrawStyle := dsTrace; GShadowObject.DrawStyle := dsTrace; GCadForm.PCad.TraceFigure := GShadowObject;} end; except on E: Exception do addExceptionToLogEx('U_Common.CreateShadowObject', E.Message); end; end; procedure DestroyShadowObject; var i: integer; begin try if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin //GCadForm.PCad.TraceFigure := nil; //16.03.2012 GIsDrawShadow := False; if GShadowObject <> nil then begin RemoveInFigureGrp(GShadowObject); GCadForm.PCad.Figures.Remove(GShadowObject); end; end; except on E: Exception do addExceptionToLogEx('U_Common.DestroyShadowObject', E.Message); end; if (GCadForm.FCreateObjectOnClick){and(not Assigned(GShadowObject))} then CreateShadowObject; // На CAD end; Procedure AutoConnectOverRaiseInCAD(AObjFromRaise, ARaiseObj: TConnectorObject); var i, j: integer; ObjFromRaise: TConnectorObject; RaiseObj: TConnectorObject; RaiseLine: TOrthoLine; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ptrConnectObjParam: PConnectObjectParam; ConnectedLines: TList; ConnectedBeforeRaise: TList; ConnectedAfterRaise: TList; procedure DefineConnectedObjectParams(ATargetConnectedObjectParams: TList; AConnectorObject: TConnectorObject); var i, j: Integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ptrConnectObjParam: PConnectObjectParam; begin if AConnectorObject.ConnectorType = ct_Clear then for i := 0 to AConnectorObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnectorObject.JoinedOrtholinesList[i]); if JoinedLine <> RaiseLine then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := JoinedLine.ID; if JoinedLine.JoinConnector1 = AConnectorObject then ptrConnectObjParam.Side := 1; if JoinedLine.JoinConnector2 = AConnectorObject then ptrConnectObjParam.Side := 2; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; end else begin for i := 0 to AConnectorObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(AConnectorObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine <> RaiseLine then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := JoinedLine.ID; if JoinedLine.JoinConnector1 = JoinedConn then ptrConnectObjParam.Side := 1; if JoinedLine.JoinConnector2 = JoinedConn then ptrConnectObjParam.Side := 2; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; end; end; end; end; begin try ObjFromRaise := AObjFromRaise; RaiseObj := ARaiseObj; if (ARaiseObj.FConnRaiseType = crt_None) and (AObjFromRaise.FConnRaiseType <> crt_None) then begin ObjFromRaise := ARaiseObj; RaiseObj := AObjFromRaise; end; RaiseLine := GetRaiseLine(RaiseObj); ConnectedBeforeRaise := TList.Create; ConnectedAfterRaise := TList.Create; DefineConnectedObjectParams(ConnectedBeforeRaise, ObjFromRaise); DefineConnectedObjectParams(ConnectedAfterRaise, RaiseObj); AutoConnectOverRaiseLine(ObjFromRaise.ID, RaiseLine.ID, ConnectedBeforeRaise, ConnectedAfterRaise, ltUpDown); if ConnectedBeforeRaise <> nil then FreeList(ConnectedBeforeRaise); if ConnectedAfterRaise <> nil then FreeList(ConnectedAfterRaise); except on E: Exception do addExceptionToLogEx('U_Common.AutoConnectOverRaiseInCAD', E.Message); end; end; function GetCADStreamByIDList(AID_List: Integer; aFileName: string = ''): TMemoryStream; var i: integer; CurCADForm: TF_CAD; begin Result := nil; //09.09.2011 TMemoryStream.Create; try for i := 0 to FSCS_Main.MDIChildCount - 1 do begin if TF_CAD(FSCS_Main.MDIChildren[i]).FCADListID = AID_List then Break; end; if i = FSCS_Main.MDIChildCount then Exit; CurCADForm := TF_CAD(FSCS_Main.MDIChildren[i]); GCadForm := CurCADForm; if GCadForm <> nil then begin GCadForm.PCad.SaveWithPreview := False; if aFileName = '' then begin Result := TMemoryStream.Create; GCadForm.PCad.SaveToStream(Result) end else begin ForceDirectories(ExtractFileDir(aFileName)); GCadForm.PCad.SaveToFile(0, aFileName); end; GCadForm.PCad.SaveWithPreview := True; end; except on E: Exception do addExceptionToLogEx('GetCADStreamByIDList', E.Message); end; end; function IfDrawFigureMoveCan(AObject: TConnectorObject; ADeltaX, ADeltaY: Double): Boolean; var BegPoints: TDoublePoint; EndPoints: TDoublePoint; ToPoints: TDoublePoint; begin Result := False; try BegPoints.x := AObject.ActualPoints[1].x - AObject.GrpSizeX / 2; BegPoints.y := AObject.ActualPoints[1].y - AObject.GrpSizeY / 2; EndPoints.x := AObject.ActualPoints[1].x + AObject.GrpSizeX / 2; EndPoints.y := AObject.ActualPoints[1].y + AObject.GrpSizeY / 2; ToPoints.x := AObject.DrawFigure.CenterPoint.x + ADeltaX; ToPoints.y := AObject.DrawFigure.CenterPoint.y + ADeltaY; if ((ToPoints.x >= BegPoints.x) and (ToPoints.x <= EndPoints.x)) and ((ToPoints.y >= BegPoints.y) and (ToPoints.y <= EndPoints.y)) then Result := True; except on E: Exception do addExceptionToLogEx('U_Common.IfDrawFigureMoveCan', E.Message); end; end; procedure ReAssignNavigatorParams; var i: integer; ListValue: Double; BaseValue: Double; KoefValue: Double; begin try if F_Navigator <> nil then begin if F_Navigator.PCadNavigator.SelectedCount > 0 then F_Navigator.PCadNavigator.DeselectAll(0); if (F_Navigator.PCadNavigator.PageOrient <> GCadForm.PCad.PageOrient) or (F_Navigator.PCadNavigator.PageLayout <> GCadForm.PCad.PageLayout) then begin F_Navigator.PCadNavigator.PageOrient := GCadForm.PCad.PageOrient; F_Navigator.PCadNavigator.PageLayout := GCadForm.PCad.PageLayout; F_Navigator.PCadNavigator.WorkWidth := GCadForm.PCad.WorkWidth; F_Navigator.PCadNavigator.WorkHeight := GCadForm.PCad.WorkHeight; // A0 - 1189*841 - 3% ZoomScale // A1 - 841*594 // A2 - 594*421 // A3 - 421*297 // A4 - 297*210 // A5 - 210*148 // A6 - 105*74 BaseValue := 1189; ListValue := Max(GCadForm.PCad.WorkHeight, GCadForm.PCad.WorkWidth); KoefValue := BaseValue / ListValue; F_Navigator.PCadNavigator.ZoomScale := Round(3 * KoefValue); end; RefreshCAD(F_Navigator.PCadNavigator); end; except on E: Exception do addExceptionToLogEx('U_Common.ReAssignNavigatorParams', E.Message); end; end; Procedure LoadSettingsForList(AListID: Integer; aApplyListFormat: Boolean); var ListSettings: TListSettingRecord; ListParams: TListParams; begin try SetDefaultPageParams; // подгрузить параметры листа ListParams := GetListParams(AListID); LoadSettingsForListByParams(ListParams, aApplyListFormat); except on E: Exception do addExceptionToLogEx('U_Common.LoadSettingsForList', E.Message); end; end; function MakeEditList(AMakeEdit: TMakeEdit; var AListParams: TListParams; AShowForm: Boolean; ASpravochnikKind: TViewKind = vkNone; AGUIDToLocate: String = ''): Boolean; var NewTab: TTabSheet; MenuItem: TMenuItem; i, j: integer; GetIDList: Integer; OldPrjCaption, PrjCaption: string; OldListCaption, ListCaption: String; Box: TConnectorObject; BoxList: TF_CAD; WasOpenedProject: Boolean; CADParams: TCADParams; Cabinet: TCabinet; x1, x2, y1, y2: double; LHandle: integer; OldListParams: TListParams; OldListW, OldListH: double; isChangeListParams: Boolean; begin Result := false; try if not CanAddListToPM(WasOpenedProject) then begin ShowMessage(cCommon_Mes8); Exit; end; OldListW := 0; //#From Oleg# //14.09.2010 OldListH := 0; //#From Oleg# //14.09.2010 //*** На случай, если Лист создается на закрытом проекте, и параметры до тек. момента // небыли определены if WasOpenedProject then ///if AListParams.MarkID = 0 then AListParams := GetListParamsForNewList; OldListParams := AListParams; CADParams := SetCADParamsStruct(AListParams); // &&& if (GIfMasterUsed) or (GLiteVersion and (AMakeEdit = meMake)) and (not GReadOnlyMode) then isChangeListParams := F_MasterNewListLite.ChangeListParams(AMakeEdit, AListParams, AShowForm{, CADParams}, ASpravochnikKind, AGUIDToLocate) else isChangeListParams := F_MasterNewList.ChangeListParams(AMakeEdit, AListParams, AShowForm{, CADParams}, ASpravochnikKind, AGUIDToLocate); if isChangeListParams then begin Result := true; BeginProgress; try // MAKE if AMakeEdit = meMake then begin // создать лист в проекте TF_CAD.Create(FSCS_Main); // создать виртуальный кабинет CreateVirtualCabinetInCAD(GCadForm); if GCurrentCADListID = 0 then begin GetIDList := GenNewListID; GCadForm.FCADListID := GetIDList; AListParams.ID := GCadForm.FCADListID; end else GCadForm.FCADListID := GCurrentCADListID; GCadForm.FCADListName := AListParams.Name; GCadForm.FCADListIndex := AListParams.MarkID; SetDefaultPageParams; // Добавить переключатель в панель листов проекта NewTab := TTabSheet.Create(nil); NewTab.PageControl := FSCS_Main.pageCADList; NewTab.Tag := GCadForm.Handle; FSCS_Main.pageCADList.ActivePage := NewTab; // Добавить Листы в главное меню for i := 0 to FSCS_Main.mainWindow.Count - 1 do if FSCS_Main.mainWindow.Items[i].Caption = '-' then break; j := 0; inc(i); while FSCS_Main.mainWindow.Count > i do begin MenuItem := FSCS_Main.mainWindow.Items[FSCS_Main.mainWindow.Count - 1]; FSCS_Main.mainWindow.Delete(FSCS_Main.mainWindow.Count - 1); MenuItem.Free; end; for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do begin MenuItem := TMenuItem.Create(nil); MenuItem.Caption := FSCS_Main.pageCADList.Pages[j].Caption; MenuItem.Tag := FSCS_Main.pageCADList.Pages[j].Tag; MenuItem.AutoCheck := True; MenuItem.RadioItem := True; MenuItem.Checked := FSCS_Main.pageCADList.Pages[j] = FSCS_Main.pageCADList.ActivePage; MenuItem.OnClick := FSCS_Main.SwitchWindow; FSCS_Main.mainWindow.Add(MenuItem); end; // Создать лист в МП if (F_NormBase <> nil) and (F_ProjMan <> nil) then if GCurrentCADListID = 0 then AddListInPM(GCadForm.FCADListID, AListParams); GCadForm.WindowState := wsMaximized; GCadForm.FCADProjectName := GetCurrProjectName; PrjCaption := GetCurrProjectParams.Caption; ListCaption := AListParams.Caption; GCadForm.Caption := PrjCaption + ' - ' + ListCaption; {$IF Defined(ES_GRAPH_SC)} GCadForm.CurrentLayer := 8; {$else} GCadForm.CurrentLayer := 2; {$ifend} end; // *** // установить параметры табов и вкладок PrjCaption := GetCurrProjectParams.Caption; ListCaption := AListParams.Caption; FSCS_Main.pageCADList.ActivePage.Caption := ListCaption; for i := 0 to FSCS_Main.mainWindow.Count - 1 do begin if FSCS_Main.mainWindow.Items[i].Checked then break; end; FSCS_Main.mainWindow.Items[i].Caption := ListCaption; // *UNDO* if AMakeEdit = meEdit then begin if GCadForm <> nil then if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; end; if AMakeEdit = meEdit then if GCadForm <> nil then begin OldListW := GCadForm.PCad.WorkWidth; OldListH := GCadForm.PCad.WorkHeight; end; // установить параметры листа от мастера создания листа LoadSettingsForListByParams(AListParams, True); SaveListParams(GCadForm.FCADListID, AListParams, F_MasterNewList.cbApplyForAllSCSObjects.Checked, F_MasterNewList.cbApplyForSelectedOnly.Checked); if (GIfMasterUsed) or (GLiteVersion and (AMakeEdit = meMake)) and (not GReadOnlyMode) then SetNewListParamsForMaster(CADParams) else SetNewListParams(CADParams); if AMakeEdit = meMake then if GCadForm <> nil then begin if GCadForm.FListType = lt_Normal then {$IF Defined(ES_GRAPH_SC)} GCadForm.CurrentLayer := 8 {$else} GCadForm.CurrentLayer := 2 {$ifend} else GCadForm.CurrentLayer := 1; end; // *** EDIT *** if AMakeEdit = meEdit then begin if GCadForm.FListType = lt_DesignBox then begin // Обновить дизайн-лист BoxList := GetListByID(GCadForm.FJoinedListIDForDesignList); if BoxList <> nil then begin Box := TConnectorObject(GetFigureByID(BoxList, GCadForm.FJoinedBoxIDForDesignList)); if Box <> nil then UpdateDesignList(GCadForm, Box); end; end; // if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin try if (OldListParams.MarkID <> AListParams.MarkID) or (OldListParams.Name <> AListParams.Name) then // 2011-05-10 RenameListInCAD(GCadForm.FCADListID, '', AListParams.Caption, @AListParams, false); except end; end; // обновить имя листа на рамке if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin try //13.09.2010 if (GCadForm.FFrameListName = nil) or (TRichText(GCadForm.FFrameListName).re.Text = '') then //13.09.2010 RenameListOnFrame(GCadForm, GetCurrProjectParams(false), OldListParams); RenameListOnFrame(GCadForm, GetCurrProjectParams(false), OldListParams); except end; end; // автоподгонка изображения if AMakeEdit = meEdit then if F_MasterNewList.cbRescaleDrawing.Enabled and F_MasterNewList.cbRescaleDrawing.Checked then if GCadForm <> nil then ReScaleDrawingToListFormat(OldListW, OldListH); // *UNDO* if GCadForm <> nil then GCadForm.FCanSaveForUndo := True; end; finally EndProgress; GIfMasterUsed := False; end; end; except on E: Exception do addExceptionToLogEx('U_Common.MakeEditList', E.Message); end; end; procedure LoadSettingsForListByParams(AListParams: TListParams; aApplyListFormat: Boolean); var ListSettings: TListSettingRecord; ListFormat: TListFormatType; IsChanged: Boolean; begin try ListSettings := AListParams.Settings; //06.08.2012 GCadForm.PCad.FGrayedColor := AListParams.Settings.CADGrayedColor; GCadForm.FCADListIndex := AListParams.MarkID; GCadForm.FCADListIndex := AListParams.MarkID; GCadForm.FRoomHeight := ListSettings.HeightRoom; GCadForm.FFalseFloorHeight := ListSettings.HeightCeiling; GCadForm.FConnHeight := ListSettings.HeightSocket; GCadForm.FLineHeight := ListSettings.HeightCorob; GCadForm.FLengthKoef := ListSettings.LengthKoef; GCadForm.FPortReserv := ListSettings.PortReserv; GCadForm.FMultiportReserv := ListSettings.MultiportReserv; GCadForm.FCableChannelFullnessKoef := ListSettings.CableCanalFullnessKoef; GCadForm.FTwistedPairMaxLength := ListSettings.TwistedPairMaxLength; // GCadForm.FShowObjectCaptionsType := ListSettings.ShowObjectTypeCAD; GCadForm.FShowObjectNotesType := ListSettings.CADShowObjectNotesType; GCadForm.FShowLineCaptionsType := ListSettings.CADCaptionsKind; GCadForm.FShowLineNotesType := ListSettings.CADNotesKind; // GCadForm.FGroupListObjectsByType := ListSettings.GroupListObjectsByType; GCadForm.FPutCableOnTrace := ListSettings.PutCableInTrace; GCadForm.FShowLinesLength := ListSettings.ShowLineObjectLength; GCadForm.FShowLinesCaptions := ListSettings.ShowLineObjectCaption; GCadForm.FShowConnectorsCaptions := ListSettings.ShowConnObjectCaption; GCadForm.FShowLinesNotes := ListSettings.ShowLineObjectNote; GCadForm.FShowConnectorsNotes := ListSettings.ShowConnObjectNote; GCadForm.FDefaultTraceColor := ListSettings.CADTraceColor; GCadForm.FDefaultBlockStep := ListSettings.CADBlockStep; GCadForm.FDefaultTraceStyle := ListSettings.CADTraceStyle; GCadForm.FDefaultTraceWidth := ListSettings.CADTraceWidth; GCadForm.FClickType := ListSettings.CADClickObjectType; GCadForm.FShowRaise := ListSettings.CADShowRaise; //GCadForm.FShowRaiseDrawFigure := ListSettings.CADShowRaiseDrawFigure; GCadForm.FNotePrefix := ListSettings.NoteCountPrefix; GCadForm.PCad.GridStep := ListSettings.CADGridStep; // Шрифт КАДа GCadForm.FFontName := ListSettings.CADFontName; GCadForm.PCad.Font.Name := GCadForm.FFontName; // Тип уголка по дефолту GCadForm.FDefaultCornerType := ListSettings.CornerType; GCadForm.FKeepLineTypesRules := ListSettings.KeepLineTypesRules; // Обновить все тексты на листе UpdateForTexts(GCadForm.FFontName); GCadForm.FListType := ListSettings.ListType; if GCadForm.FListType = lt_Normal then EnableOptionsForNormalList; if GCadForm.FListType = lt_DesignBox then DisableOptionsForDesignList; if GCadForm.FListType = lt_ProjectPlan then DisableOptionsForProjectPlan; // Для дизайнерского листа GCadForm.FJoinedBoxIDForDesignList := ListSettings.IDFigureForDesignList; GCadForm.FJoinedListIDForDesignList := ListSettings.IDListForDesignList; GCadForm.FDesignListShowName := ListSettings.ShowNameInDesignList; GCadForm.FDesignListShowSign := ListSettings.ShowNameShortInDesignList; GCadForm.FDesignListShowMark := ListSettings.ShowNameMarkInDesignList; // ПАРАМЕТРЫ СТРАНИЦЫ // заполнить структуру формата листа ListFormat.ListCountX := ListSettings.CADListCountX; ListFormat.ListCountY := ListSettings.CADListCountY; ListFormat.PageWidth := ListSettings.CADWidth * ListSettings.CADListCountX; ListFormat.PageHeight := ListSettings.CADHeight * ListSettings.CADListCountY; ListFormat.ShowMainStamp := ListSettings.CADShowMainStamp; ListFormat.ShowUpperStamp := ListSettings.CADShowUpperStamp; ListFormat.ShowSideStamp := ListSettings.CADShowSideStamp; ListFormat.StampLang := ListSettings.CADStampLang; ListFormat.StampType := ListSettings.CADStampType; ListFormat.StampFields.Margins := ListSettings.CADStampMargins; ListFormat.StampFields.Developer := ListSettings.CADStampDeveloper; //15.11.2011 - разработал ListFormat.StampFields.Checker := ListSettings.CADStampChecker; //15.11.2011 - проверил ListFormat.StampFields.ListSign := ListSettings.CADStampListSign; ListFormat.StampFields.MainEngineer := ListSettings.CADStampMainEngineer; //02.10.2012 - Главный инженер проекта ListFormat.StampFields.Approved := ListSettings.CADStampApproved; //02.10.2012 - Утвердил ListFormat.StampFields.DesignStage := ListSettings.CADStampDesignStage; //02.10.2012 - Стадия проектир. if ListSettings.CADPageSizeIndex = 0 then ListFormat.PageLayout := plA0; if ListSettings.CADPageSizeIndex = 1 then ListFormat.PageLayout := plA1; if ListSettings.CADPageSizeIndex = 2 then ListFormat.PageLayout := plA2; if ListSettings.CADPageSizeIndex = 3 then ListFormat.PageLayout := plA3; if ListSettings.CADPageSizeIndex = 4 then ListFormat.PageLayout := plA4; if ListSettings.CADPageSizeIndex = 5 then ListFormat.PageLayout := plA5; if ListSettings.CADPageSizeIndex = 6 then ListFormat.PageLayout := plA6; if ListSettings.CADPageSizeIndex = 7 then ListFormat.PageLayout := plB4; if ListSettings.CADPageSizeIndex = 8 then ListFormat.PageLayout := plB5; if ListSettings.CADPageSizeIndex = 9 then ListFormat.PageLayout := plLetter; if ListSettings.CADPageSizeIndex = 10 then ListFormat.PageLayout := plTabloid; if ListSettings.CADPageSizeIndex = 11 then ListFormat.PageLayout := plCustom; if ListSettings.CADPageOrient = PCTypesUtils.poPortrait then ListFormat.PageOrient := PCTypesUtils.poPortrait else if ListSettings.CADPageOrient = PCTypesUtils.poLandscape then ListFormat.PageOrient := PCTypesUtils.poLandscape; // проверить были ли изменения IsChanged := CheckListFormatChanged(GCadForm, ListFormat); GCadForm.FCadStampType := ListSettings.CADStampType; GCadForm.FCadStampLang := ListSettings.CADStampLang; //GCadForm.FCadStampMargins := ListSettings.CADStampMargins; //GCadForm.FCADStampDeveloper := ListSettings.CADStampDeveloper; //GCadForm.FCADStampChecker := ListSettings.CADStampChecker; GCadForm.FStampFields := ListFormat.StampFields; GCadForm.FListCountX := ListSettings.CADListCountX; GCadForm.FListCountY := ListSettings.CADListCountY; GCadForm.FShowMainStamp := ListSettings.CADShowMainStamp; GCadForm.FShowUpperStamp := ListSettings.CADShowUpperStamp; GCadForm.FShowSideStamp := ListSettings.CADShowSideStamp; //GCadForm.FShowPathLengthType := TShowPathLengthType(ListSettings.CADShowPathLengthType); GCadForm.SetShowPathLengthType(TShowPathLengthType(ListSettings.CADShowPathLengthType)); //GCadForm.FShowPathTraceLengthType := TShowPathLengthType(ListSettings.CADShowPathTraceLengthType); GCadForm.SetShowPathTraceLengthType(TShowPathLengthType(ListSettings.CADShowPathTraceLengthType)); if aApplyListFormat and IsChanged then SetCadListFormat(ListFormat); // настройки КАДа // показывать линейки GCadForm.PCad.RulerVisible := ListSettings.CADShowRuler; FSCS_Main.aShowRuler.Checked := GCadForm.PCad.RulerVisible; GCadForm.tbShowRuler.Down := GCadForm.PCad.RulerVisible; // показывать сетку GCadForm.PCad.Grids := ListSettings.CADShowGrid; FSCS_Main.aShowGrid.Checked := GCadForm.PCad.Grids; GCadForm.tbShowGrid.Down := GCadForm.PCad.Grids; // показывать центр. направляющие // FSCS_Main.aShowCenterGuides.Checked := GCadForm.PCad.CenterGuide; // показывать направляющие GCadForm.PCad.GuidesVisible := ListSettings.CADShowGuides; FSCS_Main.aShowGuideLines.Checked := GCadForm.PCad.GuidesVisible; GCadForm.tbShowGuides.Down := GCadForm.PCad.GuidesVisible; // привязка к сетке GCadForm.PCad.SnapToGrids := ListSettings.CADSnapGrid; FSCS_Main.aSnaptoGrid.Checked := GCadForm.PCad.SnapToGrids; GCadForm.tbSnapGrid.Down := GCadForm.PCad.SnapToGrids; GCadForm.LastSnapGridStatus := GCadForm.PCad.SnapToGrids; // привязка к направляющим GCadForm.PCad.SnapToGuides := ListSettings.CADSnapGuides; FSCS_Main.aSnaptoGuides.Checked := GCadForm.PCad.SnapToGuides; GCadForm.tbSnapGuides.Down := GCadForm.PCad.SnapToGuides; // привязка к ближ. объекту GCadForm.PCad.SnapToNearPoint := ListSettings.CADSnapNearObject; FSCS_Main.aSnaptoNearObject.Checked := GCadForm.PCad.SnapToNearPoint; GCadForm.tbSnapNearObject.Down := GCadForm.PCad.SnapToNearPoint; // стиль отображения измерительных линий GCadForm.FDimLinesType := ListSettings.CADDimLinesType; // обновить слои UpdateForLayers; // отображение номеров кабинетов GCadForm.FShowCabinetsNumbers := ListSettings.CADShowCabinetsNumbers; GCadForm.FShowCabinetsBounds := ListSettings.CADShowCabinetsBounds; // цвета подписей и выносок GCadForm.FLinesCaptionsColor := ListSettings.CADLinesCaptionsColor; GCadForm.FConnectorsCaptionsColor := ListSettings.CADConnectorsCaptionsColor; GCadForm.FLinesNotesColor := ListSettings.CADLinesNotesColor; GCadForm.FConnectorsNotesColor := ListSettings.CADConnectorsNotesColor; // размеры шрифтов подписей и выносок GCadForm.FLinesCaptionsFontSize := ListSettings.CADLinesCaptionsFontSize; GCadForm.FConnectorsCaptionsFontSize := ListSettings.CADConnectorsCaptionsFontSize; GCadForm.FLinesNotesFontSize := ListSettings.CADLinesNotesFontSize; GCadForm.FConnectorsNotesFontSize := ListSettings.CADConnectorsNotesFontSize; GCadForm.FCrossATSFontSize := ListSettings.CADCrossATSFontSize; GCadForm.FCrossATSFontBold := ListSettings.CADCrossATSFontBold; GCadForm.FDistribCabFontSize := ListSettings.CADDistribCabFontSize; GCadForm.FDistribCabFontBold := ListSettings.CADDistribCabFontBold; GCadForm.FPrintType := ListSettings.CADPrintType; GCadForm.FSCSType := ListSettings.SCSType; GCadForm.FDefaultTraceStepRotate := ListSettings.CADTraceStepRotate; GCadForm.FAutoCadMouse := ListSettings.AutoCadMouse; GCadForm.FScaleByCursor := ListSettings.ScaleByCursor; GCadForm.FAutoPosTraceBetweenRM := ListSettings.CADAutoPosTraceBetweenRM; GCadForm.FSaveUndoCount := ListSettings.CADSaveUndoCount; GCadForm.FActiveActions := 0; GCadForm.FAllowSuppliesKind := ListSettings.CADAllowSuppliesKind; GCadForm.FNewTraceLengthType := TTraceLengthType(ListSettings.CADNewTraceLengthType); GCadForm.FListSettings := ListSettings; except on E: Exception do addExceptionToLogEx('U_Common.LoadSettingsForListByParams', E.Message); end; end; procedure SetCADFrameParams(ACadForm: TF_CAD); var //ListParams: TListParams; //ProjectParams: TProjectParams; CadForm: TF_CAD; begin try // подгрузить параметры листа //ListParams := GetListParams(AListID); //ProjectParams := GetCurrProjectParams(false); CadForm := ACadForm; //GetListByID(AListID); if CadForm <> nil then begin LoadCaptionsOnFrame(CadForm, CadForm.FCadStampType, false); // номер листа //if GCadForm.FFrameListName <> nil then //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameListName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName); // GCadForm.FFrameListName.DataID := 200; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False); //end; end; except on E: Exception do AddExceptionToLogEx('SetCADFrameParams', E.Message); end; end; // ОТКРЫТЬ ЛИСТЫ В ПРОЕКТЕ procedure OpenListsInProject(AListID: Integer; AListName: string); var NewTab: TTabSheet; MenuItem: TMenuItem; i, j: integer; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; ListSettings: TListSettingRecord; PrjCaption: string; ListCaption: String; Addlayer: TLayer; ListStream: TMemoryStream; fFileName: string; VirtualCabinetExist: Boolean; OldTick, CurrTick: Cardinal; ObjIdx: Integer; Figure: TFigure; NeedCheck: Boolean; isDuplicate: Boolean; SCSCatalog: TSCSCatalog; SCSCompon: TSCSComponent; a: integer; ListOfUse: TList; //Tolik FFigure: Tfigure; CadFigList: TList; // слепок фигур Када (Список) // begin try // создать лист в проекте TF_CAD.Create(FSCS_Main); GCadForm.FCADListID := AListID; GCadForm.FCADListName := AListName; GCadForm.FCADProjectName := GetCurrProjectName; GCadForm.PCad.DisableAlign; //27.12.2011 GCadForm.PCad.BeginUpdate; ListOfUse := TList.Create; try LoadSettingsForList(AListID, False); PrjCaption := GetCurrProjectParams.Caption; ListCaption := GetListParams(GCadForm.FCADListID).Caption; GCadForm.Caption := PrjCaption + ' - ' + ListCaption; try // поднять Stream с листа ListStream := OpenListInPM(GCadForm.FCADListID, GCadForm.FCADListName, fFileName); if (ListStream <> nil) or (fFileName <> '') then begin //27.12.2010 - Перед поднятием объектов LoadFromFile очистит все, поэтому нужно FActiveNet сбросить if ActiveNet = GCadForm.FActiveNet then ActiveNet := nil; GCadForm.FActiveNet := nil; if ListStream <> nil then begin TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); ListStream.SaveToFile(TempPath + 'tempCAD.pwd'); // подгрузить из файла GCadForm.PCad.OnObjectInserted := nil; GCadForm.PCad.LoadFromFile(TempPath + 'tempCAD.pwd'); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; end else if fFileName <> '' then begin // подгрузить из файла GCadForm.PCad.OnObjectInserted := nil; //GProcCnt := 0; OldTick := GetTickCount; GCadForm.PCad.LoadFromFile(fFileName); CurrTick := GetTickCount - OldTick; GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; end; end; if (ListStream <> nil) or (fFileName <> '') then begin // для старых проектов - пересоздать слои if GCadForm.PCad.LayerCount = 7 then begin AddLayer := TLayer.Create(cCad_Mes7); GCadForm.PCad.Layers.Add(Addlayer); end; if GCadForm.PCad.LayerCount = 8 then begin AddLayer := TLayer.create(cCad_Mes8); GCadForm.PCad.Layers.Add(AddLayer); GCadForm.FActiveNet := nil; end; RaiseActiveNet(GCadForm); if GCadForm.PCad.LayerCount = 9 then begin AddLayer := TLayer.create(cCad_Mes29); GCadForm.PCad.Layers.Add(AddLayer); end; {//17.11.2011 GCadForm.FFrameProjectName := nil; GCadForm.FFrameListName := nil; GCadForm.FFrameCodeName := nil; GCadForm.FFrameIndexName := nil;} GCadForm.ClearFrameFigures; GNeedReRaiseProperties := False; VirtualCabinetExist := False; // 31.07.2015 // Tolik // копия блока см. ниже // для того, чтобы не "плыл" список фигур Када, который будем перебирать и обрабатывать, // здесь создадим слепок фигур Када и будем лазить по нему, а с Кадом сделаем, что захотим // и ничего нам не помешает, и сделаем все в один проход (а не в два) // БУДЕТ АКТУАЛЬНО, СКОРЕЕ ВСЕГО, ДЛЯ БИТЫХ ПРОЕКТОВ !!! CadFigList := TList.Create; // создаем пустой список for i := 0 to GCadForm.PCad.FigureCount - 1 do // тулим в него все фигуры Када как есть begin CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[i])); end; for i := 0 to CadFigList.Count - 1 do begin Figure := TFigure(CadFigList[i]); NeedCheck := False; if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).RaiseProperties(CadFigList); if TConnectorObject(Figure).FHouse = nil then begin //NeedCheck := True; end else begin { for j := 0 to Length(TConnectorObject(Figure).FHouse.FApproachesIndexes) - 1 do begin if TConnectorObject(GCadForm.PCad.Figures.Items[TConnectorObject(Figure).FHouse.FApproachesIndexes[j]]).ID = Figure.ID then begin //NeedCheck := True; break; end; end; } if TConnectorObject(Figure).FIsApproach then begin if F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferencesList(GCadForm.FCADListID, TConnectorObject(Figure).FComponID) = nil then begin SCSCatalog := nil; if TConnectorObject(Figure).FHouse <> nil then SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CheckCatalogFromReferencesBySCSID(TConnectorObject(Figure).FHouse.ID, GCadForm.FCADListID, isDuplicate); SCSCompon := nil; if SCSCatalog <> nil then SCSCompon := SCSCatalog.GetFirstComponent; if SCSCompon <> nil then begin // вернулся дом. теперь по индексу или маркировке попробуем найти нужный чилд for j := 0 to SCSCompon.ChildReferences.Count - 1 do begin if ListOfUse.Indexof(TSCSComponent(SCSCompon.ChildReferences[j])) = -1 then begin TConnectorObject(Figure).FComponID := TSCSComponent(SCSCompon.ChildReferences[j]).ID; ListOfUse.Add(TSCSComponent(SCSCompon.ChildReferences[j])); break; end; end; end else begin {TODO} // удалить из всех мест этот подьезд // выставить Deleted подъезду // НЕ ПРОВТЫКАТЬ ЧТО ИМЕННО В ТОМ МЕСТЕ НЕЛЬЗЯ удалять и что-то чистить - так как пока не прошли все фигуры через RaiseProperties - ничего удалять нельзя с КАДа end; end; end; end; end else if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).RaiseProperties(CadFigList); //NeedCheck := True; end else if CheckFigureByClassName(Figure, cTFrame) then begin TFrame(Figure).RaiseProperties; end else if CheckFigureByClassName(Figure, cTPlanTrace) then begin TPlanTrace(Figure).RaiseProperties(CadFigList); end else if CheckFigureByClassName(Figure, cTPlanObject) then begin TPlanObject(Figure).RaiseProperties(CadFigList); end else if CheckFigureByClassName(Figure, cTPlanConnector) then begin TPlanConnector(Figure).RaiseProperties(CadFigList); end else if CheckFigureByClassName(Figure, cTCabinet) then begin TCabinet(Figure).RaiseProperties(CadFigList); if TCabinet(Figure).FType = ct_Virtual then VirtualCabinetExist := True; //else // NeedCheck := True; end else if CheckFigureByClassName(Figure, cTCabinetExt) then begin TCabinetExt(Figure).RaiseProperties(CadFigList); if TCabinetExt(Figure).FType = ct_Virtual then VirtualCabinetExist := True; //else // NeedCheck := True; end else if CheckFigureByClassName(Figure, 'TRichText') then begin ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(Figure).DataID)); if ObjIdx <> -1 then GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(Figure); end else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTHouse) then begin THouse(Figure).RaiseProperties(CadFigList); NeedCheck := True; end; if NeedCheck then begin isDuplicate := False; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CheckCatalogFromReferencesBySCSID(Figure.ID, GCadForm.FCADListID, isDuplicate); if Assigned(SCSCatalog) then begin // все гуд - найден на том листе что нужно! // проверим на дубли if isDuplicate then begin // есть еще с таким же ИД на других листах // лог КРИТИЧЕСКИЙ, что с таким далее делать - нужно будет думать {TODO} end; end else begin if isDuplicate then begin // не найден, но есть дубли // лог КРИТИЧЕСКИЙ, что с таким далее делать - нужно будет думать {TODO} end else begin // не найден, возможно с таким ИД и есть - но не на нужном нам листе //лог и флаг на удаление Figure.Deleted := True; {TODO} // в лог добавить end; end; end; end; FreeAndNil(CadFigList); a := 0; while a < GCadForm.PCad.FigureCount do begin if TFigure(GCadForm.PCad.Figures[a]).Deleted then begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[a]), cTHouse) then begin THouse(GCadForm.PCad.Figures[a]).Deleted := False; THouse(GCadForm.PCad.Figures[a]).Delete; a := a + 1; end else begin //Tolik { TFigure(GCadForm.PCad.Figures[a]).destroy; GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]);} FFigure := TFigure(GCadForm.PCad.Figures[a]); GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]); FreeAndNil(FFigure); // end; end else a := a + 1; end; if GNeedReRaiseProperties then begin i := 0; while i < GCadForm.PCad.FigureCount do begin Figure := TFigure(GCadForm.PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).ReRaiseProperties; end; if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).ReRaiseProperties; end; i := i + 1; end; end; (* for i := 0 to GCadForm.PCad.FigureCount - 1 do begin Figure := TFigure(GCadForm.PCad.Figures.Items[i]); NeedCheck := False; if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).RaiseProperties; if TConnectorObject(Figure).FHouse = nil then begin //NeedCheck := True; end else begin { for j := 0 to Length(TConnectorObject(Figure).FHouse.FApproachesIndexes) - 1 do begin if TConnectorObject(GCadForm.PCad.Figures.Items[TConnectorObject(Figure).FHouse.FApproachesIndexes[j]]).ID = Figure.ID then begin //NeedCheck := True; break; end; end; } if TConnectorObject(Figure).FIsApproach then begin if F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferencesList(GCadForm.FCADListID, TConnectorObject(Figure).FComponID) = nil then begin SCSCatalog := nil; if TConnectorObject(Figure).FHouse <> nil then SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CheckCatalogFromReferencesBySCSID(TConnectorObject(Figure).FHouse.ID, GCadForm.FCADListID, isDuplicate); SCSCompon := nil; if SCSCatalog <> nil then SCSCompon := SCSCatalog.GetFirstComponent; if SCSCompon <> nil then begin // вернулся дом. теперь по индексу или маркировке попробуем найти нужный чилд for j := 0 to SCSCompon.ChildReferences.Count - 1 do begin if ListOfUse.Indexof(TSCSComponent(SCSCompon.ChildReferences[j])) = -1 then begin TConnectorObject(Figure).FComponID := TSCSComponent(SCSCompon.ChildReferences[j]).ID; ListOfUse.Add(TSCSComponent(SCSCompon.ChildReferences[j])); break; end; end; end else begin {TODO} // удалить из всех мест этот подьезд // выставить Deleted подъезду // НЕ ПРОВТЫКАТЬ ЧТО ИМЕННО В ТОМ МЕСТЕ НЕЛЬЗЯ удалять и что-то чистить - так как пока не прошли все фигуры через RaiseProperties - ничего удалять нельзя с КАДа end; end; end; end; end else if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).RaiseProperties; //NeedCheck := True; end else if CheckFigureByClassName(Figure, cTFrame) then begin TFrame(Figure).RaiseProperties; end else if CheckFigureByClassName(Figure, cTPlanTrace) then begin TPlanTrace(Figure).RaiseProperties; end else if CheckFigureByClassName(Figure, cTPlanObject) then begin TPlanObject(Figure).RaiseProperties; end else if CheckFigureByClassName(Figure, cTPlanConnector) then begin TPlanConnector(Figure).RaiseProperties; end else if CheckFigureByClassName(Figure, cTCabinet) then begin TCabinet(Figure).RaiseProperties; if TCabinet(Figure).FType = ct_Virtual then VirtualCabinetExist := True; //else // NeedCheck := True; end else if CheckFigureByClassName(Figure, cTCabinetExt) then begin TCabinetExt(Figure).RaiseProperties; if TCabinetExt(Figure).FType = ct_Virtual then VirtualCabinetExist := True; //else // NeedCheck := True; end else if CheckFigureByClassName(Figure, 'TRichText') then begin ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(Figure).DataID)); if ObjIdx <> -1 then GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(Figure); end else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTHouse) then begin THouse(Figure).RaiseProperties; NeedCheck := True; end; if NeedCheck then begin isDuplicate := False; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CheckCatalogFromReferencesBySCSID(Figure.ID, GCadForm.FCADListID, isDuplicate); if Assigned(SCSCatalog) then begin // все гуд - найден на том листе что нужно! // проверим на дубли if isDuplicate then begin // есть еще с таким же ИД на других листах // лог КРИТИЧЕСКИЙ, что с таким далее делать - нужно будет думать {TODO} end; end else begin if isDuplicate then begin // не найден, но есть дубли // лог КРИТИЧЕСКИЙ, что с таким далее делать - нужно будет думать {TODO} end else begin // не найден, возможно с таким ИД и есть - но не на нужном нам листе //лог и флаг на удаление Figure.Deleted := True; {TODO} // в лог добавить end; end; end; end; a := 0; while a < GCadForm.PCad.FigureCount do begin if TFigure(GCadForm.PCad.Figures[a]).Deleted then begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[a]), cTHouse) then begin THouse(GCadForm.PCad.Figures[a]).Deleted := False; THouse(GCadForm.PCad.Figures[a]).Delete; a := a + 1; end else begin //Tolik { TFigure(GCadForm.PCad.Figures[a]).destroy; GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]);} FFigure := TFigure(GCadForm.PCad.Figures[a]); GCadForm.PCad.Figures.Remove(GCadForm.PCad.Figures[a]); FreeAndNil(FFigure); // end; end else a := a + 1; end; if GNeedReRaiseProperties then begin i := 0; while i < GCadForm.PCad.FigureCount do begin Figure := TFigure(GCadForm.PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).ReRaiseProperties; end; if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).ReRaiseProperties; end; i := i + 1; end; end; *) GCadForm.SetFrameFigures; CorrectStampView; if not VirtualCabinetExist then CreateVirtualCabinetInCAD(GCadForm); SetVisibleCabinetsNumbers(GCadForm.FShowCabinetsNumbers); SetVisibleCabinetsBounds(GCadForm.FShowCabinetsBounds); FindObjectsForConvertClasses; SetCADFrameParams(GCadForm); if GListRaiseWithErrors then begin ShowLog; GListRaiseWithErrors := False; end; end; except on E: Exception do addExceptionToLogEx(cCommon_Mes9 + GCadForm.FCADListName + IntToStr(GCadForm.FCADListIndex) + cCommon_Mes10, E.Message); end; if ListStream <> nil then FreeAndNil(ListStream); if GCadForm.FListType = lt_Normal then {$IF Defined(ES_GRAPH_SC)} GCadForm.CurrentLayer := 8; {$else} GCadForm.CurrentLayer := 2; {$ifend} if GCadForm.FListType = lt_DesignBox then GCadForm.CurrentLayer := 1; if GCadForm.FListType = lt_ProjectPlan then GCadForm.CurrentLayer := 1; if GCadForm.PCad.ZoomScale < 50 then GCadForm.SetZoomScale(50); // Добавить переключатель в панель листов проекта FSCS_Main.pageCADList.DisableAlign; try NewTab := TTabSheet.Create(nil); NewTab.PageControl := FSCS_Main.pageCADList; NewTab.Tag := GCadForm.Handle; NewTab.Caption := ListCaption; FSCS_Main.pageCADList.ActivePage := NewTab; finally FSCS_Main.pageCADList.EnableAlign; end; // Добавить Листы в главное меню for i := 0 to FSCS_Main.mainWindow.Count - 1 do if FSCS_Main.mainWindow.Items[i].Caption = '-' then break; j := 0; inc(i); while FSCS_Main.mainWindow.Count > i do begin MenuItem := FSCS_Main.mainWindow.Items[FSCS_Main.mainWindow.Count - 1]; FSCS_Main.mainWindow.Delete(FSCS_Main.mainWindow.Count - 1); MenuItem.Free; end; for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do begin MenuItem := TMenuItem.Create(nil); MenuItem.Caption := FSCS_Main.pageCADList.Pages[j].Caption; MenuItem.Tag := FSCS_Main.pageCADList.Pages[j].Tag; MenuItem.AutoCheck := True; MenuItem.RadioItem := True; MenuItem.Checked := FSCS_Main.pageCADList.Pages[j] = FSCS_Main.pageCADList.ActivePage; MenuItem.OnClick := FSCS_Main.SwitchWindow; FSCS_Main.mainWindow.Add(MenuItem); end; finally ListOfUse.Free; GCadForm.PCad.EndUpdate; GCadForm.PCad.EnableAlign; //27.12.2011 end; except on E: Exception do addExceptionToLogEx('U_Common.OpenListsInProject', E.Message); end; end; function CreateListDuplicate(AListParams: TListParams; AListStream: TMemoryStream; AFileName: string = ''; aCopySCSFigures: Boolean=true): TF_CAD; var NewTab: TTabSheet; MenuItem: TMenuItem; i, j: integer; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; ListSettings: TListSettingRecord; PrjCaption: string; ListCaption: String; Addlayer: TLayer; ListStream: TMemoryStream; Conn: TConnectorObject; SCSFigureGrp: TSCSFigureGrp; ObjIdx: Integer; Figure: TFigure; ListToDel: TList; //Tolik CadFigList: TList; // begin Result := nil; BeginProgress; try TF_CAD.Create(FSCS_Main); Result := GCadForm; //07.11.2011 if Result.WindowState <> wsMaximized then Result.WindowState := wsMaximized; try //GCadForm.LockSCSFigures; //07.11.2011 GCadForm.FCADListID := AListParams.ID; GCadForm.FCADListName := AListParams.Name; GCadForm.FCADProjectName := GetCurrProjectName; LoadSettingsForList(GCadForm.FCADListID, False); //EndProgress; Exit; ///// EXIT ///// PrjCaption := GetCurrProjectParams.Caption; ListCaption := GetListParams(GCadForm.FCADListID).Caption; GCadForm.Caption := PrjCaption + ' - ' + ListCaption; GCadForm.PCad.BeginUpdate; //01.07.2013 try if AListStream <> nil then begin TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); AListStream.SaveToFile(TempPath + 'tempCAD.pwd'); // подгрузить из файла GCadForm.PCad.OnObjectInserted := nil; GCadForm.PCad.LoadFromFile(TempPath + 'tempCAD.pwd'); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; end else if AFileName <> '' then begin // подгрузить из файла GCadForm.PCad.OnObjectInserted := nil; GCadForm.PCad.LoadFromFile(AFileName); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; end; CorrectStampView; //01.07.2013 - чтобы объектам рамки установить правильное значение свойства Visible finally GCadForm.PCad.EndUpdate; //01.07.2013 end; //EndProgress; //Exit; ///// EXIT ///// if (AListStream <> nil) or (AFileName <> '') then begin RaiseActiveNet(GCadForm); {//17.11.2011 GCadForm.FFrameProjectName := nil; GCadForm.FFrameListName := nil; GCadForm.FFrameCodeName := nil; GCadForm.FFrameIndexName := nil; GCadForm.FFrameStampDeveloper := nil; GCadForm.FFrameStampChecker := nil;} GCadForm.ClearFrameFigures; GNeedReRaiseProperties := False; //Tolik CadFigList := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[i])); (* for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTConnectorObject) then begin if TConnectorObject(GCadForm.PCad.Figures.Items[i]).AsEndPoint then TConnectorObject(GCadForm.PCad.Figures.Items[i]).AsEndPoint := False; TConnectorObject(GCadForm.PCad.Figures.Items[i]).RaiseProperties; end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTOrthoLine) then TOrthoLine(GCadForm.PCad.Figures.Items[i]).RaiseProperties; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTFrame) then TFrame(GCadForm.PCad.Figures.Items[i]).RaiseProperties; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTPlanTrace) then TPlanTrace(GCadForm.PCad.Figures.Items[i]).RaiseProperties; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTPlanObject) then TPlanObject(GCadForm.PCad.Figures.Items[i]).RaiseProperties; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTPlanConnector) then TPlanConnector(GCadForm.PCad.Figures.Items[i]).RaiseProperties; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTCabinet) then TCabinet(GCadForm.PCad.Figures.Items[i]).RaiseProperties; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTCabinetExt) then TCabinetExt(GCadForm.PCad.Figures.Items[i]).RaiseProperties; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTHouse) then THouse(GCadForm.PCad.Figures.Items[i]).RaiseProperties; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), 'TRichText') then begin {//17.11.2011 if TRichText(GCadForm.PCad.Figures.Items[i]).DataID = 100 then GCadForm.FFrameProjectName := TRichText(GCadForm.PCad.Figures.Items[i]); if TRichText(GCadForm.PCad.Figures.Items[i]).DataID = 200 then GCadForm.FFrameListName := TRichText(GCadForm.PCad.Figures.Items[i]); if TRichText(GCadForm.PCad.Figures.Items[i]).DataID = 300 then GCadForm.FFrameCodeName := TRichText(GCadForm.PCad.Figures.Items[i]); if TRichText(GCadForm.PCad.Figures.Items[i]).DataID = 400 then GCadForm.FFrameIndexName := TRichText(GCadForm.PCad.Figures.Items[i]);} ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(GCadForm.PCad.Figures.Items[i]).DataID)); if ObjIdx <> -1 then GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(GCadForm.PCad.Figures.Items[i]); end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures.Items[i]), cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(GCadForm.PCad.Figures.Items[i]); for j := 0 to SCSFigureGrp.InFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(SCSFigureGrp.InFigures[j]), cTConnectorObject) then if TConnectorObject(SCSFigureGrp.InFigures[j]).AsEndPoint then TConnectorObject(SCSFigureGrp.InFigures[j]).AsEndPoint := False; end; TSCSFigureGrp(GCadForm.PCad.Figures.Items[i]).RaiseProperties; end; end;*) for i := 0 to CadFigList.Count - 1 do begin if CheckFigureByClassName(TFigure(CadFigList[i]), cTConnectorObject) then begin if TConnectorObject(CadFigList[i]).AsEndPoint then TConnectorObject(CadFigList[i]).AsEndPoint := False; TConnectorObject(CadFigList[i]).RaiseProperties(CadFigList); end; if CheckFigureByClassName(TFigure(CadFigList[i]), cTOrthoLine) then TOrthoLine(CadFigList[i]).RaiseProperties(CadFigList); if CheckFigureByClassName(TFigure(CadFigList[i]), cTFrame) then TFrame(CadFigList[i]).RaiseProperties; if CheckFigureByClassName(TFigure(CadFigList[i]), cTPlanTrace) then TPlanTrace(CadFigList[i]).RaiseProperties(CadFigList); if CheckFigureByClassName(TFigure(CadFigList[i]), cTPlanObject) then TPlanObject(CadFigList[i]).RaiseProperties(CadFigList); if CheckFigureByClassName(TFigure(CadFigList[i]), cTPlanConnector) then TPlanConnector(CadFigList[i]).RaiseProperties(CadFigList); if CheckFigureByClassName(TFigure(CadFigList[i]), cTCabinet) then TCabinet(CadFigList[i]).RaiseProperties(CadFigList); if CheckFigureByClassName(TFigure(CadFigList[i]), cTCabinetExt) then TCabinetExt(CadFigList[i]).RaiseProperties(CadFigList); if CheckFigureByClassName(TFigure(CadFigList[i]), cTHouse) then THouse(CadFigList[i]).RaiseProperties(CadFigList); if CheckFigureByClassName(TFigure(CadFigList[i]), 'TRichText') then begin ObjIdx := GCadForm.FFrameObjects.IndexOf(IntToStr(TRichText(CadFigList[i]).DataID)); if ObjIdx <> -1 then GCadForm.FFrameObjects.Objects[ObjIdx] := TRichText(CadFigList[i]); end; if CheckFigureByClassName(TFigure(CadFigList[i]), cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(CadFigList[i]); for j := 0 to SCSFigureGrp.InFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(SCSFigureGrp.InFigures[j]), cTConnectorObject) then if TConnectorObject(SCSFigureGrp.InFigures[j]).AsEndPoint then TConnectorObject(SCSFigureGrp.InFigures[j]).AsEndPoint := False; end; TSCSFigureGrp(CadFigList[i]).RaiseProperties(CadFigList); end; end; { if GNeedReRaiseProperties then begin i := 0; while i < GCadForm.PCad.FigureCount do begin Figure := TFigure(GCadForm.PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).ReRaiseProperties; end; if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).ReRaiseProperties; end; i := i + 1; end; end;} // Tolik FreeAndNil(CadFigList); // GCadForm.SetFrameFigures; SetVisibleCabinetsNumbers(GCadForm.FShowCabinetsNumbers); SetVisibleCabinetsBounds(GCadForm.FShowCabinetsBounds); FindObjectsForConvertClasses; SetCADFrameParams(GCadForm); if GListRaiseWithErrors then begin ShowLog; GListRaiseWithErrors := False; end; //18.06.2013 - Удаляем СКС объекты, если флаг сброшен if Not aCopySCSFigures then begin try ListToDel := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin Figure := TFigure(GCadForm.PCad.Figures.Items[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).ID := 0; ListToDel.Add(Figure); end else if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).ID := 0; ListToDel.Add(Figure); end else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(Figure); ListToDel.Add(Figure); end; end; if ListToDel.Count > 0 then begin for i := ListToDel.Count - 1 downto 0 do begin Figure := TFigure(ListToDel[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then TConnectorObject(Figure).Delete else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).Delete else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).Delete; end; RefreshCAD(GCadForm.PCad); end; FreeAndNil(ListToDel); except on E: Exception do AddExceptionToLogExt('U_Common', 'CopyList:removeSCSObjects', E.Message); end; end; end; if AListStream <> nil then FreeAndNil(ListStream); FSCS_Main.aSetSCSLayer.Execute; // Добавить переключатель в панель листов проекта NewTab := TTabSheet.Create(nil); NewTab.PageControl := FSCS_Main.pageCADList; NewTab.Tag := GCadForm.Handle; NewTab.Caption := ListCaption; FSCS_Main.pageCADList.ActivePage := NewTab; // Добавить Листы в главное меню for i := 0 to FSCS_Main.mainWindow.Count - 1 do if FSCS_Main.mainWindow.Items[i].Caption = '-' then break; j := 0; inc(i); while FSCS_Main.mainWindow.Count > i do begin MenuItem := FSCS_Main.mainWindow.Items[FSCS_Main.mainWindow.Count - 1]; FSCS_Main.mainWindow.Delete(FSCS_Main.mainWindow.Count - 1); MenuItem.Free; end; for j := 0 to FSCS_Main.pageCADList.PageCount - 1 do begin MenuItem := TMenuItem.Create(nil); MenuItem.Caption := FSCS_Main.pageCADList.Pages[j].Caption; MenuItem.Tag := FSCS_Main.pageCADList.Pages[j].Tag; MenuItem.AutoCheck := True; MenuItem.RadioItem := True; MenuItem.Checked := FSCS_Main.pageCADList.Pages[j] = FSCS_Main.pageCADList.ActivePage; MenuItem.OnClick := FSCS_Main.SwitchWindow; FSCS_Main.mainWindow.Add(MenuItem); end; if GCadForm.FListType = lt_Normal then begin EnableOptionsForNormalList; end else if GCadForm.FListType = lt_DesignBox then begin DisableOptionsForDesignList; end else if GCadForm.FListType = lt_ProjectPlan then begin DisableOptionsForDesignList; end; // SkipAllLinesShadows(GCadForm); // установить параметры листа от мастера создания листа // LoadSettingsForListByParams(AListParams); // SaveListParams(GCadForm.FCADListID, AListParams); finally //GCadForm.UnLockSCSFigures; //07.11.2011 end; except on E: Exception do addExceptionToLogEx('U_Common.CreateListDuplicate', E.Message); end; EndProgress; end; procedure SetNewListParams(aCADParams: TCADParams); var i: integer; val: double; ScaleAs: double; ScaleAll: double; KoefAs: double; KoefAll: double; PageKoef: double; GetConnHeight: Double; GetLineHeight: Double; PrjCaption: string; ListCaption: string; valInteger: Integer; valDouble: double; begin try // ЛИНЕЙКА ScaleAs := 0; ScaleAll := 0; KoefAs := 0; KoefAll := 0; PageKoef := 0; //21.09.2010 // // МЕТРИЧЕСКАЯ // if F_MasterNewList.gbRulerModeMetric.Visible then // begin // // для показа отдельного отрезка на экране // if F_MasterNewList.rbm1.Checked then // KoefAs := 100; // if F_MasterNewList.rbsm1.Checked then // KoefAs := 1; // if F_MasterNewList.rbmm1.Checked then // KoefAs := 0.1; // if (F_MasterNewList.rbm1.Checked) Or (F_MasterNewList.rbsm1.Checked) Or (F_MasterNewList.rbmm1.Checked) then // begin // if F_MasterNewList.edSizeAsMetric.Text <> '' then // begin // ScaleAs := StrToFloat_My(F_MasterNewList.edSizeAsMetric.Text) * KoefAs; // valDouble := ScaleAs; // if aCADParams.CADMapScale <> valDouble then // begin // GCadForm.PCad.MapScale := valDouble; // ReScaleAllDimLines; // end; // end; // end; // // для отображения общей длинны на странице // if F_MasterNewList.rbm2.Checked then // KoefAll := 1; // if F_MasterNewList.rbsm2.Checked then // KoefAll := 100; // if F_MasterNewList.rbmm2.Checked then // KoefAll := 1000; // if (F_MasterNewList.rbm2.Checked) Or (F_MasterNewList.rbsm2.Checked) Or (F_MasterNewList.rbmm2.Checked) then // begin // if F_MasterNewList.edSizeAllMetric.Text <> '' then // begin // PageKoef := GCadForm.PCad.WorkWidth / 1000; // ScaleAll := StrToFloat_My(F_MasterNewList.edSizeAllMetric.Text) / PageKoef / KoefAll; // valDouble := ScaleAll; // if aCADParams.CADMapScale <> valDouble then // begin // GCadForm.PCad.MapScale := valDouble; // ReScaleAllDimLines; // end; // end; // end; // end // else // // ДЮЙМОВАЯ // if F_MasterNewList.gbRulerModeWhitworth.Visible then // begin // // для показа отдельного отрезка на экране // if F_MasterNewList.rbin1.Checked then // KoefAs := 1; // if F_MasterNewList.rbft1.Checked then // KoefAs := 12; // if (F_MasterNewList.rbin1.Checked) Or (F_MasterNewList.rbft1.Checked) then // begin // if F_MasterNewList.edSizeAsWhitworth.Text <> '' then // begin // ScaleAs := StrToFloat_My(F_MasterNewList.edSizeAsWhitworth.Text) * KoefAs; // valDouble := ScaleAs; // if aCADParams.CADMapScale <> valDouble then // begin // GCadForm.PCad.MapScale := valDouble; // ReScaleAllDimLines; // end; // end; // end; // // для отображения общей длинны на странице // if F_MasterNewList.rbin2.Checked then // KoefAll := 12; // if F_MasterNewList.rbft2.Checked then // KoefAll := 1; // if (F_MasterNewList.rbin2.Checked) Or (F_MasterNewList.rbft2.Checked) then // begin // if F_MasterNewList.edSizeAllWhitworth.Text <> '' then // begin // PageKoef := GCadForm.PCad.WorkWidth / 304.8 {/ 1000}; // ScaleAll := StrToFloat_My(F_MasterNewList.edSizeAllWhitworth.Text) / PageKoef / KoefAll; // valDouble := ScaleAll; // if aCADParams.CADMapScale <> valDouble then // begin // GCadForm.PCad.MapScale := valDouble; // ReScaleAllDimLines; // end; // end; // end; // end; //21.09.2010 valDouble := F_MasterNewList.CheckMapScaleResult; if (aCADParams.CADMapScale <> valDouble) or (GCadForm.PCad.MapScale <> valDouble) then begin GCadForm.PCad.MapScale := valDouble; ReScaleAllDimLines; end; // *** // коррекция шага сетки valDouble := StrToFloat_My(F_MasterNewList.edStepGrid.Text); if valDouble = 0 then valDouble := 0.1; if aCADParams.CADGridStep <> valDouble then GCadForm.PCad.GridStep := valDouble; // Просто присвоить имена объектам по формату SetShowNameTypeInCAD(GCadForm.FShowObjectCaptionsType); SetShowNameTypeInCAD(GCadForm.FShowObjectNotesType); UpdateForLayers; PrjCaption := GetCurrProjectParams.Caption; ListCaption := GetListParams(GCadForm.FCADListID).Caption; // ИМЯ ЛИСТА if F_MasterNewList.edListName.Text <> '' then begin GCadForm.FCADListName := F_MasterNewList.edListName.Text; GCadForm.FCADProjectName := GetCurrProjectName; GCadForm.Caption := PrjCaption + ' - ' + ListCaption; end; SetNewListNameInPM(GCadForm.FCADListID, GCadForm.FCADListName); FSCS_Main.pageCADList.ActivePage.Caption := ListCaption; for i := 0 to FSCS_Main.mainWindow.Count - 1 do begin if FSCS_Main.mainWindow.Items[i].Checked then break; end; FSCS_Main.mainWindow.Items[i].Caption := ListCaption; // тип отображения сетей GCadForm.FShowNetworkTypes := []; if F_MasterNewList.cbAllNetworks.Checked then GCadForm.FShowNetworkTypes := [nt_All]; if F_MasterNewList.cbComputerNetwork.Enabled then if F_MasterNewList.cbComputerNetwork.Checked then GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Computer]; if F_MasterNewList.cbTelephonNetwork.Enabled then if F_MasterNewList.cbTelephonNetwork.Checked then GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Telephon]; if F_MasterNewList.cbElectricNetwork.Enabled then if F_MasterNewList.cbElectricNetwork.Checked then GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Electric]; if F_MasterNewList.cbTelevisionNetwork.Enabled then if F_MasterNewList.cbTelevisionNetwork.Checked then GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Television]; if F_MasterNewList.cbGasNetwork.Enabled then if F_MasterNewList.cbGasNetwork.Checked then GCadForm.FShowNetworkTypes := GCadForm.FShowNetworkTypes + [nt_Gas]; // тип уголка if F_MasterNewList.rbCornerNone.Checked then GCadForm.FDefaultCornerType := crn_None; if F_MasterNewList.rbCornerOut.Checked then GCadForm.FDefaultCornerType := crn_Out; if F_MasterNewList.rbCornerIn.Checked then GCadForm.FDefaultCornerType := crn_In; if F_MasterNewList.rbCornerVertical.Checked then GCadForm.FDefaultCornerType := crn_Vertical; if F_MasterNewList.rbCornerAdapter.Checked then GCadForm.FDefaultCornerType := crn_Adapter; GCadForm.FKeepLineTypesRules := F_MasterNewList.cbKeepLineTypesRules.Checked; SetDimLinesType(GCadForm.FDimLinesType); SetVisibleCabinetsNumbers(GCadForm.FShowCabinetsNumbers); SetVisibleCabinetsBounds(GCadForm.FShowCabinetsBounds); // тип подписи к трассе if aCADParams.CADLinesCaptions <> GCadForm.FShowLineCaptionsType then begin if GCadForm.FShowLineCaptionsType = skExternalSCS then SetAllTracesUserLength else SetAllTracesAutoLength; end; // проверить все кабинеты, переустановить высоты фальш-потолком если нужно // перепроверить все межэтажные подъемы, после изменения высоты этажа if aCADParams.CADHeightRoom <> GCadForm.FRoomHeight then begin CheckAllCabinetsFalseFloorHeights; SetAllBetweenFloorRaises; end; // применить настройки для всех объектов if F_MasterNewList.cbApplyForAllSCSObjects.Checked then begin GetConnHeight := UOMToMetre(StrToFloat_My(F_MasterNewList.edConnTotal.Text)); GetLineHeight := UOMToMetre(StrToFloat_My(F_MasterNewList.edLineTotal.Text)); ApplyParamsForAllSCSObject(GetConnHeight, GetLineHeight, GCadForm.FShowObjectCaptionsType, GCadForm.FShowObjectNotesType, GCadForm.FShowLineCaptionsType, GCadForm.FShowLineNotesType, aCADParams); ApplyCornerTypeForConnectors(GCadForm.FDefaultCornerType); ApplyCaptionNotesParams(aCADParams); end; // обновить скроллы GCadForm.ChangeScrollsOnChangeListSize; // обновить навигатор ReAssignNavigatorParams; if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin RefreshCAD(GCadForm.PCad); end; except ShowMessage(cCommon_Mes11); F_MasterNewList.ModalResult := mrNone; end; end; procedure SetNewListParamsForMaster(aCADParams: TCADParams); var i: integer; val: double; ScaleAs: double; ScaleAll: double; KoefAs: double; KoefAll: double; PageKoef: double; GetConnHeight: Double; GetLineHeight: Double; PrjCaption: string; ListCaption: string; valInteger: Integer; valDouble: double; FName: string; begin try // ЛИНЕЙКА ScaleAs := 0; ScaleAll := 0; KoefAs := 0; KoefAll := 0; PageKoef := 0; //21.09.2010 // // МЕТРИЧЕСКАЯ // if F_MasterNewListLite.gbRulerModeMetric.Visible then // begin // // для показа отдельного отрезка на экране // if F_MasterNewListLite.rbm1.Checked then // KoefAs := 100; // if F_MasterNewListLite.rbsm1.Checked then // KoefAs := 1; // if F_MasterNewListLite.rbmm1.Checked then // KoefAs := 0.1; // if (F_MasterNewListLite.rbm1.Checked) Or (F_MasterNewListLite.rbsm1.Checked) Or (F_MasterNewListLite.rbmm1.Checked) then // begin // if F_MasterNewListLite.edSizeAsMetric.Text <> '' then // begin // ScaleAs := StrToFloat_My(F_MasterNewListLite.edSizeAsMetric.Text) * KoefAs; // valDouble := ScaleAs; // if aCADParams.CADMapScale <> valDouble then // begin // GCadForm.PCad.MapScale := valDouble; // ReScaleAllDimLines; // end; // end; // end; // // для отображения общей длинны на странице // if F_MasterNewListLite.rbm2.Checked then // KoefAll := 1; // if F_MasterNewListLite.rbsm2.Checked then // KoefAll := 100; // if F_MasterNewListLite.rbmm2.Checked then // KoefAll := 1000; // if (F_MasterNewListLite.rbm2.Checked) Or (F_MasterNewListLite.rbsm2.Checked) Or (F_MasterNewListLite.rbmm2.Checked) then // begin // if F_MasterNewListLite.edSizeAllMetric.Text <> '' then // begin // PageKoef := GCadForm.PCad.WorkWidth / 1000; // ScaleAll := StrToFloat_My(F_MasterNewListLite.edSizeAllMetric.Text) / PageKoef / KoefAll; // valDouble := ScaleAll; // if aCADParams.CADMapScale <> valDouble then // begin // GCadForm.PCad.MapScale := valDouble; // ReScaleAllDimLines; // end; // end; // end; // end // else // // ДЮЙМОВАЯ // if F_MasterNewListLite.gbRulerModeWhitworth.Visible then // begin // // для показа отдельного отрезка на экране // if F_MasterNewListLite.rbin1.Checked then // KoefAs := 1; // if F_MasterNewListLite.rbft1.Checked then // KoefAs := 12; // if (F_MasterNewListLite.rbin1.Checked) Or (F_MasterNewListLite.rbft1.Checked) then // begin // if F_MasterNewListLite.edSizeAsWhitworth.Text <> '' then // begin // ScaleAs := StrToFloat_My(F_MasterNewListLite.edSizeAsWhitworth.Text) * KoefAs; // valDouble := ScaleAs; // if aCADParams.CADMapScale <> valDouble then // begin // GCadForm.PCad.MapScale := valDouble; // ReScaleAllDimLines; // end; // end; // end; // // для отображения общей длинны на странице // if F_MasterNewListLite.rbin2.Checked then // KoefAll := 12; // if F_MasterNewListLite.rbft2.Checked then // KoefAll := 1; // if (F_MasterNewListLite.rbin2.Checked) Or (F_MasterNewListLite.rbft2.Checked) then // begin // if F_MasterNewListLite.edSizeAllWhitworth.Text <> '' then // begin // PageKoef := GCadForm.PCad.WorkWidth / 304.8 {/ 1000}; // ScaleAll := StrToFloat_My(F_MasterNewListLite.edSizeAllWhitworth.Text) / PageKoef / KoefAll; // valDouble := ScaleAll; // if aCADParams.CADMapScale <> valDouble then // begin // GCadForm.PCad.MapScale := valDouble; // ReScaleAllDimLines; // end; // end; // end; // // end; //21.09.2010 valDouble := F_MasterNewListLite.CheckMapScaleResult; if (aCADParams.CADMapScale <> valDouble) or (GCadForm.PCad.MapScale <> valDouble) then begin GCadForm.PCad.MapScale := valDouble; ReScaleAllDimLines; end; // *** PrjCaption := GetCurrProjectParams.Caption; ListCaption := GetListParams(GCadForm.FCADListID).Caption; // ИМЯ ЛИСТА if F_MasterNewList.edListName.Text <> '' then begin GCadForm.FCADListName := F_MasterNewList.edListName.Text; GCadForm.FCADProjectName := GetCurrProjectName; GCadForm.Caption := PrjCaption + ' - ' + ListCaption; end; SetNewListNameInPM(GCadForm.FCADListID, GCadForm.FCADListName); FSCS_Main.pageCADList.ActivePage.Caption := ListCaption; for i := 0 to FSCS_Main.mainWindow.Count - 1 do begin if FSCS_Main.mainWindow.Items[i].Checked then break; end; FSCS_Main.mainWindow.Items[i].Caption := ListCaption; if (F_MasterNewListLite.edSubPath.Text <> '') and (FileExists(F_MasterNewListLite.edSubPath.Text)) then begin FName := F_MasterNewListLite.edSubPath.Text; LoadSubWithMaster(FName); end; // обновить скроллы GCadForm.ChangeScrollsOnChangeListSize; // обновить навигатор ReAssignNavigatorParams; if (GCadForm <> nil) and (GCadForm.PCad <> nil) then RefreshCAD(GCadForm.PCad); except ShowMessage(cCommon_Mes11); F_MasterNewList.ModalResult := mrNone; end; end; procedure ApplyCaptionNotesParams(aCADParams: TCADParams); var i, j: Integer; CurrLine: TOrthoLine; CurrConn: TConnectorObject; valBool: Boolean; isApply: Boolean; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin // Conns if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin CurrConn := TConnectorObject(GCadForm.PCad.Figures[i]); // Selected if not F_MasterNewList.cbApplyForSelectedOnly.Checked then isApply := True else begin if CurrConn.Selected then isApply := True else isApply := False; end; // if isApply then begin if CurrConn.ConnectorType <> ct_Clear then begin // ПРИМЕНИТЬ if TCheckBoxState(F_MasterNewList.cbShowConnectorsCaptions.State) <> cbGrayed then begin valBool := F_MasterNewList.cbShowConnectorsCaptions.Checked; CurrConn.ShowCaptions := F_MasterNewList.cbShowConnectorsCaptions.Checked; //26.05.2011 if aCADParams.CADShowConnObjectCaption <> valBool then begin //26.05.2011 if F_MasterNewList.cbShowConnectorsCaptions.Checked then //26.05.2011 CurrConn.ShowCaptions := True //26.05.2011 else //26.05.2011 CurrConn.ShowCaptions := False; CurrConn.ReCreateCaptionsGroup(false, true); end; end; if TCheckBoxState(F_MasterNewList.cbShowConnectorsNotes.State) <> cbGrayed then begin valBool := F_MasterNewList.cbShowConnectorsNotes.Checked; CurrConn.ShowNotes := F_MasterNewList.cbShowConnectorsNotes.Checked; //26.05.2011 if aCADParams.CADShowConnObjectNote <> valBool then begin //26.05.2011 if F_MasterNewList.cbShowConnectorsNotes.Checked then //26.05.2011 CurrConn.ShowNotes := True //26.05.2011 else //26.05.2011 CurrConn.ShowNotes := False; CurrConn.ReCreateNotesGroup; end; end; end; end; end; // Lines if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin CurrLine := TOrthoLine(GCadForm.PCad.Figures[i]); // Selected if not F_MasterNewList.cbApplyForSelectedOnly.Checked then isApply := True else begin if CurrLine.Selected then isApply := True else isApply := False; end; // if isApply then begin if not CurrLine.FIsRaiseUpDown then begin // ПРИМЕНИТЬ if TCheckBoxState(F_MasterNewList.cbShowLinesCaptions.State) <> cbGrayed then begin valBool := F_MasterNewList.cbShowLinesCaptions.Checked; CurrLine.ShowCaptions := F_MasterNewList.cbShowLinesCaptions.Checked; //26.05.2011 if aCADParams.CADShowLineObjectCaption <> valBool then begin //26.05.2011if F_MasterNewList.cbShowLinesCaptions.Checked then //26.05.2011 CurrLine.ShowCaptions := True //26.05.2011else //26.05.2011 CurrLine.ShowCaptions := False; CurrLine.ReCreateCaptionsGroup(false, true); end; end; if F_MasterNewList.cbShowLinesLength.Enabled and (TCheckBoxState(F_MasterNewList.cbShowLinesLength.State) <> cbGrayed) then begin valBool := F_MasterNewList.cbShowLinesLength.Checked; CurrLine.ShowLength := F_MasterNewList.cbShowLinesLength.Checked; //26.05.2011 if aCADParams.CADShowLineObjectLength <> valBool then begin //26.05.2011 if F_MasterNewList.cbShowLinesLength.Checked then //26.05.2011 CurrLine.ShowLength := True //26.05.2011 else //26.05.2011 CurrLine.ShowLength := False; CurrLine.UpdateLengthTextBox(false, true); end; end; if TCheckBoxState(F_MasterNewList.cbShowLinesNotes.State) <> cbGrayed then begin valBool := F_MasterNewList.cbShowLinesNotes.Checked; CurrLine.ShowNotes := F_MasterNewList.cbShowLinesNotes.Checked; //26.05.2011 if aCADParams.CADShowLineObjectNote <> valBool then begin //26.05.2011 if F_MasterNewList.cbShowLinesNotes.Checked then //26.05.2011 CurrLine.ShowNotes := True //26.05.2011 else //26.05.2011 CurrLine.ShowNotes := False; CurrLine.ReCreateNotesGroup; end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ApplyCaptionNotesParams', E.Message); end; end; procedure SetTraceLimitStatus(AID_List, AID_Object: Integer; AStatus: Boolean); var FFigure: TFigure; CurrCadForm: TF_CAD; begin try CurrCadForm := GetListByID(AID_List); if CurrCadForm <> nil then begin FFigure := GetFigureByID(CurrCadForm, AID_Object); if FFigure <> nil then if CheckFigureByClassName(FFigure, cTOrthoLine) then TOrthoLine(FFigure).IsLengthAboveLimit := AStatus; end; except on E: Exception do addExceptionToLogEx('U_Common.SetTraceLimitStatus', E.Message); end; end; procedure CreateDesignList(ABox: TConnectorObject); var ListParams: TListParams; CadFormFromBox: TF_CAD; begin try CadFormFromBox := GCadForm; ListParams := GetListParamsForNewList; ListParams.Caption := GetListDesignedName(ABox.ID); ListParams.Name := ListParams.Caption; ListParams.MarkID := 0; ListParams.Settings.ListType := lt_DesignBox; ListParams.Settings.IDFigureForDesignList := ABox.ID; ListParams.Settings.IDListForDesignList := GCadForm.FCADListID; MakeEditList(meMake, ListParams, False); ABox.FJoinedListIDForBox := GCadForm.FCADListID; GCadForm.FDesignListShowName := F_ChooseDesignBoxParams.cbShowDesignBoxName.Checked; GCadForm.FDesignListShowSign := F_ChooseDesignBoxParams.cbShowDesignBoxSign.Checked; GCadForm.FDesignListShowMark := F_ChooseDesignBoxParams.cbShowDesignBoxMark.Checked; UpdateDesignList(GCadForm, ABox); except on E: Exception do addExceptionToLogEx('U_Common.CreateDesignList', E.Message); end; end; procedure OpenDesignList(ABox: TConnectorObject; AList: TF_CAD); var i: integer; begin try AList.BringToFront; if AList.WindowState <> wsMaximized then AList.WindowState := wsMaximized; UpdateDesignList(AList, ABox); except on E: Exception do addExceptionToLogEx('U_Common.OpenDesignList', E.Message); end; end; procedure CreateOpenDesignListFromPM(AID_List, AID_Box: Integer); var FFigure: TFigure; FList: TF_CAD; begin try FList := GetListByID(AID_List); if FList <> nil then begin FFigure := GetFigureByID(FList, AID_Box); if FFigure <> nil then begin GPopupFigure := FFigure; FSCS_Main.aDesignBox.Execute; end; end; except on E: Exception do addExceptionToLogEx('CreateOpenDesignListFromPM', E.Message); end; end; procedure UpdateDesignList(AList: TF_CAD; ABox: TConnectorObject); var i, j: integer; FileName: string; TopIndent, LeftIndent: Double; DesignParams: TComponentDesignParams; aDescription, aName, aSign, aMark, ServiceStr, str: string; aWidth: Double; aHeightM: Double; aHeightU: Double; OldBoxHeight, OldBoxWidth: Double; NewBoxHeight, NewBoxWidth: Double; BoxHeightKoef, BoxWidthKoef: Double; SlotsWidth: Double; RulerHeight: Double; CadRulerWidth: Double; CadRulerHeight: Double; BegDrawPoint: TDoublePoint; ComponHeight, ComponWidth: Double; OldComponHeight, OldComponWidth: Double; ToBoxPoints: TDoublePoint; ListFormatKoef: Double; aTopBound, aBottomBound, aLeftBound, aRightBound: Double; DescrObject: TRichText; DescrInsObject: TRichText; DescrPoints: TDoublePoint; DescrLHandle: Integer; BlockFig: TBlock; ComponsList: TObjectList; aGraphicalImage: TMemoryStream; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; FigureGrp: TFigureGrp; ListX: double; PanelsHeightBefore: Double; //27.04.2011 Koef1, Koef2, PanelsHeight: Double; //27.04.2011 NeedApplayKoef: boolean; UCount: integer; StampObject: TFigureGrp; UpperStampObj: TRectangle; LHandle: integer; TextField: TRichText; begin try //Koef1_m := 1.227; //Koef2_m := 0.186; {0.1135} Koef1 := 1.01; //1 //0.99; Koef2 := 0.99; //1; NewBoxWidth := 0; //#From Oleg# //14.09.2010 ListFormatKoef := 1; //#From Oleg# //14.09.2010 SlotsWidth := 0; //#From Oleg# //14.09.2010 Alist.PCad.RecordUndo := False; Alist.PCad.UndoCount := 0; {$if Defined(ES_GRAPH_SC)} FileName := ExeDir + '\.blk\TempStream.pwb'; {$else} FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.pwb'; {$ifend} TopIndent := 2.5 + 10 + 15; LeftIndent := 20 + 2; ToBoxPoints.x := 0; ToBoxPoints.y := 0; AList.PCad.Clear(1); ComponsList := GetFigureComponGraphicalImage(ABox.ID); PanelsHeightBefore := 0; PanelsHeight := 0; if Assigned(ComponsList) then begin for i := 0 to ComponsList.Count - 1 do begin DesignParams := TComponentDesignParams(ComponsList[i]); aGraphicalImage := TMemoryStream(DesignParams.GraphicalImage); aDescription := DesignParams.Description; aName := DesignParams.Name; aSign := DesignParams.NameShort; aMark := DesignParams.NameMark; ServiceStr := '; '; aWidth := DesignParams.Width * 100; aHeightM := DesignParams.Height * 100; aHeightU := DesignParams.HeightInUnits; // по свойствам Дизайна Шкафа сформировать подписи aDescription := ''; if GCadForm.FDesignListShowName then aDescription := aDescription + aName; if GCadForm.FDesignListShowSign then aDescription := aDescription + ServiceStr + aSign; if GCadForm.FDesignListShowMark then aDescription := aDescription + ServiceStr + aMark; BlockFig := nil; if aGraphicalImage <> nil then begin aGraphicalImage.SaveToFile(FileName); BlockFig := TBlock(AList.PCad.InsertBlockwithFileName(1, FileName, LeftIndent, TopIndent)); end else begin if (i <> 0) then begin //StampObject := TFigureGrp.create(1, AList.PCad); LHandle := AList.PCad.GetLayerHandle(1); UpperStampObj := TRectangle.create(0, 0, 70, 20, 2, ord(psSolid), clBlack, ord(bsClear), clRed, LHandle, mydsNormal, AList.PCad); TextField := TRichText.create(15, 8, 60, 15, 1, ord(psSolid), clRed, ord(bsClear), clNone, LHandle, mydsNormal, AList.PCad); TextField.re.WordWrap := True; TextField.re.Font.Name := AList.FFontName; TextField.re.Font.Size := 14; TextField.re.Font.Style := [fsBold]; TextField.re.Font.Color := clRed; TextField.re.Lines.Clear; TextField.re.Lines.Add('NO IMAGE'); BlockFig := TBlock.Create(LHandle, AList.PCad); BlockFig.AddFigure(UpperStampObj); BlockFig.AddFigure(TextField); AList.PCad.AddCustomFigure(1, BlockFig, False); end; end; // Сам ШКАФ if (i = 0) and (aGraphicalImage <> nil) then begin aTopBound := DesignParams.TopBound * 100; aBottomBound := DesignParams.BottomBound * 100; aLeftBound := DesignParams.LeftBound * 100; aRightBound := DesignParams.RightBound * 100; ListFormatKoef := CalcListFormatKoef(aWidth, aHeightM, AList); OldBoxWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; OldBoxHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; ReScaleImage(BlockFig, OldBoxWidth, OldBoxHeight, aWidth * ListFormatKoef, aHeightM * ListFormatKoef); NewBoxWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; NewBoxHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; BlockFig.move(BlockFig.CenterPoint.x + NewBoxWidth / 2, BlockFig.CenterPoint.y + NewBoxHeight / 2); BoxHeightKoef := NewBoxHeight / OldBoxHeight; BoxWidthKoef := NewBoxWidth / OldBoxWidth; aTopBound := aTopBound * BoxHeightKoef; aBottomBound := aBottomBound * BoxHeightKoef; aLeftBound := aLeftBound * BoxWidthKoef; aRightBound := aRightBound * BoxWidthKoef; SlotsWidth := NewBoxWidth - aLeftBound - aRightBound; // ToBoxPoints.x := BlockFig.CenterPoint.x //ToBoxPoints.x := BlockFig.CenterPoint.x + (aLeftBound - aRightBound)/2 * ListFormatKoef; ToBoxPoints.x := BlockFig.CenterPoint.x + (aLeftBound - aRightBound)/2; ToBoxPoints.y := BlockFig.CenterPoint.y - NewBoxHeight / 2 + aTopBound; // нарисовать линейку RulerHeight := aHeightM; RulerHeight := aHeightU; CadRulerWidth := aRightBound; CadRulerHeight := NewBoxHeight - aTopBound - aBottomBound; BegDrawPoint.x := LeftIndent * 2 + NewBoxWidth - aRightBound; BegDrawPoint.y := TopIndent * 2 + NewBoxHeight - aBottomBound; // DrawDesignRulerInMetres(AList, RulerHeight, CadRulerWidth, CadRulerHeight, BegDrawPoint); DrawDesignRulerInUnits(AList, RulerHeight, CadRulerWidth, CadRulerHeight, BegDrawPoint); end else // Его комплектующие begin ComponWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; ComponHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; PanelsHeightBefore := PanelsHeightBefore + ComponHeight; NeedApplayKoef := False; for j := 0 to BlockFig.InFigures.Count - 1 do begin if (TFigure(BlockFig.inFigures[j]) is TWMFObject) or (TFigure(BlockFig.inFigures[j]) is TBMPObject) then begin NeedApplayKoef := True; break; end; end; if NeedApplayKoef then begin //ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth{aWidth * ListFormatKoef}, koef1_m * aHeightM * ListFormatKoef); //ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth, aHeightM * ListFormatKoef + koef1 * ListFormatKoef); UCount := Trunc(aHeightM / 4.374); ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth, aHeightM * ListFormatKoef + (koef1 - (0.006 * UCount)) * ListFormatKoef); ComponHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; ComponWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; //ComponHeight := ComponHeight - ComponHeight * koef2_m; //ComponHeight := ComponHeight - (koef2 * ListFormatKoef); ComponHeight := ComponHeight - ( (koef2 - (0.006 * UCount)) * ListFormatKoef); end else begin ReScaleImage(BlockFig, ComponWidth, ComponHeight, SlotsWidth {aWidth * ListFormatKoef}, aHeightM * ListFormatKoef); ComponHeight := BlockFig.GetBoundRect.Bottom - BlockFig.GetBoundRect.Top; ComponWidth := BlockFig.GetBoundRect.Right - BlockFig.GetBoundRect.Left; end; ToBoxPoints.y := ToBoxPoints.y + ComponHeight / 2; PanelsHeight := PanelsHeight + ComponHeight; //27.04.2011 BlockFig.move(ToBoxPoints.x - BlockFig.CenterPoint.x, ToBoxPoints.y - BlockFig.CenterPoint.y); // Вывести описание DescrPoints.x := LeftIndent * 2 + NewBoxWidth + 2; DescrPoints.y := ToBoxPoints.y - 3;{3 * ListFormatKoef}; DescrLHandle := AList.PCad.GetLayerHandle(1); // СОЗДАНИЕ ТЕКСТА ОПИСАНИЯ DescrObject := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, DescrLHandle, mydsNormal, AList.PCad); DescrObject.re.WordWrap := False; DescrObject.re.Font.Name := AList.FFontName; DescrObject.re.Font.Size := 12; // 14 DescrObject.re.Font.Style := []; DescrObject.re.Lines.Clear; DescrObject.re.Lines.Add(aDescription); xCanvas := TMetafileCanvas.Create(DescrObject.Metafile, 0); xCanvas.Font.Name := DescrObject.re.Font.Name; xCanvas.Font.Size := DescrObject.re.Font.Size; xCanvas.Font.Style := DescrObject.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4; w := (xCanvas.TextWidth(DescrObject.Re.Lines[0]) + 3) / 4; FreeAndNil(xCanvas); FreeAndNil(DescrObject); DescrObject := TRichText.create(DescrPoints.x, DescrPoints.y, DescrPoints.x + w, DescrPoints.y + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, DescrLHandle, mydsNormal, AList.PCad); DescrObject.re.WordWrap := False; DescrObject.re.Font.Name := AList.FFontName; DescrObject.re.Font.Size := 12; // 14 DescrObject.re.Font.Style := []; DescrObject.re.Lines.Clear; DescrObject.re.Lines.Add(aDescription); DescrInsObject := TRichText(AList.PCad.AddCustomFigure(1, DescrObject, False)); // === {$IF Defined(SCS_PE) or Defined(BASEADM_SCS) or Defined(SCS_PANDUIT)} AList.PCad.DeselectAll(1); BlockFig.Select; DescrInsObject.Select; AList.PCad.GroupSelection; {$IFEND} ToBoxPoints.y := ToBoxPoints.y + ComponHeight / 2; end; if BlockFig <> nil then BlockFig.Deselect; if (i = 0) and (aGraphicalImage = nil) then begin ShowMessage(cCommon_Mes12); if ComponsList <> nil then FreeAndNil(ComponsList); Alist.PCad.RecordUndo := True; Alist.PCad.UndoCount := 0; Exit; end; //else // ToBoxPoints.y := ToBoxPoints.y + aHeightM * ListFormatKoef; //01.10.2012 end; AList.PCad.SelectAll(1); AList.PCad.GroupSelection; FigureGrp := TFigureGrp(AList.PCad.Selection[0]); NewBoxWidth := FigureGrp.GetBoundRect.Right - FigureGrp.GetBoundRect.Left; ListX := AList.PCad.WorkWidth - (15 + 10 + 2 * 5) / 2; // сместить полностью if NewBoxWidth > ListX then begin FigureGrp.Scale(ListX / NewBoxWidth, ListX / NewBoxWidth); FigureGrp.move(LeftIndent - FigureGrp.ap1.x, TopIndent - FigureGrp.ap1.y); end else // сместить только вверх begin FigureGrp.move(LeftIndent - FigureGrp.ap1.x, TopIndent - FigureGrp.ap1.y); end; end; if ComponsList <> nil then FreeAndNil(ComponsList); // AList.CurrentLayer := 1; {$IF Defined(SCS_PE) or Defined(BASEADM_SCS) or Defined(SCS_PANDUIT)} //if FigureGrp <> nil then // FigureGrp.UnGroup; AList.PCad.UngroupSelection; AList.PCad.DeselectAll(1); {$IFEND} RefreshCAD(AList.PCad); Alist.PCad.RecordUndo := True; Alist.PCad.UndoCount := 0; str := GetListParams(AList.FCADListID).Caption; LoadCaptionsOnFrame(AList, GetListParams(AList.FCADListID).Settings.CADStampType); except on E: Exception do addExceptionToLogEx('U_Common.UpdateDesignList', E.Message); end; end; procedure UpdateDesignListOnBoxChange(AListID: Integer; ABoxID: Integer); var Box: TConnectorObject; BoxList: TF_CAD; DesingList: TF_CAD; begin try BoxList := GetListByID(AListID); if BoxList <> nil then begin Box := TConnectorObject(GetFigureByID(BoxList, ABoxID)); if Box <> nil then begin if Box.FJoinedListIDForBox <> - 1 then begin DesingList := GetListByID(Box.FJoinedListIDForBox); if DesingList <> nil then UpdateDesignList(DesingList, Box); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.UpdateDesignListOnBoxChange', E.Message); end; end; procedure ReScaleImage(aBlock: TBlock; aCurrX, aCurrY, aTotalX, aTotalY: Double); var i: integer; KoefX, KoefY: double; FFigure: TFigure; isScaled: Boolean; begin try KoefX := aTotalX / aCurrX; KoefY := aTotalY / aCurrY; isScaled := True; for i := 0 to aBlock.InFigures.Count - 1 do begin FFigure := TFigure(aBlock.InFigures[i]); if CheckFigureByClassName(FFigure, 'TWMFObject') then begin FFigure.Scale(KoefX, KoefY, FFigure.CenterPoint); isScaled := False; end; end; if isScaled then ABlock.scale(KoefX, KoefY, aBlock.CenterPoint); except on E: Exception do addExceptionToLogEx('U_Common.ReScaleImage', E.Message); end; end; function CalcListFormatKoef(aBoxWidth, aBoxHeight: Double; AList: TF_CAD): Double; var ListWidth: Double; ListHeight: Double; LimitWidth: Double; LimitHeight: Double; KoefWidth: Double; KoefHeight: Double; ListBottomParam: Double; begin Result := 0; try ListWidth := AList.PCad.WorkWidth; ListHeight := AList.PCad.WorkHeight; ListBottomParam := 0; //#From Oleg# //14.09.2010 if AList.FCadStampType = stt_simple then ListBottomParam := 15 else if AList.FCadStampType = stt_extended then ListBottomParam := 40 else if AList.FCadStampType = stt_detailed then ListBottomParam := 55; LimitWidth := ListWidth - (15 + 10 + 2 * 5) / 2; LimitHeight := ListHeight - (5 + 10 + ListBottomParam + 2 * 5 + 20); KoefWidth := LimitWidth / aBoxWidth; KoefHeight := LimitHeight / aBoxHeight; if KoefWidth < KoefHeight then Result := KoefWidth else Result := KoefHeight; except on E: Exception do addExceptionToLogEx('U_Common.CalcListFormatKoef', E.Message); end; end; procedure DrawDesignRulerInMetres(aList: TF_CAD; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint); var i: integer; Step: Double; MarkCount: Integer; LimitStep: Double; x1, y1, x2, y2: double; textx, texty: double; LHandle: Integer; LineObject: TLine; TextObject: TText; aTextHeight: Double; aTextWidth: Double; TextGroupObject: TFigureGrp; TextGroupList: TList; begin try LHandle := 0; //#From Oleg# //14.09.2010 LimitStep := 2; Step := aCadRulerHeight / aRulerHeight; MarkCount := Round(aRulerHeight); TextGroupList := TList.Create; for i := 0 to MarkCount - 1 do begin x1 := aBeginDrawPoint.x; y1 := aBeginDrawPoint.y - i * Step; y2 := aBeginDrawPoint.y - i * Step; if (i mod 10) = 0 then begin x2 := aBeginDrawPoint.x + 0.7 * aCadRulerWidth; aTextHeight := 3; aTextWidth := 1.5; end else if (i mod 5) = 0 then begin x2 := aBeginDrawPoint.x + 0.5 * aCadRulerWidth; aTextHeight := 2; aTextWidth := 1; end else begin x2 := aBeginDrawPoint.x + 0.3 * aCadRulerWidth; aTextHeight := 1.5; aTextWidth := 0.75; end; if Step < LimitStep then begin if (i mod 5) = 0 then begin LHandle := aList.PCad.GetLayerHandle(1); LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aList.PCad); LineObject.LockModify := True; LineObject.LockMove := True; TextObject := TText.Create(x2, y2, aTextHeight, aTextWidth, IntToStr(i), GCadForm.FFontName, RUSSIAN_CHARSET, clBlack, LHandle, mydsNormal, aList.PCad); TextObject.Move(- TextObject.TextLength, - TextObject.TextHeight); TextObject.LockModify := True; TextObject.LockMove := True; TextGroupList.Add(LineObject); TextGroupList.Add(TextObject); end end else begin LHandle := aList.PCad.GetLayerHandle(1); LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aList.PCad); LineObject.LockModify := True; LineObject.LockMove := True; TextGroupList.Add(LineObject); if (i mod 5) = 0 then begin TextObject := TText.Create(x2, y2, aTextHeight, aTextWidth, IntToStr(i), GCadForm.FFontName, RUSSIAN_CHARSET, clBlack, LHandle, mydsNormal, aList.PCad); TextObject.Move(- TextObject.TextLength, - TextObject.TextHeight); TextObject.LockModify := True; TextObject.LockMove := True; TextGroupList.Add(TextObject); end; end; end; TextGroupObject := TFigureGrp.create(LHandle, aList.PCad); for i := 0 to TextGroupList.Count - 1 do TextGroupObject.AddFigure(TFigure(TextGroupList[i])); aList.PCad.AddCustomFigure(1, TextGroupObject, False); if TextGroupList <> nil then FreeAndNil(TextGroupList); except on E: Exception do addExceptionToLogEx('U_Common.DrawDesignRulerInMetres', E.Message); end; end; procedure DrawDesignRulerInUnits(aList: TF_CAD; aRulerHeight, aCadRulerWidth, aCadRulerHeight: Double; aBeginDrawPoint: TDoublePoint); var i: integer; Step: Double; MarkCount: Integer; LimitStep: Double; x1, y1, x2, y2: double; textx, texty: double; LHandle: Integer; LineObject: TLine; TextObject: TRichText; aTextHeight: Double; aTextWidth: Double; TextGroupObject: TFigureGrp; TextGroupList: TList; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; begin try LimitStep := 2; Step := aCadRulerHeight / aRulerHeight; MarkCount := Round(aRulerHeight); TextGroupList := TList.Create; for i := 0 to MarkCount - 1 do begin x1 := aBeginDrawPoint.x; y1 := aBeginDrawPoint.y - i * Step; y2 := aBeginDrawPoint.y - i * Step; if (i mod 5) = 0 then begin x2 := aBeginDrawPoint.x + 0.7 * aCadRulerWidth; aTextHeight := 3; aTextWidth := 1.5; end else begin x2 := aBeginDrawPoint.x + 0.5 * aCadRulerWidth; aTextHeight := 2; aTextWidth := 1; end; if Step < LimitStep then begin if (i mod 5) = 0 then begin LHandle := aList.PCad.GetLayerHandle(1); LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aList.PCad); LineObject.LockModify := True; LineObject.LockMove := True; TextObject := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextObject.re.Font.Name := GCadForm.FFontName; TextObject.re.Font.Size := 12; TextObject.re.Font.Style := []; TextObject.re.Lines.Clear; TextObject.re.Lines.Add(IntToStr(i)); xCanvas := TMetafileCanvas.Create(TextObject.Metafile, 0); xCanvas.Font.Name := TextObject.re.Font.Name; xCanvas.Font.Size := TextObject.re.Font.Size; xCanvas.Font.Style := TextObject.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4; w := (xCanvas.TextWidth(TextObject.Re.Lines[0]) + 3) / 4; FreeAndNil(xCanvas); FreeAndNil(TextObject); TextObject := TRichText.create(x2, y2, x2 + w, y2 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextObject.re.Font.Name := GCadForm.FFontName; TextObject.re.Font.Size := 12; TextObject.re.Font.Style := []; TextObject.re.Lines.Clear; TextObject.re.Lines.Add(IntToStr(i)); TextObject.Move(- w, - h); TextObject.LockModify := True; TextObject.LockMove := True; TextGroupList.Add(LineObject); TextGroupList.Add(TextObject); end end else begin LHandle := aList.PCad.GetLayerHandle(1); LineObject := TLine.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, aList.PCad); LineObject.LockModify := True; LineObject.LockMove := True; TextGroupList.Add(LineObject); if (i mod 5) = 0 then begin TextObject := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextObject.re.Font.Name := GCadForm.FFontName; TextObject.re.Font.Size := 12; TextObject.re.Font.Style := []; TextObject.re.Lines.Clear; TextObject.re.Lines.Add(IntToStr(i)); xCanvas := TMetafileCanvas.Create(TextObject.Metafile, 0); xCanvas.Font.Name := TextObject.re.Font.Name; xCanvas.Font.Size := TextObject.re.Font.Size; xCanvas.Font.Style := TextObject.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4; w := (xCanvas.TextWidth(TextObject.Re.Lines[0]) + 3) / 4; FreeAndNil(xCanvas); FreeAndNil(TextObject); TextObject := TRichText.create(x2, y2, x2 + w, y2 + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); TextObject.re.Font.Name := GCadForm.FFontName; TextObject.re.Font.Size := 12; TextObject.re.Font.Style := []; TextObject.re.Lines.Clear; TextObject.re.Lines.Add(IntToStr(i)); TextObject.Move(- w, - h); TextObject.LockModify := True; TextObject.LockMove := True; TextGroupList.Add(TextObject); end; end; end; TextGroupObject := TFigureGrp.create(LHandle, aList.PCad); for i := 0 to TextGroupList.Count - 1 do TextGroupObject.AddFigure(TFigure(TextGroupList[i])); aList.PCad.AddCustomFigure(1, TextGroupObject, False); if TextGroupList <> nil then FreeAndNil(TextGroupList); except on E: Exception do addExceptionToLogEx('U_Common.DrawDesignRulerInUnits', E.Message); end; end; procedure DisableActForReadOnlyMode; var i: integer; begin if GReadOnlyMode then begin for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do begin if (FSCS_Main.ActionManager.Actions[i].Category = 'Tools') or (FSCS_Main.ActionManager.Actions[i].Category = 'Инструменты') then (FSCS_Main.ActionManager.Actions[i] as TAction).Enabled := False; end; FSCS_Main.aSaveRevision.Enabled := False; FSCS_Main.aViewRevs.Enabled := False; FSCS_Main.aCreateProjectPlan.Enabled := False; FSCS_Main.aCreateNormsOnCad.Enabled := False; FSCS_Main.aMasterAutoTrace.Enabled := False; FSCS_Main.aMasterAutoTraceElectric.Enabled := False; FSCS_Main.aMasterCableTracing.Enabled := False; FSCS_Main.aMasterCableChannel.Enabled := False; FSCS_Main.aMasterUpdateComponPriceFromXF.Enabled := False; FSCS_Main.aToolSelect.Enabled := True; FSCS_Main.aToolPan.Enabled := True; end; end; procedure EnableOptionsForNormalList; begin try FSCS_Main.aSaveAsSubstrate.Enabled := True; FSCS_Main.aImport.Enabled := True; FSCS_Main.aUndo.Enabled := True; FSCS_Main.aRedo.Enabled := True; FSCS_Main.aCopy.Enabled := True; FSCS_Main.aCut.Enabled := True; FSCS_Main.aPaste.Enabled := True; FSCS_Main.aSelectAll.Enabled := True; FSCS_Main.aViewLayers.Enabled := True; FSCS_Main.aRotate.Enabled := True; FSCS_Main.aBackwards.Enabled := True; FSCS_Main.aForward.Enabled := True; FSCS_Main.aGrouping.Enabled := True; FSCS_Main.aUngrouping.Enabled := True; FSCS_Main.aLock.Enabled := True; FSCS_Main.aUnlock.Enabled := True; FSCS_Main.aObjProperties.Enabled := True; FSCS_Main.aLoadSubstrate.Enabled := True; // FSCS_Main.aViewProjectManager.Enabled := True; FSCS_Main.aDelete.Enabled := True; FSCS_Main.aDeleteAll.Enabled := True; FSCS_Main.aDeSelectAll.Enabled := True; FSCS_Main.aInsertText.Enabled := True; FSCS_Main.aInsertBitmap.Enabled := True; FSCS_Main.aPenStyle.Enabled := True; FSCS_Main.aPenWidth.Enabled := True; FSCS_Main.aRowStyle.Enabled := True; FSCS_Main.aBrushStyle.Enabled := True; FSCS_Main.aTextCharset.Enabled := True; FSCS_Main.aFontStyle.Enabled := True; FSCS_Main.aFormatOrder.Enabled := True; FSCS_Main.aFormatAlign.Enabled := True; FSCS_Main.aSnaptoGrid.Enabled := True; FSCS_Main.aSnaptoGuides.Enabled := True; FSCS_Main.aSnaptoNearObject.Enabled := True; FSCS_Main.aSendtoBack.Enabled := True; FSCS_Main.aBringtoFront.Enabled := True; FSCS_Main.aSendBackwards.Enabled := True; FSCS_Main.aBringForwards.Enabled := True; FSCS_Main.aMoveSelection.Enabled := True; FSCS_Main.aRotateSelection.Enabled := True; FSCS_Main.aDuplicateSelection.Enabled := True; FSCS_Main.aMirrorSelection.Enabled := True; FSCS_Main.aToolLine.Enabled := True; FSCS_Main.aToolRectangle.Enabled := True; FSCS_Main.aToolEllipse.Enabled := True; FSCS_Main.aToolCircle.Enabled := True; FSCS_Main.aToolArc.Enabled := True; FSCS_Main.aToolElipticArc.Enabled := True; FSCS_Main.aToolPolyLine.Enabled := True; FSCS_Main.aToolPoint.Enabled := True; FSCS_Main.aToolText.Enabled := True; FSCS_Main.aToolRichText.Enabled := True; FSCS_Main.aToolKnife.Enabled := True; FSCS_Main.aToolHDimLine.Enabled := True; FSCS_Main.aToolVDimLine.Enabled := True; FSCS_Main.aTextFont.Enabled := True; FSCS_Main.aTextSize.Enabled := True; FSCS_Main.aToolMultiLine.Enabled := True; {$if Not Defined(ES_GRAPH_SC)} FSCS_Main.aToolOrthoLine.Enabled := True; FSCS_Main.aToolOrthoLineExt.Enabled := True; {$ifend} FSCS_Main.aSetSubstrateLayer.Enabled := True; FSCS_Main.aSetSCSLayer.Enabled := True; FSCS_Main.aAutoSelectTrace.Enabled := True; FSCS_Main.aOpenProject.Enabled := True; FSCS_Main.aToolText.Enabled := True; FSCS_Main.aViewSCSObjectsProp.Enabled := True; FSCS_Main.aCreateRaise.Enabled := True; FSCS_Main.aDestroyRaise.Enabled := True; FSCS_Main.aMasterAutoTrace.Enabled := True; FSCS_Main.aRaiseLine.Enabled := True; FSCS_Main.aCreateObjectOnClick.Enabled := True; FSCS_Main.aShowConnFullness.Enabled := True; FSCS_Main.aShowCableFullness.Enabled := True; FSCS_Main.aShowCableChannelFullness.Enabled := True; FSCS_Main.aCreateObjectOnClickTool.Enabled := True; FSCS_Main.aCreateBlockToFile.Enabled := True; FSCS_Main.aCreateBlockToNB.Enabled := True; FSCS_Main.aInsertBlock.Enabled := True; {$if Not Defined(ES_GRAPH_SC)} //30.05.2011 FSCS_Main.aShiftUpObject.Enabled := True; //30.05.2011 FSCS_Main.aShiftDownObject.Enabled := True; //30.05.2011 FSCS_Main.aShiftLeftObject.Enabled := True; //30.05.2011 FSCS_Main.aShiftRightObject.Enabled := True; {$ifend} FSCS_Main.aDesignBox.Enabled := True; FSCS_Main.aShowTracesLengthLimit.Enabled := True; FSCS_Main.aNoMoveConnectedObjects.Enabled := True; // Add FSCS_Main.aLoadFPlan.Enabled := True; FSCS_Main.aSaveFPlan.Enabled := True; {$if Not Defined(ES_GRAPH_SC)} FSCS_Main.aConnectionsConfigurator.Enabled := True; FSCS_Main.aMasterCableTracing.Enabled := True; FSCS_Main.aMasterCableChannel.Enabled := True; FSCS_Main.aToolCabinet.Enabled := True; FSCS_Main.aToolWallRect.Enabled := True; FSCS_Main.aToolWallPath.Enabled := True; {$ifend} FSCS_Main.cbLayers.Enabled := True; FSCS_Main.aExport.Enabled := True; FSCS_Main.aExportDWG.Enabled := True; {$if Not Defined(ES_GRAPH_SC)} FSCS_Main.aToolHouse.Enabled := True; {$ifend} except on E: Exception do addExceptionToLogEx('U_Common.EnableOptionsForNormalList', E.Message); end; DisableActForReadOnlyMode; end; procedure DisableOptionsForDesignList; begin try FSCS_Main.aSaveAsSubstrate.Enabled := False; FSCS_Main.aImport.Enabled := False; FSCS_Main.aUndo.Enabled := True; FSCS_Main.aRedo.Enabled := True; FSCS_Main.aCopy.Enabled := False; FSCS_Main.aCut.Enabled := False; FSCS_Main.aPaste.Enabled := False; FSCS_Main.aSelectAll.Enabled := False; FSCS_Main.aViewLayers.Enabled := False; FSCS_Main.aRotate.Enabled := False; FSCS_Main.aBackwards.Enabled := True; FSCS_Main.aForward.Enabled := True; FSCS_Main.aGrouping.Enabled := True; FSCS_Main.aUngrouping.Enabled := True; FSCS_Main.aLock.Enabled := False; FSCS_Main.aUnlock.Enabled := False; FSCS_Main.aObjProperties.Enabled := False; FSCS_Main.aLoadSubstrate.Enabled := False; // FSCS_Main.aViewProjectManager.Enabled := False; FSCS_Main.aDelete.Enabled := False; FSCS_Main.aDeleteAll.Enabled := False; FSCS_Main.aDeSelectAll.Enabled := False; FSCS_Main.aInsertText.Enabled := True; FSCS_Main.aInsertBitmap.Enabled := True; FSCS_Main.aPenStyle.Enabled := False; FSCS_Main.aPenWidth.Enabled := False; FSCS_Main.aRowStyle.Enabled := False; FSCS_Main.aBrushStyle.Enabled := False; FSCS_Main.aTextCharset.Enabled := False; FSCS_Main.aFontStyle.Enabled := False; FSCS_Main.aFormatOrder.Enabled := False; FSCS_Main.aFormatAlign.Enabled := False; FSCS_Main.aSnaptoGrid.Enabled := False; FSCS_Main.aSnaptoGuides.Enabled := False; FSCS_Main.aSnaptoNearObject.Enabled := False; FSCS_Main.aSendtoBack.Enabled := True; FSCS_Main.aBringtoFront.Enabled := True; FSCS_Main.aSendBackwards.Enabled := True; FSCS_Main.aBringForwards.Enabled := True; FSCS_Main.aMoveSelection.Enabled := False; FSCS_Main.aRotateSelection.Enabled := False; FSCS_Main.aDuplicateSelection.Enabled := False; FSCS_Main.aMirrorSelection.Enabled := False; FSCS_Main.aToolLine.Enabled := False; FSCS_Main.aToolRectangle.Enabled := False; FSCS_Main.aToolEllipse.Enabled := False; FSCS_Main.aToolCircle.Enabled := False; FSCS_Main.aToolArc.Enabled := False; FSCS_Main.aToolElipticArc.Enabled := False; FSCS_Main.aToolPolyLine.Enabled := False; FSCS_Main.aToolPoint.Enabled := False; FSCS_Main.aToolText.Enabled := True; FSCS_Main.aToolRichText.Enabled := True; FSCS_Main.aToolKnife.Enabled := False; FSCS_Main.aToolHDimLine.Enabled := False; FSCS_Main.aToolVDimLine.Enabled := False; FSCS_Main.aTextFont.Enabled := False; FSCS_Main.aTextSize.Enabled := False; FSCS_Main.aToolMultiLine.Enabled := False; FSCS_Main.aToolOrthoLine.Enabled := False; FSCS_Main.aToolOrthoLineExt.Enabled := False; FSCS_Main.aSetSubstrateLayer.Enabled := False; FSCS_Main.aSetSCSLayer.Enabled := False; FSCS_Main.aAutoSelectTrace.Enabled := False; FSCS_Main.aOpenProject.Enabled := False; FSCS_Main.aViewSCSObjectsProp.Enabled := False; FSCS_Main.aCreateRaise.Enabled := False; FSCS_Main.aDestroyRaise.Enabled := False; FSCS_Main.aMasterAutoTrace.Enabled := False; FSCS_Main.aRaiseLine.Enabled := False; FSCS_Main.aNoMoveConnectedObjects.Enabled := False; FSCS_Main.aCreateObjectOnClick.Enabled := False; FSCS_Main.aShowConnFullness.Enabled := False; FSCS_Main.aShowCableFullness.Enabled := False; FSCS_Main.aShowCableChannelFullness.Enabled := False; FSCS_Main.aCreateObjectOnClickTool.Enabled := False; FSCS_Main.aCreateBlockToFile.Enabled := False; FSCS_Main.aCreateBlockToNB.Enabled := False; FSCS_Main.aInsertBlock.Enabled := True; FSCS_Main.aShiftUpObject.Enabled := False; FSCS_Main.aShiftDownObject.Enabled := False; FSCS_Main.aShiftLeftObject.Enabled := False; FSCS_Main.aShiftRightObject.Enabled := False; FSCS_Main.aDesignBox.Enabled := False; FSCS_Main.aShowTracesLengthLimit.Enabled := False; // FSCS_Main.cbLayers.Clear; FSCS_Main.cbLayers.Enabled := False; // Add FSCS_Main.aLoadFPlan.Enabled := False; FSCS_Main.aSaveFPlan.Enabled := False; FSCS_Main.aConnectionsConfigurator.Enabled := False; FSCS_Main.aMasterCableTracing.Enabled := False; FSCS_Main.aMasterCableChannel.Enabled := False; FSCS_Main.aToolCabinet.Enabled := False; FSCS_Main.aToolWallRect.Enabled := False; FSCS_Main.aToolWallPath.Enabled := False; FSCS_Main.aExport.Enabled := True; FSCS_Main.aExportDWG.Enabled := True; FSCS_Main.aToolHouse.Enabled := False; except on E: Exception do addExceptionToLogEx('U_Common.DisableOptionsForDesignList', E.Message); end; end; procedure DisableOptionsForProjectPlan; begin try FSCS_Main.aSaveAsSubstrate.Enabled := False; FSCS_Main.aImport.Enabled := False; FSCS_Main.aUndo.Enabled := True; FSCS_Main.aRedo.Enabled := True; FSCS_Main.aCopy.Enabled := False; FSCS_Main.aCut.Enabled := False; FSCS_Main.aPaste.Enabled := False; FSCS_Main.aSelectAll.Enabled := False; FSCS_Main.aViewLayers.Enabled := False; FSCS_Main.aRotate.Enabled := False; FSCS_Main.aBackwards.Enabled := False; FSCS_Main.aForward.Enabled := False; FSCS_Main.aGrouping.Enabled := False; FSCS_Main.aUngrouping.Enabled := False; FSCS_Main.aLock.Enabled := False; FSCS_Main.aUnlock.Enabled := False; FSCS_Main.aObjProperties.Enabled := False; FSCS_Main.aLoadSubstrate.Enabled := False; // FSCS_Main.aViewProjectManager.Enabled := False; FSCS_Main.aDelete.Enabled := False; FSCS_Main.aDeleteAll.Enabled := False; FSCS_Main.aDeSelectAll.Enabled := False; FSCS_Main.aInsertText.Enabled := True; FSCS_Main.aInsertBitmap.Enabled := True; FSCS_Main.aPenStyle.Enabled := False; FSCS_Main.aPenWidth.Enabled := False; FSCS_Main.aRowStyle.Enabled := False; FSCS_Main.aBrushStyle.Enabled := False; FSCS_Main.aTextCharset.Enabled := False; FSCS_Main.aFontStyle.Enabled := False; FSCS_Main.aFormatOrder.Enabled := False; FSCS_Main.aFormatAlign.Enabled := False; FSCS_Main.aSnaptoGrid.Enabled := False; FSCS_Main.aSnaptoGuides.Enabled := False; FSCS_Main.aSnaptoNearObject.Enabled := False; FSCS_Main.aSendtoBack.Enabled := False; FSCS_Main.aBringtoFront.Enabled := False; FSCS_Main.aSendBackwards.Enabled := False; FSCS_Main.aBringForwards.Enabled := False; FSCS_Main.aMoveSelection.Enabled := False; FSCS_Main.aRotateSelection.Enabled := False; FSCS_Main.aDuplicateSelection.Enabled := False; FSCS_Main.aMirrorSelection.Enabled := False; FSCS_Main.aToolLine.Enabled := False; FSCS_Main.aToolRectangle.Enabled := False; FSCS_Main.aToolEllipse.Enabled := False; FSCS_Main.aToolCircle.Enabled := False; FSCS_Main.aToolArc.Enabled := False; FSCS_Main.aToolElipticArc.Enabled := False; FSCS_Main.aToolPolyLine.Enabled := False; FSCS_Main.aToolPoint.Enabled := False; FSCS_Main.aToolText.Enabled := False; FSCS_Main.aToolRichText.Enabled := False; FSCS_Main.aToolKnife.Enabled := False; FSCS_Main.aToolHDimLine.Enabled := False; FSCS_Main.aToolVDimLine.Enabled := False; FSCS_Main.aTextFont.Enabled := False; FSCS_Main.aTextSize.Enabled := False; FSCS_Main.aToolMultiLine.Enabled := False; FSCS_Main.aToolOrthoLine.Enabled := False; FSCS_Main.aToolOrthoLineExt.Enabled := False; FSCS_Main.aSetSubstrateLayer.Enabled := False; FSCS_Main.aSetSCSLayer.Enabled := False; FSCS_Main.aAutoSelectTrace.Enabled := False; FSCS_Main.aOpenProject.Enabled := False; FSCS_Main.aViewSCSObjectsProp.Enabled := False; FSCS_Main.aCreateRaise.Enabled := False; FSCS_Main.aDestroyRaise.Enabled := False; FSCS_Main.aMasterAutoTrace.Enabled := False; FSCS_Main.aRaiseLine.Enabled := False; FSCS_Main.aNoMoveConnectedObjects.Enabled := False; FSCS_Main.aCreateObjectOnClick.Enabled := False; FSCS_Main.aShowConnFullness.Enabled := False; FSCS_Main.aShowCableFullness.Enabled := False; FSCS_Main.aShowCableChannelFullness.Enabled := False; FSCS_Main.aCreateObjectOnClickTool.Enabled := False; FSCS_Main.aCreateBlockToFile.Enabled := False; FSCS_Main.aCreateBlockToNB.Enabled := False; FSCS_Main.aInsertBlock.Enabled := True; FSCS_Main.aShiftUpObject.Enabled := False; FSCS_Main.aShiftDownObject.Enabled := False; FSCS_Main.aShiftLeftObject.Enabled := False; FSCS_Main.aShiftRightObject.Enabled := False; FSCS_Main.aDesignBox.Enabled := False; FSCS_Main.aShowTracesLengthLimit.Enabled := False; // FSCS_Main.cbLayers.Clear; FSCS_Main.cbLayers.Enabled := False; // Add FSCS_Main.aLoadFPlan.Enabled := False; FSCS_Main.aSaveFPlan.Enabled := False; FSCS_Main.aConnectionsConfigurator.Enabled := False; FSCS_Main.aMasterCableTracing.Enabled := False; FSCS_Main.aMasterCableChannel.Enabled := False; FSCS_Main.aExport.Enabled := True; FSCS_Main.aExportDWG.Enabled := True; FSCS_Main.aToolHouse.Enabled := False; except on E: Exception do addExceptionToLogEx('U_Common.DisableOptionsForProjectPlan', E.Message); end; end; // функция получения номера layera по его хендлу function GLN(aLHandle: LongInt): integer; var i: integer; begin result := 1; try for i := 0 to GCadForm.PCad.LayerCount - 1 do begin if GCadForm.PCad.GetLayerHandle(i) = aLHandle then begin result := i; break; end; end; except end; end; // процедура для загрузки макета этажа procedure LoadFrameToList(aCad: TF_CAD; aMainStampName, aSideStampName: string; aListFormat: TListFormatType); var i, j: integer; LHandle: integer; FrameFileName: string; StampObject: TFigureGrp; RectangleObj: TRectangle; MainStampObj: TBlock; SideStampObj: TBlock; UpperStampObj: TRectangle; Bnd: TDoubleRect; deltax, deltay: double; FramePos: TDoublePoint; BlockFig: TBlock; InFigure: TFigure; InFigureGrp: TFigureGrp; begin try GAutoDelete := True; RemoveFrameFromList(aCad); GAutoDelete := False; if FileExists(aMainStampName) and FileExists(aSideStampName) then begin LHandle := aCad.PCad.GetLayerHandle(7); FramePos.x := aCad.PCad.WorkWidth / 2; FramePos.y := aCad.PCad.WorkHeight / 2; try // считать основной штамп MainStampObj := TBlock(aCad.PCad.GetFigureByDataID(100)); //10.11.2011 //if MainStampObj = nil then MainStampObj := TBlock(aCad.PCad.InsertBlockwithFileName(7, aMainStampName, -1000, -1000)); MainStampObj.Deselect; // считать боковой штапм SideStampObj := TBlock(aCad.PCad.InsertBlockwithFileName(7, aSideStampName, -1000, -1000)); SideStampObj.Deselect; // нарисовать верхний штамп UpperStampObj := TRectangle.create(-1000, -1000, -1000 + 70, -1000 + 15, 2, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, aCad.PCad); // нарисовать саму рамку Bnd.Left := aListFormat.StampFields.Margins.Left; //20; Bnd.Top := aListFormat.StampFields.Margins.Top; //5; Bnd.Right := aListFormat.PageWidth - aListFormat.StampFields.Margins.Right; //5; Bnd.Bottom := aListFormat.PageHeight - aListFormat.StampFields.Margins.Bottom; //5; RectangleObj := TRectangle.create(Bnd.Left, Bnd.Top, Bnd.Right, Bnd.Bottom, 2, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, aCad.PCad); // передвинуть штампы deltax := Bnd.Left - UpperStampObj.ap1.x; deltay := Bnd.Top - UpperStampObj.ap1.y; UpperStampObj.Move(deltax, deltay); deltax := Bnd.Left - SideStampObj.ap3.x; deltay := Bnd.Bottom - SideStampObj.ap3.y; SideStampObj.move(deltax, deltay); deltax := Bnd.Right - MainStampObj.ap3.x; deltay := Bnd.Bottom - MainStampObj.ap3.y; MainStampObj.move(deltax, deltay); // визибл/инвизибл штампы MainStampObj.Visible := aListFormat.ShowMainStamp; SetAllInFiguresVisible(MainStampObj, aListFormat.ShowMainStamp); SideStampObj.Visible := aListFormat.ShowSideStamp; SetAllInFiguresVisible(SideStampObj, aListFormat.ShowSideStamp); UpperStampObj.Visible := aListFormat.ShowUpperStamp; {$if Defined(SCS_PE) or Defined(SCS_PANDUIT)} RectangleObj.Visible := aListFormat.ShowUpperStamp or aListFormat.ShowSideStamp or aListFormat.ShowMainStamp; {$ifend} RectangleObj.DataID := 99; MainStampObj.DataID := 100; SideStampObj.DataID := 200; UpperStampObj.DataID := 300; // сгруппировать StampObject := TFigureGrp.create(LHandle, aCad.PCad); StampObject.AddFigure(RectangleObj); StampObject.AddFigure(MainStampObj); StampObject.AddFigure(SideStampObj); StampObject.AddFigure(UpperStampObj); GCadForm.PCad.Figures.Remove(MainStampObj); GCadForm.PCad.Figures.Remove(SideStampObj); SetAllStampFiguresLayer(StampObject, LHandle); SetAllStampTextsFont(StampObject, GCadForm.FFontName); aCad.PCad.AddCustomFigure(7, StampObject, False); // выставить подписи LoadCaptionsOnFrame(aCad, aCad.FCadStampType); aCad.FFrameFileName := StampObject.Name; except aCad.FFrameFileName := ''; end; end else begin aCad.FFrameFileName := ''; end; RefreshCAD(aCad.PCad); except on E: Exception do addExceptionToLogEx('U_Common.LoadFrameToList', E.Message); end; end; procedure LoadFrameOnMaket(aPCad: TPowerCad); var i, j: integer; LHandle: integer; FrameFileName: string; StampObject: TFigureGrp; RectangleObj: TRectangle; MainStampObj: TBlock; SideStampObj: TBlock; UpperStampObj: TRectangle; Bnd: TDoubleRect; deltax, deltay: double; FramePos: TDoublePoint; BlockFig: TBlock; InFigure: TFigure; InFigureGrp: TFigureGrp; FullPathName, MainStampName, SideStampName, StampTypeStr, StampLangStr: string; PageWidth, PageHeight: double; begin try aPCad.Clear(0); // определить параметры в именах блоков {$if Defined(ES_GRAPH_SC)} FullPathName := ExeDir + '\Stamp\'; {$else} FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; {$ifend} if F_MasterNewListLite.rbSimple.Checked then StampTypeStr := 'Small'; if F_MasterNewListLite.rbExtended.Checked then StampTypeStr := 'Big'; if F_MasterNewListLite.rbDetailed.Checked then StampTypeStr := 'ExtBig'; // if F_MasterNewListLite.rbRus.Checked then // StampLangStr := 'eng'; if F_MasterNewListLite.rbUkr.Checked then StampLangStr := 'ukr'; if F_MasterNewListLite.rbRus.Checked then StampLangStr := 'rus'; // MainStampName := FullPathName + StampTypeStr + '_Main_' + StampLangStr + '.sch'; SideStampName := FullPathName + StampTypeStr + '_Side_' + StampLangStr + '.sch'; if FileExists(MainStampName) and FileExists(SideStampName) then begin LHandle := aPCad.GetLayerHandle(0); FramePos.x := aPCad.WorkWidth / 2; FramePos.y := aPCad.WorkHeight / 2; PageWidth := StrToFloat_My(F_MasterNewListLite.edWidth.Text); PageHeight := StrToFloat_My(F_MasterNewListLite.edHeight.Text); // считать основной штамп MainStampObj := TBlock(aPCad.InsertBlockwithFileName(0, MainStampName, -1000, -1000)); MainStampObj.Deselect; // считать боковой штапм SideStampObj := TBlock(aPCad.InsertBlockwithFileName(0, SideStampName, -1000, -1000)); SideStampObj.Deselect; // нарисовать верхний штамп UpperStampObj := TRectangle.create(-1000, -1000, -1000 + 70, -1000 + 15, 2, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, aPCad); // нарисовать саму рамку Bnd.Left := F_MasterNewListLite.seStampMarginLeft.Value; //20; Bnd.Top := F_MasterNewListLite.seStampMarginTop.Value; // 5; Bnd.Right := PageWidth - F_MasterNewListLite.seStampMarginRight.Value; //5; Bnd.Bottom := PageHeight - F_MasterNewListLite.seStampMarginBottom.Value; //5; RectangleObj := TRectangle.create(Bnd.Left, Bnd.Top, Bnd.Right, Bnd.Bottom, 2, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, aPCad); // передвинуть штампы deltax := Bnd.Left - UpperStampObj.ap1.x; deltay := Bnd.Top - UpperStampObj.ap1.y; UpperStampObj.Move(deltax, deltay); deltax := Bnd.Left - SideStampObj.ap3.x; deltay := Bnd.Bottom - SideStampObj.ap3.y; SideStampObj.move(deltax, deltay); deltax := Bnd.Right - MainStampObj.ap3.x; deltay := Bnd.Bottom - MainStampObj.ap3.y; MainStampObj.move(deltax, deltay); // визибл/инвизибл штампы MainStampObj.Visible := F_MasterNewListLite.cbShowMainStamp.Checked; SetAllInFiguresVisible(MainStampObj, F_MasterNewListLite.cbShowMainStamp.Checked); SideStampObj.Visible := F_MasterNewListLite.cbShowSideStamp.Checked; SetAllInFiguresVisible(SideStampObj, F_MasterNewListLite.cbShowSideStamp.Checked); UpperStampObj.Visible := F_MasterNewListLite.cbShowUpperStamp.Checked; {$if Defined(SCS_PE) or Defined(SCS_PANDUIT)} RectangleObj.Visible := MainStampObj.Visible or SideStampObj.Visible or UpperStampObj.Visible; {$ifend} RectangleObj.DataID := 99; // сгруппировать StampObject := TFigureGrp.create(LHandle, aPCad); StampObject.AddFigure(RectangleObj); StampObject.AddFigure(MainStampObj); StampObject.AddFigure(SideStampObj); StampObject.AddFigure(UpperStampObj); aPCad.Figures.Remove(MainStampObj); aPCad.Figures.Remove(SideStampObj); SetAllStampFiguresLayer(StampObject, LHandle); SetAllStampTextsFont(StampObject, F_MasterNewListLite.cbFontName.FontName); aPCad.AddCustomFigure(0, StampObject, False); RefreshCAD(aPCad); end; except on E: Exception do AddExceptionToLogEx('U_Common.LoadFrameOnMaket', E.Message); end; end; procedure RemoveFrameFromList(aCad: TF_CAD); var FullPathName: string; FName: string; i: Integer; FrameFigure: TFigure; begin try FullPathName := ExtractSaveDir; FName := ExtractFileName(aCad.FFrameFileName); if FName = '' then FName := 'Unknown.sch'; FullPathName := FullPathName + '\' + FName; {//17.11.2011 if aCad.FFrameProjectName <> nil then begin aCad.PCad.Figures.Remove(aCad.FFrameProjectName); FreeAndNil(aCad.FFrameProjectName); end; if aCad.FFrameListName <> nil then begin aCad.PCad.Figures.Remove(aCad.FFrameListName); FreeAndNil(aCad.FFrameListName); end; if aCad.FFrameCodeName <> nil then begin aCad.PCad.Figures.Remove(aCad.FFrameCodeName); FreeAndNil(aCad.FFrameCodeName); end; if aCad.FFrameIndexName <> nil then begin aCad.PCad.Figures.Remove(aCad.FFrameIndexName); FreeAndNil(aCad.FFrameIndexName); end;} try for i := 0 to aCad.FFrameObjects.Count - 1 do begin FrameFigure := TFigure(aCad.FFrameObjects.Objects[i]); if FrameFigure <> nil then begin aCad.PCad.Figures.Remove(FrameFigure); FreeAndNil(FrameFigure); aCad.FFrameObjects.Objects[i] := nil; end; end; finally aCad.ClearFrameFigures; end; RefreshCAD(aCad.PCad); FSCS_Main.SaveStamp(FullPathName); aCad.PCad.DeselectAll(0); aCad.PCad.SelectAll(7); aCad.PCad.RemoveSelection; RefreshCAD(aCad.PCad); except on E: Exception do addExceptionToLogEx('U_Common.RemoveFrameFromList', E.Message); end; end; procedure LoadCaptionsOnFrame(ACAD: TF_CAD; AStampType: TStampType; ACreateForLack: Boolean=true; AEnabledCaptions: TintList=nil); var aProjectName: string; aListName: string; aCodeName: string; aIndexName: string; LHandle: Integer; aBnd: TDoubleRect; aTextWidth, aTextHeight: Double; aPoint: TDoublePoint; deltax, deltay: double; TextObject: TFigure; _TextX, _TextY: double; ProjParams: TProjectParams; ListParams: TListParams; i: integer; FrameFigure: TFigure; FrameFigureCode: Integer; procedure ReCreateDeveloper; begin // Разработал //aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FCadStampMargins.Right - 185.5; //14.11.2011 - 5 - 120; //aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FCadStampMargins.Right - 135.5; //14.11.2011 - 5 - 50; //aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FCadStampMargins.Bottom - 34.5; //14.11.2011 - 5 - 30; //aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FCadStampMargins.Bottom - 19.5; //14.11.2011 - 5 - 15; aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 164.5; //14.11.2011 - 5 - 120; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 104.5; //14.11.2011 - 5 - 50; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 32; //14.11.2011 - 5 - 30; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 22; //14.11.2011 - 5 - 15; ACAD.FFrameStampDeveloper := ReCreateStampCaptionToField(ACAD, ACAD.FFrameStampDeveloper, ftDeveloperName, aBnd, ACAD.FStampFields.Developer, ACreateForLack, AEnabledCaptions, false, 10); end; //03.10.2012 procedure ReCreateChecker; begin // Проверил aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 164.5; //14.11.2011 - 5 - 120; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 104.5; //14.11.2011 - 5 - 50; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 27; //14.11.2011 - 5 - 30; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 17; //14.11.2011 - 5 - 15; ACAD.FFrameStampChecker := ReCreateStampCaptionToField(ACAD, ACAD.FFrameStampChecker, ftCheckerName, aBnd, ACAD.FStampFields.Checker, ACreateForLack, AEnabledCaptions, false, 10); end; procedure ReCreateMainEngineer; begin // Главный инженер проекта aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 164.5; aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 104.5; aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 22; aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 12; ReCreateStampCaptionToField(ACAD, nil, ftMainEngineer, aBnd, ACAD.FStampFields.MainEngineer, ACreateForLack, AEnabledCaptions, false, 10); end; procedure ReCreateApproved; begin // Утвердил aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 164.5; aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 104.5; aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 12; aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 2; ReCreateStampCaptionToField(ACAD, nil, ftApproved, aBnd, ACAD.FStampFields.Approved, ACreateForLack, AEnabledCaptions, false, 10); end; procedure ReCreateDesignStage; begin // Стадия проектир aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 20 - 30; aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 20 - 15; aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 15 - 10; aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 15; ReCreateStampCaptionToField(ACAD, nil, ftDesignStage, aBnd, ACAD.FStampFields.DesignStage, ACreateForLack, AEnabledCaptions, true, 12); end; procedure ReCreateListDescription; var aListDescription: String; begin aListDescription := ''; if ListParams.Settings.ListType <> lt_Normal then begin case ListParams.Settings.ListType of lt_DesignBox: if ListParams.Settings.CADStampLang in [stl_ukr, stl_ukr_dstu] then aListDescription := cCommon_Mes25_ukr else aListDescription := cCommon_Mes25; lt_ProjectPlan: if ListParams.Settings.CADStampLang in [stl_ukr, stl_ukr_dstu] then aListDescription := cCommon_Mes26_ukr else aListDescription := cCommon_Mes26; end; end; // Описание пренадлежности листа aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 119; aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 50; aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 15 - 1; aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 1; ReCreateStampCaptionToField(ACAD, nil, ftListDescription, aBnd, aListDescription, ACreateForLack, nil, true, 13); end; procedure ReCreateFillFields; begin // Разработал ReCreateDeveloper; // Проверил ReCreateChecker; // Главный инженер проекта ReCreateMainEngineer; // Утвердил ReCreateApproved; // Стадия проектир ReCreateDesignStage; // Описание пренадлежности листа ReCreateListDescription; end; begin ACAD.PCad.DisableAlign; try ProjParams := GetCurrProjectParams(false); aProjectName := ProjParams.Caption; ListParams := GetListParams(ACAD.FCADListID); aListName := ListParams.Name; if ACAD.FStampFields.ListSign <> '' then aListName := ACAD.FStampFields.ListSign; aCodeName := ListParams.Name; aIndexName := IntToStr(ListParams.MarkID); LHandle := ACAD.PCad.GetLayerHandle(7); // ПРОСТОЙ if AStampType = stt_simple then begin // номер листа aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 10; //14.11.2011 5 - 10; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right; //14.11.2011 5; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 8; //14.11.2011 - 5 - 8; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom; //14.11.2011 - 5; //13.09.2010 //if GCadForm.FFrameIndexName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName); // GCadForm.FFrameIndexName.DataID := 400; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameIndexName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName); // GCadForm.FFrameIndexName.DataID := 400; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False); //end; ACAD.FFrameIndexName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameIndexName, 400, aBnd, aIndexName, ACreateForLack, AEnabledCaptions); // лист aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 10; //14.11.2011 - 5 - 10; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15; //14.11.2011 - 5 - 15; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom; //14.11.2011 - 5; //13.09.2010 //if GCadForm.FFrameListName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName); // GCadForm.FFrameListName.DataID := 200; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameListName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName); // GCadForm.FFrameListName.DataID := 200; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False); //end; ACAD.FFrameListName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameListName, 200, aBnd, aListName, ACreateForLack, AEnabledCaptions); end; // РАСШИРЕННЫЙ if AStampType = stt_extended then begin // номер листа aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 20 - 15; //14.11.2011 - 5 - 20 - 15; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 20; //14.11.2011 - 5 - 20; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15 - 10; //14.11.2011 - 5 - 15 - 10; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15; //14.11.2011 - 5 - 15; //13.09.2010 //if GCadForm.FFrameIndexName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName); // GCadForm.FFrameIndexName.DataID := 400; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameIndexName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName); // GCadForm.FFrameIndexName.DataID := 400; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False); //end; ACAD.FFrameIndexName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameIndexName, 400, aBnd, aIndexName, ACreateForLack, AEnabledCaptions); // лист aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right; //14.11.2011 - 5; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 45; //14.11.2011 - 5 - 45; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 30; //14.11.2011 - 5 - 30; //13.09.2010 //if GCadForm.FFrameListName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName); // GCadForm.FFrameListName.DataID := 200; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameListName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName); // GCadForm.FFrameListName.DataID := 200; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False); //end; //18.11.2011 ACAD.FFrameListName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameListName, 200, aBnd, aListName, ACreateForLack, AEnabledCaptions); ACAD.FFrameListName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameListName, 200, aBnd, aListName, ACreateForLack, AEnabledCaptions); // проект aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 50; //14.11.2011 - 5 - 50; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 30; //14.11.2011 - 5 - 30; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15; //14.11.2011 - 5 - 15; //13.09.2010 //if GCadForm.FFrameProjectName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameProjectName := CreateStampCaptionToField(aBnd, aProjectName); // GCadForm.FFrameProjectName.DataID := 100; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameProjectName, False); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameProjectName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameProjectName := CreateStampCaptionToField(aBnd, aProjectName); // GCadForm.FFrameProjectName.DataID := 100; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameProjectName, False); //end; ACAD.FFrameProjectName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameProjectName, 100, aBnd, aProjectName, ACreateForLack, AEnabledCaptions); // Заполняемые поля рамки ReCreateFillFields; end; // ПОДРОБНЫЙ if AStampType = stt_detailed then begin // номер листа aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 20 - 15; //14.11.2011 - 5 - 20 - 15; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 20; //14.11.2011 - 5 - 20; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15 - 10; //14.11.2011 - 5 - 15 - 10; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 15; //14.11.2011 - 5 - 15; //13.09.2010 //if GCadForm.FFrameIndexName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName); // GCadForm.FFrameIndexName.DataID := 400; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameIndexName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameIndexName := CreateStampCaptionToField(aBnd, aIndexName); // GCadForm.FFrameIndexName.DataID := 400; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameIndexName, False); //end; ACAD.FFrameIndexName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameIndexName, 400, aBnd, aIndexName, ACreateForLack, AEnabledCaptions); // лист aBnd.Left := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120; aBnd.Right := (ACAD.PCad.WorkWidth {/ GCadForm.FListCountX}) - ACAD.FStampFields.Margins.Right; //14.11.2011 - 5; aBnd.Top := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 55; //14.11.2011 - 5 - 55; aBnd.Bottom := (ACAD.PCad.WorkHeight {/ GCadForm.FListCountY}) - ACAD.FStampFields.Margins.Bottom - 45; //14.11.2011 - 5 - 45; //13.09.2010 //if GCadForm.FFrameListName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName); // GCadForm.FFrameListName.DataID := 200; // GCadForm.PCad.AddCustomFigure(GLN(LHandle), GCadForm.FFrameListName, False); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameListName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameListName := CreateStampCaptionToField(aBnd, aListName); // GCadForm.FFrameListName.DataID := 200; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameListName, False); //end; ACAD.FFrameListName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameListName, 200, aBnd, aListName, ACreateForLack, AEnabledCaptions); // Организация aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 119; aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right; aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 45; aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 30; ReCreateStampCaptionToField(ACAD, nil, ftOrgName, aBnd, ProjParams.Setting.OrganizationName, ACreateForLack, AEnabledCaptions); // проект //03.10.2012 - дна этом месте теперь название организации //aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 120; //14.11.2011 - 5 - 120; //aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right; //14.11.2011 - 5; //aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 45; //14.11.2011 - 5 - 45; //aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 30; //14.11.2011 - 5 - 30; aBnd.Left := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 119; aBnd.Right := ACAD.PCad.WorkWidth - ACAD.FStampFields.Margins.Right - 50; aBnd.Top := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 30; aBnd.Bottom := ACAD.PCad.WorkHeight - ACAD.FStampFields.Margins.Bottom - 15; //13.09.2010 //if GCadForm.FFrameProjectName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameProjectName := CreateStampCaptionToField(aBnd, aProjectName); // GCadForm.FFrameProjectName.DataID := 100; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameProjectName, False); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameProjectName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameProjectName := CreateStampCaptionToField(aBnd, aProjectName); // GCadForm.FFrameProjectName.DataID := 100; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameProjectName, False); //end; ACAD.FFrameProjectName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameProjectName, 100, aBnd, aProjectName, ACreateForLack, AEnabledCaptions); // Заполняемые поля рамки ReCreateFillFields; end; // штамп в верхнем углу aBnd.Left := ACAD.FStampFields.Margins.Left; //14.11.2011 20; aBnd.Top := ACAD.FStampFields.Margins.Top; //14.11.2011 5; aBnd.Right := ACAD.FStampFields.Margins.Left + 70; //14.11.2011 20 + 70; aBnd.Bottom := ACAD.FStampFields.Margins.Top + 15; //14.11.2011 5 + 15; //13.09.2010 //if GCadForm.FFrameCodeName = nil then //begin // if ACreateForLack then // begin // GCadForm.FFrameCodeName := CreateStampCaptionToField(aBnd, aCodeName); // GCadForm.FFrameCodeName.DataID := 300; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameCodeName, False); // GCadForm.FFrameCodeName.rotate(pi, GCadForm.FFrameCodeName.CenterPoint); // end; //end //else //begin // GCadForm.PCad.Figures.Remove(GCadForm.FFrameCodeName); // RefreshCad(GCadForm.PCad); // GCadForm.FFrameCodeName := CreateStampCaptionToField(aBnd, aCodeName); // GCadForm.FFrameCodeName.DataID := 300; // GCadForm.PCad.AddCustomFigure (GLN(LHandle), GCadForm.FFrameCodeName, False); // GCadForm.FFrameCodeName.rotate(pi, GCadForm.FFrameCodeName.CenterPoint); //end; //18.11.2011 ACAD.FFrameCodeName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameCodeName, 300, aBnd, aCodeName, ACreateForLack, AEnabledCaptions); ACAD.FFrameCodeName := ReCreateStampCaptionToField(ACAD, ACAD.FFrameCodeName, 300, aBnd, aCodeName+' '+aIndexName, ACreateForLack, AEnabledCaptions); if ACAD.FFrameCodeName <> nil then ACAD.FFrameCodeName.rotate(pi, ACAD.FFrameCodeName.CenterPoint); // выставить визибл/инвизибл подписей {//17.11.2011 if ACAD.FFrameProjectName <> nil then ACAD.FFrameProjectName.Visible := ACAD.FShowMainStamp; if ACAD.FFrameListName <> nil then ACAD.FFrameListName.Visible := ACAD.FShowMainStamp; if ACAD.FFrameCodeName <> nil then ACAD.FFrameCodeName.Visible := ACAD.FShowUpperStamp; if ACAD.FFrameIndexName <> nil then ACAD.FFrameIndexName.Visible := ACAD.FShowMainStamp;} for i := 0 to ACad.FFrameObjects.Count - 1 do begin FrameFigure := TFigure(ACad.FFrameObjects.Objects[i]); FrameFigureCode := StrToint(ACad.FFrameObjects[i]); if (FrameFigure <> nil) then begin if (FrameFigureCode <> ftCodeName) then FrameFigure.Visible := GCadForm.FShowMainStamp else FrameFigure.Visible := ACAD.FShowUpperStamp; end; end; except on E: Exception do addExceptionToLogEx('U_Common.LoadCaptionsOnFrame', E.Message); end; ACAD.PCad.EnableAlign; end; function CreateStampCaptionToField(ACAD: TF_CAD; aFieldBnd: TDoubleRect; const aText: String; ATextHorzCenter: Boolean=true; ATextSize: Integer=14): TRichText; var i, k: integer; LHandle: Integer; TextField: TRichText; FieldCP: TDoublePoint; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; resh, resw: double; HalfField: double; HalfText: double; ModCount: Integer; TextSize: Integer; TextStyle: TFontStyles; delta: double; textx, texty: double; begin Result := nil; try // if aText = 'Лист 1' then // aText := 'iopfgipoed_doiepoefep_efpmep9fkepfiepf_efkepfie0fi0efn_f0efi[0e0fe_epfke0[pfie0f_fmpekfpefke_efjepfjpef_epfjepofjepojfe_ejfepofkopef_lefjepjfpeojfe_elfmepfkekfpeof_emfepfkjepfkoe_felmfepofkjpoefe,_flemfpemfpemnfpe_flefmepf_epof'; delta := 0; textx := abs(aFieldBnd.Right - aFieldBnd.Left); texty := abs(aFieldBnd.Bottom - aFieldBnd.Top); TextStyle := []; LHandle := ACAD.PCad.GetLayerHandle(2); FieldCP.x := (aFieldBnd.Left + aFieldBnd.Right) / 2; FieldCP.y := (aFieldBnd.Top + aFieldBnd.Bottom) / 2; w := 0; //#From Oleg# //14.09.2010 h := 0; //#From Oleg# //14.09.2010 TextSize := 1; //#From Oleg# //14.09.2010 k := ATextSize; //17.11.2011 14; while k >= 1 do begin TextSize := k; TextField := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, ACAD.PCad); TextField.re.WordWrap := False; TextField.re.Font.Name := ACAD.FFontName; TextField.re.Font.Size := TextSize; TextField.re.Font.Style := TextStyle; TextField.re.Font.Color := clBlack; TextField.re.Lines.Clear; TextField.re.Lines.Add(aText); // получить свойства xCanvas := TMetafileCanvas.Create(TextField.Metafile, 0); xCanvas.Font.Name := TextField.re.Font.Name; xCanvas.Font.Size := TextField.re.Font.Size; xCanvas.Font.Style := TextField.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4; w := xCanvas.TextWidth(TextField.Re.Lines[0]); w := (w + 3) / 4; FreeAndNil(xCanvas); if TextField <> nil then FreeAndNil(TextField); // текст вписывается в границы if (w * h) < (textx * texty - 50) then begin Break; end; k := k - 1; end; // контроль по ширине // не больше чем ширина вписуемого поля if textx > w then resw := w else resw := textx; // вычислить высоту исходя из переносов строк { //18.11.2011 if textx > w then h := h * (Round(w / textx) + 1) else h := h * (Round(w / textx) + 1) + 1;} if textx > w then h := h * RoundUp(w / textx) else h := h * RoundUp(w / textx) + 1; // контроль по высоте // небольше чем высота вписуемого поля if texty > h then resh := h else resh := texty; TextField := TRichText.create(-100, -100, -100 + resw, -100 + resh, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, ACAD.PCad); TextField.re.WordWrap := True; TextField.re.Font.Name := ACAD.FFontName; TextField.re.Font.Size := TextSize; TextField.re.Font.Style := TextStyle; TextField.re.Font.Color := clBlack; TextField.re.Lines.Clear; TextField.re.Lines.Add(aText); if ATextHorzCenter then TextField.Move(FieldCP.x - TextField.CenterPoint.x, (FieldCP.y - TextField.CenterPoint.y) + delta) else TextField.Move(aFieldBnd.Left - TextField.ap1.x, (FieldCP.y - TextField.CenterPoint.y) + delta); Result := TextField; except on E: Exception do addExceptionToLogEx('U_Common.CreateStampCaptionToField', E.Message); end; end; function ReCreateStampCaptionToField(ACAD: TF_CAD; ACurrStampField: TRichText; ADataID: Integer; aFieldBnd: TDoubleRect; const aText: String; ACreateForLack: Boolean=true; AEnabledCaptions: TintList=nil; ATextHorzCenter: Boolean=true; ATextSize: Integer=14): TRichText; var //CAD: TF_CAD; LHandle: Integer; ObjIdx: Integer; begin result := nil; try if ACurrStampField <> nil then if ACurrStampField.ClassName <> 'TRichText' then ACurrStampField := nil; if ACurrStampField = nil then begin ObjIdx := ACAD.FFrameObjects.IndexOf(IntToStr(ADataID)); if ObjIdx <> -1 then ACurrStampField := TRichText(ACAD.FFrameObjects.Objects[ObjIdx]); end; if ACurrStampField <> nil then if ACurrStampField.ClassName <> 'TRichText' then ACurrStampField := nil; Result := ACurrStampField; if (AEnabledCaptions = nil) or (AEnabledCaptions.IndexOf(ADataID) <> -1) then begin if ACurrStampField = nil then begin if ACreateForLack then begin Result := CreateStampCaptionToField(ACAD, aFieldBnd, aText, ATextHorzCenter, ATextSize); //CAD := TF_CAD(Result.Owner.Owner); Result.DataID := ADataID; LHandle := ACAD.PCad.GetLayerHandle(7); ACAD.PCad.AddCustomFigure (GLN(LHandle), Result, False); end; end else begin //CAD := TF_CAD(ACurrStampField.Owner.Owner); if ACurrStampField.ClassName = 'TRichText' then begin ACAD.PCad.Figures.Remove(ACurrStampField); FreeAndNil(ACurrStampField); end else begin exit; end; RefreshCad(ACAD.PCad); Result := CreateStampCaptionToField(ACAD, aFieldBnd, aText, ATextHorzCenter, ATextSize); Result.DataID := ADataID; LHandle := ACAD.PCad.GetLayerHandle(7); ACAD.PCad.AddCustomFigure (GLN(LHandle), Result, False); end; if Result <> nil then begin ObjIdx := ACAD.FFrameObjects.IndexOf(IntToStr(ADataID)); if ObjIdx <> -1 then ACAD.FFrameObjects.Objects[ObjIdx] := Result; end; end; except end; end; function GetFileNameFromFullPath(aFullPath: string): string; var i, j: integer; strlen: integer; fName: string; begin try strlen := Length(aFullPath); for i := strlen - 1 downto 0 do begin if aFullPath[i] = '\' then break; end; j := 0; SetLength(fName, 0); SetLength(fName, strlen - i); while i <= strlen do begin fName[j] := aFullPath[i]; i := i + 1; j := j + 1; end; Result := fName; except on E: Exception do addExceptionToLogEx('U_Common.GetFileNameFromFullPath', E.Message); end; end; procedure GetConnObjectsByLine(AIDList, AIDLine: Integer; var AConnAtSide1: Integer; var AConnAtSide2: Integer); var FCAD: TF_CAD; FLine: TOrthoLine; JoinedConn1, JoinedConn2: TConnectorObject; begin try AConnAtSide1 := -1; AConnAtSide2 := -1; FCAD := GetListByID(AIDList); if FCAD <> nil then begin FLine := TOrthoLine(GetFigureByID(FCAD, AIDLine)); if FLine <> nil then begin JoinedConn1 := TConnectorObject(FLine.JoinConnector1); JoinedConn2 := TConnectorObject(FLine.JoinConnector2); if JoinedConn1.JoinedConnectorsList.Count > 0 then begin if TConnectorObject(JoinedConn1.JoinedConnectorsList[0]).ConnectorType <> ct_Clear then begin if TConnectorObject(JoinedConn1.JoinedConnectorsList[0]).FIsApproach then AConnAtSide1 := TConnectorObject(JoinedConn1.JoinedConnectorsList[0]).FHouse.ID else AConnAtSide1 := TConnectorObject(JoinedConn1.JoinedConnectorsList[0]).ID; end; end else begin if JoinedConn1.FIsHouseJoined then if JoinedConn1.FHouse <> nil then AConnAtSide1 := JoinedConn1.FHouse.ID; end; if JoinedConn2.JoinedConnectorsList.Count > 0 then begin if TConnectorObject(JoinedConn2.JoinedConnectorsList[0]).ConnectorType <> ct_Clear then begin if TConnectorObject(JoinedConn2.JoinedConnectorsList[0]).FIsApproach then AConnAtSide2 := TConnectorObject(JoinedConn2.JoinedConnectorsList[0]).FHouse.ID else AConnAtSide2 := TConnectorObject(JoinedConn2.JoinedConnectorsList[0]).ID; end; end else begin if JoinedConn2.FIsHouseJoined then if JoinedConn2.FHouse <> nil then AConnAtSide2 := JoinedConn2.FHouse.ID; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetConnObjectsByLine', E.Message); end; end; procedure RenameProjectOnFrame(AOldProjParams: TProjectParams); var i: integer; CurForm: TF_CAD; begin try for i := 0 to FSCS_Main.MDIChildCount - 1 do begin CurForm := TF_CAD(FSCS_Main.MDIChildren[i]); //if (TRichText(GCadForm.FFrameListName).re.Text = '') then // RenameListOnFrame(CurForm, ProjParams, GetListParams(CurForm.FCADListID)); RenameListOnFrame(CurForm, AOldProjParams, GetListParams(CurForm.FCADListID)); RefreshCAD(CurForm.PCad); end; except on E: Exception do addExceptionToLogEx('U_Common.RenameProjectOnFrame', E.Message); end; end; procedure RenameListOnFrame(ACadForm: TF_CAD; AOldProjParams: TProjectParams; AOldListParams: TListParams); var i: integer; Figure: TRichText; FigureCode: Integer; CmpText: String; FrameFig: TFrame; EnabledCaptions: TintList; function CheckRichTextCaption(AObject: TRichText; const ACaption: String): Boolean; var reText: String; i: Integer; begin //Result := (AObject <> nil) and (AObject.re <> nil) and (AObject.re.Lines.Count = 1) and (AObject.re.Lines[0] = ACaption); Result := (AObject <> nil) and (AObject.re <> nil); if Result then begin reText := ''; for i := 0 to AObject.re.Lines.Count - 1 do reText := reText + AObject.re.Lines[i]; Result := reText = ACaption; end; end; begin try //13.09.2010 //if ((GCadForm.FFrameProjectName = nil) or (GCadForm.FFrameProjectName.re.Text = '')) or // ((GCadForm.FFrameListName = nil) or (GCadForm.FFrameListName.re.Text = '')) then //begin // LoadCaptionsOnFrame(ACadForm.FCadStampType); // RefreshCAD(ACadForm.PCad); //end; EnabledCaptions := TintList.Create; {//17.11.2011 // номер листа if CheckRichTextCaption(ACadForm.FFrameIndexName, IntToStr(AOldListParams.MarkID)) then EnabledCaptions.Add(400); // штамп в верхнем углу if CheckRichTextCaption(ACadForm.FFrameCodeName, AOldListParams.Name) then EnabledCaptions.Add(300); // лист if CheckRichTextCaption(ACadForm.FFrameListName, AOldListParams.Name) then EnabledCaptions.Add(200); // проект if CheckRichTextCaption(ACadForm.FFrameProjectName, AOldProjParams.Caption) then EnabledCaptions.Add(100);} for i := 0 to ACadForm.FFrameObjects.Count - 1 do begin Figure := TRichText(ACadForm.FFrameObjects.Objects[i]); if Figure <> nil then begin FigureCode := StrToInt(ACadForm.FFrameObjects[i]); CmpText := ''; case FigureCode of ftProjectName: CmpText := AOldProjParams.Caption; ftOrgName: CmpText := AOldProjParams.Setting.OrganizationName; ftListName: begin if AOldListParams.Settings.CADStampListSign <> '' then CmpText := AOldListParams.Settings.CADStampListSign else CmpText := AOldListParams.Name; end; ftCodeName: CmpText := AOldListParams.Name +' '+ IntToStr(AOldListParams.MarkID); //18.11.2011 AOldListParams.Name; ftIndexName: CmpText := IntToStr(AOldListParams.MarkID); ftDeveloperName: CmpText := AOldListParams.Settings.CADStampDeveloper; ftCheckerName: CmpText := AOldListParams.Settings.CADStampChecker; ftMainEngineer: CmpText := AOldListParams.Settings.CADStampMainEngineer; ftApproved: CmpText := AOldListParams.Settings.CADStampApproved; ftDesignStage: CmpText := AOldListParams.Settings.CADStampDesignStage; end; if CheckRichTextCaption(Figure, CmpText) then EnabledCaptions.Add(FigureCode); end; end; if EnabledCaptions.Count > 0 then LoadCaptionsOnFrame(ACadForm, ACadForm.FCadStampType, false, EnabledCaptions); EnabledCaptions.Free; except on E: Exception do addExceptionToLogEx('U_Common.RenameListOnFrame', E.Message); end; end; function CheckByBreakConnector(aClearConn, aPointObject: TConnectorObject): Boolean; var CheckedX, CheckedY: Double; MinX, MinY, MaxX, MaxY: Double; i: integer; Step: Double; begin Result := False; try Step := GCadForm.PCad.GridStep; CheckedX := aClearConn.ActualPoints[1].x; CheckedY := aClearConn.ActualPoints[1].y; if (not APointObject.FDrawFigureMoved)and(APointObject.FDrawFigureAngle = 0) then if not HaveObjectSocketComponent(APointObject.ID) then begin MinX := (aPointObject.ActualPoints[1].x - aPointObject.GrpSizeX / 2) - 0.1; MinY := (aPointObject.ActualPoints[1].y - aPointObject.GrpSizeY / 2) - 0.1; MaxX := (aPointObject.ActualPoints[1].x + aPointObject.GrpSizeX / 2) + 0.1; MaxY := (aPointObject.ActualPoints[1].y + aPointObject.GrpSizeY / 2) + 0.1; end else //Если конектор не по центру фигуры begin MinX := (aPointObject.ActualPoints[1].x) - 0.1; MinY := (aPointObject.ActualPoints[1].y - aPointObject.GrpSizeY / 2) - 0.1; MaxX := (aPointObject.ActualPoints[1].x + aPointObject.GrpSizeX) + 0.1; MaxY := (aPointObject.ActualPoints[1].y + aPointObject.GrpSizeY / 2) + 0.1; end else //А этот кусочек нужен если фигура сдвинута или повернута на угол begin MinX := aPointObject.DrawFigure.GetBoundRect.Left - 0.1; MinY := aPointObject.DrawFigure.GetBoundRect.Top - 0.1; MaxX := aPointObject.DrawFigure.GetBoundRect.Right + 0.1; MaxY := aPointObject.DrawFigure.GetBoundRect.Bottom + 0.1; end; if GCadForm.PCad.SnapToGrids then begin MinX := Trunc(MinX / Step) * Step; MinY := Trunc(MinY / Step) * Step; MaxX := Trunc(MaxX / Step) * Step + Step; MaxY := Trunc(MaxY / Step) * Step + Step; end; if (CheckedX < MinX) or (CheckedX > MaxX) or (CheckedY < MinY) or (CheckedY > MaxY) then Result := True; except on E: Exception do addExceptionToLogEx('CheckByBreakConnector', E.Message); end; end; function CheckByBreakConnectorByCoords(aConnPoints: TDoublePoint; aPointObject: TConnectorObject): Boolean; var CheckedX, CheckedY: Double; MinX, MinY, MaxX, MaxY: Double; i: integer; Step: Double; begin Result := False; try Step := GCadForm.PCad.GridStep; CheckedX := aConnPoints.x; CheckedY := aConnPoints.y; MinX := (aPointObject.ActualPoints[1].x - aPointObject.GrpSizeX / 2) - 0.1; MinY := (aPointObject.ActualPoints[1].y - aPointObject.GrpSizeY / 2) - 0.1; MaxX := (aPointObject.ActualPoints[1].x + aPointObject.GrpSizeX / 2) + 0.1; MaxY := (aPointObject.ActualPoints[1].y + aPointObject.GrpSizeY / 2) + 0.1; if GCadForm.PCad.SnapToGrids then begin MinX := Trunc(MinX / Step) * Step; MinY := Trunc(MinY / Step) * Step; MaxX := Trunc(MaxX / Step) * Step + Step; MaxY := Trunc(MaxY / Step) * Step + Step; end; if (CheckedX < MinX) or (CheckedX > MaxX) or (CheckedY < MinY) or (CheckedY > MaxY) then Result := True; except on E: Exception do addExceptionToLogEx('CheckByBreakConnectorByCoords', E.Message); end; end; procedure RefreshCAD_T(aPCAD: TPowerCad; AExecPrev: Boolean=false); begin if AExecPrev and Assigned(GRefreshCad) and FSCS_Main.TimerRefresh.Enabled and Assigned(FSCS_Main.TimerRefresh.OnTimer) then FSCS_Main.TimerRefresh.OnTimer(FSCS_Main.TimerRefresh); GRefreshCad := aPCAD; FSCS_Main.TimerRefresh.Enabled := True; end; procedure RefreshCADs(aCADs: TList); var i: Integer; begin for i := 0 to aCADs.Count - 1 do RefreshCAD(TF_CAD(aCADs[i]).PCad); end; procedure RefreshCAD(aPCAD: TPowerCad); begin try if aPCAD <> nil then aPCAD.Refresh; except on E: Exception do addExceptionToLogEx(cCommon_Mes13, E.Message); end; end; procedure ProcessMessagesEx; function IsKeyMsg(var Msg: TMsg): Boolean; const CN_BASE = $BC00; var Wnd: HWND; begin Result := False; with Msg do if (Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST) then begin Wnd := GetCapture; if Wnd = 0 then begin Wnd := HWnd; if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then Result := True; end else if (LongWord(GetWindowLong(Wnd, GWL_HINSTANCE)) = HInstance) then if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then Result := True; end; end; function ProcessMessage(var Msg: TMsg): Boolean; begin Result := False; if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin Result := True; if ((Msg.message > WM_MOUSEFIRST) and (Msg.message > WM_MOUSELAST)) or (Msg.message = WM_PAINT) then begin TranslateMessage(Msg); DispatchMessage(Msg); end; end; end; {function ProcessMessage(var Msg: TMsg): Boolean; var HandledMsg: Boolean; begin Result := False; if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin Result := True; HandledMsg := False; if Assigned(Application.OnMessage) then Application.OnMessage(Msg, HandledMsg); if Not HandledMsg then if ((Msg.message >= WM_MOUSEFIRST) and (Msg.message <= WM_MOUSELAST)) or (Msg.message = WM_PAINT) or (Msg.message <= WM_TIMER) then begin TranslateMessage(Msg); DispatchMessage(Msg); end; end; end;} var Msg: TMsg; begin while ProcessMessage(Msg) do {loop}; //Application.ProcessMessages; end; procedure ReDrawCurrShadowOnCAD; begin try if (GCadForm <> nil) and (GCadForm.PCad <> nil) and (FSCS_Main.MDIChildCount > 0) then begin if ((GCadForm.PCad.ToolIdx = toFigure) and (GCadForm.PCad.ToolInfo = 'TOrthoLine')) and (GClickIndex > 0) then begin GCadForm.PCad.Refresh; GCadForm.PCad.Repaint; end; end; except on E: Exception do addExceptionToLogEx('U_Common.aReDrawCurrCAD', E.Message); end; end; procedure UnSelectFiguresOnSelectedChange(aSelectedList: TList); var i: integer; CurrFigure: TFigure; CurrConn: TConnectorObject; CurrLine: TOrthoLine; ObjFromRaise: TConnectorObject; begin try // 1. убрать выделение с присоединенных соединителей линий // 2. убирать выделение с с-п если выделена РТ на которой с-п for i := 0 to aSelectedList.Count - 1 do begin CurrFigure := TFigure(aSelectedList[i]); if CheckFigureByClassName(CurrFigure, cTConnectorObject) then begin CurrConn := TConnectorObject(CurrFigure); // вершина с-п if CurrConn.FConnRaiseType <> crt_None then begin // только если вершина с-п - пустой соединитель if CurrConn.ConnectorType = ct_Clear then begin ObjFromRaise := CurrConn.FObjectFromRaise; if ObjFromRaise <> nil then if not CheckNoFigureInList(ObjFromRaise, aSelectedList) then CurrConn.Deselect; end; end; end; if CheckFigureByClassName(CurrFigure, cTOrthoLine) then begin CurrLine := TOrthoLine(CurrFigure); // присоединенные коннекторы линии // if not CheckNoFigureInList(CurrLine.JoinConnector1, aSelectedList) then // CurrLine.JoinConnector1.Deselect; // if not CheckNoFigureInList(CurrLine.JoinConnector2, aSelectedList) then // CurrLine.JoinConnector2.Deselect; if CurrLine.FIsRaiseUpDown then begin ObjFromRaise := CurrLine.FObjectFromRaisedLine; if ObjFromRaise <> nil then if not CheckNoFigureInList(ObjFromRaise, aSelectedList) then CurrLine.Deselect; end; end; end; except on E: Exception do addExceptionToLogEx('UnSelectFiguresOnSelectedChange', E.Message); end; end; procedure ReCalcAllLinesLength; var i: integer; CurrLine: TOrthoLine; begin try if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin CurrLine := TOrthoLine(GCadForm.PCad.Figures[i]); if not CurrLine.FIsRaiseUpDown then begin CurrLine.CalculLength := CurrLine.LengthCalc; CurrLine.LineLength := CurrLine.CalculLength; CurrLine.UpdateLengthTextBox(false, true); SetLineFigureLengthInPM(CurrLine.ID, CurrLine.LineLength); end; end; end; end; except on E: Exception do addExceptionToLogEx('ReCalcAllLinesLength', E.Message); end; end; procedure RaiseActiveNet(aCad: TF_CAD); var i: integer; NetObject: TNet; NetExistObject: TNet; begin try //NetExistObject := nil; // for i := 0 to aCad.PCad.FigureCount - 1 do // begin // if CheckFigureByClassName(TFigure(aCad.PCad.Figures[i]), 'TNet') then // NetExistObject := TNet(aCad.PCad.Figures[i]); // end; // // Net // if NetExistObject <> nil then // begin // aCad.FActiveNet := NetExistObject; // ActiveNet := aCad.FActiveNet; // aCad.FActiveNet.MapScale := aCad.PCad.MapScale; // ActiveNet.MapScale := aCad.PCad.Mapscale; // if aCad.PCad.RulerMode = rmWorld then // aCad.FActiveNet.WorldDim := True // else // aCad.FActiveNet.WorldDim := False; // ActiveNet.WorldDim := aCad.FActiveNet.WorldDim; // end // else // begin // if not CheckFigureByClassName(aCad.FActiveNet, 'TNet') then // begin // aCad.FActiveNet := Tnet.create(8, mydsNormal, aCad.PCad); // end; // aCad.PCad.AddCustomFigure(8, aCad.FActiveNet, False); // ActiveNet := aCad.FActiveNet; // end; NetExistObject := nil; for i := 0 to aCad.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(aCad.PCad.Figures[i]), 'TNet') then begin NetObject := TNet(aCad.PCad.Figures[i]); SetCADParamsToNet(aCad, NetObject); // Если просто арх. план if NetObject.FComponID = 0 then begin NetExistObject := NetObject; aCad.FActiveNet := NetExistObject; ActiveNet := aCad.FActiveNet; end; end; end; if NetExistObject = nil then begin if not CheckFigureByClassName(aCad.FActiveNet, 'TNet') then begin aCad.FActiveNet := Tnet.create(8, mydsNormal, aCad.PCad); end; aCad.PCad.AddCustomFigure(8, aCad.FActiveNet, False); ActiveNet := aCad.FActiveNet; end; except on E: Exception do addExceptionToLogEx('U_Common.RaiseActiveNet', E.Message); end; end; procedure SetCADParamsToNet(aCad: TF_CAD; ANetObj: TObject); var Net: TNet; begin if (aCad <> nil) and (ANetObj <> nil) then begin Net := TNet(ANetObj); Net.MapScale := aCad.PCad.MapScale; if aCad.PCad.RulerMode = rmWorld then Net.WorldDim := True else Net.WorldDim := False; end; end; procedure SetMapScaleToNets(aCad: TF_CAD); var i: integer; NetObject: TNet; begin try for i := 0 to aCad.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(aCad.PCad.Figures[i]), 'TNet') then begin NetObject := TNet(aCad.PCad.Figures[i]); NetObject.SetMapScale(aCad.PCad.MapScale); //NetObject.MapScale := aCad.PCad.MapScale; end; end; except on E: Exception do AddExceptionToLogEx('SetMapScaleToNets', E.Message); end; end; procedure SetAllInFiguresVisible(AGroup: TFigureGrp; AVisible: Boolean); var i, j: integer; InFigure: TFigure; begin try for i := 0 to AGroup.InFigures.Count - 1 do begin AGroup.Visible := AVisible; InFigure := TFigureGrp(AGroup.InFigures[i]); if (InFigure is TFigureGrp) then begin SetAllInFiguresVisible(TFigureGrp(InFigure), AVisible); end else begin InFigure.Visible := AVisible; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetAllInFiguresVisible', E.Message); end; end; procedure SetAllStampFiguresLayer(AGroup: TFigureGrp; ALHandle: Integer); var i, j: integer; InFigure: TFigure; begin try for i := 0 to AGroup.InFigures.Count - 1 do begin AGroup.LayerHandle := ALHandle; InFigure := TFigureGrp(AGroup.InFigures[i]); if (InFigure is TFigureGrp) then begin SetAllStampFiguresLayer(TFigureGrp(InFigure), ALHandle); end else begin InFigure.LayerHandle := ALHandle; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetAllFiguresFromStamp', E.Message); end; end; procedure SetAllStampTextsFont(AGroup: TFigureGrp; aFontName: string); var i, j: integer; InFigure: TFigure; begin try for i := 0 to AGroup.InFigures.Count - 1 do begin InFigure := TFigureGrp(AGroup.InFigures[i]); if (InFigure is TFigureGrp) then begin SetAllStampTextsFont(TFigureGrp(InFigure), aFontName); end else if CheckFigureByClassName(InFigure, 'TText') then begin if TText(InFigure).Font.Name <> aFontName then TText(InFigure).Font.Name := aFontName; end else if CheckFigureByClassName(InFigure, 'TRichText') then begin if TRichText(InFigure).re.Font.Name <> aFontName then TRichText(InFigure).re.Font.Name := aFontName; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetAllStampTextsFont', E.Message); end; end; procedure UpdateForTexts(aFontName: string); var i: integer; FFigure: TFigure; Stamp: TFigureGrp; LHandle: Integer; begin try LHandle := GCadForm.PCad.GetLayerHandle(7); // SetAllStampTextsFont(TFigureGrp(GCadForm.FFrame), aFontName); for i := 0 to GCadForm.PCad.FigureCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Figures[i]); if FFigure is TFigureGrp then SetAllStampTextsFont(TFigureGrp(FFigure), aFontName); if CheckFigureByClassName(FFigure, 'TText') then begin if TText(FFigure).Font.Name <> aFontName then TText(FFigure).Font.Name := aFontName; end; if CheckFigureByClassName(FFigure, 'TRichText') then begin if TRichText(FFigure).re.Font.Name <> aFontName then TRichText(FFigure).re.Font.Name := aFontName; end; end; except on E: Exception do addExceptionToLogEx('U_Common.UpdateForTexts', E.Message); end; end; procedure ChangeObjectID(aListID, aOldID, aNewID: Integer); var FList: TF_CAD; FFigure: TFigure; begin try if aOldID <> aNewID then begin FList := GetListByID(aListID); if FList <> nil then begin FFigure := GetFigureByID(FList, aOldID); if FFigure <> nil then if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) then FFigure.ID := aNewID; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ChangeObjectID', E.Message); end; end; procedure ChangeCabinetID(aListID, aOldID, aNewID: Integer); var FList: TF_CAD; Cabinet: TFigure; begin try if aOldID <> aNewID then begin FList := GetListByID(aListID); if FList <> nil then begin Cabinet := FindCabinetBySCSID(Flist, aOldID); if Cabinet <> nil then begin if CheckFigureByClassname(Cabinet, cTCabinet) then begin TCabinet(Cabinet).FSCSID := aNewID; TCabinet(Cabinet).ID := aNewID; TCabinet(Cabinet).FNumberObject.FCabinetID := TCabinet(Cabinet).FSCSID; end else if CheckFigureByClassname(Cabinet, cTCabinetExt) then begin TCabinetExt(Cabinet).FSCSID := aNewID; TCabinetExt(Cabinet).ID := aNewID; TCabinetExt(Cabinet).FNumberObject.FCabinetID := TCabinetExt(Cabinet).FSCSID; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ChangeCabinetID', E.Message); end; end; function GetBetweenFloorObjectsID(AID_List: Integer; aClearJoins: Boolean = False): TIntList; var i, j, k: integer; FList: TF_CAD; FFigure: TFigure; InFigure: TFigure; FConn: TConnectorObject; FLine: TOrthoLine; begin Result := TIntList.Create; try FList := GetListByID(AID_List); if FList <> nil then begin for i := 0 to FList.PCad.FigureCount - 1 do begin FFigure := TFigure(FList.PCad.Figures[i]); if FFigure <> nil then begin // НАйдена группа - искать в ней if CheckFigureByClassName(FFigure, cTSCSFigureGrp) then begin for k := 0 to TSCSFigureGrp(FFigure).InFigures.Count - 1 do begin InFigure := TFigure(TSCSFigureGrp(FFigure).InFigures[k]); if CheckFigureByClassName(InFigure, cTConnectorObject) then begin FConn := TConnectorObject(InFigure); if (FConn.FConnRaiseType = crt_BetweenFloorUp) or (FConn.FConnRaiseType = crt_BetweenFloorDown) or (FConn.FConnRaiseType = crt_TrunkUp) or (FConn.FConnRaiseType = crt_TrunkDown) then begin for j := 0 to FConn.JoinedOrtholinesList.Count - 1 do begin FLine := TOrthoLine(FConn.JoinedOrtholinesList[j]); if FLine.FIsRaiseUpDown then Result.Add(FLine.ID); end; // очистить связи с другими этажами // при копировании листов if aClearJoins then begin FConn.FID_ListToPassage := -1; FConn.FID_ConnToPassage := -1; end; end; end; end; end else // искать на самом КАДе begin if CheckFigureByClassName(FFigure, cTConnectorObject) then begin FConn := TConnectorObject(FFigure); if (FConn.FConnRaiseType = crt_BetweenFloorUp) or (FConn.FConnRaiseType = crt_BetweenFloorDown) or (FConn.FConnRaiseType = crt_TrunkUp) or (FConn.FConnRaiseType = crt_TrunkDown) then begin for j := 0 to FConn.JoinedOrtholinesList.Count - 1 do begin FLine := TOrthoLine(FConn.JoinedOrtholinesList[j]); if FLine.FIsRaiseUpDown then Result.Add(FLine.ID); end; // очистить связи с другими этажами // при копировании листов if aClearJoins then begin FConn.FID_ListToPassage := -1; FConn.FID_ConnToPassage := -1; end; end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetBetweenFloorObjectsID', E.Message); end; end; procedure RemoveInFigureGrp(aFigureGrp: TFigureGrp); var i: integer; InFigure: TFigureGrp; FFigure: TFigure; begin try i := 0; while i < aFigureGrp.InFigures.Count do begin if CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrp') or CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpMod') or CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpNotMod') then begin InFigure := TFigureGrp(aFigureGrp.InFigures[i]); if Assigned(InFigure.FBeforeDelFromParent) then //22.09.2011 InFigure.FBeforeDelFromParent(InFigure); RemoveInFigureGrp(InFigure); aFigureGrp.RemoveFromGrp(InFigure); //28.04.2011 aFigureGrp.InFigures.Remove(InFigure); try FreeAndNil(InFigure); except end; end else begin FFigure := TFigure(aFigureGrp.InFigures[i]); if Assigned(FFigure.FBeforeDelFromParent) then //22.09.2011 FFigure.FBeforeDelFromParent(FFigure); aFigureGrp.RemoveFromGrp(FFigure); //28.04.2011 aFigureGrp.InFigures.Remove(FFigure); try FreeAndNil(FFigure); except end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message); end; end; { procedure ClearFiguresOnListDelete(aCAD: TF_CAD); var i, j, k, l: integer; FFigure, InFigure: TFigure; FigList: TList; OldTick, CurrTick: Cardinal; Procedure DelInfigures(aFigure: TFigure); var i, j :Integer; inFigure: TFigure; begin j := TFigureGrp(aFigure).InFigures.Count - 1; for i := j downto 0 do begin inFigure := TFigure(TFigureGRP(aFigure).InFigures[i]); if inFigure is TFigureGrp then DelInfigures(inFigure) else FreeAndNil(inFigure); end; end; begin try OldTick := GetTickCount; aCAD.PCad.DisableAlign; aCAD.PCad.BeginMultiDeselect; //02.04.2012 aCad.PCad.Locked := true; try j := aCad.PCad.FigureCount - 1; for i := j downto 0 do begin FFigure := TFigure(aCad.PCad.Figures[i]); if FFigure <> nil then begin // проверить, если межэтажный то удалить на другом этаже // ЕСЛИ ЛИСТ УДАЛЯЕТСЯ САМ (не закрытие проекта) if aCad.FNeedDelete then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then if (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkDown) then DeleteRaiseOtherFloor(TConnectorObject(FFigure)); end; // if FFigure is TFigureGrp then begin DelInFigures(FFigure); end; //aCad.PCad.Figures.Remove(FFigure); try FreeAndNil(FFigure); except end; end; end; finally end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end; } procedure ClearFiguresOnListDelete(aCAD: TF_CAD); var i, j: integer; FFigure: TFigure; FigList, GrpFigList: TList; OldTick, CurrTick: Cardinal; procedure DeleteGRPFigures(aFigureGrp: TFigureGrp; aCad: TF_Cad); var i: integer; InFigure: TFigureGrp; FFigure: TFigure; begin try if Assigned(aFigureGrp) then begin if Assigned(aFigureGrp.inFigures) then begin i := 0; for i := 0 to aFigureGrp.inFigures.Count - 1 do begin FFigure := TFigure(aFigureGrp.inFigures[i]); if aCad.PCad.Figures.IndexOf(FFigure) = -1 then begin try if GrpFigList.IndexOf(FFigure) = -1 then GrpFigList.Add(FFigure); if FFigure is TFigureGrp then DeleteGrpFigures(TFigureGrp(FFigure), aCad) else if CheckFigureByClassName(FFigure, 'TBlock') then DeleteGrpFigures(TFigureGrp(FFigure), aCad); except on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message); end; end; end; aFigureGrp.InFigures.Clear; end; end; except on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message); end; end; begin try GrpFigList := TList.Create; OldTick := GetTickCount; aCAD.PCad.DisableAlign; aCAD.PCad.BeginMultiDeselect; //02.04.2012 aCad.PCad.Locked := true; try FigList := TList.Create; for i := 0 to aCad.PCad.FigureCount - 1 do begin FFigure := TFigure(aCad.PCad.Figures[i]); FigList.Add(FFigure); end; for i := 0 to FigList.Count - 1 do //for i := j downto 0 do begin FFigure := TFigure(FigList[i]); // FFigure := TFigure(aCad.PCad.Figures[i]); if FFigure <> nil then begin // проверить, если межэтажный то удалить на другом этаже // ЕСЛИ ЛИСТ УДАЛЯЕТСЯ САМ (не закрытие проекта) if aCad.FNeedDelete then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then if (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkDown) then DeleteRaiseOtherFloor(TConnectorObject(FFigure)); end; try if GrpFigList.IndexOf(FFigure) = -1 then GrpFigList.Add(FFigure); if FFigure is TFigureGrp then begin DeleteGRPFigures(TFigureGrp(FFigure), aCAD) end else if CheckFigureByClassName(FFigure, 'TBlock') then DeleteGrpFigures(TFigureGrp(FFigure), aCad); except end; end; end; FigList.Clear; FreeAndNil(FigList); //aCad.FSCSFigures.Clear; //Tolik for i := 0 to aCad.PCad.Figures.Count - 1 do begin FFigure := TFigure(aCad.PCad.Figures[i]); if GrpFigList.IndexOf(fFigure) = -1 then GrpFigList.Add(FFigure); end; { for i := 0 to GrpFigList.Count - 1 do begin FFigure := TFigure(GrpFigList[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then begin for j := 0 to TOrthoLine(FFigure).JoinedFigures.Count - 1 do begin if GrpFigList.IndexOf(TFigure(TOrthoLine(FFigure).JoinedFigures[j])) = -1 then GrpFigList.Add(TOrthoLine(FFigure).JoinedFigures[j]); end; if GrpFigList.IndexOf(TOrthoLine(FFigure).JoinConnector1) = -1 then GrpFigList.Add(TOrthoLine(FFigure).JoinConnector1); if GrpFigList.IndexOf(TOrthoLine(FFigure).JoinConnector2) = -1 then GrpFigList.Add(TOrthoLine(FFigure).JoinConnector2); if GrpFigList.IndexOf(TOrthoLine(FFigure).JoinFigure1 ) = -1 then GrpFigList.Add(TOrthoLine(FFigure).JoinFigure1); if GrpFigList.IndexOf(TOrthoLine(FFigure).JoinFigure1 ) = -1 then GrpFigList.Add(TOrthoLine(FFigure).JoinFigure1); end; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin for j := 0 to TConnectorObject(FFigure).JoinedOrtholinesList.Count - 1 do begin if GrpFigList.IndexOf(TFigure(TConnectorObject(FFigure).JoinedOrtholinesList[j])) = -1 then GrpFigList.Add(TFigure(TConnectorObject(FFigure).JoinedOrtholinesList[j])); end; for j := 0 to TConnectorObject(FFigure).JoinedConnectorsList.Count - 1 do begin if GrpFigList.IndexOf(TFigure(TConnectorObject(FFigure).JoinedConnectorsList[j])) = -1 then GrpFigList.Add(TFigure(TConnectorObject(FFigure).JoinedConnectorsList[j])); end; for j := 0 to TConnectorObject(FFigure).JoinedFigures.Count - 1 do begin if GrpFigList.IndexOf(TFigure(TConnectorObject(FFigure).JoinedFigures[j])) = -1 then GrpFigList.Add(TFigure(TConnectorObject(FFigure).JoinedFigures[j])); end; end; end; } for i := 0 to GrpFigList.Count - 1 do begin FFigure := TFigure(GrpFigList[i]); if Assigned(FFigure) then begin try FreeAndNil(FFigure); except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end; end; GrpFigList.Clear; FreeAndNil(GrpFigList); aCad.PCad.Figures.Clear; aCad.FSCSFigures.Clear; finally aCAD.PCad.EndMultiDeselect; aCAD.PCad.EnableAlign; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end; (* procedure ClearFiguresOnListDelete(aCAD: TF_CAD); var i, j: integer; FFigure: TFigure; FigList, GrpFigList: TList; OldTick, CurrTick: Cardinal; procedure DeleteGRPFigures(aFigureGrp: TFigureGrp; aCad: TF_Cad); var i: integer; InFigure: TFigureGrp; FFigure: TFigure; begin try if Assigned(aFigureGrp) then begin if Assigned(aFigureGrp.inFigures) then begin i := 0; for i := 0 to aFigureGrp.inFigures.Count - 1 do begin FFigure := TFigure(aFigureGrp.inFigures[i]); if aCad.PCad.Figures.IndexOf(FFigure) = -1 then begin try FreeAndNil(FFigure); except on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message); end; end; end; {while i < aFigureGrp.InFigures.Count do begin // групповая фигура if CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrp') or CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpMod') or // CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TBlock') or CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpNotMod') then //Tolik begin InFigure := TFigureGrp(aFigureGrp.InFigures[i]); if Assigned(InFigure) then begin { if Assigned(InFigure.FBeforeDelFromParent) then //22.09.2011 InFigure.FBeforeDelFromParent(InFigure);} { DeleteGRPFigures(InFigure, aCad); aFigureGrp.RemoveFromGrp(InFigure); //28.04.2011 aFigureGrp.InFigures.Remove(InFigure); // если нет в списке фигур када - добавить в общий if aCad.PCad.Figures.IndexOf(inFigure) = -1 then //GrpFigList.Add(inFigure); FreeAndNil(inFigure); end; end else //Простая фигура begin FFigure := TFigure(aFigureGrp.InFigures[i]); if Assigned(FFigure) then begin if CheckFigureByClassName(FFigure, 'TBlock') then showmessage('TBlock Catched'); // если нет в списке фигур Када - удалить нах if ACad.PCad.Figures.IndexOf(FFigure) = -1 then begin if Assigned(FFigure.FBeforeDelFromParent) then //22.09.2011 FFigure.FBeforeDelFromParent(FFigure); aFigureGrp.RemoveFromGrp(FFigure); //28.04.2011 aFigureGrp.InFigures.Remove(FFigure); try FreeAndNil(FFigure); except end; end; end; end; end;} aFigureGRP.InFigures.Clear; end; end; except on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message); end; end; begin try OldTick := GetTickCount; GrpFigList := TList.Create; aCAD.PCad.DisableAlign; aCAD.PCad.BeginMultiDeselect; //02.04.2012 aCad.PCad.Locked := true; try FigList := TList.Create; for i := 0 to aCad.PCad.FigureCount - 1 do begin FFigure := TFigure(aCad.PCad.Figures[i]); FigList.Add(FFigure); end; for i := 0 to FigList.Count - 1 do //for i := j downto 0 do begin FFigure := TFigure(FigList[i]); // FFigure := TFigure(aCad.PCad.Figures[i]); if FFigure <> nil then begin // проверить, если межэтажный то удалить на другом этаже // ЕСЛИ ЛИСТ УДАЛЯЕТСЯ САМ (не закрытие проекта) if aCad.FNeedDelete then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then if (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkDown) then DeleteRaiseOtherFloor(TConnectorObject(FFigure)); end; // { if FFigure is TFigureGrp then RemoveInFigureGrp(TFigureGrp(FFigure)); aCad.PCad.Figures.Remove(FFigure);} try if FFigure is TFigureGrp then begin DeleteGRPFigures(TFigureGrp(FFigure), aCAD) end else begin aCad.PCad.Figures.Remove(FFigure); FreeAndNil(FFigure); end; except end; end; end; FigList.Clear; FreeAndNil(FigList); //aCad.FSCSFigures.Clear; //Tolik for i := 0 to aCad.PCad.Figures.Count - 1 do begin FFigure := TFigure(aCad.PCad.Figures[i]); try FreeAndNil(FFigure); except on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message); end; end; { for i := 0 to GrpFigList.Count - 1 do begin FFigure := TFigure(aCad.PCad.Figures[0]); if Assigned(FFigure) then begin try //aCad.FSCSFigures.Remove(FFigure.ID); FreeAndNil(FFigure); except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end; end; } { while aCad.PCad.FigureCount > 0 do begin FFigure := TFigure(aCad.PCad.Figures[0]); if Assigned(FFigure) then begin try //aCad.FSCSFigures.Remove(FFigure.ID); FreeAndNil(FFigure); aCad.PCad.Figures.Delete(0); Inc(CounterDeleted); except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end else begin aCad.PCad.Figures.Delete(0); // Inc(CounterDeleted); end; end; } aCad.PCad.Figures.Clear; aCad.FSCSFigures.Clear; finally aCAD.PCad.EndMultiDeselect; aCAD.PCad.EnableAlign; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end; *) (* procedure ClearFiguresOnListDelete(aCAD: TF_CAD); var i, j: integer; FFigure: TFigure; FigList, GrpFigList: TList; OldTick, CurrTick: Cardinal; //Tolik CounterDeleted: Integer; //Procedure DeleteGRPFigures procedure DeleteGRPFigures(aFigureGrp: TFigureGrp; aCad: TF_Cad); var i: integer; InFigure: TFigureGrp; FFigure: TFigure; begin try if Assigned(aFigureGrp) then begin if Assigned(aFigureGrp.inFigures) then begin i := 0; while i < aFigureGrp.InFigures.Count do begin // групповая фигура if CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrp') or CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpMod') or // CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TBlock') or CheckFigureByClassName(TFigure(aFigureGrp.InFigures[i]), 'TFigureGrpNotMod') then //Tolik begin InFigure := TFigureGrp(aFigureGrp.InFigures[i]); if Assigned(InFigure) then begin { if Assigned(InFigure.FBeforeDelFromParent) then //22.09.2011 InFigure.FBeforeDelFromParent(InFigure);} DeleteGRPFigures(InFigure, aCad); aFigureGrp.RemoveFromGrp(InFigure); //28.04.2011 aFigureGrp.InFigures.Remove(InFigure); // если нет в списке фигур када - добавить в общий if aCad.PCad.Figures.IndexOf(inFigure) = -1 then begin if GrpFigList.IndexOF(inFigure) = -1 then GrpFigList.Add(inFigure); // FreeAndNil(inFigure); end; end; end else //Простая фигура - удалить нах begin FFigure := TFigure(aFigureGrp.InFigures[i]); if Assigned(FFigure) then begin // если нет в списке фигур Када - удалить нах if ACad.PCad.Figures.IndexOf(FFigure) = -1 then begin if Assigned(FFigure.FBeforeDelFromParent) then //22.09.2011 FFigure.FBeforeDelFromParent(FFigure); aFigureGrp.RemoveFromGrp(FFigure); //28.04.2011 aFigureGrp.InFigures.Remove(FFigure); try FreeAndNil(FFigure); except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end; end; end; end; //aFigureGRP.InFigures.Clear; end; end; except on E: Exception do addExceptionToLogEx('U_Common.RemoveInFigureGrp', E.Message); end; end; begin try CounterDeleted := 0; OldTick := GetTickCount; GrpFigList := TList.Create; aCAD.PCad.DisableAlign; aCAD.PCad.BeginMultiDeselect; //02.04.2012 aCad.PCad.Locked := true; try FigList := TList.Create; for i := 0 to aCad.PCad.FigureCount - 1 do begin FFigure := TFigure(aCad.PCad.Figures[i]); FigList.Add(FFigure); end; for i := 0 to FigList.Count - 1 do //for i := j downto 0 do begin FFigure := TFigure(FigList[i]); // FFigure := TFigure(aCad.PCad.Figures[i]); if FFigure <> nil then begin // проверить, если межэтажный то удалить на другом этаже // ЕСЛИ ЛИСТ УДАЛЯЕТСЯ САМ (не закрытие проекта) if aCad.FNeedDelete then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then if (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FFigure).FConnRaiseType = crt_TrunkDown) then DeleteRaiseOtherFloor(TConnectorObject(FFigure)); end; // { if FFigure is TFigureGrp then RemoveInFigureGrp(TFigureGrp(FFigure)); aCad.PCad.Figures.Remove(FFigure);} try if FFigure is TFigureGrp then begin if CheckFigureByClassName(FFigure, 'TBlock') then Showmessage('TBLock Catched!'); DeleteGRPFigures(TFigureGrp(FFigure), aCAD) end else begin aCad.PCad.Figures.Remove(FFigure); //aCad.FSCSFigures.Remove(FFigure.ID); try FreeAndNil(FFigure); except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; Inc(CounterDeleted); end; except end; end; end; FigList.Clear; FreeAndNil(FigList); //aCad.FSCSFigures.Clear; //Tolik {for i := 0 to aCad.PCad.Figures.Count - 1 do begin FFigure := TFigure(aCad.PCad.Figures[i]); if GrpFigList.IndexOf(FFigure) = -1 then GrpFigList.Add(FFigure); end; } for i := 0 to GrpFigList.Count - 1 do begin FFigure := TFigure(GrpFigList[i]); if Assigned(FFigure) then begin try FreeAndNil(FFigure); except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end; end; {while aCad.PCad.FigureCount > 0 do begin FFigure := TFigure(aCad.PCad.Figures[0]); if Assigned(FFigure) then begin try //aCad.FSCSFigures.Remove(FFigure.ID); FreeAndNil(FFigure); aCad.PCad.Figures.Delete(0); Inc(CounterDeleted); except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end else begin aCad.PCad.Figures.Delete(0); // Inc(CounterDeleted); end; end;} GrpFigList.Clear; FreeAndNil(GrpFigList); aCad.PCad.Figures.Clear; aCad.FSCSFigures.Clear; finally aCAD.PCad.EndMultiDeselect; aCAD.PCad.EnableAlign; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; except on E: Exception do addExceptionToLogEx('U_Common.ClearFiguresonListDelete', E.Message); end; end; *) function CanListsInterchange(AIDMoveList, AID_List2: Integer; aMessRes: PInteger=nil; aMsg: Boolean=true): Boolean; var i, j: Integer; FList1, FList2: TF_CAD; FFiguresList1: TList; FFiguresList2: TList; OtherList: TF_CAD; Conn: TConnectorObject; Line: TOrthoLine; IsRaiseExist, IsRaiseExistOnMoveList: Boolean; mess: string; MessStyle: Integer; //04.04.2012 vLists: TList; SavedGCadForm: TF_CAD; DelObjs: Boolean; MessRes: Integer; begin Result := False; try IsRaiseExist := False; IsRaiseExistOnMoveList := false; FList1 := GetListByID(AIDMoveList); FList2 := GetListByID(AID_List2); if (FList1 = nil) or (FList2 = nil) then Exit; FFiguresList1 := TList.Create; FFiguresList2 := TList.Create; vLists := TList.create; vLists.Add(FList1); vLists.Add(FList2); for i := 0 to FList1.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(FList1.PCad.Figures[i]), cTConnectorObject) then if (TConnectorObject(FList1.PCad.Figures[i]).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FList1.PCad.Figures[i]).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(FList1.PCad.Figures[i]).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FList1.PCad.Figures[i]).FConnRaiseType = crt_TrunkDown) then begin IsRaiseExist := True; IsRaiseExistOnMoveList := true; Conn := TConnectorObject(FList1.PCad.Figures[i]); FFiguresList1.Add(Conn); // связующие этажи кроме тех которые уже в списке OtherList := GetListByID(Conn.FID_ListToPassage); if OtherList <> nil then if CheckNoCadInList(OtherList, vLists) then vLists.Add(OtherList); end; end; for i := 0 to FList2.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(FList2.PCad.Figures[i]), cTConnectorObject) then if (TConnectorObject(FList2.PCad.Figures[i]).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(FList2.PCad.Figures[i]).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(FList2.PCad.Figures[i]).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(FList2.PCad.Figures[i]).FConnRaiseType = crt_TrunkDown) then begin IsRaiseExist := True; Conn := TConnectorObject(FList2.PCad.Figures[i]); FFiguresList2.Add(Conn); // связующие этажи кроме тех которые уже в списке OtherList := GetListByID(Conn.FID_ListToPassage); if OtherList <> nil then if CheckNoCadInList(OtherList, vLists) then vLists.Add(OtherList); end; end; if IsRaiseExist then begin //04.04.2012 mess := cCommon_Mes14; if aMsg then begin // Если есть на перемещаемом листе, то предлагаем разорвать связи //04.04.2012 if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCommon_Mes15, MB_YESNO) then DelObjs := false; MessRes := -1; if aMessRes <> nil then MessRes := aMessRes^; if MessRes = -1 then begin if IsRaiseExistOnMoveList then begin mess := cCommon_Mes14; MessStyle := MB_YESNO; end else begin mess := cCommon_Mes14_2; MessStyle := MB_YESNOCANCEL; end; MessRes := MessageModal(mess, cCommon_Mes15, MessStyle); if aMessRes <> nil then aMessRes^ := MessRes; end; if MessRes = IDYes then DelObjs := true; if DelObjs then begin SaveForProjectUndo(vLists, True, False); BeginProgress; try SavedGCadForm := GCadForm; // удаление всех м-э с-п for i := 0 to FFiguresList1.Count - 1 do begin Conn := TConnectorObject(FFiguresList1[i]); GCadForm := FList1; Conn.Delete; end; for i := 0 to FFiguresList2.Count - 1 do begin Conn := TConnectorObject(FFiguresList2[i]); GCadForm := FList2; Conn.Delete; end; Result := True; RefreshCAD(FList1.PCad); RefreshCAD(FList2.PCad); GCadForm := SavedGCadForm; finally EndProgress; end; end else Result := False; end else Result := False; end else Result := True; FreeAndNil(FFiguresList1); FreeAndNil(FFiguresList2); FreeAndNil(vLists); except on E: Exception do addExceptionToLogEx('U_Common.CanListsInterchange', E.Message); end; end; function CheckListWithFloorRaise(aListID: Integer): Boolean; var List: TF_CAD; i: Integer; Fig: TFigure; begin Result := false; List := GetListByID(aListID); if List <> nil then for i := 0 to List.PCad.Figures.Count - 1 do begin Fig := TFigure(List.PCad.Figures[i]); if CheckFigureByClassName(TFigure(Fig), cTConnectorObject) then if (TConnectorObject(Fig).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(Fig).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(Fig).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(Fig).FConnRaiseType = crt_TrunkDown) then begin Result := true; Break; //// BREAK //// end; end; end; function GetTraceInfo(AID_List: Integer): TList; var FList: TF_CAD; i: integer; CurrTrace: TOrthoLine; ptrTraceInfo: PTraceInfo; begin Result := TList.Create; try FList := GetListByID(AID_List); if FList <> nil then begin for i := 0 to FList.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(FList.PCad.Figures[i]), cTOrthoLine) then begin CurrTrace := TOrthoLine(FList.PCad.Figures[i]); New(ptrTraceInfo); ptrTraceInfo.FigureID := CurrTrace.ID; ptrTraceInfo.HeightSide1 := CurrTrace.ActualZOrder[1]; ptrTraceInfo.HeightSide2 := CurrTrace.ActualZOrder[2]; ptrTraceInfo.IsSelected := CurrTrace.Selected; if (CurrTrace.FIsRaiseUpDown) or (CurrTrace.FIsVertical) then begin ptrTraceInfo.Position := tpVertical; end else begin if CurrTrace.ActualZOrder[1] = CurrTrace.ActualZOrder[2] then ptrTraceInfo.Position := tpHorizontal else ptrTraceInfo.Position := tpIncline; end; Result.Add(ptrTraceInfo); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetTraceInfo', E.Message); end; end; function IsStringListsDifferent(aStringList: TStringList; aStrings: TStrings): Boolean; var i, j: integer; begin Result := False; try if (aStringList = nil) or (aStrings = nil) then begin Result := True; Exit; end; if aStringList.Count <> aStrings.Count then begin Result := True; end else begin for i := 0 to aStringList.Count - 1 do begin if aStringList[i] <> aStrings[i] then Result := True; end; end; except on E: Exception do addExceptionToLogEx('TF_SCSObjectsProp.IsCompareStringLists', E.Message); end; end; procedure FindObjectsForConvertClasses; var i, j: integer; FLine: TOrthoLine; FConn: TConnectorObject; NotesCaptions: TRichTextMod; Captions: TRichTextMod; LinesList: TList; ConnsList: TList; Str: string; Background: TRectangle; SCSFigureGrp: TSCSFigureGrp; begin try LinesList := TList.Create; ConnsList := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin LinesList.Add(TFigure(GCadForm.PCad.Figures[i])); end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin ConnsList.Add(TFigure(GCadForm.PCad.Figures[i])); end; // В ГРУППЕ if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(GCadForm.PCad.Figures[i]); for j := 0 to SCSFigureGrp.InFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(SCSFigureGrp.InFigures[j]), cTConnectorObject) then TConnectorObject(SCSFigureGrp.InFigures[j]).CaptionsGroup := TRichTextMod(TConnectorObject(SCSFigureGrp.InFigures[j]).tmpCaptionsGroup); if CheckFigureByClassName(TFigure(SCSFigureGrp.InFigures[j]), cTOrthoLine) then TOrthoLine(SCSFigureGrp.InFigures[j]).CaptionsGroup := TFigureGrpNotMod(TOrthoLine(SCSFigureGrp.InFigures[j]).tmpCaptionsGroup); end; end; end; // Конвертить классы for i := 0 to LinesList.Count - 1 do begin FLine := TOrthoLine(LinesList[i]); // CaptionGroup if FLine.tmpCaptionsGroup <> nil then begin // старые форматы if FLine.tmpCaptions = nil then begin GCadForm.PCad.Figures.Remove(FLine.tmpCaptionsGroup); FreeAndNil(FLine.tmpCaptionsGroup); FLine.ReCreateCaptionsGroup(True, false); end // самый новый формат else begin FLine.CaptionsGroup := TFigureGrpNotMod(FLine.tmpCaptionsGroup); end; FLine.CaptionsGroup.LockModify := True; FLine.tmpCaptionsGroup := nil; FLine.tmpCaptions := nil; end else begin FLine.CalculLength := FLine.LengthCalc; FLine.LineLength := FLine.CalculLength; if FLine.OutTextCaptions.Count = 0 then begin Str := GetLineCaptionFormat(FLine, GCadForm.FShowLineCaptionsType); FLine.OutTextCaptions.Add(Str); end else begin Str := GetLineCaptionFormat(FLine, GCadForm.FShowLineCaptionsType); FLine.OutTextCaptions[0] := Str; end; FLine.ReCreateCaptionsGroup(True, false); end; // NotesCaptions if FLine.tmpNotesCaptions <> nil then begin if CheckFigureByClassName(FLine.tmpNotesCaptions, cTFigureGrpNotMod) then begin FLine.NotesGroup := ConvertNotesGroupToRichText(FLine.NotesGroup, True); FLine.ReCreateNotesGroup; end; FLine.NotesGroup.LockModify := True; FLine.tmpNotesCaptions := nil; end else begin FLine.ReCreateNotesGroup(True); end; end; for i := 0 to ConnsList.Count - 1 do begin FConn := TConnectorObject(ConnsList[i]); // CaptionGroup if FConn.ConnectorType = ct_Clear then begin if FConn.tmpCaptionsGroup <> nil then begin if CheckFigureByClassName(FConn.tmpCaptionsGroup, cTFigureGrpNotMod) then RemoveInFigureGrp(TFigureGrp(FConn.tmpCaptionsGroup)); GCadForm.PCad.Figures.Remove(FConn.tmpCaptionsGroup); FreeAndNil(FConn.tmpCaptionsGroup); end; end; if FConn.tmpCaptionsGroup <> nil then begin if CheckFigureByClassName(FConn.tmpCaptionsGroup, cTFigureGrpNotMod) then begin FConn.CaptionsGroup := ConvertCaptionsGroupToRichText(TFigureGrpNotMod(FConn.tmpCaptionsGroup), False); FConn.ReCreateCaptionsGroup(false, false); FConn.DefRaizeDrawFigurePos; end else begin FConn.CaptionsGroup := TRichTextMod(FConn.tmpCaptionsGroup); end; FConn.CaptionsGroup.LockModify := True; FConn.tmpCaptionsGroup := nil; end; // NotesCaptions if FConn.ConnectorType = ct_Clear then begin if FConn.NotesGroup <> nil then begin RemoveInFigureGrp(TFigureGrp(FConn.NotesGroup)); GCadForm.PCad.Figures.Remove(FConn.NotesGroup); FreeAndNil(FConn.NotesGroup); end; end; if FConn.NotesGroup <> nil then if FConn.tmpNotesCaptions <> nil then begin if CheckFigureByClassName(FConn.tmpNotesCaptions, cTFigureGrpNotMod) then begin FConn.NotesGroup := ConvertNotesGroupToRichText(FConn.NotesGroup, False); FConn.ReCreateNotesGroup; end else begin end; FConn.NotesGroup.LockModify := True; FConn.tmpNotesCaptions := nil; end; end; FreeAndNil(LinesList); FreeAndNil(ConnsList); except on E: Exception do addExceptionToLogEx('U_Common.FindObjectsForConvertClasses', E.Message); end; end; Function ConvertCaptionsGroupToRichText(aCaptionsGroup: TFigureGrpNotMod; aIsLine: Boolean): TRichTextMod; var i: integer; tempstr: string; StrList: TStringList; LHandle: Integer; CPoints: TDoublePoint; Angle: Double; RichTextMod: TRichTextMod; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; begin Result := nil; try // сохранить данные с FigureGroup CPoints := aCaptionsGroup.CenterPoint; LHandle := aCaptionsGroup.LayerHandle; Angle := aCaptionsGroup.AngletoPoint; StrList := TStringList.Create; for i := 0 to aCaptionsGroup.InFigures.Count - 1 do begin tempstr := TText(aCaptionsGroup.InFigures[i]).Text; StrList.Add(tempstr); end; // удалить FigureGroup RemoveInFigureGrp(aCaptionsGroup); GCadForm.PCad.Figures.Remove(aCaptionsGroup); FreeAndNil(aCaptionsGroup); // Создать и Обработать RichText if aIsLine then RichTextMod := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption) else RichTextMod := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Caption); RichTextMod.RE.Lines.Clear; for i := 0 to StrList.Count - 1 do RichTextMod.re.Lines.Add(StrList.Strings[i]); GCadForm.PCad.AddCustomFigure(GLN (LHandle), RichTextMod, False); RefreshCAD(GCadForm.PCad); xCanvas := TMetafileCanvas.Create(RichTextMod.Metafile, 0); xCanvas.Font.Name := RichTextMod.re.Font.Name; xCanvas.Font.Size := RichTextMod.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * RichTextMod.re.Lines.Count + 1; w := 0; for i := 0 to RichTextMod.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(RichTextMod.Re.Lines[i]) then w := xCanvas.TextWidth(RichTextMod.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); GCadForm.PCad.Figures.Remove(RichTextMod); FreeAndNil(RichTextMod); if aIsLine then RichTextMod := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Caption) else RichTextMod := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Caption); RichTextMod.RE.Lines.Clear; for i := 0 to StrList.Count - 1 do RichTextMod.re.Lines.Add(StrList.Strings[i]); RichTextMod.Move(CPoints.x - RichTextMod.CenterPoint.x, CPoints.y - RichTextMod.CenterPoint.y); RichTextMod.rotate(Angle, RichTextMod.CenterPoint); GCadForm.PCad.AddCustomFigure(GLN (LHandle), RichTextMod, False); // FreeAndNil(StrList); Result := RichTextMod; except on E: Exception do addExceptionToLogEx('U_Common.ConvertCaptionsGroupToRichText', E.Message); end; end; Function ConvertNotesGroupToRichText(aNotesGroup: TFigureGrpNotMod; aIsLine: Boolean): TFigureGrpNotMod; var i: integer; tempstr: string; StrList: TStringList; LHandle: Integer; CPoints: TDoublePoint; Angle: Double; RichTextMod: TRichTextMod; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; NotesCaptions: TFigureGrpNotMod; begin Result := nil; try NotesCaptions := TFigureGrpNotMod(aNotesGroup.InFigures[1]); // сохранить данные с FigureGroup CPoints := NotesCaptions.CenterPoint; LHandle := NotesCaptions.LayerHandle; Angle := NotesCaptions.AngletoPoint; StrList := TStringList.Create; for i := 0 to NotesCaptions.InFigures.Count - 1 do begin tempstr := TText(NotesCaptions.InFigures[i]).Text; StrList.Add(tempstr); end; // удалить FigureGroup RemoveInFigureGrp(NotesCaptions); aNotesGroup.RemoveFromGrp(NotesCaptions); //28.04.2011 aNotesGroup.InFigures.Remove(NotesCaptions); FreeAndNil(NotesCaptions); // Создать и Обработать RichText if aIsLine then RichTextMod := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Note) else RichTextMod := TRichTextMod.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Note); RichTextMod.RE.Lines.Clear; for i := 0 to StrList.Count - 1 do RichTextMod.re.Lines.Add(StrList.Strings[i]); GCadForm.PCad.AddCustomFigure(GLN (LHandle), RichTextMod, False); RefreshCAD(GCadForm.PCad); xCanvas := TMetafileCanvas.Create(RichTextMod.Metafile, 0); xCanvas.Font.Name := RichTextMod.re.Font.Name; xCanvas.Font.Size := RichTextMod.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * RichTextMod.re.Lines.Count + 1; w := 0; for i := 0 to RichTextMod.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(RichTextMod.Re.Lines[i]) then w := xCanvas.TextWidth(RichTextMod.Re.Lines[i]); end; w := (w + 3) / 4; FreeAndNil(xCanvas); GCadForm.PCad.Figures.Remove(RichTextMod); FreeAndNil(RichTextMod); if aIsLine then RichTextMod := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad, rot_Line, rnt_Note) else RichTextMod := TRichTextMod.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad, rot_Conn, rnt_Note); RichTextMod.RE.Lines.Clear; for i := 0 to StrList.Count - 1 do RichTextMod.re.Lines.Add(StrList.Strings[i]); RichTextMod.Move(CPoints.x - RichTextMod.CenterPoint.x, CPoints.y - RichTextMod.CenterPoint.y); RichTextMod.rotate(Angle, RichTextMod.CenterPoint); aNotesGroup.AddFigure(RichTextMod); // FreeAndNil(StrList); Result := aNotesGroup; except on E: Exception do addExceptionToLogEx('U_Common.ConvertCaptionsGroupToRichText', E.Message); end; end; Function GetFiguresByLevel(aFigure: TFigure; X, Y: Double; aSameType: Boolean; ASort: Boolean=false): TList; var i: integer; FFigure: TFigure; FLine: TOrthoLine; FConn: TConnectorObject; CurrLine: TOrthoLine; CurrConn: TConnectorObject; function GetItemHeight(AFigure: TFigure): Double; begin Result := 0; if CheckFigureByClassName(AFigure, cTOrthoLine) then if TOrthoLine(AFigure).ActualZOrder[1] = TOrthoLine(AFigure).ActualZOrder[2] then Result := TOrthoLine(AFigure).ActualZOrder[1] else Result := Min(TOrthoLine(AFigure).ActualZOrder[1], TOrthoLine(AFigure).ActualZOrder[2]); if CheckFigureByClassName(AFigure, cTConnectorObject) then Result := TConnectorObject(AFigure).ActualZOrder[1]; end; function CompareMenuItems(Item1, Item2: Pointer): Integer; var h1, h2: Double; begin Result := 0; h1 := GetItemHeight(TFigure(Item1)); h2 := GetItemHeight(TFigure(Item2)); if h1 > h2 then Result := 1 else if h1 < h2 then Result := -1; end; begin Result := TList.Create; try // Трасса if aSameType then begin if CheckFigureByClassName(aFigure, cTOrthoLine) then begin FLine := TOrthoLine(aFigure); Result.Add(FLine); if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; //for i := 0 to GCadForm.PCad.FigureCount - 1 do for i := 0 to GCadForm.FCheckedFigures.Count - 1 do begin //if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[i]), cTOrthoLine) then begin //CurrLine := TOrthoLine(GCadForm.PCad.Figures[i]); CurrLine := TOrthoLine(GCadForm.FCheckedFigures[i]); if FLine <> CurrLine then begin if CurrLine.IsPointIn(X, Y) then Result.Add(CurrLine); end; end; end; end; // Коннектор if CheckFigureByClassName(aFigure, cTConnectorObject) then begin FConn := TConnectorObject(aFigure); Result.Add(FConn); if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; //for i := 0 to GCadForm.PCad.FigureCount - 1 do for i := 0 to GCadForm.FCheckedFigures.Count - 1 do begin //if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[i]), cTConnectorObject) then begin //CurrConn := TConnectorObject(GCadForm.PCad.Figures[i]); CurrConn := TConnectorObject(GCadForm.FCheckedFigures[i]); if FConn <> CurrConn then begin if CurrConn.ConnectorType = ct_Clear then begin if CurrConn.JoinedConnectorsList.Count = 0 then if CurrConn.IsPointIn(X, Y) then Result.Add(CurrConn); end else begin if CurrConn.IsPointIn(X, Y) then Result.Add(CurrConn); end; end; end; end; end; end else begin Result.Add(aFigure); if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; //for i := 0 to GCadForm.PCad.FigureCount - 1 do for i := 0 to GCadForm.FCheckedFigures.Count - 1 do begin //FFigure := TFigure(GCadForm.PCad.Figures[i]); FFigure := TFigure(GCadForm.FCheckedFigures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin CurrConn := TConnectorObject(FFigure); if aFigure <> CurrConn then begin if CurrConn.ConnectorType = ct_Clear then begin if CurrConn.JoinedConnectorsList.Count = 0 then if CurrConn.IsPointIn(X, Y) then Result.Add(CurrConn); end else begin if CurrConn.IsPointIn(X, Y) then Result.Add(CurrConn); end; end; end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin CurrLine := TOrthoLine(FFigure); if aFigure <> CurrLine then begin if CurrLine.IsPointIn(X, Y) then Result.Add(CurrLine); end; end; end; end; if ASort then Result.Sort(@CompareMenuItems); except on E: Exception do addExceptionToLogEx('U_Common.GetFiguresByLevel', E.Message); end; end; Function GetObjectsByVertical(aSelf, aSnapConnector: TConnectorObject): TList; var i: integer; FFigure: TFigure; FLine: TOrthoLine; FConn: TConnectorObject; CurrLine: TOrthoLine; CurrConn: TConnectorObject; X, Y, Z: double; begin Result := TList.Create; try Result.Add(aSnapConnector); X := aSnapConnector.ActualPoints[1].x; Y := aSnapConnector.ActualPoints[1].y; Z := aSelf.ActualZOrder[1]; if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; //for i := 0 to GCadForm.PCad.FigureCount - 1 do for i := 0 to GCadForm.FCheckedFigures.Count - 1 do begin //FFigure := TFigure(GCadForm.PCad.Figures[i]); FFigure := TFigure(GCadForm.FCheckedFigures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin CurrConn := TConnectorObject(FFigure); if (CurrConn <> aSelf) and (CurrConn <> aSnapConnector) then begin if CurrConn.ConnectorType = ct_Clear then begin if CurrConn.JoinedConnectorsList.Count = 0 then if CurrConn.IsPointIn(X, Y) then Result.Add(CurrConn); end else begin if CurrConn.IsPointIn(X, Y) then Result.Add(CurrConn); end; end; end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin CurrLine := TOrthoLine(FFigure); if CurrLine.FIsVertical then begin if CurrLine.IsPointIn(X, Y) then if CheckVerticalInInterval(CurrLine, Z) then Result.Add(CurrLine); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetObjectsByVertical', E.Message); end; end; Function GetLinesByVertical(aSelf: TConnectorObject; aSnapLine: TOrthoLine): TList; var i: integer; FFigure: TFigure; FLine: TOrthoLine; FConn: TConnectorObject; CurrLine: TOrthoLine; CurrConn: TConnectorObject; X, Y: double; begin Result := TList.Create; try Result.Add(aSnapLine); X := aSnapLine.ActualPoints[1].x; Y := aSnapLine.ActualPoints[1].y; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then begin CurrLine := TOrthoLine(FFigure); if CurrLine <> aSnapLine then if CurrLine.FIsVertical then begin if CurrLine.IsPointIn(X, Y) then Result.Add(CurrLine); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetFiguresByLevel', E.Message); end; end; Function CheckVerticalInInterval(aVertical: TOrthoLine; aZ: Double): Boolean; var z1, z2: double; begin Result := False; try if (aVertical.ActualZOrder[2] > aVertical.ActualZOrder[1]) then begin z1 := aVertical.ActualZOrder[1]; z2 := aVertical.ActualZOrder[2]; end else begin z1 := aVertical.ActualZOrder[2]; z2 := aVertical.ActualZOrder[1]; end; if (aZ >= z1) and (aZ <= z2) then Result := True; except on E: Exception do AddExceptionToLogEx('U_Common.CheckVerticalInInterval', E.Message); end; end; Procedure DeleteRaiseOtherFloor(aItRaise: TConnectorObject); var ListOfPassage: TF_CAD; ConnOfPassage: TConnectorObject; CurGCadForm: TF_CAD; SCSFigureGrp: TSCSFigureGrp; begin try ListOfPassage := GetListOfPassage(aItRaise.FID_ListToPassage); if ListOfPassage <> nil then begin ConnOfPassage := TConnectorObject(GetFigureByID(ListOfPassage, aItRaise.FID_ConnToPassage)); if ConnOfPassage <> nil then begin CurGCadForm := GCadForm; GCadForm := ListOfPassage; ConnOfPassage.FConnRaiseType := crt_None; ConnOfPassage.Delete(True); RefreshCAD(GCadForm.PCad); GCadForm := CurGCadForm; end else begin SCSFigureGrp := GetSCSFigureGrp(ListOfPassage, aItRaise.FID_ConnToPassage); if SCSFigureGrp <> nil then begin ConnOfPassage := TConnectorObject(GetFigureByIDInSCSFigureGrp(SCSFigureGrp, aItRaise.FID_ConnToPassage)); if ConnOfPassage <> nil then begin CurGCadForm := GCadForm; GCadForm := ListOfPassage; ConnOfPassage.FConnRaiseType := crt_None; DeleteObjectFromSCSFigureGrp(SCSFigureGrp, ConnOfPassage); RefreshCAD(GCadForm.PCad); GCadForm := CurGCadForm; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.DeleteRaiseOtherFloor', E.Message); end; end; Function MirrorCables(aClearConn: TConnectorObject; aNearTracedLine: TOrthoLine): Integer; var i,j: integer; CurrConn: TConnectorObject; CurrLine: TOrthoLine; mess: string; Count: Integer; MessBoxResult: Integer; Side: Integer; begin Result := 0; try for i := 0 to aClearConn.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(aClearConn.JoinedOrtholinesList[i]); if CurrLine <> aNearTracedLine then begin Side := 1; //#From Oleg# //14.09.2010 if CurrLine.JoinConnector1 = aClearConn then Side := 1; if CurrLine.JoinConnector2 = aClearConn then Side := 2; Count := GetCablesCountFromTrace(CurrLine.ID, Side, GDropComponent.ID); if count > 1 then begin mess := cCommon_Mes16 + IntTostr(Count) + cCommon_Mes17 + #13#10 + cCommon_Mes18; MessBoxResult := MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCommon_Mes19, MB_YESNOCANCEL); if MessBoxResult = IDYes then begin Result := Count; exit; end else if MessBoxResult = IDNo then Result := 1; if MessBoxResult = IDCancel then exit; end else begin Result := 1; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.MirrorCables', E.Message); end; end; Function CheckCanTracingBetweenFloor(aLists: TIntList; aRaises: TList): Boolean; var i: integer; begin Result := True; try if aLists.Count <> aRaises.Count + 1 then Result := False; for i := 0 to aRaises.Count - 1 do if aRaises[i] = Nil then Result := False; except on E: Exception do addExceptionToLogEx('U_Common.CheckCanTracingBetweenFloor', E.Message); end; end; Function GetSortedListOfRaises(var aLists: TIntList; aRaiseType: TConnRaiseType; aEndPoint, aBeginPoint: TConnectorObject): TList; var i, j: Integer; RaiseConn: TConnectorObject; ListID: Integer; CurCad: TF_CAD; RaisesList: TList; ResList: TList; ListIndex: Integer; GlobalExit: Boolean; aRaiseType1, aRaiseType2: TConnRaiseType; OtherListIndex: Integer; ResListOfLists: TList; Procedure DoFindRaises(aCadForm: TF_CAD; aRaiseType: TConnRaiseType; aConnFrom, aConnTo: TConnectorObject; aListIndex: Integer); var i, j: integer; CurrRaise: TConnectorObject; OtherRaise: TConnectorObject; OtherCadList: TF_CAD; RaisesList: TList; AllTrace: TList; begin try RaisesList := TList.Create; if aCadForm <> nil then begin // если последний лист if aListIndex = ListIndex then begin AllTrace := GetAllTraceInCAD(aConnFrom, aBeginPoint); if AllTrace <> nil then begin GlobalExit := True; Exit; end; end // иначе снова искать с-п else begin aRaiseType1 := crt_none; aRaiseType2 := crt_none; if aRaiseType = crt_BetweenFloorUp then begin aRaiseType1 := crt_BetweenFloorUp; aRaiseType2 := crt_TrunkUp; end; if aRaiseType = crt_BetweenFloorDown then begin aRaiseType1 := crt_BetweenFloorDown; aRaiseType2 := crt_TrunkDown; end; for i := 0 to aCadForm.PCad.FigureCount - 1 do if CheckFigureByClassName(TFigure(aCadForm.PCad.Figures[i]), cTConnectorObject) then if (TConnectorObject(aCadForm.PCad.Figures[i]).FConnRaiseType = aRaiseType1) or (TConnectorObject(aCadForm.PCad.Figures[i]).FConnRaiseType = aRaiseType2) then RaisesList.Add(TConnectorObject(aCadForm.PCad.Figures[i])); end; end; if RaisesList.Count > 0 then begin for i := 0 to RaisesList.Count - 1 do begin if GlobalExit then Exit; CurrRaise := TConnectorObject(RaisesList[i]); AllTrace := GetAllTraceInCAD(aConnFrom, CurrRaise); if AllTrace <> nil then begin OtherCadList := GetListByID(CurrRaise.FID_ListToPassage); OtherRaise := TConnectorObject(GetFigureByID(OtherCadList, CurrRaise.FID_ConnToPassage)); if (OtherRaise <> nil) and (OtherCadList <> nil) then begin ResList.Add(CurrRaise); OtherListIndex := aLists.IndexOf(OtherCadList.FCADListID); // &&& ResListOfLists.Add(OtherCadList); // &&& DoFindRaises(OtherCadList, aRaiseType, OtherRaise, aBeginPoint, OtherListIndex {aListIndex + 1}); end; end; end; end; begin if GlobalExit then Exit; if ResList.Count > 0 then ResList.Delete(ResList.Count - 1); if ResListOfLists.Count > 0 then ResListOfLists.Delete(ResListOfLists.Count - 1); Exit; end; if RaisesList <> nil then FreeAndNil(RaisesList); if AllTrace <> nil then FreeAndNil(AllTrace); except on E: Exception do addExceptionToLogEx('U_Common.GetBetweenFloorRaises', E.Message); end; end; begin ResList := TList.Create; try ResListOfLists := TList.Create; ListIndex := aLists.Count - 1; ListID := aLists[0]; CurCad := GetListByID(ListID); GlobalExit := False; // &&& ResListOfLists.Add(CurCad); // &&& DoFindRaises(CurCad, aRaiseType, aEndPoint, aBeginPoint, 0); Result := ResList; aLists := CadsToIntCads(ResListOfLists); except on E: Exception do addExceptionToLogEx('U_Common.GetSortedListOfRaises', E.Message); end; end; // ***************************************************************************** Function GetSortedListOfRaisesFromCurr(var aLists: TIntList; aRaiseType: TConnRaiseType; aBeginPoint, aEndPoint: TConnectorObject): TList; var i, j: Integer; RaiseConn: TConnectorObject; ListID: Integer; CurCad: TF_CAD; RaisesList: TList; ResList: TList; ListIndex: Integer; GlobalExit: Boolean; aRaiseType1, aRaiseType2: TConnRaiseType; ResListOfLists: TList; function GetMarkedCount(aCurrList: TList): Integer; var i: Integer; vFigure: TFigure; begin Result := 0; for i := 0 to aCurrList.Count - 1 do begin vFigure := TFigure(aCurrList[i]); if CheckFigureByClassName(vFigure, cTOrthoLine) then if TOrthoLine(vFigure).FMarkTracing then Result := Result + 1; end; end; function GetMaxMarkedCount(aList: TList): Integer; var i: Integer; AllTraces: TList; MaxMarked: Integer; CurMarked: Integer; begin Result := 0; try MaxMarked := 0; for i := 0 to aList.Count - 1 do begin AllTraces := TList(aList[i]); CurMarked := GetMarkedCount(AllTraces); if CurMarked > MaxMarked then MaxMarked := CurMarked; end; Result := MaxMarked; except on E: Exception do addExceptionToLogEx('U_Common.GetMaxMarkedCount', E.Message); end; end; function GetSortedRaisesByMarked(aCurrConn: TConnectorObject; aRaises: TList): TList; var i, j: Integer; CurrRaise: TConnectorObject; ListOfAllTraces: TList; CurMarked, MaxMarked: Integer; MaxIndex: Integer; begin Result := TList.create; try i := 0; while i < aRaises.Count do begin CurrRaise := TConnectorObject(aRaises[i]); ListOfAllTraces := GetAllTraceInCADByMarked(CurrRaise, aCurrConn); CurMarked := GetMaxMarkedCount(ListOfAllTraces); MaxMarked := CurMarked; MaxIndex := 0; for j := 1 to aRaises.Count - 1 do begin CurrRaise := TConnectorObject(aRaises[j]); ListOfAllTraces := GetAllTraceInCADByMarked(CurrRaise, aCurrConn); CurMarked := GetMaxMarkedCount(ListOfAllTraces); if CurMarked > MaxMarked then begin MaxMarked := CurMarked; MaxIndex := j; end; end; Result.Add(aRaises[MaxIndex]); aRaises.Delete(MaxIndex); end; except on E: Exception do addExceptionToLogEx('U_Common.GetSortedRaisesByMarked', E.Message); end; end; Procedure DoFindRaises(aCadForm: TF_CAD; aRaiseType: TConnRaiseType; aConnFrom, aConnTo: TConnectorObject; aListIndex: Integer); var i, j: integer; CurrRaise: TConnectorObject; OtherRaise: TConnectorObject; OtherCadList: TF_CAD; RaisesList: TList; AllTrace: TList; OtherListIndex: Integer; begin try RaisesList := TList.Create; if aCadForm <> nil then begin // если последний лист if aListIndex = ListIndex then begin AllTrace := GetAllTraceInCAD(aConnFrom, aEndPoint); if AllTrace <> nil then begin GlobalExit := True; Exit; end; end // иначе снова искать с-п else begin aRaiseType1 := crt_none; aRaiseType2 := crt_none; if aRaiseType = crt_BetweenFloorUp then begin aRaiseType1 := crt_BetweenFloorUp; aRaiseType2 := crt_TrunkUp; end; if aRaiseType = crt_BetweenFloorDown then begin aRaiseType1 := crt_BetweenFloorDown; aRaiseType2 := crt_TrunkDown; end; for i := 0 to aCadForm.PCad.FigureCount - 1 do if CheckFigureByClassName(TFigure(aCadForm.PCad.Figures[i]), cTConnectorObject) then if (TConnectorObject(aCadForm.PCad.Figures[i]).FConnRaiseType = aRaiseType1) or (TConnectorObject(aCadForm.PCad.Figures[i]).FConnRaiseType = aRaiseType2) then RaisesList.Add(TConnectorObject(aCadForm.PCad.Figures[i])); end; end; if RaisesList.Count > 0 then begin // это первый лист, искать по отмеченным трассам if aListIndex = 0 then begin RaisesList := GetSortedRaisesByMarked(aConnFrom, RaisesList); end; for i := 0 to RaisesList.Count - 1 do begin if GlobalExit then Exit; CurrRaise := TConnectorObject(RaisesList[i]); AllTrace := GetAllTraceInCAD(aConnFrom, CurrRaise); if AllTrace <> nil then begin OtherCadList := GetListByID(CurrRaise.FID_ListToPassage); OtherRaise := TConnectorObject(GetFigureByID(OtherCadList, CurrRaise.FID_ConnToPassage)); if (OtherRaise <> nil) and (OtherCadList <> nil) then begin ResList.Add(CurrRaise); OtherListIndex := aLists.IndexOf(OtherCadList.FCADListID); // &&& ResListOfLists.Add(OtherCadList); // &&& DoFindRaises(OtherCadList, aRaiseType, OtherRaise, aBeginPoint, OtherListIndex{aListIndex + 1}); end; end; end; end; begin if GlobalExit then Exit; if ResList.Count > 0 then ResList.Delete(ResList.Count - 1); // &&& if ResListOfLists.Count > 0 then ResListOfLists.Delete(ResListOfLists.Count - 1); // &&& Exit; end; if RaisesList <> nil then FreeAndNil(RaisesList); if AllTrace <> nil then FreeAndNil(AllTrace); except on E: Exception do addExceptionToLogEx('U_Common.GetBetweenFloorRaises', E.Message); end; end; begin ResList := TList.Create; try ResListOfLists := TList.Create; ListIndex := aLists.Count - 1; ListID := aLists[0]; CurCad := GetListByID(ListID); GlobalExit := False; // &&& ResListOfLists.Add(CurCad); // &&& DoFindRaises(CurCad, aRaiseType, aBeginPoint, aEndPoint, 0); Result := ResList; aLists := CadsToIntCads(ResListOfLists); except on E: Exception do addExceptionToLogEx('U_Common.GetSortedListOfRaisesFromCurr', E.Message); end; end; Function IsBetweenFloorObject(AListID, AIDFigure: Integer; var AIDOtherFloorFigure: Integer): Boolean; var i, j: Integer; ItList, OtherList: TF_CAD; ItRaiseLine, OtherRaiseLine: TFigure; ItRaiseConn, OtherRaiseConn: TConnectorObject; begin Result := False; try AIDOtherFloorFigure := -1; ItList := GetListByID(AListID); if ItList <> nil then begin ItRaiseLine := GetFigureByID(ItList, AIDFigure); if ItRaiseLine <> nil then begin if CheckFigureByClassName(ItRaiseLine, cTOrthoLine) then begin if TOrthoLine(ItRaiseLine).FIsRaiseUpDown then begin ItRaiseConn := TConnectorObject(TOrthoLine(ItRaiseLine).JoinConnector1); if (ItRaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (ItRaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (ItRaiseConn.FConnRaiseType = crt_TrunkUp) or (ItRaiseConn.FConnRaiseType = crt_TrunkDown) then begin Result := True; OtherList := GetListByID(ItRaiseConn.FID_ListToPassage); if OtherList <> nil then begin OtherRaiseConn := TConnectorObject(GetFigureByID(OtherList, ItRaiseConn.FID_ConnToPassage)); if OtherRaiseConn <> nil then begin for i := 0 to OtherRaiseConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(OtherRaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then AIDOtherFloorFigure := TOrthoLine(OtherRaiseConn.JoinedOrtholinesList[i]).ID; end; end; end; ItRaiseConn := TConnectorObject(TOrthoLine(ItRaiseLine).JoinConnector2); if (ItRaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (ItRaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (ItRaiseConn.FConnRaiseType = crt_TrunkUp) or (ItRaiseConn.FConnRaiseType = crt_TrunkDown) then begin Result := True; OtherList := GetListByID(ItRaiseConn.FID_ListToPassage); if OtherList <> nil then begin OtherRaiseConn := TConnectorObject(GetFigureByID(OtherList, ItRaiseConn.FID_ConnToPassage)); if OtherRaiseConn <> nil then begin for i := 0 to OtherRaiseConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(OtherRaiseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then AIDOtherFloorFigure := TOrthoLine(OtherRaiseConn.JoinedOrtholinesList[i]).ID; end; end; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.IsBetweenFloorObject', E.Message); end; end; Function SetCADParamsStruct(aListParams: TListParams): TCADParams; begin try // Вкладка "Общие" Result.CADHeightRoom := aListParams.Settings.HeightRoom; Result.CADHeightFalseFloor := aListParams.Settings.HeightCeiling; Result.CADHeightConns := aListParams.Settings.HeightSocket; Result.CADHeightLines := aListParams.Settings.HeightCorob; Result.CADIndexPointObjects := aListParams.IndexPointObj + 1; Result.CADIndexConnector := aListParams.IndexConnector + 1; Result.CADIndexLine := aListParams.IndexLine + 1; // Вкладка "CAD" Result.CADPageSizeIndex := aListParams.Settings.CADPageSizeIndex; Result.CADPageOrient := aListParams.Settings.CADPageOrient; Result.CADStampType := aListParams.Settings.CADStampType; Result.CADStampLang := aListParams.Settings.CADStampLang; Result.CADStampMargins := aListParams.Settings.CADStampMargins; Result.CADWidth := aListParams.Settings.CADWidth; Result.CADHeight := aListParams.Settings.CADHeight; Result.CADListCountX := aListParams.Settings.CADListCountX; Result.CADListCountY := aListParams.Settings.CADListCountY; Result.CADFontName := aListParams.Settings.CADFontName; Result.CADGridStep := aListParams.Settings.CADGridStep; Result.CADShowMainStamp := aListParams.Settings.CADShowMainStamp; Result.CADShowUpperStamp := aListParams.Settings.CADShowUpperStamp; Result.CADShowSideStamp := aListParams.Settings.CADShowSideStamp; //Result.CADShowPathLineType := aListParams.Settings.CADShowPathLineType; //#From Oleg# //21.09.2010 //try // if (GCadForm <> nil) and (GCadForm.PCad <> nil) then // Result.CADMapScale := GCadForm.PCad.MapScale // else // Result.CADMapScale := 100; //except // Result.CADMapScale := 100; //end; Result.CADMapScale := 0; //21.09.2010 Result.CADTraceColor := aListParams.Settings.CADTraceColor; Result.CADTraceStyle := aListParams.Settings.CADTraceStyle; Result.CADTraceWidth := aListParams.Settings.CADTraceWidth; Result.CADBlockStep := aListParams.Settings.CADBlockStep; Result.CADObjectCaptions := aListParams.Settings.ShowObjectTypeCAD; Result.CADLinesCaptions := aListParams.Settings.CADCaptionsKind; Result.CADObjectNotes := aListParams.Settings.CADShowObjectNotesType; Result.CADLinesNotes := aListParams.Settings.CADNotesKind; Result.CADNotePrefix := aListParams.Settings.NoteCountPrefix; Result.CADShowLineObjectCaption := aListParams.Settings.ShowLineObjectCaption; Result.CADShowLineObjectLength := aListParams.Settings.ShowLineObjectLength; Result.CADShowLineObjectNote := aListParams.Settings.ShowLineObjectNote; Result.CADShowConnObjectCaption := aListParams.Settings.ShowConnObjectCaption; Result.CADShowConnObjectNote := aListParams.Settings.ShowConnObjectNote; Result.CADShowRaise := aListParams.Settings.CADShowRaise; Result.CADShowRaiseDrawFigure := aListParams.Settings.CADShowRaiseDrawFigure; Result.CADPutCableInTrace := aListParams.Settings.PutCableInTrace; Result.CADLinesCaptionsColor := aListParams.Settings.CADLinesCaptionsColor; Result.CADConnectorsCaptionsColor := aListParams.Settings.CADConnectorsCaptionsColor; Result.CADLinesNotesColor := aListParams.Settings.CADLinesNotesColor; Result.CADConnectorsNotesColor := aListParams.Settings.CADConnectorsNotesColor; Result.CADLinesCaptionsFontSize := aListParams.Settings.CADLinesCaptionsFontSize; Result.CADConnectorsCaptionsFontSize := aListParams.Settings.CADConnectorsCaptionsFontSize; Result.CADLinesNotesFontSize := aListParams.Settings.CADLinesNotesFontSize; Result.CADConnectorsNotesFontSize := aListParams.Settings.CADConnectorsNotesFontSize; Result.CADLinesCaptionsFontBold := aListParams.Settings.CADLinesCaptionsFontBold; Result.CADCrossATSFontSize := aListParams.Settings.CADCrossATSFontSize; Result.CADCrossATSFontBold := aListParams.Settings.CADCrossATSFontBold; Result.CADDistribCabFontSize := aListParams.Settings.CADDistribCabFontSize; Result.CADDistribCabFontBold := aListParams.Settings.CADDistribCabFontBold; Result.CADPrintType := aListParams.Settings.CADPrintType; Result.SCSType := aListParams.Settings.SCSType; Result.CADTraceStepRotate := aListParams.Settings.CADTraceStepRotate; Result.AutoCadMouse := aListParams.Settings.AutoCadMouse; Result.ScaleByCursor := aListParams.Settings.ScaleByCursor; Result.AutoPosTraceBetweenRM := aListParams.Settings.CADAutoPosTraceBetweenRM; Result.CADSaveUndoCount := aListParams.Settings.CADSaveUndoCount; Result.CADAllowSupplieskind := aListParams.Settings.CADAllowSuppliesKind; //11.10.2012 Result.CADNewTraceLengthType := aListParams.Settings.CADNewTraceLengthType; except on E: Exception do addExceptionToLogEx('U_Common.SetCADParamsStruct', E.Message); end; end; Procedure CheckByCaptionsNotes(X, Y: Double); var i, j: Integer; CheckCaptionNote: TFigure; CurrFigure: TFigure; FindSCSObject: TFigure; NotesCaptions: TRichTextMod; begin try FindSCSObject := nil; CheckCaptionNote := GCadForm.PCad.CheckByPoint(0, X, Y); // Caption if CheckCaptionNote <> nil then begin if CheckFigureByClassName(CheckCaptionNote, cTRichTextMod) then begin for i := 0 to GCadForm.PCad.FigureCount - 1 do begin CurrFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(CurrFigure, cTConnectorObject) then if TConnectorObject(CurrFigure).CaptionsGroup <> nil then if TConnectorObject(CurrFigure).CaptionsGroup.ID = CheckCaptionNote.ID then FindSCSObject := CurrFigure; if CheckFigureByClassName(CurrFigure, cTOrthoLine) then if TOrthoLine(CurrFigure).CaptionsGroup <> nil then if TOrthoLine(CurrFigure).CaptionsGroup.ID = CheckCaptionNote.ID then FindSCSObject := CurrFigure; end; if FindSCSObject <> nil then begin FSCS_Main.aViewSCSObjectsProp.Checked := True; CheckCaptionNote.Deselect; OpenCaptionAtPos(FindSCSObject, TRichTextMod(CheckCaptionNote), X, Y); end; end; // Note if CheckFigureByClassName(CheckCaptionNote, cTFigureGrpNotMod) then begin for i := 0 to GCadForm.PCad.FigureCount - 1 do begin CurrFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(CurrFigure, cTConnectorObject) then if TConnectorObject(CurrFigure).NotesGroup <> nil then if TConnectorObject(CurrFigure).NotesGroup.ID = CheckCaptionNote.ID then begin NotesCaptions := TRichTextMod(TFigureGrpNotMod(CheckCaptionNote).InFigures[1]); if NotesCaptions.isPointIn(X, Y) then FindSCSObject := CurrFigure; end; if CheckFigureByClassName(CurrFigure, cTOrthoLine) then if TOrthoLine(CurrFigure).NotesGroup <> nil then if TOrthoLine(CurrFigure).NotesGroup.ID = CheckCaptionNote.ID then begin NotesCaptions := TRichTextMod(TFigureGrpNotMod(CheckCaptionNote).InFigures[1]); if NotesCaptions.isPointIn(X, Y) then FindSCSObject := CurrFigure; end; end; if FindSCSObject <> nil then begin FSCS_Main.aViewSCSObjectsProp.Checked := True; CheckCaptionNote.Deselect; OpenNoteAtPos(FindSCSObject, TRichTextMod(TFigureGrpNotMod(CheckCaptionNote).InFigures[1]), X, Y); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckByCaptionsNotes', E.Message); end; end; Procedure OpenCaptionAtPos(aObject: TFigure; aCaption: TRichTextMod; X, Y: Double); var i: Integer; Point: TPoint; Bnd: TDoubleRect; y1, y2: Double; height: double; Count: Integer; ItemSize: Double; DeltaPos: Double; SelItem: Integer; StartPos: Integer; begin try aObject.Select; RefreshCAD(GCadForm.PCad); GetCursorPos(Point); F_SCSObjectsProp.Left := Point.X; F_SCSObjectsProp.Top := Point.Y; F_SCSObjectsProp.Show; Bnd := aCaption.GetBoundRect; y1 := Bnd.Top; y2 := Bnd.Bottom; height := abs(Bnd.Bottom - Bnd.Top); Count := aCaption.re.Lines.Count; ItemSize := height / Count; DeltaPos := abs(Y - y1); SelItem := Round(DeltaPos / ItemSize); if CheckFigureByClassName(aObject, cTConnectorObject) then begin F_SCSObjectsProp.PageSCSObjects.ActivePageIndex := 0; F_SCSObjectsProp.ConnectorPropertiesForNormal(TConnectorObject(aObject).ConnectorType); F_SCSObjectsProp.LoadConnectorProperties(TConnectorObject(aObject)); F_SCSObjectsProp.bConnOK.Enabled := True; if F_SCSObjectsProp.mConnCaptionsGroup.Enabled then begin F_SCSObjectsProp.mConnCaptionsGroup.SetFocus; F_SCSObjectsProp.mConnCaptionsGroup.SelStart := 0; F_SCSObjectsProp.mConnCaptionsGroup.SelLength := 0; StartPos := 0; for i := 0 to SelItem - 1 do begin StartPos := StartPos + Length(F_SCSObjectsProp.mConnCaptionsGroup.Lines[i]); StartPos := StartPos + 2; end; F_SCSObjectsProp.mConnCaptionsGroup.SelStart := StartPos; if SelItem >= 0 then F_SCSObjectsProp.mConnCaptionsGroup.SelLength := length(F_SCSObjectsProp.mConnCaptionsGroup.Lines[SelItem]) + 1; end; end; if CheckFigureByClassName(aObject, cTOrthoLine) then begin F_SCSObjectsProp.PageSCSObjects.ActivePageIndex := 1; // если это с-п if TOrthoLine(aObject).FIsRaiseUpDown then begin F_SCSObjectsProp.OrtholinePropertiesForRaise; end else begin F_SCSObjectsProp.OrtholinePropertiesForNormal; end; F_SCSObjectsProp.LoadOrtholineProperties(TOrthoLine(aObject)); F_SCSObjectsProp.bLineOK.Enabled := True; if F_SCSObjectsProp.mLineCaptionsGroup.Enabled then begin if TOrthoLine(aObject).ShowLength then SelItem := SelItem - 1; F_SCSObjectsProp.mLineCaptionsGroup.SetFocus; F_SCSObjectsProp.mLineCaptionsGroup.SelStart := 0; F_SCSObjectsProp.mLineCaptionsGroup.SelLength := 0; StartPos := 0; for i := 0 to SelItem - 1 do begin StartPos := StartPos + Length(F_SCSObjectsProp.mLineCaptionsGroup.Lines[i]); StartPos := StartPos + 2; end; F_SCSObjectsProp.mLineCaptionsGroup.SelStart := StartPos; if SelItem >= 0 then F_SCSObjectsProp.mLineCaptionsGroup.SelLength := length(F_SCSObjectsProp.mLineCaptionsGroup.Lines[SelItem]) + 1; end; end; except on E: Exception do addExceptionToLogEx('U_Common.OpenCaptionAtPos', E.Message); end; end; Procedure OpenNoteAtPos(aObject: TFigure; aNote: TRichTextMod; X, Y: Double); var i: Integer; Point: TPoint; Bnd: TDoubleRect; y1, y2: Double; height: double; Count: Integer; ItemSize: Double; DeltaPos: Double; SelItem: Integer; StartPos: Integer; begin try aObject.Select; RefreshCAD(GCadForm.PCad); GetCursorPos(Point); F_SCSObjectsProp.Left := Point.X; F_SCSObjectsProp.Top := Point.Y; F_SCSObjectsProp.Show; Bnd := aNote.GetBoundRect; y1 := Bnd.Top; y2 := Bnd.Bottom; height := abs(Bnd.Bottom - Bnd.Top); Count := aNote.re.Lines.Count; ItemSize := height / Count; DeltaPos := abs(Y - y1); SelItem := Round(DeltaPos / ItemSize); if CheckFigureByClassName(aObject, cTConnectorObject) then begin F_SCSObjectsProp.PageSCSObjects.ActivePageIndex := 0; F_SCSObjectsProp.ConnectorPropertiesForNormal(TConnectorObject(aObject).ConnectorType); F_SCSObjectsProp.LoadConnectorProperties(TConnectorObject(aObject)); F_SCSObjectsProp.bConnOK.Enabled := True; if F_SCSObjectsProp.mConnCaptionsGroup.Enabled then begin F_SCSObjectsProp.mConnNotesGroup.SetFocus; F_SCSObjectsProp.mConnNotesGroup.SelStart := 0; F_SCSObjectsProp.mConnNotesGroup.SelLength := 0; StartPos := 0; for i := 0 to SelItem - 1 do begin StartPos := StartPos + Length(F_SCSObjectsProp.mConnNotesGroup.Lines[i]); StartPos := StartPos + 2; end; F_SCSObjectsProp.mConnNotesGroup.SelStart := StartPos; if SelItem >= 0 then F_SCSObjectsProp.mConnNotesGroup.SelLength := length(F_SCSObjectsProp.mConnNotesGroup.Lines[SelItem]) + 1; end; end; if CheckFigureByClassName(aObject, cTOrthoLine) then begin F_SCSObjectsProp.PageSCSObjects.ActivePageIndex := 1; // если это с-п if TOrthoLine(aObject).FIsRaiseUpDown then begin F_SCSObjectsProp.OrtholinePropertiesForRaise; end else begin F_SCSObjectsProp.OrtholinePropertiesForNormal; end; F_SCSObjectsProp.LoadOrtholineProperties(TOrthoLine(aObject)); F_SCSObjectsProp.bLineOK.Enabled := True; if F_SCSObjectsProp.mLineNotesGroup.Enabled then begin F_SCSObjectsProp.mLineNotesGroup.SetFocus; F_SCSObjectsProp.mLineNotesGroup.SelStart := 0; F_SCSObjectsProp.mLineNotesGroup.SelLength := 0; StartPos := 0; for i := 0 to SelItem - 1 do begin StartPos := StartPos + Length(F_SCSObjectsProp.mLineNotesGroup.Lines[i]); StartPos := StartPos + 2; end; F_SCSObjectsProp.mLineNotesGroup.SelStart := StartPos; if SelItem >= 0 then F_SCSObjectsProp.mLineNotesGroup.SelLength := length(F_SCSObjectsProp.mLineNotesGroup.Lines[SelItem]) + 1; end; end; except on E: Exception do addExceptionToLogEx('U_Common.OpenNotesAtPos', E.Message); end; end; procedure ModifyConnNoteAfterMove(aConn: TConnectorObject; aDeltaX, aDeltaY: Double); var NotesRows: TFigureGrpNotMod; Row1: TLine; Row2: TLine; ConnX, ConnY: Double; ResPointX, ResPointY: Double; begin try NotesRows := TFigureGrpNotMod(aConn.NotesGroup.InFigures[0]); Row1 := TLine(NotesRows.InFigures[0]); Row2 := TLine(NotesRows.InFigures[1]); // перерисовать стрелки Row2.ActualPoints[1] := DoublePoint(Row2.ActualPoints[1].x + adeltax, Row2.ActualPoints[1].y + adeltay); Row2.ActualPoints[2] := DoublePoint(Row2.ActualPoints[2].x + adeltax, Row2.ActualPoints[2].y + adeltay); Row1.ActualPoints[2] := Row2.ActualPoints[1]; // установить новый тип отображения стрелки ConnX := aConn.ActualPoints[1].x; ConnY := aConn.ActualPoints[1].y; ResPointX := Row1.ActualPoints[2].x; ResPointY := Row1.ActualPoints[2].y; if ResPointX >= ConnX then begin if ResPointY <= ConnY then aConn.FNotesRowsType := nr_UpRightSide else if ResPointY > ConnY then aConn.FNotesRowsType := nr_DownRightSide; end else if ResPointX < ConnX then begin if ResPointY >= ConnY then aConn.FNotesRowsType := nr_DownLeftSide else if ResPointY < ConnY then aConn.FNotesRowsType := nr_UpLeftSide; end; aConn.ReCreateNotesGroup(True); except on E: Exception do addExceptionToLogEx('U_Common.ModifyConnNoteAfterMove', E.Message); end; end; procedure ModifyLineNoteAfterMove(aLine: TOrthoLine; aDeltaX, aDeltaY: Double); var NotesRows: TFigureGrpNotMod; Row1: TLine; Row2: TLine; Row3: TLine; LineX, LineY: Double; ResPointX, ResPointY: Double; begin try NotesRows := TFigureGrpNotMod(aLine.NotesGroup.InFigures[0]); Row1 := TLine(NotesRows.InFigures[0]); Row2 := TLine(NotesRows.InFigures[1]); Row3 := TLine(NotesRows.InFigures[2]); // перерисовать стрелки Row3.ActualPoints[1] := DoublePoint(Row3.ActualPoints[1].x + adeltax, Row3.ActualPoints[1].y + adeltay); Row3.ActualPoints[2] := DoublePoint(Row3.ActualPoints[2].x + adeltax, Row3.ActualPoints[2].y + adeltay); Row2.ActualPoints[2] := Row3.ActualPoints[1]; // установить новый тип отображения стрелки LineX := Row2.ActualPoints[1].x; LineY := Row2.ActualPoints[1].y; ResPointX := Row2.ActualPoints[2].x; ResPointY := Row2.ActualPoints[2].y; if ResPointX >= LineX then begin if ResPointY <= LineY then aLine.FNotesRowsType := nr_UpRightSide else if ResPointY > LineY then aLine.FNotesRowsType := nr_DownRightSide; end else if ResPointX < LineX then begin if ResPointY >= LineY then aLine.FNotesRowsType := nr_DownLeftSide else if ResPointY < LineY then aLine.FNotesRowsType := nr_UpLeftSide; end; aLine.ReCreateNotesGroup(True); except on E: Exception do addExceptionToLogEx('U_Common.ModifyLineNoteAfterMove', E.Message); end; end; procedure SetFigureCoordZ(AIDList, AIDFigure: Integer; ACoordZ: Double); var vList: TF_CAD; SavedCadForm: TF_CAD; FFigure: TFigure; FConn: TConnectorObject; FLine: TOrthoLine; ObjFromRaise: TConnectorObject; mess: string; begin vList := GetListByID(AIDList); if vList <> nil then begin FFigure := GetFigureByID(vList, AIDFigure); if FFigure <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; // RT if CheckFigureByClassName(FFigure, cTConnectorObject) then begin FConn := TConnectorObject(FFigure); // если высоты не совпадают - применить if FConn.ActualZOrder[1] <> ACoordZ then begin if ACoordZ <> - 1 then FConn.ActualZOrder[1] := ACoordZ else FConn.ActualZOrder[1] := vList.FConnHeight; // ================= // Он не с-п и на нем нет с-п if (FConn.FConnRaiseType = crt_None) and (GetRaiseConn(FConn) = nil) then begin if FConn.JoinedConnectorsList.Count = 0 then begin SetConFigureCoordZInPM(FConn.ID, FConn.ActualZOrder[1]); end else CreateRaiseOnPointObject(FConn, FConn.ActualZOrder[1]); end else // на нем есть с-п if GetRaiseConn(FConn) <> nil then begin // только подъем-спуск begin if FConn.JoinedConnectorsList.Count = 0 then begin SetConFigureCoordZInPM(FConn.ID, FConn.ActualZOrder[1]); end else ChangeRaiseOnPointObject(FConn, FConn.ActualZOrder[1]); end; end else // это с-п if (FConn.FConnRaiseType = crt_OnFloor) then begin ObjFromRaise := FConn.FObjectFromRaise; if FConn.ActualZOrder[1] = ObjFromRaise.ActualZOrder[1] then begin mess := cSCSObjectProp_Mes1; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end; end; end; end; end; // LINE if CheckFigureByClassName(FFigure, cTOrthoLine) then begin FLine := TOrthoLine(FFigure); if not FLine.FIsRaiseUpDown then begin // если высоты не совпадают - применить if (FLine.ActualZOrder[1] <> ACoordZ) or (FLine.ActualZOrder[2] <> ACoordZ) then begin if ACoordZ <> -1 then RaiseLineOnHeight(FLine, ACoordZ, nil) else RaiseLineOnHeight(FLine, vList.FLineHeight, nil) end; end; end; GCadForm := SavedCadForm; end; end; end; Function GetRaiseType(aObjFromRaise, aRaise: TConnectorObject): TLineRaiseType; var BaseHeight: Double; Height1: Double; Height2: Double; DeltaBaseDown, DeltaBaseUp: Double; begin Result := lrt_None; try DeltaBaseDown := 0; //#From Oleg# //14.09.2010 DeltaBaseUp := 0; //#From Oleg# //14.09.2010 BaseHeight := GCadForm.FLineHeight; Height1 := aObjFromRaise.ActualZOrder[1]; Height2 := aRaise.ActualZOrder[1]; if Height1 <> Height2 then begin // Один из объектов на базовой высотой if (Height1 = BaseHeight) or (Height2 = BaseHeight) then begin if Height1 = BaseHeight then begin if Height2 > BaseHeight then Result := lrt_Up; if Height2 < BaseHeight then Result := lrt_Down; end; if Height2 = BaseHeight then begin if Height1 > BaseHeight then Result := lrt_Up; if Height1 < BaseHeight then Result := lrt_Down; end; end else // вне базовой высоты begin // оба выше базы if (Height1 > BaseHeight) and (Height2 > BaseHeight) then begin Result := lrt_Up; end else // оба ниже базы if (Height1 < BaseHeight) and (Height2 < BaseHeight) then begin Result := lrt_Down; end else // по разные стороны базы if ((Height1 > BaseHeight) and (Height2 < BaseHeight)) or ((Height1 < BaseHeight) and (Height2 > BaseHeight)) then begin // delta над базовым уровнем if Height1 > BaseHeight then DeltaBaseUp := abs(BaseHeight - Height1); if Height2 > BaseHeight then DeltaBaseUp := abs(BaseHeight - Height2); // delta под базовым уровнем if Height1 < BaseHeight then DeltaBaseDown := abs(BaseHeight - Height1); if Height2 < BaseHeight then DeltaBaseDown := abs(BaseHeight - Height2); // if DeltaBaseUp >= DeltaBaseDown then Result := lrt_Up else Result := lrt_Down; end; end; end else Result := lrt_Up; except on E: Exception do addExceptionToLogEx('U_Common.GetRaiseType', E.Message); end; end; function GetLineCaptionFormat(aLine: TOrthoLine; aShowKind: TShowKind): string; var str: string; DblLen: Double; StrLen: String; DblHeight: Double; StrHeight: String; begin try Result := ''; DblLen := aLine.LineLength; StrLen := FormatFloat(ffMask, MetreToUOM(DblLen)); if aShowKind = skSimple then begin if aLine.FIsRaiseUpDown then begin if aLine.FLineRaiseType = lrt_Down then Result := '-' + StrLen else Result := StrLen; end else Result := StrLen; end; if aShowKind = skdetail then begin if aLine.FIsRaiseUpDown then begin DblHeight := aLine.FObjectFromRaisedLine.ActualZOrder[1]; StrHeight := FormatFloat(ffMask, MetreToUOM(DblHeight)); if aLine.FLineRaiseType = lrt_Down then Result := '-' + StrLen + '/' + StrHeight else Result := StrLen + '/' + StrHeight; end else begin if aLine.ActualZOrder[1] = aLine.ActualZOrder[2] then begin DblHeight := aLine.ActualZOrder[1]; StrHeight := FormatFloat(ffMask, MetreToUOM(DblHeight)); Result := StrLen + '/' + StrHeight; end else Result := StrLen; end; end; if aShowKind = skExternalSCS then begin StrLen := FormatFloat(ffMask, MetreToUOM(DblLen)); Result := '-' + StrLen + '-'; end; except on E: Exception do addExceptionToLogEx('U_Common.GetLineCaptionFormat', E.Message); end; end; Function GetFullFigureName(aFigure: TFigure; x: Double=-1; y: Double=-1): string; var strName: string; strIndex: string; ChildObject: TObject; begin try Result := ''; Result := aFigure.Name; if CheckFigureByClassName(aFigure, cTConnectorObject) then begin strName := TConnectorObject(aFigure).Name; strIndex := IntToStr(TConnectorObject(aFigure).FIndex); Result := strName + strIndex; end; if CheckFigureByClassName(aFigure, cTOrthoLine) then begin strName := TOrthoLine(aFigure).Name; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} Result := strName; {$ELSE} strIndex := IntToStr(TOrthoLine(aFigure).FIndex); Result := strName + strIndex; {$IFEND} end else if aFigure is TNet then begin ChildObject := nil; if (x<>-1) and (y<>-1) then ChildObject := TNet(aFigure).GetObjInPoint(x,y) else if aFigure.Selected then ChildObject := TNet(aFigure).GetSelectedObject; Result := GetArchCADObjCaption(aFigure, ChildObject, cMain_Mes107); //if ChildObject <> aFigure then //begin // ChildName := GetArchCADObjCaption(ChildObject, ''); // if ChildName <> '' then // begin // if Result <> '' then // Result := Result + ', '; // Result := Result + ChildName; // end; //end; end; except // on E: Exception do addExceptionToLogEx('U_Common.GetFullFigureName', E.Message); end; end; function GetFullFigureLenName(aFigure: TFigure; x: Double=-1; y: Double=-1): string; var ChildObject: TObject; begin Result := ''; if aFigure is TNet then begin ChildObject := nil; if (x<>-1) and (y<>-1) then ChildObject := TNet(aFigure).GetObjInPoint(x,y) else if aFigure.Selected then ChildObject := TNet(aFigure).GetSelectedObject; Result := GetArchCADObjLenCaption(aFigure, ChildObject); end; end; Procedure AutoDisconnectOverRaiseInCAD(AConnector, ARaiseConnector: TConnectorObject; ARaiseLine: TOrthoLine); var Connector: TConnectorObject; RaiseConnector: TConnectorObject; JoinedConn: TConnectorObject; ConnectedLines: TList; ConnectedBeforeRaise: TList; ConnectedAfterRaise: TList; procedure DefineConnectedObjectParams(ATargetConnectedObjectParams: TList; AConnectorObject: TConnectorObject); var i, j: Integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ptrConnectObjParam: PConnectObjectParam; begin try New(ptrConnectObjParam); ptrConnectObjParam.IDObject := AConnectorObject.ID; ptrConnectObjParam.Side := 0; ATargetConnectedObjectParams.Add(ptrConnectObjParam); if AConnectorObject.ConnectorType = ct_Clear then for i := 0 to AConnectorObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnectorObject.JoinedOrtholinesList[i]); if JoinedLine <> ARaiseLine then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := JoinedLine.ID; if JoinedLine.JoinConnector1 = AConnectorObject then ptrConnectObjParam.Side := 1; if JoinedLine.JoinConnector2 = AConnectorObject then ptrConnectObjParam.Side := 2; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; end else begin for i := 0 to AConnectorObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(AConnectorObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine <> ARaiseLine then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := JoinedLine.ID; if JoinedLine.JoinConnector1 = JoinedConn then ptrConnectObjParam.Side := 1; if JoinedLine.JoinConnector2 = JoinedConn then ptrConnectObjParam.Side := 2; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.DefineConnectedObjectParams', E.Message); end; end; begin try ConnectedBeforeRaise := TList.Create; ConnectedAfterRaise := TList.Create; Connector := AConnector; RaiseConnector := ARaiseConnector; if (ARaiseConnector.FConnRaiseType = crt_None) and (AConnector.FConnRaiseType <> crt_None) then begin Connector := ARaiseConnector; RaiseConnector := AConnector; end; // AConnector DefineConnectedObjectParams(ConnectedBeforeRaise, Connector); // ARaiseConnector DefineConnectedObjectParams(ConnectedAfterRaise, RaiseConnector); AutoDisconnectOverRaiseLine(ARaiseLine.ID, ConnectedBeforeRaise, ConnectedAfterRaise); if ConnectedBeforeRaise <> nil then FreeList(ConnectedBeforeRaise); if ConnectedAfterRaise <> nil then FreeList(ConnectedAfterRaise); except on E: Exception do addExceptionToLogEx('U_Common.AutoDisconnectOverRaiseInCAD', E.Message); end; end; Procedure EditBlockOnCAD(aActiveBlockStream, aProjectBlockStream: TMemoryStream); var ActBlockFileName, ProjBlockFileName: string; BlockFig: TBlock; i: integer; Bnd: TDoubleRect; x, y: double; begin try {$if Defined(ES_GRAPH_SC)} ActBlockFileName := ExeDir + '\.blk\ActBlockTempStream.blk'; ProjBlockFileName := ExeDir + '\.blk\ProjBlockTempStream.blk'; {$else} ActBlockFileName := ExtractFileDir(Application.ExeName) + '\.blk\ActBlockTempStream.blk'; ProjBlockFileName := ExtractFileDir(Application.ExeName) + '\.blk\ProjBlockTempStream.blk'; {$ifend} if aActiveBlockStream <> nil then begin aActiveBlockStream.SaveToFile(ActBlockFileName); GCadForm.CurrentLayer := 1; BlockFig := TBlock(GCadForm.PCad.InsertBlockwithFileName(1, ActBlockFileName, 0, 0)); Bnd := BlockFig.GetBoundRect; x := abs(Bnd.Right - Bnd.Left); y := abs(Bnd.Bottom - Bnd.Top); BlockFig.move(x / 2, y / 2); end; if aProjectBlockStream <> nil then begin aProjectBlockStream.SaveToFile(ProjBlockFileName); GCadForm.CurrentLayer := 1; BlockFig := TBlock(GCadForm.PCad.InsertBlockwithFileName(1, ProjBlockFileName, 10, 0)); Bnd := BlockFig.GetBoundRect; x := abs(Bnd.Right - Bnd.Left); y := abs(Bnd.Bottom - Bnd.Top); BlockFig.move(x / 2, y / 2); end; RefreshCAD(GCadForm.PCad); if FileExists(ActBlockFileName) then DeleteFile(ActBlockFileName); if FileExists(ProjBlockFileName) then DeleteFile(ProjBlockFileName); except on E: Exception do addExceptionToLogEx('U_Common.EditBlockOnCAD', E.Message); end; end; procedure RemoveRMWithRM(aRM1, aRM2: TConnectorObject); var i, j: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; ConnectedConn: TConnectorObject; ConnectedList: TList; begin try ConnectedConn := nil; //#From Oleg# //14.09.2010 ConnectedList := TList.Create; // опр. связуюший с с-п for i := 0 to aRM1.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aRM1.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then ConnectedConn := JoinedConn; end; if ConnectedConn = nil then Exit; // сохранить коннекторы for i := 0 to aRM1.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aRM1.JoinedConnectorsList[i]); ConnectedList.Add(JoinedConn); end; DublicateObjectComponents(aRM1.ID, aRM2.ID); // отвязать все for i := 0 to ConnectedList.Count - 1 do begin JoinedConn := TConnectorObject(ConnectedList[i]); UnsnapConnectorFromPointObject(JoinedConn, aRM1); end; for i := 0 to ConnectedList.Count - 1 do begin JoinedConn := TConnectorObject(ConnectedList[i]); if JoinedConn <> ConnectedConn then begin SnapConnectorToConnector(ConnectedConn, JoinedConn); // ConnectedConn := JoinedConn; end; end; ConnectedConn.FConnRaiseType := aRM1.FConnRaiseType; ConnectedConn.FObjectFromRaise := aRM1.FObjectFromRaise; if aRM2.FObjectFromRaise = aRM1 then aRM2.FObjectFromRaise := ConnectedConn; for i := 0 to aRM2.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aRM2.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FObjectFromRaisedLine = aRM1 then TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FObjectFromRaisedLine := ConnectedConn; end; end; aRM1.FConnRaiseType := crt_None; aRM1.FObjectFromRaise := nil; aRM1.Delete(False, False); RefreshCAD(GCadForm.PCad); FreeAndNil(ConnectedList); if aRM2.FConnRaiseType <> crt_None then begin ReverseRaise(aRM2); end; except on E: Exception do addExceptionToLogEx('U_Common.RemoveRMWithRM', E.Message); end; end; procedure RemoveRMWithClear(aRM, aClear: TConnectorObject); var i, j: integer; JoinedConn: TConnectorObject; ConnectedConn: TConnectorObject; ConnectedList: TList; TestLine: TOrthoLine; begin try ConnectedConn := nil; //#From Oleg# //14.09.2010 ConnectedList := TList.Create; // опр. связуюший с с-п for i := 0 to aRM.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aRM.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(JoinedConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then ConnectedConn := JoinedConn; end; if ConnectedConn = nil then Exit; // сохранить коннекторы for i := 0 to aRM.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aRM.JoinedConnectorsList[i]); ConnectedList.Add(JoinedConn); end; // отвязать все for i := 0 to ConnectedList.Count - 1 do begin JoinedConn := TConnectorObject(ConnectedList[i]); UnsnapConnectorFromPointObject(JoinedConn, aRM); end; for i := 0 to ConnectedList.Count - 1 do begin JoinedConn := TConnectorObject(ConnectedList[i]); if JoinedConn <> ConnectedConn then begin SnapConnectorToConnector(ConnectedConn, JoinedConn); // ConnectedConn := JoinedConn; end; end; ConnectedConn.FConnRaiseType := aRM.FConnRaiseType; if aClear.FObjectFromRaise = aRM then aClear.FObjectFromRaise := ConnectedConn; for i := 0 to aClear.JoinedOrtholinesList.Count - 1 do if TOrthoLine(aClear.JoinedOrtholinesList[i]).FIsRaiseUpDown then if TOrthoLine(aClear.JoinedOrtholinesList[i]).FObjectFromRaisedLine = aRM then TOrthoLine(aClear.JoinedOrtholinesList[i]).FObjectFromRaisedLine := ConnectedConn; aRM.FConnRaiseType := crt_None; aRM.FObjectFromRaise := nil; SnapPointObjectToConnector(aRM, aClear); aClear.LockMove := False; aClear.LockModify := False; aClear.Move(aRM.ActualPoints[1].x - aClear.ActualPoints[1].x, aRM.ActualPoints[1].y - aClear.ActualPoints[1].y); RefreshCAD(GCadForm.PCad); FreeAndNil(ConnectedList); if aRM.FConnRaiseType <> crt_None then begin ReverseRaise(aRM); end; except on E: Exception do addExceptionToLogEx('U_Common.RemoveRMWithClear', E.Message); end; end; procedure ReverseRaise(aPointObject: TConnectorObject); var i: integer; ObjFromRaise: TConnectorObject; RaiseLine: TOrthoLine; ObjParams: TObjectParams; begin try RaiseLine := nil; //#From Oleg# //14.09.2010 if aPointObject.FObjectFromRaise = nil then Exit; if aPointObject.FObjectFromRaise.ConnectorType <> ct_Clear then Exit; ObjFromRaise := aPointObject.FObjectFromRaise; ObjFromRaise.FConnRaiseType := aPointObject.FConnRaiseType; aPointObject.FConnRaiseType := crt_None; ObjFromRaise.FObjectFromRaise := aPointObject; aPointObject.FObjectFromRaise := nil; ObjFromRaise.LockModify := True; ObjFromRaise.LockMove := True; aPointObject.LockModify := False; aPointObject.LockMove := False; for i := 0 to ObjFromRaise.JoinedOrtholinesList.Count - 1 do if TOrthoLine(ObjFromRaise.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(ObjFromRaise.JoinedOrtholinesList[i]); if RaiseLine.FObjectFromRaisedLine = ObjFromRaise then RaiseLine.FObjectFromRaisedLine := aPointObject; end; if RaiseLine <> nil then begin RaiseLine.ReCreateCaptionsGroup(false, true); RaiseLine.ReCreateNotesGroup; end; ObjFromRaise.Name := cCadClasses_Mes24; SetNewObjectNameInPM(ObjFromRaise.ID, ObjFromRaise.Name); ObjParams := GetFigureParams(ObjFromRaise.ID); ObjFromRaise.Name := ObjParams.Name; ObjFromRaise.FIndex := ObjParams.MarkID; GMoveWithRaise := False; ObjFromRaise.Move(aPointObject.ActualPoints[1].x - ObjFromRaise.ActualPoints[1].x, aPointObject.ActualPoints[1].y - ObjFromRaise.ActualPoints[1].y); GMoveWithRaise := True; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.ReverseRaise', E.Message); end; end; function CheckListNormalType(aListID: Integer): Boolean; var List: TF_CAD; begin Result := False; try List := GetListByID(aListID); if List <> nil then begin if List.FListType = lt_Normal then Result := True else Result := False; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckListNormalType', E.Message); end; end; procedure CallProjectPlanFromNB; begin try FSCS_Main.aCreateProjectPlan.Execute; except on E: Exception do addExceptionToLogEx('U_ProjectPlan.CallProjectPlanFromNB', E.Message); end; end; procedure CreateCabinetOnCAD(aSCSID, aIndex: Integer); var Cabinet: TCabinet; Bnd: TDoubleRect; P1: TPoint; P2: TPoint; CP: TPoint; LHandle: Integer; begin try // создание с МП if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin FSCS_Main.aToolCabinet.Execute; LHandle := GCadForm.PCad.GetLayerHandle(9); Bnd := GCadForm.PCad.GetVisibleRect; P1.X := Round(Bnd.Left); P1.Y := Round(bnd.Top); P2.X := Round(Bnd.Right); P2.Y := Round(bnd.Bottom); CP.X := Round((P1.x + P2.x) / 2); CP.Y := Round((P1.y + P2.y) / 2); Cabinet := TCabinet.Create(CP.X, CP.Y, CP.X + 80, CP.Y + 40, 2, ord(psSolid), clMaroon, ord(bsClear), clBlack, LHandle, mydsNormal, GCadForm.PCad); Cabinet.FSCSID := aSCSID; Cabinet.ID := aSCSID; //08.11.2011 Cabinet.FIndex := aIndex; Cabinet.Visible := True; Cabinet.FType := ct_Visual; Cabinet.FNumberObject := CreateNumberObjectOnCAD(Cabinet, GCadForm.FShowCabinetsNumbers); GCadForm.Pcad.AddCustomFigure(9, Cabinet, False); GCadForm.AddSCSFigure(Cabinet); CP.X := CP.X + 80; CP.Y := CP.Y + 40; ClientToScreen(GCadForm.PCad.Handle, CP); SetCursorPos(CP.X, CP.Y); end; except on E: Exception do addExceptionToLogEx('U_Common.CreateCabinetOnCAD', E.Message); end; end; procedure DeleteCabinetOnCAD(AID_List, aSCSID: Integer); var Cabinet: TFigure; vList: TF_CAD; CabinetNumberObject: TCabinetNumber; aFigure: TFigure; j: INteger; begin try vList := GetListByID(AID_List); if vList <> nil then begin Cabinet := FindCabinetBySCSID(vList, aSCSID); if Cabinet <> nil then begin if CheckFigureByClassName(Cabinet, cTCabinet) then CabinetNumberObject := TCabinet(Cabinet).FNumberObject; if CheckFigureByClassName(Cabinet, cTCabinetExt) then CabinetNumberObject := TCabinetExt(Cabinet).FNumberObject; if CabinetNumberObject <> nil then begin vList.PCad.Figures.Remove(CabinetNumberObject); FreeAndNil(CabinetNumberObject); end; vList.PCad.Figures.Remove(Cabinet); FreeAndNil(Cabinet); RefreshCAD(vList.PCad); end; end; except on E: Exception do addExceptionToLogEx('U_Common.DeleteCabinetOnCAD', E.Message); end; end; procedure ActivateCabinetOnCAD(AID_List, aSCSID: Integer); var Cabinet: TFigure; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin if not vList.FShowCabinetsBounds then begin Cabinet := FindCabinetBySCSID(vList, aSCSID); if Cabinet <> nil then begin if CheckFigureByClassName(Cabinet, cTCabinet) then begin TCabinet(Cabinet).Visible := True; TCabinet(Cabinet).Draw(vList.PCad.DEngine, False); end; if CheckFigureByClassName(Cabinet, cTCabinetExt) then begin TCabinetExt(Cabinet).Visible := True; TCabinetExt(Cabinet).Draw(vList.PCad.DEngine, False); end; RefreshCAD(vList.PCad); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ActivateCabinetOnCAD', E.Message); end; end; procedure DeactivateCabinetOnCAD(AID_List, aSCSID: Integer); var Cabinet: TFigure; vList: TF_CAD; begin try vList := GetListByID(AID_List); if vList <> nil then begin if not vList.FShowCabinetsBounds then begin Cabinet := FindCabinetBySCSID(vList, aSCSID); if Cabinet <> nil then begin if Cabinet.Selected then Cabinet.Deselect; if CheckFigureByClassName(Cabinet, cTCabinet) then begin TCabinet(Cabinet).Visible := False; TCabinet(Cabinet).Draw(vList.PCad.DEngine, False); if TCabinet(Cabinet).FNumberObject <> nil then if TCabinet(Cabinet).FNumberObject.Visible then if TCabinet(Cabinet).FNumberObject.Selected then TCabinet(Cabinet).FNumberObject.Deselect; end; if CheckFigureByClassName(Cabinet, cTCabinetExt) then begin TCabinetExt(Cabinet).Visible := False; TCabinetExt(Cabinet).Draw(vList.PCad.DEngine, False); if TCabinetExt(Cabinet).FNumberObject <> nil then if TCabinetExt(Cabinet).FNumberObject.Visible then if TCabinetExt(Cabinet).FNumberObject.Selected then TCabinetExt(Cabinet).FNumberObject.Deselect; end; RefreshCAD(vList.PCad); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.DeactivateCabinetOnCAD', E.Message); end; end; function FindCabinetBySCSID(aList: TF_CAD; aSCSID: Integer): TFigure; var i: integer; Figure: TFigure; FigLayerHandle: Integer; begin Result := nil; try FigLayerHandle := aList.PCad.GetLayerHandle(lnRoom); for i := 0 to aList.PCad.FigureCount - 1 do begin Figure := TFigure(aList.PCad.Figures[i]); if (Figure.LayerHandle = FigLayerHandle) then begin if CheckFigureByClassName(Figure, cTCabinet) then begin if TCabinet(Figure).FSCSID = aSCSID then begin Result := Figure; Break; end; end else if CheckFigureByClassName(Figure, cTCabinetExt) then begin if TCabinetExt(Figure).FSCSID = aSCSID then begin Result := Figure; Break; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.FindCabinetBySCSID', E.Message); end; end; function CreateNumberObjectOnCAD(aCabinet: TFigure; aVisible: Boolean): TCabinetNumber; var i: integer; Number: TRichText; Bound: TCircle; Radius: Double; CabCP: TDoublePoint; NoteBnd: TDoubleRect; CaptionGroup: TRichText; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w: double; TraceCP: TDoublePoint; MvAngle: Double; Bnd: TDoubleRect; MaxX, MaxY, MinX, MinY: Double; begin try Result := nil; Result := TCabinetNumber.Create(aCabinet.LayerHandle, GCadForm.PCad); Radius := 5; Bound := TCircle.Create(-100, -100, Radius, 1, ord(psSolid), clMaroon, ord(bsClear), clBlack, aCabinet.LayerHandle, mydsNormal, GCadForm.PCad); {******************************************************************************} Number := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clMaroon, ord(bsClear), clNone, aCabinet.LayerHandle, mydsNormal, GCadForm.PCad); Number.re.Font.Size := 12; Number.re.Font.Color := clMaroon; Number.re.Lines.Clear; if CheckFigureByClassName(aCabinet, cTCabinet) then Number.re.Lines.Add(IntToStr(TCabinet(aCabinet).FIndex)); if CheckFigureByClassName(aCabinet, cTCabinetExt) then Number.re.Lines.Add(IntToStr(TCabinetExt(aCabinet).FIndex)); GCadForm.PCad.AddCustomFigure(9, Number, False); RefreshCAD(GCadForm.PCad); // получить свойства xCanvas := TMetafileCanvas.Create(Number.Metafile, 0); xCanvas.Font.Name := Number.re.Font.Name; xCanvas.Font.Size := Number.re.Font.Size; GetTextMetrics(xCanvas.Handle, TM); h := TM.tmHeight / 4 * Number.re.Lines.Count; w := xCanvas.TextWidth(Number.Re.Lines[0]); w := (w + 3) / 4 ; FreeAndNil(xCanvas); // пересоздать с новыми свойствами if Number <> nil then begin GCadForm.PCad.Figures.Remove(Number); FreeAndNil(Number); end; Number := TRichText.create(-100, -100, -100 + w, -100 + h, 1, ord(psSolid), clMaroon, ord(bsClear), clNone, aCabinet.LayerHandle, mydsNormal, GCadForm.PCad); Number.re.Font.Size := 12; Number.re.Font.Color := clMaroon; Number.re.Lines.Clear; if CheckFigureByClassName(aCabinet, cTCabinet) then Number.re.Lines.Add(IntToStr(TCabinet(aCabinet).FIndex)); if CheckFigureByClassName(aCabinet, cTCabinetExt) then Number.re.Lines.Add(IntToStr(TCabinetExt(aCabinet).FIndex)); Number.Move(Bound.CenterPoint.x - Number.CenterPoint.x, Bound.CenterPoint.y - Number.CenterPoint.y); Result.AddFigure(Bound); Result.AddFigure(Number); // найти центр кабинета // для обычного if CheckFigureByClassName(aCabinet, cTCabinet) then begin CabCP.x := (aCabinet.ActualPoints[1].x + aCabinet.ActualPoints[3].x) / 2; CabCP.y := (aCabinet.ActualPoints[1].y + aCabinet.ActualPoints[3].y) / 2; end; // сложной формы if CheckFigureByClassName(aCabinet, cTCabinetExt) then begin TCabinetExt(aCabinet).getbounds(MaxX, MaxY, MinX, MinY); CabCP.x := (MinX + MaxX) / 2; CabCP.y := (MinY + MaxY) / 2; end; Result.move(CabCP.x - Result.CenterPoint.x, CabCP.y - Result.CenterPoint.y); GCadForm.PCad.AddCustomFigure(9, Result, False); // Result.Visible := aVisible; for i := 0 to Result.InFigures.Count - 1 do TFigure(Result.InFigures[i]).Visible := aVisible; // Result.LockModify := True; Result.LockMove := True; Result.LockSelect := False; if CheckFigureByClassName(aCabinet, cTCabinet) then Result.FCabinetID := TCabinet(aCabinet).FSCSID; if CheckFigureByClassName(aCabinet, cTCabinetExt) then Result.FCabinetID := TCabinetExt(aCabinet).FSCSID; except on E: Exception do addExceptionToLogEx('U_Common.CreateNumberObject', E.Message); end; end; procedure ChangeCabinetParams(AID_List: Integer; AObjectParams: TObjectParams); var Cabinet: TFigure; i: integer; NumberText: TRichText; vList: TF_CAD; SavedCadForm: TF_CAD; NumberObject: TCabinetNumber; j:Integer; aFigure: TFigure; begin try vList := GetListByID(AID_List); if vList <> nil then begin Cabinet := FindCabinetBySCSID(vList, AObjectParams.ID); if Cabinet <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; //Проверка фигуры на вхождение в кабинет if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; for j := 0 to GCadForm.FCheckedFigures.Count - 1 do begin aFigure := TFigure(GCadForm.FCheckedFigures[j]); GCadForm.Pcad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure); end; if CheckFigureByClassName(Cabinet, cTCabinet) then begin NumberObject := TCabinet(Cabinet).FNumberObject; if NumberObject <> nil then begin RemoveInFigureGrp(NumberObject); vList.PCad.Figures.Remove(NumberObject); FreeAndNil(NumberObject); TCabinet(Cabinet).FIndex := AObjectParams.MarkID; TCabinet(Cabinet).FFalseFloorHeight := AObjectParams.HeightCeiling; TCabinet(Cabinet).CabinetConfig := AObjectParams.CabinetConfig; TCabinet(Cabinet).FNumberObject := CreateNumberObjectOnCAD(Cabinet, vList.FShowCabinetsNumbers); TCabinet(Cabinet).FNumberObject.Visible := AObjectParams.CabinetConfig.aWorkRoom; TCabinet(Cabinet).FNumberObject.FPositionIndex := AObjectParams.CabinetConfig.CabinetNumPos; TCabinet(Cabinet).FNumberObject.IsCabinetExt := AObjectParams.CabinetConfig.IsCabinetExt; TCabinet(Cabinet).FNumberObject.CircleRadius := AObjectParams.CabinetConfig.NumRadius; end; end; if CheckFigureByClassName(Cabinet, cTCabinetExt) then begin NumberObject := TCabinetExt(Cabinet).FNumberObject; if NumberObject <> nil then begin RemoveInFigureGrp(NumberObject); vList.PCad.Figures.Remove(NumberObject); FreeAndNil(NumberObject); TCabinetExt(Cabinet).FIndex := AObjectParams.MarkID; TCabinetExt(Cabinet).FFalseFloorHeight := AObjectParams.HeightCeiling; TCabinetExt(Cabinet).CabinetConfig := AObjectParams.CabinetConfig; TCabinetExt(Cabinet).FNumberObject := CreateNumberObjectOnCAD(Cabinet, vList.FShowCabinetsNumbers); TCabinetExt(Cabinet).FNumberObject.Visible := AObjectParams.CabinetConfig.aWorkRoom; TCabinetExt(Cabinet).FNumberObject.FPositionIndex := AObjectParams.CabinetConfig.CabinetNumPos; TCabinetExt(Cabinet).FNumberObject.IsCabinetExt := AObjectParams.CabinetConfig.IsCabinetExt; TCabinetExt(Cabinet).FNumberObject.CircleRadius := AObjectParams.CabinetConfig.NumRadius; end; end; MoveObjectsToCabinetOnMove(Cabinet); GCadForm := SavedCadForm; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ChangeCabinetParams', E.Message); end; end; procedure SetVisibleCabinetsNumbers(aVisible: Boolean); var i, j: integer; Cabinet: TCabinet; CabinetExt: TCabinetExt; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then begin Cabinet := TCabinet(GCadForm.PCad.Figures[i]); if Cabinet.FNumberObject <> nil then begin if not aVisible then begin Cabinet.FNumberObject.Visible := aVisible; for j := 0 to Cabinet.FNumberObject.InFigures.Count - 1 do TFigure(Cabinet.FNumberObject.InFigures[j]).Visible := aVisible; end else begin Cabinet.FNumberObject.Visible := Cabinet.CabinetConfig.aWorkRoom; for j := 0 to Cabinet.FNumberObject.InFigures.Count - 1 do TFigure(Cabinet.FNumberObject.InFigures[j]).Visible := Cabinet.CabinetConfig.aWorkRoom; end; end; end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then begin CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]); if CabinetExt.FNumberObject <> nil then begin if not aVisible then begin CabinetExt.FNumberObject.Visible := aVisible; for j := 0 to CabinetExt.FNumberObject.InFigures.Count - 1 do TFigure(CabinetExt.FNumberObject.InFigures[j]).Visible := aVisible; end else begin CabinetExt.FNumberObject.Visible := CabinetExt.Cabinetconfig.aWorkRoom; for j := 0 to CabinetExt.FNumberObject.InFigures.Count - 1 do TFigure(CabinetExt.FNumberObject.InFigures[j]).Visible := CabinetExt.Cabinetconfig.aWorkRoom; end; end; end; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.SetVisibleCabinetsNumbers', E.Message); end; end; procedure SetVisibleCabinetsBounds(aVisible: Boolean); var i, j: integer; Cabinet: TCabinet; CabinetExt: TCabinetExt; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then begin Cabinet := TCabinet(GCadForm.PCad.Figures[i]); Cabinet.Visible := aVisible; end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then begin CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]); CabinetExt.Visible := aVisible; end; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.SetVisibleCabinetsBounds', E.Message); end; end; function GetCabinetWhereObject(aObject: TFigure): TFigure; var i: integer; X, Y: Double; Cabinet: TCabinet; CabinetExt: TCabinetExt; begin Result := nil; try X := aObject.ActualPoints[1].x; Y := aObject.ActualPoints[1].y; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then begin Cabinet := TCabinet(GCadForm.PCad.Figures[i]); if Cabinet.FType = ct_Visual then begin if Cabinet.CabinetConfig.aWorkRoom then if Cabinet.isPointInMod(X, Y) then begin Result := Cabinet; Break; end; end; end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then begin CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]); if CabinetExt.FType = ct_Visual then begin if CabinetExt.CabinetConfig.aWorkRoom then if CabinetExt.isPointInMod(X, Y) then begin Result := CabinetExt; Break; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetCabinetWhereObject', E.Message); end; end; function GetCabinetAtPos(aX, aY: double; aCheckAllFigInside: boolean = True; aMovedFigure: TFigure = nil): TFigure; var i, SquareCounter: integer; Cabinet: TCabinet; CabinetExt: TCabinetExt; aFigure:TFigure; // Tolik CabinetList : TList; currSquare: Double; Catalog: TSCSCatalog; currList: TSCSList; square: Double; SquareList: array of Double; SortAgain: Boolean; CatalogList: TSCSCatalogs; aCad: TF_CAD; begin Result := nil; //переписана совсем (by Tolik), старый код закоммечен см. ниже CabinetList := TList.Create; currList := F_ProjMan.GSCSBase.CurrProject.CurrList; SetLength(SquareList, 0); SquareCounter := 1; CatalogList := TSCSCatalogs.Create(False); aCad := GetListByID(F_ProjMan.GSCSBase.CurrProject.CurrList.SCSID); try for i := 0 to currList.ChildCatalogReferences.Count - 1 do begin Catalog := currList.ChildCatalogReferences[i]; if Catalog.ItemType = itRoom then begin CatalogList.Add(Catalog); end; end; if CatalogList.Count > 0 then begin for i := 0 to CatalogList.Count - 1 do begin Cabinet := Nil; CabinetExt := Nil; Catalog := CatalogList[i]; aFigure := GetFigureByID(aCad, Catalog.SCSID); if aFigure <> nil then begin Cabinet := TCabinet(aFigure); if not Cabinet.CabinetConfig.IsCabinetExt then begin if Cabinet.CabinetConfig.aWorkRoom then begin if Cabinet.isPointInMod(aX, aY) then begin CabinetList.Add(Cabinet); end; end; end end; end; for i := 0 to CatalogList.Count - 1 do begin Catalog := CatalogList[i]; aFigure := GetFigureByID(aCad, Catalog.SCSID); CabinetExt := TCabinetExt(aFigure); if CabinetExt <> nil then begin if CabinetExt.CabinetConfig.IsCabinetExt then begin if CabinetExt.CabinetConfig.aWorkRoom then begin if CabinetExt.isPointInMod(aX, aY) then begin CabinetList.Add(CabinetExt); end; end; end; end; end; end; if CabinetList.Count = 0 then Result := GetVirtualCabinet else begin if CabinetList.Count > 1 then begin for i := 0 to CabinetList.Count - 1 do begin square := GetRoomSquare(currList.SCSID, TFigure(CabinetList[i]).ID); SetLength(SquareList, SquareCounter); SquareList[SquareCounter - 1] := Square; Inc(SquareCounter); end; SortAgain := True; while sortAgain do begin SortAgain := False; for i := 0 to Length(SquareList) - 2 do begin if SquareList[i] > SquareList[i + 1] then begin SortAgain := True; Square := SquareList[i]; SquareList[i] := SquareList[i + 1]; SquareList[i + 1] := Square; aFigure := TFigure(CabinetList[i]); CabinetList[i] := CabinetList[i + 1]; CabinetList[i + 1] := aFigure; end; end; end; end; Result := TFigure(CabinetList[0]); end; except on E: Exception do addExceptionToLogEx('U_Common.GetCabinetAtPos', E.Message); end; { try if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; if aMovedFigure <> nil then begin GCadForm.PCad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aMovedFigure); end else begin if aCheckAllFigInside then begin for i := 0 to GCadForm.FCheckedFigures.Count - 1 do begin aFigure := TFigure(GCadForm.FCheckedFigures[i]); GCadForm.PCad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure); end; end; end; //for i := 0 to GCadForm.PCad.FigureCount - 1 do for i := 0 to GCadForm.FCheckedFigures.Count - 1 do begin //if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[i]), cTCabinet) then begin //Cabinet := TCabinet(GCadForm.PCad.Figures[i]); Cabinet := TCabinet(GCadForm.FCheckedFigures[i]); if Cabinet.FType = ct_Virtual then begin Result := Cabinet; end; // if Cabinet.FType = ct_Visual then // if (Cabinet.FType = ct_Visual) or (Cabinet.FType = ct_Virtual) then begin if Cabinet.CabinetConfig.aWorkRoom then if Cabinet.isPointInMod(aX, aY) then begin Result := Cabinet; Break; //CabinetList.Add(Cabinet); end; end; end; //if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then if CheckFigureByClassName(TFigure(GCadForm.FCheckedFigures[i]), cTCabinetExt) then begin //CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]); CabinetExt := TCabinetExt(GCadForm.FCheckedFigures[i]); if CabinetExt.FType = ct_Virtual then begin Result := CabinetExt; end; if CabinetExt.FType = ct_Visual then begin if CabinetExt.CabinetConfig.aWorkRoom then if CabinetExt.isPointInMod(aX, aY) then begin Result := CabinetExt; Break; //CabinetList.Add(CabinetExt); end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetCabinetAtPos', E.Message); end; } SetLength(SquareList, 0); if CabinetList.Count > 0 then FreeAndNil(CabinetList); end; procedure MoveObjectsToCabinetOnCreate(aCabinet: TFigure); var i: Integer; Line: TOrthoLine; Conn: TConnectorObject; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin Line := TOrthoLine(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(aCabinet, cTCabinet) then begin if TCabinet(aCabinet).isPointInMod(Line.ActualPoints[1].x, Line.ActualPoints[1].y) then begin if (Line.FCabinetID <> TCabinet(aCabinet).FSCSID) then begin Line.FCabinetID := TCabinet(aCabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID); end; end; end; if CheckFigureByClassName(aCabinet, cTCabinetExt) then begin if TCabinetExt(aCabinet).isPointInMod(Line.ActualPoints[1].x, Line.ActualPoints[1].y) then begin if (Line.FCabinetID <> TCabinetExt(aCabinet).FSCSID) then begin Line.FCabinetID := TCabinetExt(aCabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID); end; end; end; end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin Conn := TConnectorObject(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(aCabinet, cTCabinet) then begin if TCabinet(aCabinet).isPointInMod(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y) then begin if (Conn.FCabinetID <> TCabinet(aCabinet).FSCSID) then begin Conn.FCabinetID := TCabinet(aCabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID); end; end; end; if CheckFigureByClassName(aCabinet, cTCabinetExt) then begin if TCabinetExt(aCabinet).isPointInMod(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y) then begin if (Conn.FCabinetID <> TCabinetExt(aCabinet).FSCSID) then begin Conn.FCabinetID := TCabinetExt(aCabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID); end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.MoveObjectsToCabinet', E.Message); end; end; procedure MoveObjectsToCabinetOnMove(aCabinet: TFigure); var i: Integer; Line: TOrthoLine; Conn: TConnectorObject; OtherCabinet: TFigure; aFigure: TFigure; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin aFigure := TFigure(GCadForm.PCad.Figures[i]); GCadForm.PCad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure); if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin // LINE Line := TOrthoLine(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(aCabinet, cTCabinet) then begin if (TCabinet(aCabinet).isPointInMod(Line.ActualPoints[1].x, Line.ActualPoints[1].y))and(TCabinet(aCabinet).CabinetConfig.aWorkRoom) then begin // в области данного кабинета if (Line.FCabinetID <> TCabinet(aCabinet).FSCSID) then begin Line.FCabinetID := TCabinet(aCabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID); end; end else begin // вне области данного кабинета if (Line.FCabinetID = TCabinet(aCabinet).FSCSID) then begin // найти в каком кабинете он теперь остался OtherCabinet := GetCabinetAtPos(Line.ActualPoints[1].x, Line.ActualPoints[1].y, False); if OtherCabinet <> nil then begin if CheckFigureByClassName(OtherCabinet, cTCabinet) then Line.FCabinetID := TCabinet(OtherCabinet).FSCSID; if CheckFigureByClassName(OtherCabinet, cTCabinetExt) then Line.FCabinetID := TCabinetExt(OtherCabinet).FSCSID; end else Line.FCabinetID := -1; MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID); end; end; end; if CheckFigureByClassName(aCabinet, cTCabinetExt) then begin if (TCabinetExt(aCabinet).isPointInMod(Line.ActualPoints[1].x, Line.ActualPoints[1].y))and(TCabinetExt(aCabinet).CabinetConfig.aWorkRoom) then begin // в области данного кабинета if (Line.FCabinetID <> TCabinetExt(aCabinet).FSCSID) then begin Line.FCabinetID := TCabinetExt(aCabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID); end; end else begin // вне области данного кабинета if (Line.FCabinetID = TCabinetExt(aCabinet).FSCSID) then begin // найти в каком кабинете он теперь остался OtherCabinet := GetCabinetAtPos(Line.ActualPoints[1].x, Line.ActualPoints[1].y, False); if OtherCabinet <> nil then begin if CheckFigureByClassName(OtherCabinet, cTCabinet) then Line.FCabinetID := TCabinet(OtherCabinet).FSCSID; if CheckFigureByClassName(OtherCabinet, cTCabinetExt) then Line.FCabinetID := TCabinetExt(OtherCabinet).FSCSID; end else Line.FCabinetID := -1; MoveObjectToRoomInPM(GCadForm.FCADListID, Line.ID, Line.FCabinetID); end; end; end; end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin // CONN Conn := TConnectorObject(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(aCabinet, cTCabinet) then begin if (TCabinet(aCabinet).isPointInMod(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y))and(TCabinet(aCabinet).CabinetConfig.aWorkRoom) then begin // в области данного кабинета if (Conn.FCabinetID <> TCabinet(aCabinet).FSCSID) then begin Conn.FCabinetID := TCabinet(aCabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID); end; end else begin // вне области данного кабинета if (Conn.FCabinetID = TCabinet(aCabinet).FSCSID) then begin // найти в каком кабинете он теперь остался OtherCabinet := GetCabinetAtPos(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y, False); if OtherCabinet <> nil then begin if CheckFigureByClassName(OtherCabinet, cTCabinet) then Conn.FCabinetID := TCabinet(OtherCabinet).FSCSID; if CheckFigureByClassName(OtherCabinet, cTCabinetExt) then Conn.FCabinetID := TCabinetExt(OtherCabinet).FSCSID; end else Conn.FCabinetID := -1; MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID); end; end; end; if CheckFigureByClassName(aCabinet, cTCabinetExt) then begin if (TCabinetExt(aCabinet).isPointInMod(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y))and(TCabinetExt(aCabinet).CabinetConfig.aWorkRoom) then begin // в области данного кабинета if (Conn.FCabinetID <> TCabinetExt(aCabinet).FSCSID) then begin Conn.FCabinetID := TCabinetExt(aCabinet).FSCSID; MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID); end; end else begin // вне области данного кабинета if (Conn.FCabinetID = TCabinetExt(aCabinet).FSCSID) then begin // найти в каком кабинете он теперь остался OtherCabinet := GetCabinetAtPos(Conn.ActualPoints[1].x, Conn.ActualPoints[1].y, False); if OtherCabinet <> nil then begin if CheckFigureByClassName(OtherCabinet, cTCabinet) then Conn.FCabinetID := TCabinet(OtherCabinet).FSCSID; if CheckFigureByClassName(OtherCabinet, cTCabinetExt) then Conn.FCabinetID := TCabinetExt(OtherCabinet).FSCSID; end else Conn.FCabinetID := -1; MoveObjectToRoomInPM(GCadForm.FCADListID, Conn.ID, Conn.FCabinetID); end; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.MoveObjectsToCabinetOnMove', E.Message); end; end; function GetVirtualCabinet: TFigure; var i: integer; begin Result := nil; try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then begin if TCabinet(GCadForm.PCad.Figures[i]).FType = ct_Virtual then begin Result := TFigure(GCadForm.PCad.Figures[i]); Break; end; end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then begin if TCabinetExt(GCadForm.PCad.Figures[i]).FType = ct_Virtual then begin Result := TFigure(GCadForm.PCad.Figures[i]); Break; end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.GetVirtualCabinet', E.Message); end; end; function IsNoteExist(aNoteObject: TFigureGrpNotMod): Boolean; var i: integer; Note: TRichTextMod; begin Result := True; //03.11.2011 //try // Note := nil; // for i := 0 to aNoteObject.InFigures.Count - 1 do // begin // if CheckFigureByClassName(TFigure(aNoteObject.InFigures[i]), cTRichTextMod) then // Note := TRichTextMod(aNoteObject.InFigures[i]); // end; // if Note <> nil then // begin // if Note.re.Lines.Count > 0 then // Result := True // else // Result := False; // end; // except // on E: Exception do addExceptionToLogEx('U_Common.IsNoteExist', E.Message); // end; Note := nil; for i := 0 to aNoteObject.InFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(aNoteObject.InFigures[i]), cTRichTextMod) then begin Note := TRichTextMod(aNoteObject.InFigures[i]); if Note <> nil then begin if Note.re.Lines.Count > 0 then begin Result := True; Break; //// BREAK //// end else Result := False; end; end; end; end; function isRaiseEmptyAndNotNeed(aRaiseLine: TOrthoLine): boolean; var JoinObject1, JoinObject2: TConnectorObject; LinesCount1, LinesCount2, ConnsCount1, ConnsCount2: Integer; begin try result := False; if aRaiseLine.FIsRaiseUpDown then begin if CheckEmptyFigure(aRaiseLine.ID) then begin JoinObject1 := TConnectorObject(aRaiseLine.JoinConnector1); JoinObject2 := TConnectorObject(aRaiseLine.JoinConnector2); ConnsCount1 := JoinObject1.JoinedConnectorsList.Count; ConnsCount2 := JoinObject2.JoinedConnectorsList.Count; LinesCount1 := JoinObject1.JoinedOrtholinesList.Count - 1; LinesCount2 := JoinObject2.JoinedOrtholinesList.Count - 1; if ((ConnsCount1 = 0) and (LinesCount1 = 0)) or ((ConnsCount2 = 0) and (LinesCount2 = 0)) or (aRaiseLine.LineLength = 0) then begin result := True; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.isRaiseEmptyAndNotNeed', E.Message); end; end; procedure CheckDeleteRaise(aRaiseLine: TOrthoLine); var ObjFromRaise: TConnectorObject; RaiseConn: TConnectorObject; begin try if isRaiseEmptyAndNotNeed(aRaiseLine) then begin ObjFromRaise := aRaiseLine.FObjectFromRaisedLine; if ObjFromRaise <> nil then begin RaiseConn := GetRaiseConn(ObjFromRaise); if (RaiseConn <> nil) and (RaiseConn.FConnRaiseType = crt_OnFloor) then begin // ????? if not RaiseConn.Deleted then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckDeleteRaise', E.Message); end; end; procedure CheckDeleteAllRaises(aPCad: TPowerCad); var i: integer; RaiseLine: TOrthoLine; RaisesList: TList; begin try RaisesList := TList.Create; for i := 0 to aPCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(aPCad.Figures[i]), cTOrthoLine) then begin RaiseLine := TOrthoLine(aPCad.Figures[i]); if RaiseLine.FIsRaiseUpDown then RaisesList.Add(RaiseLine); end; end; for i := 0 to RaisesList.Count - 1 do begin RaiseLine := TOrthoLine(RaisesList[i]); if (RaiseLine <> nil) and (not RaiseLine.Deleted) then begin CheckDeleteRaise(RaiseLine); end; end; FreeAndNil(RaisesList); RefreshCAD(aPCad); except on E: Exception do addExceptionToLogEx('U_Common.CheckDeleteAllRaises', E.Message); end; end; function CheckCADObjectSelect(AID_List, AID_Object: Integer): Boolean; var FList: TF_CAD; FObject: TFigure; begin Result := False; try FList := GetListByID(AID_List); if FList <> nil then begin FObject := GetFigureByID(FList, AID_Object); if FObject <> nil then begin if FObject.Selected then Result := True else Result := False; end; end; except on E: Exception do addExceptionToLogEx('', E.Message); end; end; function GetPointObjectsRelations(AID_List: Integer): TObjectList; var i, j, k: Integer; CurObject: TConnectorObject; CurTrace: TOrthoLine; FList: TF_CAD; PointObjectsList: TList; UsedObjectsList: TList; GetTrace: TList; FirstObject: TConnectorObject; LastObject: TConnectorObject; PointFigureRelation: TPointFigureRelation; begin Result := TObjectList.Create(True); try PointObjectsList := TList.Create; UsedObjectsList := TList.Create; FList := GetListByID(AID_List); FList := GCadForm; if FList <> nil then begin // заполнить список ТО for i := 0 to FList.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(FList.PCad.Figures[i]), cTConnectorObject) then begin CurObject := TConnectorObject(FList.PCad.Figures[i]); if CurObject.ConnectorType <> ct_Clear then PointObjectsList.Add(CurObject); end; end; end; // перебрать соединения на КАДе for i := 0 to PointObjectsList.Count - 1 do begin FirstObject := TConnectorObject(PointObjectsList[i]); for j := i + 1 to PointObjectsList.Count - 1 do begin LastObject := TConnectorObject(PointObjectsList[j]); GetTrace := GetAllTraceInCAD(FirstObject, LastObject); // соединение есть if GetTrace <> nil then begin PointFigureRelation := TPointFigureRelation.Create; PointFigureRelation.FirstPointFigure := FirstObject.ID; PointFigureRelation.LastPointFigure := LastObject.ID; // отделить трассы от ТО и занести в список класса for k := 0 to GetTrace.Count - 1 do begin if CheckFigureByClassName(TFigure(GetTrace[k]), cTOrthoLine) then begin CurTrace := TOrthoLine(GetTrace[k]); PointFigureRelation.Traces.Add(CurTrace.ID); end; end; Result.Add(PointFigureRelation); end; end; end; FreeAndNil(PointObjectsList); FreeAndNil(UsedObjectsList); except on E: Exception do addExceptionToLogEx('U_Common.GetPointObjectsRelations', E.Message); end; end; Procedure ReScaleAllDimLines; var i: integer; HDimLine: TSCSHDimLine; VDimLine: TSCSVDimLine; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTSCSHDimLine) then begin HDimLine := TSCSHDimLine(GCadForm.PCad.Figures[i]); HDimLine.FValue := HDimLine.GetValue; HDimLine.DLabel := FormatFloat(ffMask, HDimLine.FValue); HDimLine.AutoText := True; HDimLine.Modified := True; end; if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTSCSVDimLine) then begin VDimLine := TSCSVDimLine(GCadForm.PCad.Figures[i]); VDimLine.FValue := VDimLine.GetValue; VDimLine.DLabel := FormatFloat(ffMask, VDimLine.FValue); VDimLine.AutoText := True; VDimLine.Modified := True; end; end; except on E: Exception do addExceptionToLogEx('U_Common.ReScaleAllDimLines', E.Message); end; end; Function CheckObjectDeleted(AID_List, AID_Object: Integer): Boolean; var FFigure: TFigure; vList: TF_CAD; begin Result := False; try vList := GetListByID(AID_List); if vList <> nil then begin FFigure := GetFigureByID(vList, AID_Object); if FFigure <> nil then begin if FFigure.Deleted then Result := True else Result := False; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckObjectDeleted', E.Message); end; end; procedure ReverseCaptionAfterTypeChange(aLine: TOrthoLine; aOldType, aNewType: TShowKind); var PairStr: string; LengthStr: string; begin try // переключается с обычного на внешние СКС if (aOldType <> skExternalSCS) and (aNewType = skExternalSCS) then begin aLine.OutTextCaptions.Clear; PairStr := GetPairCountFromTrace(GCadForm.FCADListID, aLine.ID); aLine.OutTextCaptions.Add(PairStr); LengthStr := GetLineCaptionFormat(aLine, GCadForm.FShowLineCaptionsType); aLine.OutTextCaptions.Add(LengthStr); end else // переключается с внешних СКС на обычне if (aOldType = skExternalSCS) and (aNewType <> skExternalSCS) then begin aLine.OutTextCaptions.Clear; LengthStr := GetLineCaptionFormat(aLine, GCadForm.FShowLineCaptionsType); aLine.OutTextCaptions.Add(LengthStr); end; except on E: Exception do addExceptionToLogEx('TOrthoLine.ReverseCaptionAfterTypeChange', E.Message); end; end; procedure SetDimLinesType(aType: TDimLinesType); var i: Integer; FFigure: TFigure; EndType: TEndType; begin try EndType := etRow; //#From Oleg# //14.09.2010 if aType = dlt_None then EndType := etClear; if aType = dlt_Row then EndType := etRow; if aType = dlt_Stroke then EndType := etNick; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTSCSHDimLine) then begin TSCSHDimLine(FFigure).EndType := EndType; end; if CheckFigureByClassName(FFigure, cTSCSVDimLine) then begin TSCSVDimLine(FFigure).EndType := EndType; end; if CheckFigureByClassName(FFigure, 'THDimLine') then begin THDimLine(FFigure).EndType := EndType; end; if CheckFigureByClassName(FFigure, 'TVDimLine') then begin TVDimLine(FFigure).EndType := EndType; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetDimLinesType', E.Message); end; end; function CheckTrunkObject(aObject: TConnectorObject): Boolean; begin Result := false; try if aObject = nil then exit; if CheckFigureByClassName(aObject, cTConnectorObject) then begin if (aObject.FTrunkName = ctsnCrossATS) or (aObject.FTrunkName = ctsnDistributionCabinet) then Result := True else Result := False; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckTrunkObject', E.Message); end; end; function CreateSCSObjectDuplicates(ACad: TF_CAD; aObjects: TList): TList; var i, j, k: integer; vConn, ResConn: TConnectorObject; vLine, ResLine: TOrthoLine; ClearsList: TList; ObjectsList: TList; ClearConn, OtherClearConn: TConnectorObject; PointConn, GetParentDup: TConnectorObject; DrawDeltaX, DrawDeltaY: double; TotalList: TList; FFigure: TFigure; ResConnectingTraces: TList; vConnectingTraces: TList; ResConnectingLine: TOrthoLine; vConnectingLine: TOrthoLine; isSP: Boolean; Net: TNet; begin Result := TList.create; try if not CheckAnyButFigureGrp(aObjects) then begin EndProgress; ShowMessage(cCommon_Mes22); Exit; end; ClearsList := TList.Create; ObjectsList := TList.Create; TotalList := TList.Create; for i := 0 to aObjects.Count - 1 do begin FFigure := TFigure(aObjects[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin vConn := TConnectorObject(FFigure); if vConn.ConnectorType <> ct_Clear then begin // КРОСС АТС if vConn.FTrunkName = ctsnCrossATS then begin ResConn := vConn.CreateCrossATSDuplicate(vConn.ActualPoints[1].x, vConn.ActualPoints[1].y); ResConn.tmpParentDupID := vConn.ID; if CheckNoFigureInList(ResConn, ObjectsList) then ObjectsList.Add(ResConn); TotalList.Add(ResConn); vConnectingTraces := GetAllConnectingTraces(vConn); ResConnectingTraces := GetAllConnectingTraces(ResConn); for j := 0 to ResConnectingTraces.Count - 1 do begin ResConnectingLine := TOrthoLine(ResConnectingTraces[j]); vConnectingLine := TOrthoLine(vConnectingTraces[j]); TConnectorObject(ResConnectingLine.JoinConnector1).tmpParentDupID := TConnectorObject(vConnectingLine.JoinConnector1).ID; TConnectorObject(ResConnectingLine.JoinConnector2).tmpParentDupID := TConnectorObject(vConnectingLine.JoinConnector2).ID; if CheckNoFigureInList(ResConnectingLine.JoinConnector1, ClearsList) then begin ClearsList.Add(ResConnectingLine.JoinConnector1); TotalList.Add(ResConnectingLine.JoinConnector1); end; TotalList.Add(ResConnectingLine); end; end else // РАСПРЕДЕЛИТЕЛЬНЫЙ ШКАФ if vConn.FTrunkName = ctsnDistributionCabinet then begin ResConn := vConn.CreateDistribCabDuplicate(vConn.ActualPoints[1].x, vConn.ActualPoints[1].y); ResConn.tmpParentDupID := vConn.ID; if CheckNoFigureInList(ResConn, ObjectsList) then ObjectsList.Add(ResConn); TotalList.Add(ResConn); vConnectingTraces := GetAllConnectingTraces(vConn); ResConnectingTraces := GetAllConnectingTraces(ResConn); for j := 0 to ResConnectingTraces.Count - 1 do begin ResConnectingLine := TOrthoLine(ResConnectingTraces[j]); vConnectingLine := TOrthoLine(vConnectingTraces[j]); TConnectorObject(ResConnectingLine.JoinConnector1).tmpParentDupID := TConnectorObject(vConnectingLine.JoinConnector1).ID; TConnectorObject(ResConnectingLine.JoinConnector2).tmpParentDupID := TConnectorObject(vConnectingLine.JoinConnector2).ID; if CheckNoFigureInList(ResConnectingLine.JoinConnector1, ClearsList) then begin ClearsList.Add(ResConnectingLine.JoinConnector1); TotalList.Add(ResConnectingLine.JoinConnector1); end; TotalList.Add(ResConnectingLine); end; end else // ОБЫЧНЫЙ begin ResConn := vConn.CreateDuplicate(vConn.ActualPoints[1].x, vConn.ActualPoints[1].y); ResConn.tmpParentDupID := vConn.ID; if CheckNoFigureInList(ResConn, ObjectsList) then ObjectsList.Add(ResConn); TotalList.Add(ResConn); end; end; end else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin vLine := TOrthoLine(FFigure); if (not vLine.FConnectingLine) and (not vLine.FIsVertical) then begin GLastTracedLinePoints1 := vLine.ActualPoints[1]; GLastTracedLinePoints2 := vLine.ActualPoints[2]; ResLine := vLine.CreateDuplicate; TConnectorObject(ResLine.JoinConnector1).tmpParentDupID := TConnectorObject(vLine.JoinConnector1).ID; TConnectorObject(ResLine.JoinConnector2).tmpParentDupID := TConnectorObject(vLine.JoinConnector2).ID; if CheckNoFigureInList(ResLine.JoinConnector1, ClearsList) then begin ClearsList.Add(ResLine.JoinConnector1); TotalList.Add(ResLine.JoinConnector1); end; if CheckNoFigureInList(ResLine.JoinConnector2, ClearsList) then begin ClearsList.Add(ResLine.JoinConnector2); TotalList.Add(ResLine.JoinConnector2); end; TotalList.Add(ResLine); GLastTracedLinePoints1 := DoublePoint(-10000, -10000); GLastTracedLinePoints2 := DoublePoint(-10000, -10000); end; end else if FFigure is TNet then begin Net := TNet(FFigure).CreateDuplicate; GArchEngine.SetHandlersToObj(Net); ACad.PCad.AddCustomFigure(lnArch, Net, False); //CAD.PCad.AddCustomFigure(lnArch, Net, False); RefreshNet(Net); TotalList.Add(Net); end; end; // создать все связи // 1 - связь пустого с пустым for i := 0 to ClearsList.Count - 1 do begin ClearConn := TConnectorObject(ClearsList[i]); if (ClearConn <> nil) and (not ClearConn.Deleted) then begin for j := i + 1 to ClearsList.Count - 1 do begin OtherClearConn := TConnectorObject(ClearsList[j]); if (OtherClearConn <> nil) and (not OtherClearConn.Deleted) then begin if ClearConn.ID <> OtherClearConn.ID then if ClearConn.tmpParentDupID = OtherClearConn.tmpParentDupID then begin SnapConnectorToConnector(ClearConn, OtherClearConn); end; end; end; end; end; // 2 - связь пустого с ТО for i := 0 to ObjectsList.Count - 1 do begin PointConn := TConnectorObject(ObjectsList[i]); GetParentDup := TConnectorObject(GetFigureByID(GCadForm, PointConn.tmpParentDupID)); for j := 0 to GetParentDup.JoinedConnectorsList.Count - 1 do begin ClearConn := TConnectorObject(GetParentDup.JoinedConnectorsList[j]); OtherClearConn := GetJoinedConnForDuplicate(ClearsList, ClearConn.ID); if (OtherClearConn <> nil) and (not OtherClearConn.Deleted) then begin SnapConnectorToPointObject(OtherClearConn, PointConn); end; end; end; // почистить пустые коннекторы for i := 0 to ClearsList.Count - 1 do begin ClearConn := TConnectorObject(ClearsList[i]); if CheckFigureByClassName(ClearConn, cTConnectorObject) then begin if (ClearConn <> nil) and (not ClearConn.Deleted) then begin ClearConn.tmpParentDupID := -1; if (ClearConn.FConnRaiseType = crt_None) and (ClearConn.LockMove) then begin isSP := False; for j := 0 to ClearConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(ClearConn.JoinedOrtholinesList[j]).FIsRaiseUpDown then isSP := True; if (IsSP) and (ClearConn.JoinedConnectorsList.Count = 0) then begin ClearConn.LockMove := False; ClearConn.LockModify := False; end; end; end; end; end; // занести в Result for i := 0 to TotalList.Count - 1 do begin FFigure := TFigure(TotalList[i]); if (FFigure <> nil) and (not FFigure.Deleted) then if CheckFigureByClassName(FFigure, cTConnectorObject) or CheckFigureByClassName(FFigure, cTOrthoLine) or (FFigure is TNet) then Result.Add(FFigure); end; FreeAndNil(TotalList); FreeAndNil(ClearsList); FreeAndNil(ObjectsList); except on E: Exception do addExceptionToLogEx('U_Common.CreateSCSObjectDuplicates', E.Message); end; end; function GetJoinedConnForDuplicate(aClearConns: TList; aParentDupID: Integer): TConnectorObject; var i: Integer; ClearConn: TConnectorObject; begin Result := nil; try for i := 0 to aClearConns.Count - 1 do begin ClearConn := TConnectorObject(aClearConns[i]); if (ClearConn <> nil) and (not ClearConn.Deleted) then begin if ClearConn.tmpParentDupID = aParentDupID then Result := ClearConn; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetJoinedConnForDuplicate', E.Message); end; end; Procedure AutoConnectOverDivideLine(AConnDivider, AConnOther: TConnectorObject; ADividedLine, ANewLine: TOrthoLine); var i, j: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ptrConnectObjParam: PConnectObjectParam; ConnectedLines: TList; ConnectedBeforeRaise: TList; ConnectedAfterRaise: TList; PointObject: TConnectorObject; OtherPointObject: TConnectorObject; AfterConnector: TConnectorObject; BeforeConnector: TConnectorObject; DevidedLineSideJoinedToAfterConn: Integer; procedure DefineConnectedObjectParams(ATargetConnectedObjectParams: TList; AConnectorObject: TConnectorObject; ASkipLine1, ASkipLine2: TOrtholine; AAddConn: Boolean); var i, j: Integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ptrConnectObjParam: PConnectObjectParam; begin if AAddConn then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := AConnectorObject.ID; ptrConnectObjParam.Side := 0; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; if AConnectorObject.ConnectorType = ct_Clear then for i := 0 to AConnectorObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnectorObject.JoinedOrtholinesList[i]); if (JoinedLine <> ASkipLine1) and (JoinedLine <> ASkipLine2) then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := JoinedLine.ID; if JoinedLine.JoinConnector1 = AConnectorObject then ptrConnectObjParam.Side := 1; if JoinedLine.JoinConnector2 = AConnectorObject then ptrConnectObjParam.Side := 2; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; end else begin for i := 0 to AConnectorObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(AConnectorObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if (JoinedLine <> ASkipLine1) and (JoinedLine <> ASkipLine2) then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := JoinedLine.ID; if JoinedLine.JoinConnector1 = JoinedConn then ptrConnectObjParam.Side := 1; if JoinedLine.JoinConnector2 = JoinedConn then ptrConnectObjParam.Side := 2; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; end; end; end; end; function CheckRelatedConns(AConn1, AConn2: TConnectorObject): Boolean; begin Result := false; if AConn1 = AConn2 then Result := true else if (AConn1.ConnectorType = ct_Clear) and (AConn1.JoinedConnectorsList.IndexOf(AConn2) <> -1) then Result := true else if (AConn2.ConnectorType = ct_Clear) and (AConn2.JoinedConnectorsList.IndexOf(AConn1) <> -1) then Result := true; end; begin try ConnectedBeforeRaise := TList.Create; ConnectedAfterRaise := TList.Create; PointObject := AConnDivider; OtherPointObject := AConnOther; //if (AConn1.ConnectorType = ct_Clear) and (AConn2.ConnectorType <> ct_Clear) then //begin // PointObject := AConn2; // OtherPointObject := AConn1; //end; //13.11.2008 DefineConnectedObjectParams(ConnectedBeforeRaise, PointObject, ANewLine, nil, false); //13.11.2008 DefineConnectedObjectParams(ConnectedAfterRaise, OtherPointObject, ANewLine, nil, true); //13.11.2008 AfterConnector := nil; BeforeConnector := nil; DevidedLineSideJoinedToAfterConn := 0; // проверяем подключение разделенной линии стороной 1 if CheckRelatedConns(TConnectorObject(ADividedLine.JoinConnector1), PointObject) then AfterConnector := PointObject else if CheckRelatedConns(TConnectorObject(ADividedLine.JoinConnector1), OtherPointObject) then AfterConnector := OtherPointObject; if AfterConnector <> nil then DevidedLineSideJoinedToAfterConn := 1 else begin // проверяем подключение разделенной линии стороной 2 if CheckRelatedConns(TConnectorObject(ADividedLine.JoinConnector2), PointObject) then AfterConnector := PointObject else if CheckRelatedConns(TConnectorObject(ADividedLine.JoinConnector2), OtherPointObject) then AfterConnector := OtherPointObject; if AfterConnector <> nil then DevidedLineSideJoinedToAfterConn := 2; end; if DevidedLineSideJoinedToAfterConn > 0 then begin // добавляем разделенную линию в список ConnectedAfterRaise New(ptrConnectObjParam); ptrConnectObjParam.IDObject := ADividedLine.ID; ptrConnectObjParam.Side := DevidedLineSideJoinedToAfterConn; ConnectedAfterRaise.Add(ptrConnectObjParam); if AfterConnector = PointObject then BeforeConnector := OtherPointObject else BeforeConnector := PointObject; // В список ConnectedBeforeRaise добавляем объекты связанные с BeforeConnector if BeforeConnector <> nil then //10.02.2014 DefineConnectedObjectParams(ConnectedBeforeRaise, BeforeConnector, nil, ADividedLine, false); DefineConnectedObjectParams(ConnectedBeforeRaise, BeforeConnector, ANewLine, ADividedLine, true); end; AutoConnectOverRaiseLine(PointObject.ID, ANewLine.ID, ConnectedBeforeRaise, ConnectedAfterRaise, ltTrace); if ConnectedBeforeRaise <> nil then FreeList(ConnectedBeforeRaise); if ConnectedAfterRaise <> nil then FreeList(ConnectedAfterRaise); except on E: Exception do addExceptionToLogEx('U_Common.AutoConnectOverDivideLine', E.Message); end; end; Procedure AutoDisconnectOverDivideLine(AConn1, AConn2: TConnectorObject; ALine: TOrthoLine); var JoinedConn: TConnectorObject; ConnectedLines: TList; ConnectedBeforeRaise: TList; ConnectedAfterRaise: TList; PointObject: TConnectorObject; OtherPointObject: TConnectorObject; procedure DefineConnectedObjectParams(ATargetConnectedObjectParams: TList; AConnectorObject: TConnectorObject); var i, j: Integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ptrConnectObjParam: PConnectObjectParam; begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := AConnectorObject.ID; ptrConnectObjParam.Side := 0; ATargetConnectedObjectParams.Add(ptrConnectObjParam); if AConnectorObject.ConnectorType = ct_Clear then for i := 0 to AConnectorObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnectorObject.JoinedOrtholinesList[i]); if JoinedLine <> ALine then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := JoinedLine.ID; if JoinedLine.JoinConnector1 = AConnectorObject then ptrConnectObjParam.Side := 1; if JoinedLine.JoinConnector2 = AConnectorObject then ptrConnectObjParam.Side := 2; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; end else begin for i := 0 to AConnectorObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(AConnectorObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine <> ALine then begin New(ptrConnectObjParam); ptrConnectObjParam.IDObject := JoinedLine.ID; if JoinedLine.JoinConnector1 = JoinedConn then ptrConnectObjParam.Side := 1; if JoinedLine.JoinConnector2 = JoinedConn then ptrConnectObjParam.Side := 2; ATargetConnectedObjectParams.Add(ptrConnectObjParam); end; end; end; end; end; begin try ConnectedBeforeRaise := TList.Create; ConnectedAfterRaise := TList.Create; PointObject := AConn1; OtherPointObject := AConn2; //if (AConn1.ConnectorType = ct_Clear) and (AConn2.ConnectorType <> ct_Clear) then //begin // PointObject := AConn2; // OtherPointObject := AConn1; //end; // AConnector DefineConnectedObjectParams(ConnectedBeforeRaise, PointObject); // ARaiseConnector DefineConnectedObjectParams(ConnectedAfterRaise, OtherPointObject); AutoDisconnectOverRaiseLine(ALine.ID, ConnectedBeforeRaise, ConnectedAfterRaise); if ConnectedBeforeRaise <> nil then FreeList(ConnectedBeforeRaise); if ConnectedAfterRaise <> nil then FreeList(ConnectedAfterRaise); except on E: Exception do addExceptionToLogEx('AutoDisconnectOverDivideLine', E.Message); end; end; function GetFigureObjectByID(aListID, aObjectID: Integer): TFigure; var vList: TF_CAD; vObject: TFigure; begin Result := nil; try vList := GetListByID(aListID); if vList <> nil then begin vObject := GetFigureByID(vList, aObjectID); // найден if vObject <> nil then Result := vObject else // не найден, искать в SCSFigureGroup begin vObject := GetFigureByIDInSCSFigureGroups(vList, aObjectID); if vObject <> nil then Result := vObject; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetFigureObjectByID', E.Message); end; end; procedure SetNewObjectsIDs(aObjects: TObjectList; aIDs: TIntList); var i, j: Integer; vFigure: TFigure; vID: Integer; Conn: TConnectorObject; begin try if aObjects.Count > 0 then TF_CAD(TPowerCad(TFigure(aObjects[0]).Owner).Owner).FSCSFigures.Clear; for i := 0 to aObjects.Count - 1 do begin vFigure := TFigure(aObjects[i]); vID := aIDs[i]; // коннектор или ортилиния if CheckFigureByClassName(vFigure, cTConnectorObject) or CheckFigureByClassName(vFigure, cTOrthoLine) then begin vFigure.ID := vID; if vFigure.Owner <> nil then TF_CAD(TPowerCad(vFigure.Owner).Owner).AddSCSFigure(vFigure); end else // кабинет if CheckFigureByClassName(vFigure, cTCabinet) then begin TCabinet(vFigure).FSCSID := vID; TCabinet(vFigure).FNumberObject.FCabinetID := TCabinet(vFigure).FSCSID; TCabinet(vFigure).ID := vID; //08.11.2011 if vFigure.Owner <> nil then TF_CAD(TPowerCad(vFigure.Owner).Owner).AddSCSFigure(vFigure); end else // кабинет if CheckFigureByClassName(vFigure, cTCabinetExt) then begin TCabinetExt(vFigure).FSCSID := vID; TCabinetExt(vFigure).FNumberObject.FCabinetID := TCabinetExt(vFigure).FSCSID; TCabinetExt(vFigure).ID := vID; //08.11.2011 if vFigure.Owner <> nil then TF_CAD(TPowerCad(vFigure.Owner).Owner).AddSCSFigure(vFigure); end else // кабинет if CheckFigureByClassName(vFigure, cTHouse) then begin THouse(vFigure).ID := vID; end else // не найден, искать внутри SCSFigureGroup begin end; end; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin Conn := TConnectorObject(GCadForm.PCad.Figures[i]); if Conn.ConnectorType = ct_Clear then begin if Conn.JoinedConnectorsList.Count > 0 then begin Conn.ID := GenNewSCSID; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetNewObjectsIDs', E.Message); end; end; function CanDeleteObjectFromPM(aListID, aObjectID: Integer): Boolean; var i: Integer; vList: TF_CAD; vObject: TFigure; vLine: TOrthoLine; vConn: TConnectorObject; begin Result := True; try vList := GetListByID(aListID); if vList <> nil then begin vObject := GetFigureByID(vList, aObjectID); if vObject <> nil then begin if CheckFigureByClassName(vObject, cTConnectorObject) then begin vConn := TConnectorObject(vObject); for i := 0 to vConn.JoinedOrtholinesList.Count - 1 do if TOrthoLine(vConn.JoinedOrtholinesList[i]).FConnectingLine then Result := False; end else if CheckFigureByClassName(vObject, cTOrthoLine) then begin vLine := TOrthoLine(vObject); if vLine.FConnectingLine then Result := False; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CanDeleteObjectFromPM', E.Message); end; end; procedure SetAllTracesAutoLength; var i: Integer; Trace: TOrthoLine; TracesList: TList; begin try TracesList := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then TracesList.Add(TFigure(GCadForm.PCad.Figures[i])); end; for i := 0 to TracesList.Count - 1 do begin Trace := TOrthoLine(TracesList[i]); Trace.UserLength := -1; Trace.CalculLength := Trace.LengthCalc; Trace.LineLength := Trace.CalculLength; SetLineFigureLengthInPM(Trace.ID, Trace.LineLength); Trace.UpdateLengthTextBox(True, true); end; FreeAndNil(TracesList); except on E: Exception do addExceptionToLogEx('U_Common.SetAllTracesAutoLength', E.Message); end; end; procedure SetAllTracesUserLength; var i: Integer; Trace: TOrthoLine; TracesList: TList; begin try TracesList := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then TracesList.Add(TFigure(GCadForm.PCad.Figures[i])); end; for i := 0 to TracesList.Count - 1 do begin Trace := TOrthoLine(TracesList[i]); if Trace.UserLength = -1 then Trace.UserLength := 0; Trace.CalculLength := Trace.LengthCalc; Trace.LineLength := Trace.CalculLength; SetLineFigureLengthInPM(Trace.ID, Trace.LineLength); Trace.UpdateLengthTextBox(True, true); end; FreeAndNil(TracesList); except on E: Exception do addExceptionToLogEx('U_Common.SetAllTracesUserLength', E.Message); end; end; function CheckFigureByClassName(aFigure: TFigure; const aClassName: string): Boolean; begin Result := False; try if aFigure <> nil then begin if aFigure.ClassName = aClassName then Result := True; end; except on E: Exception do Result := False; end; //GProcCnt := GProcCnt + 1; end; function CheckFigureByClassIdx(aFigure: TFigure; const aClassIdx: Integer): Boolean; begin Result := False; try if aFigure <> nil then begin if aFigure.FClassIndex = aClassIdx then Result := True; end; except on E: Exception do Result := False; end; end; procedure SetExistOtherObjectType(aListID, aObjectID: Integer; aExist: Boolean); var FList: TF_CAD; FLine: TOrthoLine; begin try FList := GetListByID(aListID); if FList <> nil then begin FLine := TOrthoLine(GetFigureByID(FList, aObjectID)); if FLine <> nil then begin Fline.FExistOtherObjectType := aExist; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetExistOtherObjectType', E.Message); end; end; function GetTrunkNumber(aLine: TOrthoLine): string; var i, j: Integer; StartConn, CurConn, JoinConn: TConnectorObject; CadCrossObject: TCADCrossObject; CadCrossObjectElement: TCADCrossObjectElement; CrossesList: TList; DistribsList: TList; CurCross, FindedCross: TConnectorObject; FindedPos: Integer; FindedTrace: TList; begin try Result := ''; FindedCross := nil; FindedPos := -1; StartConn := TConnectorObject(aLine.JoinConnector1); // Найти все Кросс АТС CrossesList := TList.Create; DistribsList := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin If CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin CurConn := TConnectorObject(GCadForm.PCad.Figures[i]); if CurConn.FTrunkName = ctsnCrossATS then CrossesList.Add(CurConn); if CurConn.FTrunkName = ctsnDistributionCabinet then DistribsList.Add(CurConn); end; end; // перебрать список кроссов for i := 0 to CrossesList.Count - 1 do begin CurCross := TConnectorObject(CrossesList[i]); FindedTrace := GetAllTraceInCAD(CurCross, StartConn); // нашли нужный кросс if FindedTrace <> nil then begin FindedCross := CurCross; Break; end; end; // найти номер магистрали от найденного кросса if FindedCross <> nil then begin // не трассировать через кроссы for i := 0 to CrossesList.Count - 1 do TConnectorObject(CrossesList[i]).FDisableTracing := True; for i := 0 to DistribsList.Count - 1 do TConnectorObject(DistribsList[i]).FDisableTracing := True; for i := 0 to FindedCross.JoinedConnectorsList.Count - 1 do begin JoinConn := TConnectorObject(FindedCross.JoinedConnectorsList[i]); FindedTrace := GetAllTraceInCAD(JoinConn, StartConn); if FindedTrace <> nil then begin FindedPos := i; Break; end; end; // убрать флаг for i := 0 to CrossesList.Count - 1 do TConnectorObject(CrossesList[i]).FDisableTracing := False; for i := 0 to DistribsList.Count - 1 do TConnectorObject(DistribsList[i]).FDisableTracing := False; // обработать саму позицию if FindedPos <> -1 then begin CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, FindedCross.ID); if CadCrossObject <> nil then begin CadCrossObjectElement := TCADCrossObjectElement(CadCrossObject.Elements[FindedPos]); if CadCrossObjectElement <> nil then Result := CadCrossObjectElement.Npp; end; end; end; FreeAndNil(CrossesList); FreeAndNil(DistribsList); except on E: Exception do addExceptionToLogEx('U_Common.GetTrunkNumber', E.Message); end; end; function SCSGroupSelection: TSCSFigureGrp; var i: integer; FFigure: TFigure; grp: TSCSFigureGrp; sel: TList; SelMod: TList; cnt: integer; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; ObjFromRaise: TConnectorObject; Conn1, Conn2: TConnectorObject; begin Result := nil; try sel := TList.Create; SelMod := TList.Create; GCadForm.PCad.collectselectedFigures(sel); cnt := sel.count; sel.Clear; if cnt = 0 then exit; grp := TSCSFigureGrp.create(LongInt(GCadForm.PCad.Layers[2]), GCadForm.PCad); for i := GCadForm.PCad.figures.count - 1 downto 0 do begin FFigure := Tfigure(GCadForm.PCad.figures[i]); if FFigure.Selected then begin FFigure.Deselect; if CheckNoFigureInList(FFigure, sel) then begin if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if not TConnectorObject(FFigure).FIsApproach then sel.Add(FFigure); end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin sel.Add(FFigure); end; end; end; end; // Correct for External if GCadForm.FSCSType = st_External then begin for i := 0 to sel.Count - 1 do begin FFigure := TFigure(sel[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then begin Conn1 := TConnectorObject(TOrthoLine(FFigure).JoinConnector1); Conn2 := TConnectorObject(TOrthoLine(FFigure).JoinConnector2); if CheckNoFigureInList(Conn1, sel) then sel.Add(Conn1); if CheckNoFigureInList(Conn2, sel) then sel.Add(Conn2); end; end; end; for i := sel.count - 1 downto 0 do begin FFigure := TFigure(sel[i]); if CheckNoFigureInList(FFigure, SelMod) then SelMod.Add(FFigure); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if TConnectorObject(FFigure).ConnectorType = ct_Clear then begin RaiseConn := nil; RaiseLine := nil; if TConnectorObject(FFigure).JoinedConnectorsList.Count > 0 then ObjFromRaise := TConnectorObject(TConnectorObject(FFigure).JoinedConnectorsList[0]) else ObjFromRaise := TConnectorObject(FFigure); RaiseConn := GetRaiseConn(ObjFromRaise); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); if RaiseConn <> nil then if CheckNoFigureInList(RaiseConn, SelMod) then begin SelMod.Add(RaiseConn); end; if RaiseLine <> nil then if CheckNoFigureInList(RaiseLine, SelMod) then begin SelMod.Add(RaiseLine); end; end; end; end; for i := SelMod.count - 1 downto 0 do begin FFigure := TFigure(SelMod[i]); GCadForm.PCad.Figures.Remove(FFigure); grp.AddFigure(FFigure); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin TConnectorObject(FFigure).FGroupObject := grp; end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin TOrthoLine(FFigure).FGroupObject := grp; end; end; FreeAndNil(sel); FreeAndNil(SelMod); grp.select; GCadForm.PCad.AddCustomFigure(2, grp, False); grp.CreateMetaFile; RefreshCAD(GCadForm.PCad); Result := grp; except on E: Exception do addExceptionToLogEx('U_Common.SCSGroupSelections', E.Message); end; end; function SCSGroupObjects(aObjects: TList): TSCSFigureGrp; var i: integer; FFigure: TFigure; grp: TSCSFigureGrp; begin Result := nil; try grp := TSCSFigureGrp.create(LongInt(GCadForm.PCad.Layers[2]), GCadForm.PCad); for i := aObjects.count - 1 downto 0 do begin FFigure := TFigure(aObjects[i]); if (FFigure <> nil) and (not FFigure.Deleted) then begin GCadForm.PCad.Figures.Remove(FFigure); grp.AddFigure(FFigure); if CheckFigureByClassName(FFigure, cTConnectorObject) then if (not TConnectorObject(FFigure).FIsApproach) and (not TConnectorObject(FFigure).FIsHouseJoined) then begin TConnectorObject(FFigure).FGroupObject := grp; end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin TOrthoLine(FFigure).FGroupObject := grp; end; end; end; GCadForm.PCad.AddCustomFigure(2, grp, False); grp.CreateMetaFile; RefreshCAD(GCadForm.PCad); Result := grp; except on E: Exception do addExceptionToLogEx('U_Common.SCSGroupObjects', E.Message); end; end; Procedure SCSUngroupSelection; var i: Integer; FFigure: TFigure; begin try for i := GCadForm.PCad.Figures.count - 1 downto 0 do begin FFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTSCSFigureGrp) and (FFigure.selected) then begin if not TFigureGrp(FFigure).AlwaysTogether then begin TSCSFigureGrp(FFigure).UnGroup; GCadForm.PCad.Figures.Delete(i); end; end; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.SCSGroupSelections', E.Message); end; end; function IsLockedObject(aListID, aObjectID: Integer): Boolean; var vList: TF_CAD; vObject: TFigure; begin Result := False; try vList := GetListByID(aListID); if vList <> nil then begin vObject := GetFigureByID(vList, aObjectID); if vObject = nil then begin vObject := GetFigureByIDInSCSFigureGroups(vList, aObjectID); if vObject <> nil then Result := True; end; end; except on E: Exception do addExceptionToLogEx('U_Common.IsLockedObject', E.Message); end; end; procedure DisconnectConn(AConn: TConnectorObject); var NextConnector: TConnectorObject; JoinedLine1, JoinedLine2: TOrthoLine; i: integer; JoinedConn: TConnectorObject; CP_Line: TDoublePoint; OtherConn: TConnectorObject; OtherConnPoints: TDoublePoint; begin BeginProgress; try JoinedLine1 := TOrthoLine(AConn.JoinedOrtholinesList[0]); JoinedLine2 := TOrthoLine(AConn.JoinedOrtholinesList[1]); if JoinedLine2.JoinConnector1 = AConn then begin NextConnector := TConnectorObject(JoinedLine2.JoinConnector2); if NextConnector.JoinedConnectorsList.Count > 0 then OtherConn := TConnectorObject(NextConnector.JoinedConnectorsList[0]) else OtherConn := NextConnector; OtherConnPoints := OtherConn.ActualPoints[1]; AutoDisconnectOverDivideLine(AConn, OtherConn, JoinedLine2); TOrthoLine(JoinedLine2).Delete; RefreshCAD(GCadForm.PCad); AConn.Move(OtherConnPoints.x - AConn.ActualPoints[1].x, OtherConnPoints.y - AConn.ActualPoints[1].y); if OtherConn.ConnectorType = ct_Clear then begin if (OtherConn <> nil) and (not OtherConn.Deleted) then SnapConnectorToConnector(AConn, OtherConn); end else begin SnapConnectorToPointObject(AConn, OtherConn); end; end else if JoinedLine2.JoinConnector2 = AConn then begin NextConnector := TConnectorObject(JoinedLine2.JoinConnector1); if NextConnector.JoinedConnectorsList.Count > 0 then OtherConn := TConnectorObject(NextConnector.JoinedConnectorsList[0]) else OtherConn := NextConnector; OtherConnPoints := OtherConn.ActualPoints[1]; AutoDisconnectOverDivideLine(AConn, OtherConn, JoinedLine2); TOrthoLine(JoinedLine2).Delete; RefreshCAD(GCadForm.PCad); AConn.Move(OtherConnPoints.x - AConn.ActualPoints[1].x, OtherConnPoints.y - AConn.ActualPoints[1].y); if OtherConn.ConnectorType = ct_Clear then begin if (OtherConn <> nil) and (not OtherConn.Deleted) then SnapConnectorToConnector(AConn, OtherConn); end else begin SnapConnectorToPointObject(AConn, OtherConn); end; end; if JoinedLine1 <> nil then JoinedLine1.ReCreateDrawFigureBlock; except on E: Exception do addExceptionToLogEx('U_Common.DisconnectConn', E.Message); end; EndProgress; end; procedure DisconnectTraces(aConn: TConnectorObject); var i, j: Integer; x, y, z: double; JoinedLine: TOrthoLine; CreatedConn: TConnectorObject; isDisconnected: Boolean; ptrInterfRecord1, ptrInterfRecord2: PConnectObjectParam; ParamsList1, ParamsList2: TList; begin BeginProgress; try x := aConn.ActualPoints[1].x; y := aConn.ActualPoints[1].y; z := aConn.ActualZOrder[1]; if aConn.JoinedOrtholinesList.Count > 1 then begin ParamsList1 := TList.create; ParamsList2 := TList.create; for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(aConn.JoinedOrtholinesList[i]); CreatedConn := TConnectorObject.Create(x, y, z, aConn.LayerHandle, mydsNormal, GCadForm.PCad); CreatedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure(2, CreatedConn, False); if JoinedLine.JoinConnector1 = aConn then JoinedLine.SetJConnector1(CreatedConn); if JoinedLine.JoinConnector2 = aConn then JoinedLine.SetJConnector2(CreatedConn); // ParamsList1 if i = 0 then begin New(ptrInterfRecord1); ptrInterfRecord1.IDObject := JoinedLine.ID; if aConn = JoinedLine.JoinConnector1 then ptrInterfRecord1.Side := 1; if aConn = JoinedLine.JoinConnector2 then ptrInterfRecord1.Side := 2; ParamsList1.Add(ptrInterfRecord1); end else // ParamsList2 begin New(ptrInterfRecord2); ptrInterfRecord2.IDObject := JoinedLine.ID; if aConn = JoinedLine.JoinConnector1 then ptrInterfRecord2.Side := 1; if aConn = JoinedLine.JoinConnector2 then ptrInterfRecord2.Side := 2; ParamsList2.Add(ptrInterfRecord2); end; end; // isDisconnected := DisconnectObjectsInPM(ParamsList1, ParamsList2); aConn.Delete(False, False); RefreshCAD(GCadForm.PCad); end; except on E: Exception do addExceptionToLogEx('U_Common.DisconnectTraces', E.Message); end; EndProgress; end; procedure DisconnectPointObject(aObject: TConnectorObject); var i: integer; PointObject: TConnectorObject; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; ConnectedConn: TConnectorObject; PrevConnector: TConnectorObject; ConnectedList: TList; begin BeginProgress; try ConnectedConn := nil; //#From Oleg# //14.09.2010 // это с-п if aObject.FObjectFromRaise <> nil then begin RaiseConn := aObject.FObjectFromRaise; RaiseLine := GetRaiseLine(aObject); RaiseLine.Delete; RefreshCAD(GCadForm.PCad); end; // на объекте есть с-п if GetRaiseConn(aObject) <> nil then begin RaiseConn := GetRaiseConn(aObject); RaiseLine := GetRaiseLine(RaiseConn); RaiseLine.Delete; RefreshCAD(GCadForm.PCad); end; ConnectedList := TList.Create; for i := 0 to aObject.JoinedConnectorsList.Count - 1 do ConnectedList.Add(aObject.JoinedConnectorsList[i]); if ConnectedList.Count > 0 then begin // рассоединить с трассами на одном уровне for i := 0 to ConnectedList.Count - 1 do begin ConnectedConn := TConnectorObject(ConnectedList[i]); UnsnapConnectorFromPointObject(ConnectedConn, aObject); end; PrevConnector := TConnectorObject(ConnectedList[0]); for i := 1 to ConnectedList.Count - 1 do begin ConnectedConn := TConnectorObject(ConnectedList[i]); SnapConnectorToConnector(ConnectedConn, PrevConnector); PrevConnector := ConnectedConn; end; ConnectedConn.Move(aObject.ActualPoints[1].x - ConnectedConn.ActualPoints[1].x, aObject.ActualPoints[1].y - ConnectedConn.ActualPoints[1].y); end; if ConnectedList <> nil then FreeAndNil(ConnectedList); aObject.Move(GCadForm.PCad.GridStep, GCadForm.PCad.GridStep); except on E: Exception do addExceptionToLogEx('U_Common.DisconnectPointObject', E.Message); end; EndProgress; end; procedure DeleteAllTraces; var i: Integer; Trace: TOrthoLine; TracesList: TList; begin try TracesList := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTOrthoLine) then begin Trace := TOrthoLine(GCadForm.PCad.Figures[i]); TracesList.Add(Trace); end; end; for i := 0 to TracesList.Count - 1 do begin Trace := TOrthoLine(TracesList[i]); Trace.Delete; end; RefreshCAD(GCadForm.PCad); FreeAndNil(TracesList); except on E: Exception do addExceptionToLogEx('DeleteAllTraces', E.Message); end; end; procedure DeleteSCSFigureGrps(aListID: Integer); var i: Integer; vList: TF_CAD; SavedCadForm: TF_CAD; SCSFigureGrp: TSCSFigureGrp; GrpList: TList; begin try vList := GetListByID(aListID); if vList <> nil then begin SavedCadForm := GCadForm; GCadForm := vList; GrpList := TList.Create; for i := 0 to vList.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(vList.PCad.Figures[i]), cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(vList.PCad.Figures[i]); GrpList.Add(SCSFigureGrp); end; end; for i := 0 to GrpList.Count - 1 do begin SCSFigureGrp := TSCSFigureGrp(GrpList[i]); SCSFigureGrp.Delete; end; FreeAndNil(GrpList); GCadForm := SavedCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.DeleteSCSFigureGrps', E.Message); end; end; function CheckAnyButFigureGrp(aFiguresList: TList): Boolean; var i: Integer; Figure: TFigure; begin Result := False; try for i := 0 to aFiguresList.Count - 1 do begin Figure := TFigure(aFiguresList[i]); if not CheckFigureByClassName(Figure, cTSCSFigureGrp) then Result := True; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckAnyButFigureGrp', E.Message); end; end; procedure ChangeDrawFigurePercentForObject(aObject: TConnectorObject; aPercent: Double); var MapScale: Double; CorrectX: Double; CorrectY: Double; Bnd: TDoubleRect; begin try MapScale := GCadForm.PCad.MapScale; // вернуть на 0 градус aObject.Rotate(0 - aObject.FDrawFigureAngle, aObject.ActualPoints[1]); if aObject.DrawFigure <> nil then aObject.DrawFigure.Rotate(0 - aObject.FDrawFigureAngle, aObject.ActualPoints[1]); // изменить размеры // BND Bnd := aObject.DrawFigure.GetBoundRect; aObject.GrpSizeX := abs(Bnd.Right - Bnd.Left); aObject.GrpSizeY := abs(Bnd.Bottom - Bnd.Top); CorrectX := aObject.FOriginalSizeX / aObject.GrpSizeX; CorrectY := aObject.FOriginalSizeY / aObject.GrpSizeY; // correct aObject.Scale(CorrectX, CorrectY, aObject.ActualPoints[1]); aObject.DrawFigure.Scale(CorrectX, CorrectY, aObject.ActualPoints[1]); // percent aObject.Scale(aPercent / 100, aPercent / 100, aObject.ActualPoints[1]); aObject.DrawFigure.Scale(aPercent / 100, aPercent / 100, aObject.ActualPoints[1]); aObject.FDrawFigurePercent := aPercent; // BND Bnd := aObject.DrawFigure.GetBoundRect; aObject.GrpSizeX := abs(Bnd.Right - Bnd.Left); aObject.GrpSizeY := abs(Bnd.Bottom - Bnd.Top); // повернуть назад aObject.Rotate(aObject.FDrawFigureAngle, aObject.ActualPoints[1]); if aObject.DrawFigure <> nil then aObject.DrawFigure.Rotate(aObject.FDrawFigureAngle, aObject.ActualPoints[1]); aObject.DefRaizeDrawFigurePos; // Recreate aObject.ReCreateCaptionsGroup(True, false); aObject.ReCreateNotesGroup(True); except on E: Exception do addExceptionToLogEx('U_Common.ChangeDrawFigurePercentForObject', E.Message); end; end; procedure ChangeDrawFigurePercentForLine(aLine: TOrthoLine; aPercent: Double); var i: Integer; MapScale: Double; CorrectX: Double; CorrectY: Double; Bnd: TDoubleRect; CP: TDoublePoint; GrpSizeX, GrpSizeY: Double; tmpDrawFigure: TFigureGrpMod; BlockBnd: TDoubleRect; DrawFigureBnd: TDoubleRect; BlockDelta: double; deltax, deltay: double; InFigGroup, InFigGroup1, InFigGroup2: TFigureGrpMod; delta: double; ScaleKoeff: Double; begin try if aLine.FIsRaiseUpDown then begin if aLine.FSingleBlock <> nil then begin {for i := 0 to aLine.DrawFigure.InFigures.Count - 1 do begin InFigGroup := TFigureGrpMod(aLine.FSingleBlock.InFigures[i]); //InFigGroup.Scale(CorrectX, CorrectY, InFigGroup.CenterPoint); InFigGroup.Scale(aPercent / 100, aPercent / 100, InFigGroup.CenterPoint); end; } CP.x := (aLine.ActualPoints[1].x + aLine.ActualPoints[2].x) / 2; CP.y := (aLine.ActualPoints[1].y + aLine.ActualPoints[2].y) / 2; InFigGroup := TFigureGrpMod(aLine.FSingleBlock.Duplicate); //InFigGroup.scale(1, 1, InFigGroup.CenterPoint); //InFigGroup.scale(0.5*1, 0.5*1, InFigGroup.CenterPoint); //InFigGroup.scale(1/aLine.FDrawFigurePercent, 1/aLine.FDrawFigurePercent, InFigGroup.CenterPoint); ScaleKoeff := 1/(aLine.FDrawFigurePercent/100 * 0.5); InFigGroup.scale(ScaleKoeff, ScaleKoeff, InFigGroup.CenterPoint); InFigGroup.Rotate(0 - aLine.FDrawFigureAngle, CP); //InFigGroup.scale(aPercent / 100, aPercent / 100, InFigGroup.CenterPoint); aLine.FDrawFigurePercent := aPercent; SetBlockForLineObject(aLine, nil, nil); aLine.DrawFigure := InFigGroup; //27.04.2013 - чтобы вызвать TOrthoLine.SetDrawFigure end; end else begin MapScale := GCadForm.PCad.MapScale; // вернуть на 0 градус CP.x := (aLine.ActualPoints[1].x + aLine.ActualPoints[2].x) / 2; CP.y := (aLine.ActualPoints[1].y + aLine.ActualPoints[2].y) / 2; if aLine.DrawFigure <> nil then aLine.DrawFigure.Rotate(0 - aLine.FDrawFigureAngle, CP); // Если есть блок if aLine.FSingleBlock <> nil then begin aLine.DrawFigure.RemoveFromGrp(aLine.FSingleBlock); //28.04.2011 aLine.DrawFigure.InFigures.Remove(aLine.FSingleBlock); RemoveInFigureGrp(aLine.DrawFigure); // изменить размеры // BND if aLine.FSingleBlock.InFigures.Count = 0 then begin Bnd := aLine.FSingleBlock.GetBoundRect; end else begin Bnd := TFigure(aLine.FSingleBlock.InFigures[0]).GetBoundRect; end; GrpSizeX := abs(Bnd.Right - Bnd.Left); GrpSizeY := abs(Bnd.Bottom - Bnd.Top); CorrectX := aLine.FOriginalSizeX / GrpSizeX; CorrectY := aLine.FOriginalSizeY / GrpSizeY; for i := 0 to aLine.FSingleBlock.InFigures.Count - 1 do begin InFigGroup := TFigureGrpMod(aLine.FSingleBlock.InFigures[i]); InFigGroup.Scale(CorrectX, CorrectY, InFigGroup.CenterPoint); InFigGroup.Scale(aPercent / 100, aPercent / 100, InFigGroup.CenterPoint); end; if aLine.FSingleBlock.InFigures.Count = 2 then begin InFigGroup1 := TFigureGrpMod(aLine.FSingleBlock.InFigures[0]); InFigGroup2 := TFigureGrpMod(aLine.FSingleBlock.InFigures[1]); Bnd := InFigGroup1.GetBoundRect; delta := abs(Bnd.Bottom - Bnd.Top); delta := delta / 2; if not aLine.FIsRotated then InFigGroup2.move(0, InFigGroup1.CenterPoint.y - InFigGroup2.CenterPoint.y + delta) else InFigGroup2.move(0, InFigGroup1.CenterPoint.y - InFigGroup2.CenterPoint.y - delta); aLine.FSingleBlockDelta := 0; end; aLine.FDrawFigurePercent := aPercent; // присвоить темповому DrawFigure tmpDrawFigure := aLine.GetAllBlocks(aLine.FSingleBlock); // перебросить в DrawFigure for i := 0 to tmpDrawFigure.InFigures.Count - 1 do begin aLine.DrawFigure.AddFigure(TFigure(tmpDrawFigure.InFigures[i])); end; if aLine.FSingleBlock.InFigures.Count = 0 then begin BlockBnd := aLine.FSingleBlock.GetBoundRect; end else begin BlockBnd := TFigure(aLine.FSingleBlock.InFigures[0]).GetBoundRect; end; DrawFigureBnd := aLine.DrawFigure.GetBoundRect; aLine.GrpSizeX := DrawFigureBnd.Right - DrawFigureBnd.Left; aLine.GrpSizeY := BlockBnd.Bottom - BlockBnd.Top; BlockDelta := 0.2 / 2 * (aLine.FSingleBlock.InFigures.Count - 1); aLine.DrawFigure.ActualPoints[1] := DoublePoint((DrawFigureBnd.Left + DrawFigureBnd.Right) / 2 - aLine.GrpSizeX / 2, (BlockBnd.Top + BlockBnd.Bottom) / 2 - aLine.GrpSizeY / 2); deltax := cp.x - aLine.GrpSizeX / 2 - aLine.DrawFigure.ActualPoints[1].x; deltay := cp.y - aLine.GrpSizeY / 2 - aLine.DrawFigure.ActualPoints[1].y; aLine.DrawFigure.move(deltax, deltay); aLine.DrawFigure.LockModify := True; aLine.MoveTextBox(aLine.DrawFigure, aLine.ActualPoints[1], aLine.ActualPoints[2], True); end; end; except on E: Exception do addExceptionToLogEx('U_Common.ChangeDrawFigurePercentForLine', E.Message); end; end; function GetTraceLength(aListID, aTraceID: Integer): Double; var FList: TF_CAD; i: Integer; Trace: TOrthoLine; begin Result := -1; try FList := GetListByID(aListID); if FList <> nil then begin Trace := TOrthoLine(GetFigureByID(FList, aTraceID)); if Trace <> nil then Result := Trace.LineLength; end; except on E: Exception do addExceptionToLogEx('U_Common.GetTraceLength', E.Message); end; end; procedure CloseCad(aListID: Integer); var FList: TF_CAD; begin try FList := GetListByID(aListID); if FList <> nil then TF_CAD(FList).Close; except on E: Exception do addExceptionToLogEx('U_Common.CloseCad', E.Message); end; end; procedure SetProjectChanged(aChanged: Boolean); begin try GProjectChanged := aChanged; FSCS_Main.aSaveProject.Enabled := aChanged; except on E: Exception do addExceptionToLogEx('U_Common.SetProjectChanged', E.Message); end; end; function GetFigureIconParams(aListID, aObjectID: Integer): TFigureIconParams; var FList: TF_CAD; FFigure: TFigure; begin try FList := GetListByID(aListID); if FList <> nil then begin FFigure := GetFigureByID(FList, aObjectID); if FFigure <> nil then begin if CheckFigureByClassName(FFigure, cTOrthoLine) then begin Result.GUIDObjectIcon := TOrthoLine(FFigure).FBlockGUID; Result.IconType := TOrthoLine(FFigure).FObjectType; Result.IconCount := 1; end; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin Result.GUIDObjectIcon := TConnectorObject(FFigure).FBlockGUID; Result.IconType := TConnectorObject(FFigure).FObjectType; Result.IconCount := TConnectorObject(FFigure).FBlockCount; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetFigureIconParams', E.Message); end; end; function GetSortedListForAutoTrace(aFiguresList: TList): TList; var i, j: Integer; ObjectsList: TList; BaseObject: TConnectorObject; BaseObjectFIndex: Integer; CurObject: TConnectorObject; CurObjectFIndex: Integer; MinIndex: Integer; CurMinFindex: Integer; begin Result := TList.Create; try ObjectsList := TList.Create; for i := 0 to aFiguresList.Count - 1 do if CheckFigureByClassName(TFigure(aFiguresList[i]), cTConnectorObject) then if TConnectorObject(aFiguresList[i]).ConnectorType <> ct_Clear then if not TConnectorObject(aFiguresList[i]).AsEndPoint then ObjectsList.Add(TConnectorObject(aFiguresList[i])); i := 0; while i < ObjectsList.Count do begin BaseObject := TConnectorObject(ObjectsList[0]); BaseObjectFIndex := BaseObject.FIndex; CurMinFindex := BaseObjectFIndex; MinIndex := 0; for j := 1 to ObjectsList.Count - 1 do begin CurObject := TConnectorObject(ObjectsList[j]); CurObjectFIndex := CurObject.FIndex; if CurObjectFIndex < CurMinFindex then begin CurMinFindex := CurObjectFIndex; MinIndex := j; end; end; Result.Add(ObjectsList[MinIndex]); ObjectsList.Delete(MinIndex); end; FreeAndNil(ObjectsList); except on E: Exception do addExceptionToLogEx('U_Common.GetSortedListForAutoTrace', E.Message); end; end; function GetObjectBlockbyID(aListID, aObjectID: Integer; aCanLoadIcons: Boolean): TObjectIconParams; var i: Integer; FList: TF_CAD; FFigure: TFigure; FObject: TConnectorObject; FTrace: TOrthoLine; Stream: TMemoryStream; Bitmap: TBitmap; MetaFile: TMetafile; FileName: string; DrawFigure: TFigureGrp; tmpDrawFigure: TFigureGrp; tmpInFigure: TFigure; tmpCad: TPowerCad; begin try Result.Executed := False; Result.GUIDIcon := ''; Result.IconBLK := nil; Result.IconBMP := nil; Result.IDIcon := -1; FList := GetListByID(aListID); if FList <> nil then begin FFigure := GetFigureByID(FList, aObjectID); DrawFigure := nil; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin FObject := TConnectorObject(FFigure); DrawFigure := FObject.DrawFigure; Result.IDIcon := FObject.FBlockID; Result.GUIDIcon := FObject.FBlockGUID; Result.Executed := False; end else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin FTrace := TOrthoLine(FFigure); DrawFigure := FTrace.FSingleBlock; Result.IDIcon := FTrace.FBlockID; Result.GUIDIcon := FTrace.FBlockGUID; Result.Executed := False; end; if DrawFigure <> nil then begin if aCanLoadIcons then begin TmpCad := TPowerCad.create(FSCS_Main); TmpCad.Parent := FSCS_Main; TmpCad.Top := -1000; TmpCad.Left := -1000; TmpCad.width := 100; TmpCad.height := 100; tmpDrawFigure := TFigureGrp.create(tmpCad.GetLayerHandle(0), tmpCad); for i := 0 to DrawFigure.InFigures.Count - 1 do begin tmpInFigure := TFigure(DrawFigure.InFigures[i]).Duplicate; tmpDrawFigure.AddFigure(tmpInFigure); end; tmpCad.AddCustomFigure(0, tmpDrawFigure, false); tmpCad.DeselectAll(0); tmpDrawFigure.Select; RefreshCAD(tmpCad); // получить Stream УГО Stream := TMemoryStream.Create; {$if Defined(ES_GRAPH_SC)} FileName := ExeDir + '\.blk\TempStream.blk'; {$else} FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.blk'; {$ifend} tmpCad.MakeSelectionBlock(FileName); Stream.LoadFromFile(FileName); Result.IconBLK := Stream; // получить Bitmap УГО MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := tmpCad.SelectionAsWmf; Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); FreeAndNil(MetaFile); Result.IconBMP := Bitmap; RemoveInFigureGrp(tmpDrawFigure); tmpCad.Figures.Remove(tmpDrawFigure); FreeAndNil(tmpCad); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetObjectBlockbyID', E.Message); end; end; function GetObjectBlockStream(aListID, aObjectID: Integer): TMemoryStream; var i: Integer; FList: TF_CAD; FFigure: TFigure; FObject: TConnectorObject; FTrace: TOrthoLine; Stream: TMemoryStream; Bitmap: TBitmap; MetaFile: TMetafile; FileName: string; tmpDrawFigure: TFigureGrp; tmpInFigure: TFigure; tmpCad: TPowerCad; GetDrawFigure: TFigureGrp; begin Result := nil; try Result := TMemoryStream.Create; FList := GetListByID(aListID); if FList <> nil then begin FFigure := GetFigureByID(FList, aObjectID); if FFigure <> nil then begin GetDrawFigure := nil; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin FObject := TConnectorObject(FFigure); GetDrawFigure := FObject.DrawFigure; end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin FTrace := TOrthoLine(FFigure); GetDrawFigure := FTrace.FSingleBlock; end; if GetDrawFigure <> nil then begin TmpCad := TPowerCad.create(FSCS_Main); TmpCad.Parent := FSCS_Main; TmpCad.Top := -1000; TmpCad.Left := -1000; TmpCad.width := 100; TmpCad.height := 100; tmpDrawFigure := TFigureGrp.create(tmpCad.GetLayerHandle(0), tmpCad); for i := 0 to GetDrawFigure.InFigures.Count - 1 do begin tmpInFigure := TFigure(GetDrawFigure.InFigures[i]).Duplicate; tmpDrawFigure.AddFigure(tmpInFigure); end; tmpCad.AddCustomFigure(0, tmpDrawFigure, false); tmpCad.DeselectAll(0); tmpDrawFigure.Select; RefreshCAD(tmpCad); // получить Stream УГО {$if Defined(ES_GRAPH_SC)} FileName := ExeDir + '\.blk\TempStream.blk'; {$else} FileName := ExtractFileDir(Application.ExeName) + '\.blk\TempStream.blk'; {$ifend} tmpCad.MakeSelectionBlock(FileName); Result.LoadFromFile(FileName); RemoveInFigureGrp(tmpDrawFigure); tmpCad.Figures.Remove(tmpDrawFigure); FreeAndNil(tmpCad); end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.GetObjectBlockStream', E.Message); end; end; function GetObjectBlockToSubstrateLayer(aListID, aObjectID: Integer): Boolean; var i: Integer; FList: TF_CAD; FFigure: TFigure; FObject: TConnectorObject; FTrace: TOrthoLine; Stream: TMemoryStream; Bitmap: TBitmap; MetaFile: TMetafile; FileName: string; tmpDrawFigure: TFigureGrp; tmpInFigure: TFigure; tmpCad: TPowerCad; GetDrawFigure: TFigureGrp; begin Result := false; try FList := GetListByID(aListID); if FList <> nil then begin FFigure := GetFigureByID(FList, aObjectID); if FFigure <> nil then begin GetDrawFigure := nil; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin FObject := TConnectorObject(FFigure); GetDrawFigure := FObject.DrawFigure; end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin FTrace := TOrthoLine(FFigure); GetDrawFigure := FTrace.FSingleBlock; end; if GetDrawFigure <> nil then begin tmpDrawFigure := TFigureGrp.create(GCadForm.PCad.GetLayerHandle(1), GCadForm.PCad); for i := 0 to GetDrawFigure.InFigures.Count - 1 do begin tmpInFigure := TFigure(GetDrawFigure.InFigures[i]).Duplicate; tmpDrawFigure.AddFigure(tmpInFigure); end; GCadForm.PCad.AddCustomFigure(1, tmpDrawFigure, false); GCadForm.PCad.DeselectAll(1); tmpDrawFigure.Select; RefreshCAD(GCadForm.PCad); Result := true; end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.GetObjectBlockToSubstrateLayer', E.Message); end; end; function ChoiceAutoTraceConnectOrder(AProjectSetting: PProjectSettingRecord=nil; AIsTracing: Boolean=true; ATraceCompon: TSCSComponent=nil; aFromDropConnObj: Boolean=false; aTracingFigInfo: Pointer=nil): Boolean; var ProjectSetting: PProjectSettingRecord; CurrProjectParams: TProjectParams; IsLookingCurrProjectParams: Boolean; begin Result := false; try IsLookingCurrProjectParams := false; ProjectSetting := AProjectSetting; //*** Если параметр не известный, то берем настройки текущего проекта if ProjectSetting = nil then begin CurrProjectParams := GetCurrProjectParams; IsLookingCurrProjectParams := true; ProjectSetting := @CurrProjectParams.Setting; end; if Not AIsTracing or Not ProjectSetting.TraceNoAskParams then begin if GIsProgress then PauseProgress(true); try if (Not GUseVisibleInterfaces) and (AProjectSetting = nil) then Result := true else if F_AutoTraceConnectOrder.Execute(ProjectSetting, ATraceCompon, aTracingFigInfo) then begin Result := true; if IsLookingCurrProjectParams then SaveCurrProjectParams(CurrProjectParams); end; finally if GIsProgress then PauseProgress(false); end; end else Result := true; except on E: Exception do addExceptionToLogEx('U_Common.ChoiceAutoTraceConnectOrder', E.Message); end; end; procedure SkipAllLinesShadows(aForm: TF_CAD); var i, j: Integer; vFigure: TFigure; vLine: TOrthoLine; begin try for i := 0 to aForm.PCad.FigureCount - 1 do begin vFigure := TFigure(aForm.PCad.Figures[i]); if CheckFigureByClassName(vFigure, cTOrthoLine) then begin vLine := TOrthoLine(vFigure); if not vLine.FIsRaiseUpDown then begin if vLine.tmpDrawShadow then begin vLine.tmpDrawShadow := False; // vLine.Draw(aForm.PCad.DEngine, False); end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SkipAllLinesShadows', E.Message); end; end; procedure PrintCADLists(aAllLists, aCheckedLists: TIntList); var i: Integer; ListID: Integer; ListName: string; FList: TF_CAD; FCADAllLists: TList; FCADCheckedLists: TList; Item: TListItem; begin try FCADAllLists := TList.Create; FCADCheckedLists := TList.Create; for i := 0 to aAllLists.Count - 1 do begin ListID := aAllLists[i]; FList := GetListByID(ListID); if FList <> nil then FCADAllLists.Add(FList); end; for i := 0 to aCheckedLists.Count - 1 do begin ListID := aCheckedLists[i]; FList := GetListByID(ListID); if FList <> nil then FCADCheckedLists.Add(FList); end; if FCADAllLists.Count > 0 then begin F_PrintLists.lvCadLists.Items.Clear; for i := 0 to FCADAllLists.Count - 1 do begin FList := TF_CAD(FCADAllLists[i]); Item := F_PrintLists.lvCadLists.Items.Add; Item.Caption := FList.FCADListName + ' ' + IntToStr(FList.FCADListIndex); Item.Data := FList.PCad; if FCADCheckedLists.IndexOf(FList) <> - 1 then Item.Checked := True else Item.Checked := False; if i = 0 then begin F_PrintLists.lvCadLists.Selected := Item; F_PrintLists.CadControl := FList.PCad; end; end; F_PrintLists.Init; F_PrintLists.ShowModal; FreeAndNil(FCADAllLists); FreeAndNil(FCADCheckedLists); end; except on E: Exception do addExceptionToLogEx('U_Common.PrintCADLists', E.Message); end; end; procedure AutoPosTracesBetweenRM(aConns, aTraces, aSnaps: TList); var i: Integer; Trace: TOrthoLine; JoinedConn1, JoinedConn2: TConnectorObject; RM1, RM2: TConnectorObject; Snap1, Snap2: TFigure; begin try for i := 0 to aTraces.Count - 1 do begin Trace := TOrthoLine(aTraces[i]); JoinedConn1 := TConnectorObject(Trace.JoinConnector1); JoinedConn2 := TConnectorObject(Trace.JoinConnector2); Snap1 := TFigure(aSnaps[i]); Snap2 := TFigure(aSnaps[i + 1]); if (Snap1 <> nil) and (Snap2 <> nil) then begin if CheckFigureByClassName(Snap1, cTConnectorObject) and CheckFigureByClassName(Snap2, cTConnectorObject) then begin if (TConnectorObject(Snap1).ConnectorType <> ct_Clear) and (TConnectorObject(Snap2).ConnectorType <> ct_Clear) then begin Trace.ActualZOrder[1] := TConnectorObject(Snap1).ActualZOrder[1]; JoinedConn1.ActualZOrder[1] := TConnectorObject(Snap1).ActualZOrder[1]; Trace.ActualZOrder[2] := TConnectorObject(Snap2).ActualZOrder[1]; JoinedConn2.ActualZOrder[1] := TConnectorObject(Snap2).ActualZOrder[1]; // поставить высоту для линии SetLineFigureCoordZInPM(Trace.ID, 1, Trace.ActualZOrder[1]); SetLineFigureCoordZInPM(Trace.ID, 2, Trace.ActualZOrder[2]); SetLineFigureLengthInPM(Trace.ID, Trace.LineLength); end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.AutoPosTracesbetweenRM', E.Message); end; end; procedure AutoPosTracesBetweenRMAfterSnap(aTraces: TList); var i: Integer; Trace: TOrthoLine; JoinedConn1, JoinedConn2: TConnectorObject; RM1, RM2: TConnectorObject; Snap1, Snap2: TFigure; begin try for i := 0 to aTraces.Count - 1 do begin Trace := TOrthoLine(aTraces[i]); JoinedConn1 := TConnectorObject(Trace.JoinConnector1); JoinedConn2 := TConnectorObject(Trace.JoinConnector2); if (JoinedConn1.JoinedConnectorsList.Count = 0) or (JoinedConn2.JoinedConnectorsList.Count = 0) then begin if (Trace.ActualZOrder[1] <> Trace.ActualZOrder[2]) then if (Trace.ActualZOrder[1] = GCadForm.FLineHeight) or (Trace.ActualZOrder[2] = GCadForm.FLineHeight) then begin RaiseLineOnHeight(Trace, GCadForm.FLineHeight, aTraces); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.AutoPosTracesBetweenRMAfterSnap', E.Message); end; end; procedure SetCabinetFalseFloor(aCabinet: TFigure); var Val: Double; oldtempstr, tempstr: string; Params: TObjectParams; begin try if CheckFigureByClassName(aCabinet, cTCabinet) then oldtempstr := FormatFloat(ffMask, MetreToUOM(TCabinet(aCabinet).FFalseFloorHeight)); if CheckFigureByClassName(aCabinet, cTCabinetExt) then oldtempstr := FormatFloat(ffMask, MetreToUOM(TCabinetExt(aCabinet).FFalseFloorHeight)); tempstr := oldtempstr; if InputQuery(cCommon_Mes23, cCommon_Mes24, tempstr) then begin try Val := StrToFloat_My(tempstr); if Val < 0 then tempstr := '0'; if Val > MetreToUOM(GCadForm.FRoomHeight) then begin Val := MetreToUOM(GCadForm.FRoomHeight); tempstr := FormatFloat(ffMask, Val); end; except ShowMessage(cSizePos_Mes1); SetCabinetFalseFloor(aCabinet); Exit; end; if (tempstr <> '') and (tempstr <> oldtempstr) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; if CheckFigureByClassName(aCabinet, cTCabinet) then begin TCabinet(aCabinet).FFalseFloorHeight := UOMToMetre(StrToFloat_My(Tempstr)); Params := GetFigureParams(TCabinet(aCabinet).FSCSID); Params.HeightCeiling := TCabinet(aCabinet).FFalseFloorHeight; SaveFigureParams(TCabinet(aCabinet).FSCSID, Params); end; if CheckFigureByClassName(aCabinet, cTCabinetExt) then begin TCabinetExt(aCabinet).FFalseFloorHeight := UOMToMetre(StrToFloat_My(Tempstr)); Params := GetFigureParams(TCabinetExt(aCabinet).FSCSID); Params.HeightCeiling := TCabinetExt(aCabinet).FFalseFloorHeight; SaveFigureParams(TCabinetExt(aCabinet).FSCSID, Params); end; RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := True; end; SetProjectChanged(True); end; except on E: Exception do addExceptionToLogEx('SetCabinetFalseFloor', E.Message); end; end; procedure CheckAllCabinetsFalseFloorHeights; var i: integer; Cabinet: TCabinet; CabinetExt: TCabinetExt; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinet) then begin Cabinet := TCabinet(GCadForm.PCad.Figures[i]); if Cabinet.FType = ct_Visual then begin if Cabinet.FFalseFloorHeight > GCadForm.FRoomHeight then Cabinet.FFalseFloorHeight := GCadForm.FRoomHeight; end; end else if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCabinetExt) then begin CabinetExt := TCabinetExt(GCadForm.PCad.Figures[i]); if CabinetExt.FType = ct_Visual then begin if CabinetExt.FFalseFloorHeight > GCadForm.FRoomHeight then CabinetExt.FFalseFloorHeight := GCadForm.FRoomHeight; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CheckAllCabinetsFalseFloorHeights', E.Message); end; end; procedure SetCadListFormat(aListFormat: TListFormatType); var i: integer; x1, x2, y1, y2: double; Cabinet: TFigure; StampTypeStr, StampLangStr, FullPathName, MainStampName, SideStampName: string; begin try GCadForm.PCad.PageLayout := aListFormat.PageLayout; GCadForm.PCad.PageOrient := aListFormat.PageOrient; // if (GCadForm.FListCountX <> 1) or (GCadForm.FListCountY <> 1) then begin GCadForm.PCad.WorkWidth := aListFormat.PageWidth; GCadForm.PCad.WorkHeight := aListFormat.PageHeight; // виртуальный кабинет Cabinet := GetVirtualCabinet; if Cabinet <> nil then begin x1 := GCadForm.PCad.Left; x2 := GCadForm.PCad.Left + GCadForm.PCad.WorkWidth; y1 := GCadForm.PCad.Top; y2 := GCadForm.PCad.Top + GCadForm.PCad.WorkHeight; Cabinet.ActualPoints[1] := DoublePoint(x1, y1); Cabinet.ActualPoints[2] := DoublePoint(x2, y1); Cabinet.ActualPoints[3] := DoublePoint(x2, y2); Cabinet.ActualPoints[4] := DoublePoint(x1, y2); end; end; // определить параметры в именах блоков {$if Defined(ES_GRAPH_SC)} FullPathName := ExeDir + '\Stamp\'; {$else} FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; {$ifend} StampTypeStr := ''; if GCadForm.FCadStampType = stt_simple then StampTypeStr := 'Small' else if GCadForm.FCadStampType = stt_extended then StampTypeStr := 'Big' else if GCadForm.FCadStampType = stt_detailed then StampTypeStr := 'ExtBig'; StampLangStr := ''; if GCadForm.FCadStampLang = stl_eng then StampLangStr := 'eng' else if GCadForm.FCadStampLang = stl_ukr then StampLangStr := 'ukr' else if GCadForm.FCadStampLang = stl_ukr_dstu then StampLangStr := 'ukr_dstu' else if GCadForm.FCadStampLang = stl_rus then StampLangStr := 'rus'; // MainStampName := StampTypeStr + '_Main_' + StampLangStr + '.sch'; SideStampName := StampTypeStr + '_Side_' + StampLangStr + '.sch'; LoadFrameToList(GCadForm, FullPathName + MainStampName, FullPathName + SideStampName, aListFormat); except on E: Exception do addExceptionToLogEx('U_Common.SetCadListFormat', E.Message); end; end; procedure SetCabinetFalseFloorHeightFromPM(aListID, aCabinetID: Integer; aSettings: TRoomSettingRecord); var vList: TF_CAD; vCabinet: TFigure; begin try vList := GetListByID(aListID); if vList <> nil then begin vCabinet := FindCabinetBySCSID(vList, aCabinetID); if vCabinet <> nil then begin if CheckFigureByClassName(vCabinet, cTCabinet) then TCabinet(vCabinet).FFalseFloorHeight := aSettings.HeightCeiling else if CheckFigureByClassName(vCabinet, cTCabinetExt) then TCabinetExt(vCabinet).FFalseFloorHeight := aSettings.HeightCeiling; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetCabinetFalseFloorHeightFromPM', E.Message); end; end; function CheckListFormatChanged(aCad: TF_CAD; aListFormat: TListFormatType): Boolean; begin Result := False; try // if aCad.PCad.PageLayout <> aListFormat.PageLayout then // Result := True; // if aCad.PCad.PageOrient <> aListFormat.PageOrient then // Result := True; if aCad.FCadStampLang <> aListFormat.StampLang then Result := True else if aCad.FCadStampType <> aListFormat.StampType then Result := True else if aCad.FListCountX <> aListFormat.ListCountX then Result := True else if aCad.FListCountY <> aListFormat.ListCountY then Result := True else if aCad.FShowMainStamp <> aListFormat.ShowMainStamp then Result := True else if aCad.FShowUpperStamp <> aListFormat.ShowUpperStamp then Result := True else if aCad.FShowSideStamp <> aListFormat.ShowSideStamp then Result := True else if aCad.PCad.WorkWidth <> aListFormat.PageWidth then Result := True else if aCad.PCad.WorkHeight <> aListFormat.PageHeight then Result := True //14.11.2011 else if aCad.FStampFields.Margins.Left <> aListFormat.StampFields.Margins.Left then Result := True else if aCad.FStampFields.Margins.Right <> aListFormat.StampFields.Margins.Right then Result := True else if aCad.FStampFields.Margins.Top <> aListFormat.StampFields.Margins.Top then Result := True else if aCad.FStampFields.Margins.Bottom <> aListFormat.StampFields.Margins.Bottom then Result := True else if aCad.FStampFields.Developer <> aListFormat.StampFields.Developer then Result := True else if aCad.FStampFields.Checker <> aListFormat.StampFields.Checker then Result := True //03.10.2012 else if aCad.FStampFields.ListSign <> aListFormat.StampFields.ListSign then Result := True else if aCad.FStampFields.MainEngineer <> aListFormat.StampFields.MainEngineer then Result := True else if aCad.FStampFields.Approved <> aListFormat.StampFields.Approved then Result := True else if aCad.FStampFields.DesignStage <> aListFormat.StampFields.DesignStage then Result := True; except on E: Exception do addExceptionToLogEx('U_Common.CheckListFormatChanged', E.Message); end; end; procedure CorrectStampView; var StampHandle: Integer; i, j: integer; Stamp: TFigureGrp; FFigure: TFigure; InFigure: TFigure; FrameFigure: TFigure; FrameFigureCode: Integer; MainStampObj, SideStampObj: TFigureGrp; UpperStampObj: TRectangle; RectangleObj: TRectangle; begin try StampHandle := GCadForm.PCad.GetLayerHandle(7); for i := 0 to GCadForm.PCad.FigureCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Figures[i]); if FFigure.LayerHandle = StampHandle then begin if CheckFigureByClassName(FFigure, 'TFigureGrp') then begin Stamp := TFigureGrp(FFigure); MainStampObj := nil; SideStampObj := nil; UpperStampObj := nil; RectangleObj := nil; for j := 0 to Stamp.InFigures.Count - 1 do begin if TFigure(Stamp.InFigures[j]).DataID = 100 then MainStampObj := TFigureGrp(Stamp.InFigures[j]); if TFigure(Stamp.InFigures[j]).DataID = 200 then SideStampObj := TFigureGrp(Stamp.InFigures[j]); if TFigure(Stamp.InFigures[j]).DataID = 300 then UpperStampObj := TRectangle(Stamp.InFigures[j]); if TFigure(Stamp.InFigures[j]).DataID = 99 then RectangleObj := TRectangle(Stamp.InFigures[j]); end; // основной штамп if MainStampObj <> nil then begin SetAllInFiguresVisible(MainStampObj, GCadForm.FShowMainStamp); {//17.11.2011 if GCadForm.FFrameProjectName <> nil then GCadForm.FFrameProjectName.Visible := GCadForm.FShowMainStamp; if GCadForm.FFrameListName <> nil then GCadForm.FFrameListName.Visible := GCadForm.FShowMainStamp; if GCadForm.FFrameIndexName <> nil then GCadForm.FFrameIndexName.Visible := GCadForm.FShowMainStamp;} for j := 0 to GCadForm.FFrameObjects.Count - 1 do begin FrameFigure := TFigure(GCadForm.FFrameObjects.Objects[j]); FrameFigureCode := StrToint(GCadForm.FFrameObjects[j]); if (FrameFigure <> nil) and (FrameFigureCode <> ftCodeName) then FrameFigure.Visible := GCadForm.FShowMainStamp; end; end; // боковой штамп if SideStampObj <> nil then begin SetAllInFiguresVisible(SideStampObj, GCadForm.FShowSideStamp); end; // верхний штамп if UpperStampObj <> nil then begin UpperStampObj.Visible := GCadForm.FShowUpperStamp; if GCadForm.FFrameCodeName <> nil then GCadForm.FFrameCodeName.Visible := GCadForm.FShowUpperStamp; end; {$if Defined(SCS_PE) or Defined(SCS_PANDUIT)} if RectangleObj <> nil then begin RectangleObj.Visible := GCadForm.FShowUpperStamp or GCadForm.FShowSideStamp or GCadForm.FShowMainStamp; end; {$ifend} end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.CorrectStampView', E.Message); end; end; function IfTraceHorizontal(aTrace: TOrthoLine): Boolean; begin Result := False; try if DoubleCMP(aTrace.ActualPoints[1].y, aTrace.ActualPoints[2].y) then Result := True; except on E: Exception do addExceptionToLogEx('U_Common.IfTraceHorizontal', E.Message); end; end; function IfTraceVertical(aTrace: TOrthoLine): Boolean; begin Result := False; try if DoubleCMP(aTrace.ActualPoints[1].x, aTrace.ActualPoints[2].x) then Result := True; except on E: Exception do addExceptionToLogEx('U_Common.IfTraceVertical', E.Message); end; end; function GetRaiseCountConnectedToFigure(AIDList, AIDFigure: Integer): Integer; var vList: TF_CAD; vLine: TOrthoLine; JoinConn: TConnectorObject; begin Result := 0; try vList := GetListByID(AIDList); if vList <> nil then begin vLine := TOrthoLine(GetFigureByID(vList, AIDFigure)); if vLine <> nil then begin JoinConn := TConnectorObject(vLine.JoinConnector1); if (JoinConn.FConnRaiseType = crt_BetweenFloorUp) or (JoinConn.FConnRaiseType = crt_BetweenFloorDown) or (JoinConn.FConnRaiseType = crt_TrunkUp) or (JoinConn.FConnRaiseType = crt_TrunkDown) then Result := Result + 1; JoinConn := TConnectorObject(vLine.JoinConnector2); if (JoinConn.FConnRaiseType = crt_BetweenFloorUp) or (JoinConn.FConnRaiseType = crt_BetweenFloorDown) or (JoinConn.FConnRaiseType = crt_TrunkUp) or (JoinConn.FConnRaiseType = crt_TrunkDown) then Result := Result + 1; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetRaiseCountConnectedToFigure', E.Message); end; end; procedure SetAllBetweenFloorRaises; var i: Integer; vFigure: TFigure; vConn: TConnectorObject; begin try for i := 0 to GCadForm.PCad.FigureCount - 1 do begin vFigure := TFigure(GCadForm.PCad.Figures[i]); if CheckFigureByClassName(vFigure, cTConnectorObject) then begin vConn := TConnectorObject(vFigure); if vConn.FConnRaiseType = crt_BetweenFloorUp then vConn.ActualZOrder[1] := GCadForm.FRoomHeight; end; end; except on E: Exception do addExceptionToLogEx('U_Common.SetAllBetweenFloorRaises', E.Message); end; end; function IsNowTracingByUser: Boolean; begin Result := False; try if GCadForm.PCad.ToolIdx = toFigure then Result := True; except on E: Exception do addExceptionToLogEx('U_Common.IsNowTracingByUser', E.Message); end; end; //14.09.2010 //function IsMousedPressed: Boolean; //var // Button: TMouseButton; //begin // Result := False; // try // if Button = mbLeft then // Result := True; // except // on E: Exception do addExceptionToLogEx('U_Common.IsMousedPressed', E.Message); // end; //end; procedure ObjectsShiftUp(aObjList: TList); var i: integer; CurObject: TConnectorObject; AddDelta: Double; CanMove: Boolean; Shift: TShiftState; temp: double; begin try // сдвинуть объекты for i := 0 to aObjList.Count - 1 do begin CurObject := TConnectorObject(aObjList[i]); Shift := KeyboardStateToShiftState; if CurObject.DrawFigure.InFigures.Count > 0 then begin // Обьект из VISIO if (CurObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(CurObject.DrawFigure.InFigures[0]), 'TWMFObject') then begin if not(ssCtrl in Shift) then begin if IfDrawFigureMoveCan(CurObject, 0, - 0.1) then begin CurObject.DrawFigure.move(0, - 0.1); CurObject.CaptionsGroup.Move(0, - 0.1); end; end else begin if IfDrawFigureMoveCan(CurObject, 0, - CurObject.GrpSizeY / 2 + 0.6) then begin CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2 + 0.6); CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2 + 0.6); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2 + 0.6); CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2 + 0.6); GCadForm.PCad.AutoRefresh := True; end; end; end // Объект из POWERCAD else begin if not(ssCtrl in Shift) then begin if IfDrawFigureMoveCan(CurObject, 0, - 0.1) then begin CurObject.DrawFigure.move(0, - 0.1); CurObject.CaptionsGroup.Move(0, - 0.1); end; end else begin if IfDrawFigureMoveCan(CurObject, 0, - CurObject.GrpSizeY / 2) then begin CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2); CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2); CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2); GCadForm.PCad.AutoRefresh := True; end; end; end; end else begin if IfDrawFigureMoveCan(CurObject, 0, - CurObject.GrpSizeY / 2) then begin CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2); CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(0, - CurObject.GrpSizeY / 2); CurObject.CaptionsGroup.Move(0, - CurObject.GrpSizeY / 2); GCadForm.PCad.AutoRefresh := True; end; end; CurObject.DefRaizeDrawFigurePos; CurObject.FDrawFigureMoved := True; end; except on E: Exception do addExceptionToLogEx('U_Common.ObjectsShiftUp', E.Message); end; end; procedure ObjectsShiftDown(aObjList: TList); var i: integer; CurObject: TConnectorObject; AddDelta: Double; CanMove: Boolean; Shift: TShiftState; begin try // сдвинуть объекты for i := 0 to aObjList.Count - 1 do begin CurObject := TConnectorObject(aObjList[i]); Shift := KeyboardStateToShiftState; if CurObject.DrawFigure.InFigures.Count > 0 then begin // Обьект из VISIO if (CurObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(CurObject.DrawFigure.InFigures[0]), 'TWMFObject') then begin if not (ssCtrl in Shift) then begin if IfDrawFigureMoveCan(CurObject, 0, 0.1) then begin CurObject.DrawFigure.move(0, 0.1); CurObject.CaptionsGroup.Move(0, 0.1); end; end else begin if IfDrawFigureMoveCan(CurObject, 0, CurObject.GrpSizeY / 2 - 0.6) then begin CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2 - 0.6); CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2 - 0.6); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2 - 0.6); CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2 - 0.6); GCadForm.PCad.AutoRefresh := True; end; end; end // Объект из POWERCAD else begin if not (ssCtrl in Shift) then begin if IfDrawFigureMoveCan(CurObject, 0, 0.1) then begin CurObject.DrawFigure.move(0, 0.1); CurObject.CaptionsGroup.Move(0, 0.1); end; end else begin if IfDrawFigureMoveCan(CurObject, 0, CurObject.GrpSizeY / 2) then begin CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2); CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2); CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2); GCadForm.PCad.AutoRefresh := True; end; end; end; end else begin if IfDrawFigureMoveCan(CurObject, 0, CurObject.GrpSizeY / 2) then begin CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2); CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(0, CurObject.ActualPoints[1].y - CurObject.DrawFigure.CenterPoint.y); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(0, CurObject.GrpSizeY / 2); CurObject.CaptionsGroup.Move(0, CurObject.GrpSizeY / 2); GCadForm.PCad.AutoRefresh := True; end; end; CurObject.DefRaizeDrawFigurePos; CurObject.FDrawFigureMoved := True; end; except on E: Exception do addExceptionToLogEx('U_Common.ObjectsShiftDown', E.Message); end; end; procedure ObjectsShiftLeft(aObjList: TList); var i: integer; CurObject: TConnectorObject; AddDelta: Double; CanMove: Boolean; Shift: TShiftState; begin try // сдвинуть объекты for i := 0 to aObjList.Count - 1 do begin CurObject := TConnectorObject(aObjList[i]); Shift := KeyboardStateToShiftState; if CurObject.DrawFigure.InFigures.Count > 0 then begin // Обьект из VISIO if (CurObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(CurObject.DrawFigure.InFigures[0]), 'TWMFObject') then begin if not (ssCtrl in Shift) then begin if IfDrawFigureMoveCan(CurObject, - 0.1, 0) then begin CurObject.DrawFigure.move( - 0.1, 0); CurObject.CaptionsGroup.Move( - 0.1, 0); end; end else begin if IfDrawFigureMoveCan(CurObject, - CurObject.GrpSizeX / 2 + 0.6, 0) then begin CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2 + 0.6, 0); CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2 + 0.6, 0); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2 + 0.6, 0); CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2 + 0.6, 0); GCadForm.PCad.AutoRefresh := True; end; end; end // Объект из POWERCAD else begin if not (ssCtrl in Shift) then begin if IfDrawFigureMoveCan(CurObject, - 0.1, 0) then begin CurObject.DrawFigure.move( - 0.1, 0); CurObject.CaptionsGroup.Move( - 0.1, 0); end; end else begin if IfDrawFigureMoveCan(CurObject, - CurObject.GrpSizeX / 2, 0) then begin CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2, 0); CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2, 0); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2, 0); CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2, 0); GCadForm.PCad.AutoRefresh := True; end; end; end; end else begin if IfDrawFigureMoveCan(CurObject, - CurObject.GrpSizeX / 2, 0) then begin CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2, 0); CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2, 0); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move( - CurObject.GrpSizeX / 2, 0); CurObject.CaptionsGroup.Move( - CurObject.GrpSizeX / 2, 0); GCadForm.PCad.AutoRefresh := True; end; end; CurObject.DefRaizeDrawFigurePos; CurObject.FDrawFigureMoved := True; end; except on E: Exception do addExceptionToLogEx('U_Common.ObjectsShiftLeft', E.Message); end; end; procedure ObjectsShiftRight(aObjList: TList); var i: integer; CurObject: TConnectorObject; AddDelta: Double; CanMove: Boolean; tmpfig: TFigureGrp; Shift: TShiftState; begin try // сдвинуть объекты for i := 0 to aObjList.Count - 1 do begin CurObject := TConnectorObject(aObjList[i]); Shift := KeyboardStateToShiftState; if CurObject.DrawFigure.InFigures.Count > 0 then begin // Обьект из VISIO if (CurObject.DrawFigure.InFigures.Count = 1) and CheckFigureByClassName(TFigure(CurObject.DrawFigure.InFigures[0]), 'TWMFObject') then begin if not (ssCtrl in Shift) then begin if IfDrawFigureMoveCan(CurObject, 0.1, 0) then begin CurObject.DrawFigure.move(0.1, 0); CurObject.CaptionsGroup.Move(0.1, 0); end; end else begin if IfDrawFigureMoveCan(CurObject, CurObject.GrpSizeX / 2 - 0.6, 0) then begin CurObject.DrawFigure.move(CurObject.GrpSizeX / 2 - 0.6, 0); CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2 - 0.6, 0); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(CurObject.GrpSizeX / 2 - 0.6, 0); CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2 - 0.6, 0); GCadForm.PCad.AutoRefresh := True; end; end end // Объект из POWERCAD else begin if not (ssCtrl in Shift) then begin if IfDrawFigureMoveCan(CurObject, 0.1, 0) then begin CurObject.DrawFigure.move(0.1, 0); CurObject.CaptionsGroup.Move(0.1, 0); end; end else begin if IfDrawFigureMoveCan(CurObject, CurObject.GrpSizeX / 2, 0) then begin CurObject.DrawFigure.move(CurObject.GrpSizeX / 2, 0); CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2, 0); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(CurObject.GrpSizeX / 2, 0); CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2, 0); GCadForm.PCad.AutoRefresh := True; end; end end end else begin if IfDrawFigureMoveCan(CurObject, CurObject.GrpSizeX / 2, 0) then begin CurObject.DrawFigure.move(CurObject.GrpSizeX / 2, 0); CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2, 0); end else begin GCadForm.PCad.AutoRefresh := False; CurObject.DrawFigure.move(CurObject.ActualPoints[1].x - CurObject.DrawFigure.CenterPoint.x, 0); CurObject.ReCreateCaptionsGroup(false, false); CurObject.DrawFigure.move(CurObject.GrpSizeX / 2, 0); CurObject.CaptionsGroup.Move(CurObject.GrpSizeX / 2, 0); GCadForm.PCad.AutoRefresh := True; end; end; CurObject.DefRaizeDrawFigurePos; CurObject.FDrawFigureMoved := True; end; except on E: Exception do addExceptionToLogEx('U_Common.ObjectsShiftRight', E.Message); end; end; procedure LinesShiftUp(aLinesList: TList); var i: Integer; CurrLine: TOrthoLine; Bnd: TDoubleRect; AngleDegrees, AngleRad: Double; dx, dy: double; oldCP, newCP: TDoublePoint; delta: double; begin try delta := 0.1; for i := 0 to aLinesList.Count - 1 do begin CurrLine := TOrthoLine(aLinesList[i]); if (CurrLine.DrawFigure <> nil) and (CurrLine.DrawFigure.InFigures.Count > 0) then begin // получить старую центр точку DrawFigure Bnd := CurrLine.DrawFigure.GetBoundRect; oldCP.x := (Bnd.Left + Bnd.Right) / 2; oldCP.y := (Bnd.Top + Bnd.Bottom) / 2; // получить точку пересечения AngleDegrees := CurrLine.GetAngle(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y); AngleRad := AngleDegrees * pi / 180; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; AngleDegrees := round(AngleDegrees) mod 360; AngleRad := AngleDegrees * pi / 180; dx := - (delta * Cos(AngleRad)); dy := - (delta * Sin(AngleRad)); if (AngleDegrees >= 180) and (AngleDegrees < 360) then begin dx := -dx; dy := -dy; end; // если поворот на 180 то перебросить линию на другую сторону if CurrLine.FIsRotated then begin dx := -dx; dy := -dy; end; newCP.x := oldCP.x + dx; newCP.y := oldCP.y + dy; CurrLine.DrawFigure.move(newCP.x - oldCP.x, newCP.y - oldCP.y); CurrLine.DrawFigureH := CurrLine.CalcHDrawFigure; end; end; except on E: Exception do addExceptionToLogEx('U_Common.LinesShiftUp', E.Message); end; end; procedure LinesShiftDown(aLinesList: TList); var i: Integer; CurrLine: TOrthoLine; Bnd: TDoubleRect; AngleDegrees, AngleRad: Double; dx, dy: double; oldCP, newCP: TDoublePoint; delta: double; begin try delta := 0.1; for i := 0 to aLinesList.Count - 1 do begin CurrLine := TOrthoLine(aLinesList[i]); if (CurrLine.DrawFigure <> nil) and (CurrLine.DrawFigure.InFigures.Count > 0) then begin // получить старую центр точку DrawFigure Bnd := CurrLine.DrawFigure.GetBoundRect; oldCP.x := (Bnd.Left + Bnd.Right) / 2; oldCP.y := (Bnd.Top + Bnd.Bottom) / 2; // получить точку пересечения AngleDegrees := CurrLine.GetAngle(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y); AngleRad := AngleDegrees * pi / 180; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; AngleDegrees := round(AngleDegrees) mod 360; AngleRad := AngleDegrees * pi / 180; dx := delta * Cos(AngleRad); dy := delta * Sin(AngleRad); if (AngleDegrees >= 180) and (AngleDegrees < 360) then begin dx := -dx; dy := -dy; end; // если поворот на 180 то перебросить линию на другую сторону if CurrLine.FIsRotated then begin dx := -dx; dy := -dy; end; newCP.x := oldCP.x + dx; newCP.y := oldCP.y + dy; CurrLine.DrawFigure.move(newCP.x - oldCP.x, newCP.y - oldCP.y); CurrLine.DrawFigureH := CurrLine.CalcHDrawFigure; end; end; except on E: Exception do addExceptionToLogEx('U_Common.LinesShiftDown', E.Message); end; end; procedure LinesShiftLeft(aLinesList: TList); var i: Integer; CurrLine: TOrthoLine; Bnd: TDoubleRect; AngleDegrees, AngleRad: Double; dx, dy: double; oldCP, newCP: TDoublePoint; delta: double; begin try delta := 0.1; for i := 0 to aLinesList.Count - 1 do begin CurrLine := TOrthoLine(aLinesList[i]); if (CurrLine.DrawFigure <> nil) and (CurrLine.DrawFigure.InFigures.Count > 0) then begin // получить старую центр точку DrawFigure Bnd := CurrLine.DrawFigure.GetBoundRect; oldCP.x := (Bnd.Left + Bnd.Right) / 2; oldCP.y := (Bnd.Top + Bnd.Bottom) / 2; // получить точку пересечения AngleDegrees := CurrLine.GetAngle(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y); AngleRad := AngleDegrees * pi / 180; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; AngleDegrees := round(AngleDegrees) mod 360; AngleRad := AngleDegrees * pi / 180; if ((AngleDegrees >= 0) and (AngleDegrees < 90)) then begin dx := - (delta * Cos(AngleRad)); dy := - (delta * Sin(AngleRad)); end; if ((AngleDegrees >= 90) and (AngleDegrees < 180)) then begin dx := (delta * Cos(AngleRad)); dy := (delta * Sin(AngleRad)); end; if ((AngleDegrees >= 180) and (AngleDegrees < 270)) then begin dx := - (delta * Cos(AngleRad)); dy := - (delta * Sin(AngleRad)); end; if ((AngleDegrees >= 270) and (AngleDegrees < 360)) then begin dx := (delta * Cos(AngleRad)); dy := (delta * Sin(AngleRad)); end; if (AngleDegrees >= 180) and (AngleDegrees < 360) then begin dx := -dx; dy := -dy; end; // если поворот на 180 то перебросить линию на другую сторону if CurrLine.FIsRotated then begin dx := -dx; dy := -dy; end; newCP.x := oldCP.x + dx; newCP.y := oldCP.y + dy; CurrLine.DrawFigure.move(newCP.x - oldCP.x, newCP.y - oldCP.y); CurrLine.DrawFigureH := CurrLine.CalcHDrawFigure; end; end; except on E: Exception do addExceptionToLogEx('U_Common.LinesShiftLeft', E.Message); end; end; procedure LinesShiftRight(aLinesList: TList); var i: Integer; CurrLine: TOrthoLine; Bnd: TDoubleRect; AngleDegrees, AngleRad: Double; dx, dy: double; oldCP, newCP: TDoublePoint; delta: double; begin try delta := 0.1; for i := 0 to aLinesList.Count - 1 do begin CurrLine := TOrthoLine(aLinesList[i]); if (CurrLine.DrawFigure <> nil) and (CurrLine.DrawFigure.InFigures.Count > 0) then begin // получить старую центр точку DrawFigure Bnd := CurrLine.DrawFigure.GetBoundRect; oldCP.x := (Bnd.Left + Bnd.Right) / 2; oldCP.y := (Bnd.Top + Bnd.Bottom) / 2; // получить точку пересечения AngleDegrees := CurrLine.GetAngle(CurrLine.ActualPoints[1].x, CurrLine.ActualPoints[1].y, CurrLine.ActualPoints[2].x, CurrLine.ActualPoints[2].y); AngleRad := AngleDegrees * pi / 180; // получить точку для перемещения AngleDegrees := AngleDegrees + 90; AngleDegrees := round(AngleDegrees) mod 360; AngleRad := AngleDegrees * pi / 180; if ((AngleDegrees >= 0) and (AngleDegrees < 90)) then begin dx := (delta * Cos(AngleRad)); dy := (delta * Sin(AngleRad)); end; if ((AngleDegrees >= 90) and (AngleDegrees < 180)) then begin dx := - (delta * Cos(AngleRad)); dy := - (delta * Sin(AngleRad)); end; if ((AngleDegrees >= 180) and (AngleDegrees < 270)) then begin dx := (delta * Cos(AngleRad)); dy := (delta * Sin(AngleRad)); end; if ((AngleDegrees >= 270) and (AngleDegrees < 360)) then begin dx := - (delta * Cos(AngleRad)); dy := - (delta * Sin(AngleRad)); end; if (AngleDegrees >= 180) and (AngleDegrees < 360) then begin dx := -dx; dy := -dy; end; // если поворот на 180 то перебросить линию на другую сторону if CurrLine.FIsRotated then begin dx := -dx; dy := -dy; end; newCP.x := oldCP.x + dx; newCP.y := oldCP.y + dy; CurrLine.DrawFigure.move(newCP.x - oldCP.x, newCP.y - oldCP.y); CurrLine.DrawFigureH := CurrLine.CalcHDrawFigure; end; end; except on E: Exception do addExceptionToLogEx('U_Common.LinesShiftRight', E.Message); end; end; procedure SetIsCableChannel(aListID, aLineID: Integer; aFlag: Boolean); var vList: TF_CAD; vLine: TOrthoLine; begin try vList := GetListByID(aListID); if vList <> nil then begin vLine := TOrthoLine(GetFigureByID(vList, aLineID)); if vLine <> nil then vLine.FIsCableChannel := aFlag; end; except on E: Exception do addExceptionToLogEx('U_Common.SetIsCableChannel', E.Message); end; end; procedure SaveForProjectUndo(aLists: TList; aSavePM: Boolean; aIsProject: Boolean); var i, j: integer; vList: TF_CAD; ProjectUndoAction: TProjectUndoAction; ListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; SavedGCadForm: TF_CAD; begin try if GUndoList = nil then GUndoList := TList.Create; ProjectUndoAction := TProjectUndoAction.create; SavedGCadForm := GCadForm; for i := 0 to aLists.Count - 1 do begin vList := TF_CAD(aLists[i]); GCadForm := vList; ListUndoAction := nil; //#From Oleg# //14.09.2010 // if vList.FListType = lt_Normal then ListUndoAction := vList.SaveForUndoNormalList(uat_Floor, aSavePM, aIsProject, i) else if vList.FListType = lt_ProjectPlan then ListUndoAction := vList.SaveForUndoProjectPlan(uat_Floor, aSavePM, aIsProject, i) else if vList.FListType = lt_DesignBox then ListUndoAction := vList.SaveForUndoDesignList(uat_Floor, aSavePM, aIsProject, i); // ListUndoAction := vList.SaveForUndo(uat_Floor, aSavePM, aIsProject, i); // if ListUndoAction <> nil then begin ListUndoAction.FProjectUndoAction := ProjectUndoAction; LinkUndoObject := TLinkUndoObject.create; LinkUndoObject.FCad := vList; LinkUndoObject.FListUndoAction := ListUndoAction; ProjectUndoAction.FLinkUndoObject.Add(LinkUndoObject); end; end; GCadForm := SavedGCadForm; GUndoList.Add(ProjectUndoAction); except on E: Exception do addExceptionToLogEx('U_Common.SaveForProjectUndo', E.Message); end; end; procedure DeleteProjectUndoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction); var i, j: integer; vList: TF_CAD; ProjectUndoAction: TProjectUndoAction; ListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; Index: Integer; Count: Integer; OldFName, FName: string; SetUndoName: string; begin try if GUndoList <> nil then begin ProjectUndoAction := aListUndoAction.FProjectUndoAction; // удалить из глобал листа GUndoList.Remove(ProjectUndoAction); // удалить со всех листов for i := 0 to ProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ProjectUndoAction.FLinkUndoObject[i]); vList := LinkUndoObject.FCad; ListUndoAction := LinkUndoObject.FListUndoAction; //Index := -1; //if vList.FSCSUndoList <> nil then // Index := vList.FSCSUndoList.IndexOf(ListUndoAction); Index := vList.FSCSUndoList.IndexOf(ListUndoAction); // этот Undo не с текущего листа (он уже обработат) if ListUndoAction <> aListUndoAction then begin // удалить с указанного листа нужный Undo и все что перед ним while Index >= 0 do begin ListUndoAction := TListUndoAction(vList.FSCSUndoList[Index]); FName := ListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов vList.FSCSUndoList.Delete(Index); // *UNDO ProjectManager* DeleteUndoFromPM(vList.FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject); FreeAndNil(ListUndoAction); Index := Index - 1; end; // переприсвоить имена файлов с учетом смещения for j := 0 to vList.FSCSUndoList.Count - 1 do begin ListUndoAction := TListUndoAction(vList.FSCSUndoList[j]); // FName := vList.FUndoDir + vList.FCADListName + IntTostr(vList.FCADListIndex) + '_' + IntToStr(j); FName := vList.FUndoDir + vList.FCADListFileName + '_' + IntToStr(j); OldFName := ListUndoAction.FCadFileName; RenameFile(OldFName, FName); ListUndoAction.FCadFileName := FName; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.DeleteProjectUndoActions', E.Message); end; end; procedure LoadProjectUndoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction); var i, j, k, l: integer; vList: TF_CAD; ProjectUndoAction: TProjectUndoAction; ListUndoAction, DelListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; Index: Integer; Count: Integer; FName: string; SetUndoName: string; Stream: TMemoryStream; size: integer; SavedGCadForm: TF_CAD; CountInPrj: Integer; ListIndex: Integer; CurListParams: TListParams; ListOfLists: TList; Figure: TFigure; //Tolik CadFigList: TList; // begin try if GUndoList <> nil then begin ProjectUndoAction := aListUndoAction.FProjectUndoAction; // удалить из глобал листа GUndoList.Remove(ProjectUndoAction); // удалить со всех листов SavedGCadForm := GCadForm; ListIndex := 1; for i := 0 to ProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ProjectUndoAction.FLinkUndoObject[i]); vList := LinkUndoObject.FCad; ListUndoAction := LinkUndoObject.FListUndoAction; Index := vList.FSCSUndoList.IndexOf(ListUndoAction); // этот Undo не с текущего листа (он уже обработан) if ListUndoAction <> aListUndoAction then begin // удалить с указанного листа все что после этого Undo j := vList.FSCSUndoList.Count - 1; while j > Index do begin DelListUndoAction := TListUndoAction(vList.FSCSUndoList[j]); FName := DelListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов vList.FSCSUndoList.Delete(j); FreeAndNil(DelListUndoAction); j := j - 1; end; GCadForm := vList; FName := ListUndoAction.FCadFileName; if FileExists(FName) then begin // поднять темповый файл if GCadForm.FListType = lt_Normal then GCadForm.ClearSCSFigures else GCadForm.ClearPlanFigures; GCadForm.PCad.OnObjectInserted := nil; GCadForm.FUndoFiguresList.Clear; GCadForm.PCad.LoadSCSFiguresFromFile(FName); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; GCadForm.FUndoStatus := True; try if GListWithEndPoint = GCadForm then begin GEndPoint := nil; GListWithEndPoint := nil; end; GNeedReRaiseProperties := False; //Tolik CadFigList := TList.Create; for k := 0 to GCadForm.PCad.FigureCount - 1 do CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[k])); for k := 0 to CadFigList.Count - 1 do begin Figure := TFigure(CadFigList[k]); if CheckFigureByClassName(Figure, cTConnectorObject) then TConnectorObject(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTCabinet) then TCabinet(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTCabinetExt) then TCabinetExt(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTHouse) then THouse(Figure).RaiseProperties(CadFigList); end; FreeAndNil(CadFigList); { for k := 0 to GCadForm.PCad.FigureCount - 1 do begin Figure := TFigure(GCadForm.PCad.Figures.Items[k]); if CheckFigureByClassName(Figure, cTConnectorObject) then TConnectorObject(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTCabinet) then TCabinet(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTCabinetExt) then TCabinetExt(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTHouse) then THouse(Figure).RaiseProperties; end; if GNeedReRaiseProperties then begin k := 0; while k < GCadForm.PCad.FigureCount do begin Figure := TFigure(GCadForm.PCad.Figures.Items[k]); if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).ReRaiseProperties; end; if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).ReRaiseProperties; end; k := k + 1; end; end; } finally GCadForm.FUndoStatus := False; end; FindObjectsForConvertClasses; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить последний который поднимается из спика GCadForm.FSCSUndoList.Delete(vList.FSCSUndoList.Count - 1); if ListUndoAction.ActionType = uat_Floor then begin CountInPrj := 0; ListOfLists := TList.Create; for l := 0 to ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ListUndoAction.FProjectUndoAction.FLinkUndoObject[l]); if LinkUndoObject.FCad.FListType = lt_Normal then begin CountInPrj := CountInPrj + 1; end; end; end else CountInPrj := 1; // *UNDO ProjectManager* UndoListInPM(GCadForm.FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject, ListIndex, CountInPrj); CurListParams := GetListParams(GCadForm.FCADListID); LoadSettingsForListByParams(CurListParams, False); end; // удалить объект UndoAction FreeAndNil(ListUndoAction); ListIndex := ListIndex + 1; end; end; GcadForm := SavedGCadForm; end; except on E: Exception do addExceptionToLogEx('U_Common.LoadProjectUndoActions', E.Message); end; end; procedure SaveForUndoFromPM(aListsIDs: TIntList; aIsProject: Boolean = False); var i, j: integer; vList: TF_CAD; ID: Integer; vLists: TList; begin try if (aListsIDs <> nil) and (aListsIDs.Count > 0) then begin // сохранение одного листа if aListsIDs.Count = 1 then begin ID := aListsIDs[0]; ReOpenListInCADIfClosed(ID, ''); //17.08.2012 vList := GetListByID(ID); if vList <> nil then vList.SaveForUndo(uat_None, True, aIsProject); end else // сохранние нескольких листов begin vLists := TList.Create; for i := 0 to aListsIDs.Count - 1 do begin ID := aListsIDs[i]; ReOpenListInCADIfClosed(ID, ''); //17.08.2012 vList := GetListByID(ID); if vList <> nil then vLists.Add(vList); end; SaveForProjectUndo(vLists, True, aIsProject); FreeAndNil(vLists); end; end; except on E: Exception do addExceptionToLogEx('U_Common.SaveForUndoFromPM', E.Message); end; end; procedure SaveForProjectRedo(aLists: TList; aSavePM: Boolean; aIsProject: Boolean); var i, j: integer; vList: TF_CAD; ProjectUndoAction: TProjectUndoAction; ListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; SavedGCadForm: TF_CAD; begin try if GRedoList = nil then GRedoList := TList.Create; ProjectUndoAction := TProjectUndoAction.create; SavedGCadForm := GCadForm; for i := 0 to aLists.Count - 1 do begin vList := TF_CAD(aLists[i]); GCadForm := vList; ListUndoAction := vList.SaveForRedo(uat_Floor, aSavePM, aIsProject, i); if ListUndoAction <> nil then begin ListUndoAction.FProjectUndoAction := ProjectUndoAction; LinkUndoObject := TLinkUndoObject.create; LinkUndoObject.FCad := vList; LinkUndoObject.FListUndoAction := ListUndoAction; ProjectUndoAction.FLinkUndoObject.Add(LinkUndoObject); end; end; GCadForm := SavedGCadForm; GRedoList.Add(ProjectUndoAction); except on E: Exception do AddExceptionToLogEx('U_Common.SaveForProjectRedo', E.Message); end; end; procedure DeleteProjectRedoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction); var i, j: integer; vList: TF_CAD; ProjectUndoAction: TProjectUndoAction; ListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; Index: Integer; Count: Integer; OldFName, FName: string; SetUndoName: string; begin try if GRedoList <> nil then begin ProjectUndoAction := aListUndoAction.FProjectUndoAction; // удалить из глобал листа GRedoList.Remove(ProjectUndoAction); // удалить со всех листов for i := 0 to ProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ProjectUndoAction.FLinkUndoObject[i]); vList := LinkUndoObject.FCad; ListUndoAction := LinkUndoObject.FListUndoAction; Index := vList.FSCSRedoList.IndexOf(ListUndoAction); // этот Undo не с текущего листа (он уже обработат) if ListUndoAction <> aListUndoAction then begin // удалить с указанного листа нужный Redo и все что перед ним while Index >= 0 do begin ListUndoAction := TListUndoAction(vList.FSCSRedoList[Index]); FName := ListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов vList.FSCSRedoList.Delete(Index); // *UNDO ProjectManager* DeleteUndoFromPM(vList.FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject); FreeAndNil(ListUndoAction); Index := Index - 1; end; // переприсвоить имена файлов с учетом смещения for j := 0 to vList.FSCSRedoList.Count - 1 do begin ListUndoAction := TListUndoAction(vList.FSCSRedoList[j]); // FName := vList.FRedoDir + vList.FCADListName + IntTostr(vList.FCADListIndex) + '_' + IntToStr(j); FName := vList.FRedoDir + vList.FCADListFileName + '_' + IntToStr(j); OldFName := ListUndoAction.FCadFileName; RenameFile(OldFName, FName); ListUndoAction.FCadFileName := FName; end; end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.DeleteProjectRedoActions', E.Message); end; end; procedure LoadProjectRedoActions(aCad: TF_CAD; aListUndoAction: TListUndoAction); var i, j, k: integer; vList: TF_CAD; ProjectUndoAction: TProjectUndoAction; ListUndoAction, DelListUndoAction: TListUndoAction; LinkUndoObject: TLinkUndoObject; Index: Integer; Count: Integer; FName: string; SetUndoName: string; Stream: TMemoryStream; size: integer; SavedGCadForm: TF_CAD; CountInPrj: Integer; ListIndex: Integer; CurListParams: TListParams; Figure: TFigure; //Tolik CadFigList: TList; // begin try if GRedoList <> nil then begin ProjectUndoAction := aListUndoAction.FProjectUndoAction; // удалить из глобал листа GRedoList.Remove(ProjectUndoAction); // удалить со всех листов SavedGCadForm := GCadForm; ListIndex := 1; for i := 0 to ProjectUndoAction.FLinkUndoObject.Count - 1 do begin LinkUndoObject := TLinkUndoObject(ProjectUndoAction.FLinkUndoObject[i]); vList := LinkUndoObject.FCad; ListUndoAction := LinkUndoObject.FListUndoAction; Index := vList.FSCSRedoList.IndexOf(ListUndoAction); // этот Undo не с текущего листа (он уже обработан) if ListUndoAction <> aListUndoAction then begin // удалить с указанного листа все что после этого Undo j := vList.FSCSRedoList.Count - 1; while j > Index do begin DelListUndoAction := TListUndoAction(vList.FSCSRedoList[j]); FName := DelListUndoAction.FCadFileName; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить элемент из списка файлов vList.FSCSRedoList.Delete(j); FreeAndNil(DelListUndoAction); j := j - 1; end; GCadForm := vList; FName := ListUndoAction.FCadFileName; if FileExists(FName) then begin // поднять темповый файл if GCadForm.FListType = lt_Normal then GCadForm.ClearSCSFigures else GCadForm.ClearPlanFigures; GCadForm.PCad.OnObjectInserted := nil; GCadForm.FUndoFiguresList.Clear; GCadForm.PCad.LoadSCSFiguresFromFile(FName); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; GCadForm.FUndoStatus := True; try if GListWithEndPoint = GCadForm then begin GEndPoint := nil; GListWithEndPoint := nil; end; GNeedReRaiseProperties := False; //Tolik CadFigList := TList.create; for k := 0 to GCadForm.PCad.FigureCount - 1 do CadFigList.Add(TFigure(GCadForm.PCad.Figures.Items[k])); for k := 0 to CadFigList.Count - 1 do begin Figure := TFigure(CadFigList[k]); if CheckFigureByClassName(Figure, cTConnectorObject) then TConnectorObject(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTCabinet) then TCabinet(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTCabinetExt) then TCabinetExt(Figure).RaiseProperties(CadFigList) else if CheckFigureByClassName(Figure, cTHouse) then THouse(Figure).RaiseProperties(CadFigList); end; FreeAndNil(CadFigList); { for k := 0 to GCadForm.PCad.FigureCount - 1 do begin Figure := TFigure(GCadForm.PCad.Figures.Items[k]); if CheckFigureByClassName(Figure, cTConnectorObject) then TConnectorObject(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTCabinet) then TCabinet(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTCabinetExt) then TCabinetExt(Figure).RaiseProperties else if CheckFigureByClassName(Figure, cTHouse) then THouse(Figure).RaiseProperties; end; if GNeedReRaiseProperties then begin k := 0; while k < GCadForm.PCad.FigureCount do begin Figure := TFigure(GCadForm.PCad.Figures.Items[k]); if CheckFigureByClassName(Figure, cTConnectorObject) then begin TConnectorObject(Figure).ReRaiseProperties; end; if CheckFigureByClassName(Figure, cTOrthoLine) then begin TOrthoLine(Figure).ReRaiseProperties; end; k := k + 1; end; end; } finally GCadForm.FUndoStatus := False; end; FindObjectsForConvertClasses; // удалить файл if FileExists(FName) then DeleteFile(FName); // удалить последний который поднимается из спика GCadForm.FSCSRedoList.Delete(vList.FSCSRedoList.Count - 1); if ListUndoAction.ActionType = uat_Floor then CountInPrj := ListUndoAction.FProjectUndoAction.FLinkUndoObject.Count else CountInPrj := 1; // *UNDO ProjectManager* UndoListInPM(GCadForm.FCADListID, ListUndoAction.FBasePath, ListUndoAction.FIsProject, ListIndex, CountInPrj); CurListParams := GetListParams(GCadForm.FCADListID); LoadSettingsForListByParams(CurListParams, False); end; // удалить объект UndoAction FreeAndNil(ListUndoAction); ListIndex := ListIndex + 1; end; end; GcadForm := SavedGCadForm; end; except on E: Exception do AddExceptionToLogEx('U_Common.LoadProjectRedoActions', E.Message); end; end; procedure SaveForRedoFromPM(aListsIDs: TIntList; aIsProject: Boolean = False); var i, j: integer; vList: TF_CAD; ID: Integer; vLists: TList; begin try if (aListsIDs <> nil) and (aListsIDs.Count > 0) then begin // сохранение одного листа if aListsIDs.Count = 1 then begin ID := aListsIDs[0]; vList := GetListByID(ID); if vList <> nil then vList.SaveForRedo(uat_None, True, aIsProject); end else // сохранние нескольких листов begin vLists := TList.Create; for i := 0 to aListsIDs.Count - 1 do begin ID := aListsIDs[i]; vList := GetListByID(ID); if vList <> nil then vLists.Add(vList); end; SaveForProjectRedo(vLists, True, aIsProject); FreeAndNil(vLists); end; end; except on E: Exception do AddExceptionToLogEx('U_Common.SaveForRedoFromPM', E.Message); end; end; function GetOtherListRelatedToFigure(AListID, AFigureID: Integer): Integer; var vList: TF_CAD; vFigure: TFigure; vConn: TConnectorObject; vLine: TOrthoLine; RaiseConn, Join1, Join2: TConnectorObject; begin Result := -1; try vList := GetListByID(AListID); if vList <> nil then begin vFigure := GetFigureByID(vList, AFigureID); if vFigure <> nil then begin // КОННЕКТОР if CheckFigureByClassName(vFigure, cTConnectorObject) then begin vConn := TConnectorObject(vFigure); // это вершина межэтиажного перехода if (vConn.FConnRaiseType = crt_BetweenFloorUp) or (vConn.FConnRaiseType = crt_BetweenFloorDown) or (vConn.FConnRaiseType = crt_TrunkUp) or (vConn.FConnRaiseType = crt_TrunkDown) then begin Result := vConn.FID_ListToPassage; end else // на этом коннекторе есть вершина межэтажного begin RaiseConn := GetRaiseConn(vConn); if RaiseConn <> nil then if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then Result := RaiseConn.FID_ListToPassage; end; end // ОРТОЛИНИЯ else if CheckFigureByClassName(vFigure, cTOrthoLine) then begin vLine := TOrthoLine(vFigure); if vLine.FIsRaiseUpDown then begin Join1 := TConnectorObject(vLine.JoinConnector1); Join2 := TConnectorObject(vLine.JoinConnector2); if (Join1.FConnRaiseType = crt_BetweenFloorUp) or (Join1.FConnRaiseType = crt_BetweenFloorDown) or (Join1.FConnRaiseType = crt_TrunkUp) or (Join1.FConnRaiseType = crt_TrunkDown) then Result := Join1.FID_ListToPassage; if (Join2.FConnRaiseType = crt_BetweenFloorUp) or (Join2.FConnRaiseType = crt_BetweenFloorDown) or (Join2.FConnRaiseType = crt_TrunkUp) or (Join2.FConnRaiseType = crt_TrunkDown) then Result := Join2.FID_ListToPassage; end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetOtherListRelatedToFigure', E.Message); end; end; function GetRelatedListsBySelected(aObjects: TList; aCheckBySelectedType: TCheckBySelectedType): TList; var i, j: Integer; vFigure: TFigure; vConn: TConnectorObject; vLine: TOrthoLine; vList: TF_CAD; RaiseConn, Join1, Join2: TConnectorObject; begin Result := TList.Create; try Result.Add(GCadForm); for i := 0 to aObjects.Count - 1 do begin vFigure := TFigure(aOBjects[i]); if CheckFigureByClassName(vFigure, cTConnectorObject) then begin vConn := TConnectorObject(vFigure); // это шкаф, который удаляется, нужно удалить ссылки на лист дизайна шкафа if aCheckBySelectedType = cst_Delete then if vConn.FJoinedListIDForBox <> - 1 then vConn.FJoinedListIDForBox := - 1; // это вершина межэтиажного перехода if (vConn.FConnRaiseType = crt_BetweenFloorUp) or (vConn.FConnRaiseType = crt_BetweenFloorDown) or (vConn.FConnRaiseType = crt_TrunkUp) or (vConn.FConnRaiseType = crt_TrunkDown) then begin vList := GetListByID(vConn.FID_ListToPassage); if vList <> nil then if CheckNoCadInList(vList, Result) then Result.Add(vList); end else // на этом коннекторе есть вершина межэтажного begin RaiseConn := GetRaiseConn(vConn); if RaiseConn <> nil then if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then begin vList := GetListByID(RaiseConn.FID_ListToPassage); if vList <> nil then if CheckNoCadInList(vList, Result) then Result.Add(vList); end; end; end else if CheckFigureByClassName(vFigure, cTOrthoLine) then begin vLine := TOrthoLine(vFigure); Join1 := TConnectorObject(vLine.JoinConnector1); Join2 := TConnectorObject(vLine.JoinConnector2); // это вершина межэтиажного перехода if (Join1.FConnRaiseType = crt_BetweenFloorUp) or (Join1.FConnRaiseType = crt_BetweenFloorDown) or (Join1.FConnRaiseType = crt_TrunkUp) or (Join1.FConnRaiseType = crt_TrunkDown) then begin vList := GetListByID(Join1.FID_ListToPassage); if vList <> nil then if CheckNoCadInList(vList, Result) then Result.Add(vList); end else // на этом коннекторе есть вершина межэтажного if aCheckBySelectedType = cst_Move then begin RaiseConn := GetRaiseConn(Join1); if RaiseConn <> nil then if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then begin vList := GetListByID(RaiseConn.FID_ListToPassage); if vList <> nil then if CheckNoCadInList(vList, Result) then Result.Add(vList); end; end; // это вершина межэтиажного перехода if (Join2.FConnRaiseType = crt_BetweenFloorUp) or (Join2.FConnRaiseType = crt_BetweenFloorDown) or (Join2.FConnRaiseType = crt_TrunkUp) or (Join2.FConnRaiseType = crt_TrunkDown) then begin vList := GetListByID(Join2.FID_ListToPassage); if vList <> nil then if CheckNoCadInList(vList, Result) then Result.Add(vList); end else // на этом коннекторе есть вершина межэтажного if aCheckBySelectedType = cst_Move then begin RaiseConn := GetRaiseConn(Join2); if RaiseConn <> nil then if (RaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (RaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (RaiseConn.FConnRaiseType = crt_TrunkUp) or (RaiseConn.FConnRaiseType = crt_TrunkDown) then begin vList := GetListByID(RaiseConn.FID_ListToPassage); if vList <> nil then if CheckNoCadInList(vList, Result) then Result.Add(vList); end; end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetRelatedListsBySelected', E.Message); end; end; function CheckOneOfSCSlayers(aLNbr: Integer): Boolean; begin Result := False; try if aLNbr = 2 then Result := True; if aLNbr = 3 then Result := True; if aLNbr = 4 then Result := True; if aLNbr = 5 then Result := True; if aLNbr = 6 then Result := True; if aLNbr = 9 then Result := True; except on E: Exception do addExceptionToLogEx('U_Common.CheckOneOfSCSlayers', E.Message); end; end; procedure DeselectAllSCSObjectsInCAD(AListID: Integer); var vList: TF_CAD; begin try vList := GetListByID(AListID); if vList <> nil then begin vList.PCad.DeselectAll(2); RefreshCAD(vList.PCad); end; except on E: Exception do AddExceptionToLogEx('U_Common.DeselectAllSCSObjectsInCAD', E.Message); end; end; procedure DeselectAllSCSObjectsInProject; var i: integer; CAD: TF_CAD; begin for i := 0 to FSCS_Main.MDIChildCount - 1 do begin CAD := TF_CAD(FSCS_Main.MDIChildren[i]); if CAD.FListType = lt_Normal then begin CAD.PCad.DeselectAll(2); RefreshCAD(CAD.PCad); end; end; end; procedure DeselectNoDrawed(aPCAD: TPowerCad); var i: Integer; Figure: TFigure; begin for i := 0 to aPCAD.Figures.Count - 1 do begin Figure := TFigure(aPCAD.Figures[i]); if Figure is TConnectorObject then if Not TConnectorObject(Figure).FIsDraw and TConnectorObject(Figure).Selected then TConnectorObject(Figure).DeSelect; end; end; procedure SelectObjectsInCADByIDs(aListID: Integer; aObjectsID: TIntList); var i: Integer; ID: Integer; vList: TF_CAD; vFigure: TFigure; begin try vList := GetListByID(aListID); if vList <> nil then begin for i := 0 to aObjectsID.Count - 1 do begin ID := aObjectsID[i]; vFigure := GetFigureByID(vList, ID); if vFigure <> nil then begin if Not GCanRefreshProperties then if (not vFigure.LockSelect) and (vList.PCad.ActiveLayer = 2) then GCanRefreshProperties := True; vFigure.Select; end; end; RefreshCAD(vList.PCad); end; except on E: Exception do AddExceptionToLogEx('U_Common.SelectObjectsInCADByIDs', E.Message); end; end; function GetObjectsListWithSelectedInCAD(aListID: Integer): TIntList; var i: Integer; vFigure: TFigure; vList: TF_CAD; begin Result := TIntList.create; try vList := GetListByID(aListID); if vList <> nil then begin for i := 0 to vList.PCad.SelectedCount - 1 do begin vFigure := TFigure(vList.PCad.Selection[i]); Result.Add(vFigure.ID); end; end; except on E: Exception do AddExceptionToLogEx('U_Common.GetObjectsListWithSelectedInCAD', E.Message); end; end; function Get_News(ParentWin : THandle; gpid, gURL_p, gURL_a, gfil : string; func : byte; var timr :word): byte; var ActHandle : THandle;//хэндл активного приложения GetNews : procedure(hndl : THandle; pid, URL_p, URL_a, fil : string; alarm, draw, autosave : boolean); stdcall; OpenNews : procedure(hndl : THandle; pid, URL_p, URL_a, fil : string); stdcall; GetInt : function(hndl : THandle; pid, URL_p, URL_a, fil : string):word; stdcall; begin Result:=0; (* if Newshandle = 0 then Newshandle := LoadLibrary(PChar('exnews.dll')); try if Newshandle<>0 then begin case func of 0:begin//проверка наличия новостей @GetNews:=GetProcAddress(Newshandle,'GetNews'); if @GetNews<>nil then begin try ActHandle:=GetForegroundWindow; GetNews(ParentWin, gpid, gURL_p, gURL_a, gfil,false, false, true); SetForegroundWindow(ActHandle);//чтобы не забирать фокус у активного окна! except Result:=4;// 4 - Ошибка выполнения процедуры Exit; end; end else begin Result:=2;// 2 - Ошибка вызова процедуры Exit; end; end;{1} 1:begin{2} //открытие формы для работы с новостями @OpenNews:=GetProcAddress(Newshandle,'Execute'); if @OpenNews<>nil then begin{a} try OpenNews(ParentWin, gpid, gURL_p, gURL_a, gfil) except Result:=4;// 4 - Ошибка выполнения процедуры Exit; end;{except} end{a} else begin Result:=2;// 2 - Ошибка вызова процедуры Exit; end; end;{2} 2:begin{3} //открытие формы для работы с новостями @GetInt:=GetProcAddress(Newshandle,'GetInterval'); if @GetInt<>nil then begin{a} try timr:=GetInt(ParentWin, gpid, gURL_p, gURL_a, gfil) except Result:=4;// 4 - Ошибка выполнения процедуры Exit; end;{except} end{a} else begin Result:=2;// 2 - Ошибка вызова процедуры Exit; end; end;{3} else begin Result:=3;// 3 - ошибочный параметр func Exit; end; end; end else begin Result:=1;// 1 - ошибка загрузки DLL, Exit; end; finally // if FreeLibrary(Newshandle) then // Newshandle:=0; end; *) end; //Tolik function GetRoomSquare(AListID, ARoomID: Integer; RecalcSquare:Boolean = False): Double; var vList: TF_CAD; Cabinet: TFigure; x1, x2, y1, y2: double; a, b, S: double; MaxX, MaxY, MinX, MinY: Double; i, j: Integer; sum1, sum2, resultsum: double; Segment: TPlSegment; begin Result := -1; try vList := GetListByID(AListID); Cabinet := nil; //#From Oleg# //14.09.2010 if vList <> nil then Cabinet := FindCabinetBySCSID(vList, ARoomID); if Cabinet <> nil then begin // Для простых кабинетов if CheckFigureByClassName(Cabinet, cTCabinet) then begin if (RecalcSquare or (TCabinet(Cabinet).FCabinetSquare = -1)) then begin for i := 1 to Cabinet.PointCount - 1 do begin x1 := Cabinet.FigurePoints[i].x; y1 := Cabinet.FigurePoints[i].y; x2 := Cabinet.FigurePoints[i+1].x; y2 := Cabinet.FigurePoints[i+1].y; //S := S + ((y2+y1)/2) * ((x2-x1)/2); sum1 := sum1 + x1*y2; sum2 := sum2 + y1*x2; end; x1 := Cabinet.FigurePoints[TCabinetExt(Cabinet).PointCount].x; y1 := Cabinet.FigurePoints[TCabinetExt(Cabinet).PointCount].y; x2 := Cabinet.FigurePoints[1].x; y2 := Cabinet.FigurePoints[1].y; //S := S + ((y2+y1)/2) * ((x2-x1)/2); sum1 := sum1 + x1*y2; sum2 := sum2 + y1*x2; Result := RoundX(ABS(sum2 - sum1)/2, 2); if RecalcSquare then TCabinet(Cabinet).FCabinetSquare := -1; end else Result := TCabinet(Cabinet).FCabinetSquare; end else if CheckFigureByClassName(Cabinet, cTCabinetExt) then begin // !!! if (RecalcSquare or (TCabinetExt(Cabinet).FCabinetSquare = -1)) then begin S := 0; TCabinetExt(Cabinet).getbounds(MaxX, MaxY, MinX, MinY); for i := round(MinX) to round(MaxX) do begin for j := round(MinY) to round(MaxY) do begin if TCabinetExt(Cabinet).IsPointInMod(i, j) then S := S + 1; end; end; S := SQR(vList.PCad.MapScale / 1000) * S; Result := S; if RecalcSquare then TCabinetExt(Cabinet).FCabinetSquare := -1; { for i := 0 to TCabinetExt(Cabinet).Segments.Count - 1 do begin Segment:= TPlSegment(TCabinetExt(Cabinet).Segments); x1 := Segment.CPoint1.x; y1 := Segment.CPoint1.y; end;} // Tolik { TCabinetExt(Cabinet).getbounds(MaxX, MaxY, MinX, MinY); s := 0; sum1 := 0; sum2 := 0; ResultSum := 0; for i := 0 to TCabinetExt(Cabinet).Segments.Count - 1 do begin Segment:= TPlSegment(TCabinetExt(Cabinet).Segments); x1 := Segment.CPoint1.x; end; for i := 1 to TCabinetExt(Cabinet).PointCount - 1 do begin x1 := TCabinetExt(Cabinet).FigurePoints[i].x/10; y1 := TCabinetExt(Cabinet).FigurePoints[i].y/10; x2 := TCabinetExt(Cabinet).FigurePoints[i+1].x/10; y2 := TCabinetExt(Cabinet).FigurePoints[i+1].y/10; S := S + ((y2+y1)/2) * ((x2-x1)/2); sum1 := sum1 + x1*y2; sum2 := sum2 + y1*x2; end; x1 := TCabinetExt(Cabinet).FigurePoints[TCabinetExt(Cabinet).PointCount].x/10; y1 := TCabinetExt(Cabinet).FigurePoints[TCabinetExt(Cabinet).PointCount].y/10; x2 := TCabinetExt(Cabinet).FigurePoints[1].x/10; y2 := TCabinetExt(Cabinet).FigurePoints[1].y/10; S := S + ((y2+y1)/2) * ((x2-x1)/2); sum1 := sum1 + x1*y2; sum2 := sum2 + y1*x2; Result := RoundX(ABS(sum2 - sum1)/2, 2); } end else Result := TCabinetExt(Cabinet).FCabinetSquare; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.GetRoomSquare', E.Message); end; end; { function GetRoomSquare(AListID, ARoomID: Integer): Double; var vList: TF_CAD; Cabinet: TFigure; x1, x2, y1, y2: double; a, b, S: double; MaxX, MaxY, MinX, MinY: Double; i, j: Integer; begin Result := -1; try vList := GetListByID(AListID); Cabinet := nil; //#From Oleg# //14.09.2010 if vList <> nil then Cabinet := FindCabinetBySCSID(vList, ARoomID); if Cabinet <> nil then begin if CheckFigureByClassName(Cabinet, cTCabinet) then begin x1 := Cabinet.ap1.x; y1 := Cabinet.ap1.y; x2 := Cabinet.ap3.x; y2 := Cabinet.ap3.y; a := abs(x2 - x1); a := a * vList.PCad.MapScale / 1000; b := abs(y2 - y1); b := b * vList.PCad.MapScale / 1000; S := a * b; Result := S; end else if CheckFigureByClassName(Cabinet, cTCabinetExt) then begin // !!! S := 0; TCabinetExt(Cabinet).getbounds(MaxX, MaxY, MinX, MinY); for i := round(MinX) to round(MaxX) do begin for j := round(MinY) to round(MaxY) do begin if TCabinetExt(Cabinet).IsPointInMod(i, j) then S := S + 1; end; end; S := SQR(vList.PCad.MapScale / 1000) * S; Result := S; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.GetRoomSquare', E.Message); end; end; } //Tolik // function GetRoomVolume(AListID, ARoomID: Integer ): Double; function GetRoomVolume(AListID, ARoomID: Integer; ARoomSquare: Double): Double; var x1, x2, y1, y2: double; S, V: double; begin Result := 0; try //S := GetRoomSquare(AListID, ARoomID); //V := S * GCadForm.FRoomHeight; V := ARoomSquare * GCadForm.FRoomHeight; Result := V; except on E: Exception do AddExceptionToLogEx('U_Common.GetRoomVolume', E.Message); end; end; procedure CreateVirtualCabinetInCAD(vList: TF_CAD); var Cabinet: TCabinet; Lhandle: Integer; x1, y1, x2, y2: double; begin try if vList <> nil then begin x1 := vList.PCad.Left; x2 := vList.PCad.Left + vList.PCad.WorkWidth; y1 := vList.PCad.Top; y2 := vList.PCad.Top + vList.PCad.WorkHeight; LHandle := vList.PCad.GetLayerHandle(9); Cabinet := TCabinet.create(x1, y1, x2, y2, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, LHandle, mydsNormal, vList.PCad); vList.PCad.AddCustomFigure(9, Cabinet, False); end; except on E: Exception do AddExceptionToLogEx('U_Common.CreateVirtualCabinetInCAD', E.Message); end; end; procedure ReScaleDrawingToListFormat(aOldListW, aOldListH: double); var ListFormat: TListFormatType; Grp: TSCSFigureGrp; rp: TDoublePoint; i: Integer; Cabinet: TCabinet; CabinetExt: TCabinetExt; SCSFigureGrp: TSCSFigureGrp; cp: TDoublePoint; BoundRect: TDoubleRect; koefx, koefy: double; deltax, deltay: double; oldsizex, oldsizey, newsizex, newsizey: double; NewListW, NewListH: double; Figure: TFigure; begin try BeginProgress; NewListW := GCadForm.PCad.WorkWidth; NewListH := GCadForm.PCad.WorkHeight; GCadForm.PCad.SelectAll(1); GCadForm.PCad.SelectAll(2); GCadForm.PCad.SelectAll(8); GCadForm.PCad.SelectAll(9); BoundRect := GCadForm.PCad.GetSelectionRect; GCadForm.PCad.DeselectAll(0); rp := DoublePoint(BoundRect.Left, BoundRect.Top); // 1 - подложка GCadForm.PCad.SelectAll(1); oldsizex := abs(BoundRect.Right - BoundRect.Left); oldsizey := abs(BoundRect.Bottom - BoundRect.Top); deltax := aOldListW - oldsizex; newsizex := NewListW - deltax; koefx := newsizex / oldsizex; deltay := aOldListH - oldsizey; newsizey := NewListH - deltay; koefy := newsizey / oldsizey; GCadForm.PCad.ScaleSelection(koefx, koefy, rp); GCadForm.PCad.DeSelectAll(1); // (2-6) СКС GCadForm.PCad.SelectAll(2); Grp := SCSGroupSelection; if Grp <> nil then begin Grp.Scale(koefx, koefy, rp); Grp.UnGroup; GCadForm.PCad.Figures.Remove(Grp); end; GCadForm.PCad.DeSelectAll(2); // отдельно Scale для TSCSFigureGrp for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(GCadForm.PCad.Figures[i]); SCSFigureGrp.Scale(koefx, koefy, rp); end; end; //Залочил,потому что ниже данный ActiveNet пересчитывается ещё раз { // 8 - архитектурный if ActiveNet <> nil then ActiveNet.Scale(koefx, koefy, rp); } // 9 - кабинеты for i := 0 to GCadForm.Pcad.FigureCount - 1 do begin Figure := TFigure(GCadForm.Pcad.Figures[i]); if Figure is TCabinet then begin Cabinet := TCabinet(Figure); Cabinet.Scale(koefx, koefy, rp); if Cabinet.FNumberObject <> nil then begin cp.x := (Cabinet.ActualPoints[1].x + Cabinet.ActualPoints[3].x) / 2; cp.y := (Cabinet.ActualPoints[1].y + Cabinet.ActualPoints[3].y) / 2; Cabinet.FNumberObject.move(CP.x - Cabinet.FNumberObject.CenterPoint.x, CP.y - Cabinet.FNumberObject.CenterPoint.y); end; MoveObjectsToCabinetOnMove(Cabinet); end else if Figure is TCabinetExt then begin CabinetExt := TCabinetExt(Figure); CabinetExt.Scale(koefx, koefy, rp); CabinetExt.CenterNumberObject; end // Если арх. объект else if Figure is TNet then begin TNet(Figure).Scale(koefx, koefy, rp); end; end; RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('U_Common.ReScaleDrawingToListFormat', E.Message); end; EndProgress; end; procedure DeleteDxfLayers(aPCad: TPowerCad); var i: integer; vLayer: TLayer; vLNbr: Integer; vList: TList; begin try BeginProgress; vList := TList.Create; for i := 10 to aPcad.Layers.count - 1 do begin vLayer := TLayer(aPcad.Layers[i]); if vLayer.isDxf then vList.add(vLayer); end; for i := 0 to vList.Count - 1 do begin vLayer := TLayer(vList[i]); vLNbr := aPCad.GetLayerNbr(vLayer); aPCad.DeleteLayerWithNbr(vLNbr); end; FreeAndNil(vList); except on E: Exception do AddExceptionToLogEx('U_Common.DeleteDxfLayers', E.Message); end; EndProgress; end; function CheckFigureInDXFLayer(aFigure: TFigure): Boolean; var i: integer; Layer: Tlayer; fLNbr: integer; begin Result := false; try for i := 10 to GCadForm.PCad.LayerCount - 1 do begin Layer := TLayer(GCadForm.PCad.Layers[i]); if Layer.IsDxf then begin if (aFigure.LayerHandle = LongInt(Layer)) then Result := true; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.CheckFigureInDXFLayer', E.Message); end; end; procedure ApplyUOMForProject(aOldUOM, aNewUOM: Integer); var i: Integer; vList: TF_CAD; vLists: TList; begin try // *UNDO* // vLists := TList.Create; // for i := 0 to FSCS_Main.MDIChildCount - 1 do // begin // vList := TF_CAD(FSCS_Main.MDIChildren[i]); // vLists.add(vList); // end; // SaveForProjectUndo(vLists, True, False); // // метрическая if (aNewUOM = umSM) or (aNewUOM = umM) then begin // была американская, поставить на все листы метрическую if (aOldUOM = umIn) or (aOldUOM = umFt) then begin for i := 0 to FSCS_Main.MDIChildCount - 1 do begin vList := TF_CAD(FSCS_Main.MDIChildren[i]); vList.PCad.RulerSystem := rsMetric; end; end; end else // американская if (aNewUOM = umIn) or (aNewUOM = umFt) then begin // была метрическая, поставить на все листы американскую if (aOldUOM = umSM) or (aOldUOM = umM) then begin for i := 0 to FSCS_Main.MDIChildCount - 1 do begin vList := TF_CAD(FSCS_Main.MDIChildren[i]); vList.PCad.RulerSystem := rsWhitworth; end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.ApplyUOMForProject', E.Message); end; end; function GetUOMString(aUOM: Integer): string; begin try Result := ' '; if aUOM = umSM then Result := Result + cMetric_sm; if aUOM = umM then Result := Result + cMetric_m; if aUOM = umIn then Result := Result + cWhitworth_in; if aUOM = umFt then Result := Result + cWhitworth_ft; except on E: Exception do AddExceptionToLogEx('U_Common.GetUOMString', E.Message); end; end; // перевести метры в текущую систему измерений function MetreToUOM(aValue: Double): Double; begin Result := 0; try Result := FloatInUOM(AValue, umM, GCurrProjUnitOfMeasure); except on E: Exception do AddExceptionToLogEx('U_Common.MetreToUOM', E.Message); end; end; // перевести текущую систему измерений в метры function UOMToMetre(aValue: Double): Double; begin Result := 0; try Result := FloatInUOM(AValue, GCurrProjUnitOfMeasure, umM); except on E: Exception do AddExceptionToLogEx('U_Common.UOMToMetre', E.Message); end; end; procedure UpdateAllTracesLengthAndRefreshTextBoxOnAllLists; var i, j: Integer; vList: TF_CAD; vLine: TOrtholine; SavedGCadForm: TF_CAD; begin try for i := 0 to FSCS_Main.MDIChildCount - 1 do begin vList := TF_CAD(FSCS_Main.MDIChildren[i]); if vList.FListType = lt_Normal then begin for j := 0 to vList.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(vLIst.PCad.Figures[j]), cTOrthoLine) then begin SavedGCadForm := GCadForm; GCadForm := vList; vLine := TOrthoLine(vLIst.PCad.Figures[j]); vLine.UpdateLengthTextBox(true, false); vLine.ReCreateNotesGroup(True); SetConFigureCoordZInPM(vLine.JoinConnector1.ID, vLine.ActualZOrder[1]); SetConFigureCoordZInPM(vLine.JoinConnector2.ID, vLine.ActualZOrder[2]); GCadForm := SavedGCadForm; end; end; end; end; except on E: Exception do AddExceptionToLogEx('UpdateAllTracesLengthOnAllLists', E.Message); end; end; procedure UpdateAllTracesLengthOnAllLists; var i, j: Integer; vList: TF_CAD; vLine: TOrtholine; SavedGCadForm: TF_CAD; begin try for i := 0 to FSCS_Main.MDIChildCount - 1 do begin vList := TF_CAD(FSCS_Main.MDIChildren[i]); if vList.FListType = lt_Normal then begin for j := 0 to vList.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(vLIst.PCad.Figures[j]), cTOrthoLine) then begin SavedGCadForm := GCadForm; GCadForm := vList; vLine := TOrthoLine(vLIst.PCad.Figures[j]); vLine.UpdateLengthTextBox(true, false); GCadForm := SavedGCadForm; end; end; end; end; except on E: Exception do AddExceptionToLogEx('UpdateAllTracesLengthOnAllLists', E.Message); end; end; function CadsToIntCads(aList: TList): TIntList; var i: Integer; ID: Integer; begin Result := TIntList.Create; try for i := 0 to aList.Count - 1 do begin ID := TF_CAD(aList[i]).FCADListID; Result.Add(ID); end; except on E: Exception do AddExceptionToLogEx('U_Common.CadsToIntCads', E.Message); end; end; function IntCadsToCads(aIntList: TIntList): TList; var i: Integer; ID: Integer; Cad: TF_CAD; begin Result := TList.Create; try for i := 0 to aIntList.Count - 1 do begin ID := aIntList[i]; Cad := GetListByID(ID); Result.Add(Cad); end; except on E: Exception do AddExceptionToLogEx('U_Common.IntCadsToCads', E.Message); end; end; function FiguresToIntFigures(aList: TList): TIntList; var i: Integer; ID: Integer; begin Result := TIntList.Create; try for i := 0 to aList.Count - 1 do begin ID := TFigure(aList[i]).ID; Result.Add(ID); end; except on E: Exception do AddExceptionToLogEx('U_Common.FiguresToIntFigures', E.Message); end; end; function IntFiguresToFigures(aIntList: TIntList): TList; var i: Integer; ID: Integer; Figure: TFigure; begin Result := TList.Create; try for i := 0 to aIntList.Count - 1 do begin ID := aIntList[i]; Figure := GetFigureByID(GCadForm, ID); Result.Add(Figure); end; except on E: Exception do AddExceptionToLogEx('U_Common.IntFiguresToFigures', E.Message); end; end; function CheckExistBetweenFloorOnList(aCad: TF_CAD): Boolean; var i: integer; figure: Tfigure; begin Result := False; try for i := 0 to aCad.PCad.FigureCount - 1 do begin figure := TFigure(aCad.PCad.Figures[i]); if CheckFigureByClassName(figure, cTConnectorObject) then if (TConnectorObject(figure).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(figure).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(figure).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(figure).FConnRaiseType = crt_TrunkDown) then begin Result := True; Break; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.CheckExistBetweenFloorOnList', E.Message); end; end; function CheckTTextExistForDXF(aBlock: TBlock): Boolean; var i: integer; InFigure: TFigure; begin Result := false; try for i := 0 to aBlock.InFigures.Count - 1 do begin InFigure := TFigure(aBlock.InFigures[i]); if InFigure.ClassName = 'TText' then begin Result := true; break; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.CheckTTextExistForDXF', E.Message); end; end; procedure ConvertBMPToJpeg(aBmp: TBitmap; aFileName: string); var Jpeg: TJPEGImage; begin try Jpeg := TJpegImage.Create; Jpeg.Assign(aBmp); JPeg.SaveToFile(ChangeFileExt(aFileName, '.jpg')); FreeAndNil(Jpeg); except on E: Exception do AddExceptionToLogEx('U_Common.ConvertBMPToJpeg', E.Message); end; end; procedure SaveSubstrateArchPlan(aFileName: string); var Bmp: TBitmap; Jpeg: TJPEGImage; ExtStr: string; BmpFileName: string; begin try ExtStr := ExtractFileExt(aFileName); if ExtStr = '.bmp' then begin GCadForm.PCad.SaveSubstrateAsBitmap(aFileName); end else if (ExtStr = '.jpg') then begin BmpFileName := ChangeFileExt(aFileName, '.bmp'); GCadForm.PCad.SaveSubstrateAsBitmap(BmpFileName); Bmp := TBitmap.Create; Bmp.LoadFromFile(BmpFileName); ConvertBMPToJpeg(Bmp, aFileName); FreeAndNil(Bmp); DeleteFile(BmpFileName); end; except on E: Exception do AddExceptionToLogEx('U_Common.GetSubstrateArchPlanBitmap', E.Message); end; end; procedure DeleteHouseOnCAD(aListID, AObjectID: Integer); var vHouse: THouse; vList: TF_CAD; vFigure: TFigure; begin try // Нельзя здесь - иначе на КАДе на том что нужно удалится, а вот с ПМ - не с того // такая проверка - в procedure TF_MAIN.DelCompon(AComponent: TSCSComponent; ANode: TTreeNode; //if aListID <> GCadForm.FCADListID then // aListID := GCadForm.FCADListID; // а что бы исключить зависание КАДа лучше наверное так сделаем: if aListID <> GCadForm.FCADListID then exit; vList := GetListByID(aListID); if (vList <> nil) then begin vFigure := GetHouseByID(vList, AObjectID); if vFigure <> nil then begin if CheckFigureByClassName(vFigure, cTHouse) then begin THouse(vFigure).Delete; RefreshCAD(vList.PCad); end; end; end; except on E: Exception do addExceptionToLogEx('U_Common.DeleteHouseOnCAD', E.Message); end; end; procedure DeleteApproachOnCAD(aListID, aHouseID, AComponID: Integer); var vList: TF_CAD; House: THouse; Approach: TConnectorObject; begin try if aListID <> GCadForm.FCADListID then exit; vList := GetListByID(aListID); if vList <> nil then begin Approach := GetApproachByComponID(vList, AComponID); if Approach <> nil then begin Approach.Delete(False, False); RefreshCAD(vList.PCad); end; end; except on E: Exception do AddExceptionToLogEx('U_Common.DeleteApproachOnCAD', E.Message); end; end; procedure SnapConnectorToHouse(aConnector: TConnectorObject; aSnapHouse: THouse); var i: Integer; pt: TDoublePoint; SegIndex: Integer; begin try pt := aConnector.ActualPoints[1]; SegIndex := -1; For i := 1 to aSnapHouse.PointCount do begin if aSnapHouse.IsPointInSegment(i, pt.x, pt.y) then begin SegIndex := i; break; end; end; if SegIndex = - 1 then exit; aSnapHouse.InsertKnot(SegIndex, pt); aConnector.FIsHouseJoined := True; aConnector.FHouse := aSnapHouse; aSnapHouse.fJoined.Add(aConnector); except on E: Exception do AddExceptionToLogEx('U_Common.SnapConnectorToHouse', E.Message); end; end; function GetIDElementFromComplexObjByTrace(AID_List, AIDComplexFigure, AIDTrace: Integer): Integer; var vHouse: THouse; vLine: TOrthoLine; Join1, Join2: TConnectorObject; vList: TF_CAD; begin Result := -1; try //на выходе: //ID элемента комплексного объекта(подъезда), или //0 - трасса подключена к комплексному объекту(тоесть дому) //-1 - трасса ни чем не связана с домом vList := GetListByID(AID_List); if vList = nil then exit; vHouse := GetHouseByID(vList, AIDComplexFigure); vLine := TOrthoLine(GetFigureByID(vList, AIDTrace)); if (vHouse = nil) or (vLine = nil) then exit; Join1 := TConnectorObject(vLine.JoinConnector1); Join2 := TConnectorObject(vLine.JoinConnector2); if Join1.FIsHouseJoined then if Join1.FHouse <> nil then if Join1.FHouse = vHouse then begin Result := 0; exit; end; if Join2.FIsHouseJoined then if Join2.FHouse <> nil then if Join2.FHouse = vHouse then begin Result := 0; exit; end; if Join1.JoinedConnectorsList.Count > 0 then if TConnectorObject(Join1.JoinedConnectorsList[0]).FIsApproach then if TConnectorObject(Join1.JoinedConnectorsList[0]).FHouse = vHouse then Result := TConnectorObject(Join1.JoinedConnectorsList[0]).FComponID; if Join2.JoinedConnectorsList.Count > 0 then if TConnectorObject(Join2.JoinedConnectorsList[0]).FIsApproach then if TConnectorObject(Join2.JoinedConnectorsList[0]).FHouse = vHouse then Result := TConnectorObject(Join2.JoinedConnectorsList[0]).FComponID; except on E: Exception do AddExceptionToLogEx('U_Common.GetIDElementFromComplexObjByTrace', E.Message); end; end; function GetConnectedTracesToConnetorByID(AIDList, AIDConnectorFigure: Integer): TIntList; var CADList: TF_CAD; vFigure: TFigure; ConnectorFigure: TConnectorObject; JoinedConnector: TConnectorObject; Approach: TConnectorObject; House: THouse; i, j, k: Integer; begin Result := TIntList.Create; ConnectorFigure := nil; CADList := GetListByID(AIDList); if CADList <> nil then begin vFigure := GetFigureByID(CADList, AIDConnectorFigure); if vFigure = nil then vFigure := GetHouseByID(CADList, AIDConnectorFigure); if vFigure <> nil then begin // CONNECTOR if CheckFigureByClassName(vFigure, cTConnectorObject) then begin ConnectorFigure := TConnectorObject(vFigure); // трассы присоединены напрямую if ConnectorFigure.JoinedConnectorsList.Count = 0 then begin for i := 0 to ConnectorFigure.JoinedOrtholinesList.Count - 1 do Result.Add(TOrthoLine(ConnectorFigure.JoinedOrtholinesList[i]).ID); end else // Через точ. объекты for i := 0 to ConnectorFigure.JoinedConnectorsList.Count - 1 do begin JoinedConnector := TConnectorObject(ConnectorFigure.JoinedConnectorsList[i]); for j := 0 to JoinedConnector.JoinedOrtholinesList.Count - 1 do Result.Add(TOrthoLine(JoinedConnector.JoinedOrtholinesList[j]).ID); end; end // HOUSE else if CheckFigureByClassName(vFigure, cTHouse) then begin House := THouse(vFigure); // перебрать связующие коннекторы for i := 0 to House.fJoined.Count - 1 do begin JoinedConnector := TConnectorObject(House.fJoined[i]); for j := 0 to JoinedConnector.JoinedOrtholinesList.Count - 1 do Result.Add(TOrthoLine(JoinedConnector.JoinedOrtholinesList[j]).ID); end; // перебрать подъезды for i := 0 to House.fApproaches.Count - 1 do begin Approach := TConnectorObject(House.fApproaches[i]); for j := 0 to Approach.JoinedConnectorsList.Count - 1 do begin JoinedConnector := TConnectorObject(Approach.JoinedConnectorsList[j]); for k := 0 to JoinedConnector.JoinedOrtholinesList.Count - 1 do Result.Add(TOrthoLine(JoinedConnector.JoinedOrtholinesList[k]).ID); end; end; end; end; end; end; function GetConnectedFigures(AFigure: TFigure; AClearConnToRes: Boolean=false; ASkipList: TList=nil): TList; //#From Oleg# //15.09.2010 var i, j: Integer; JoinedConnObject: TConnectorObject; //ListOfPassage: TF_CAD; //ConnOfPassage: TConnectorObject; //ConnectedObjectsFromBetweenFloorConnector: TRapList; JoinedLine: TOrtholine; JoinedConnector: TConnectorObject; FigureToResult: TFigure; procedure AddFigureToResult(AFigureToRes: TFigure); begin if (ASkipList = nil) or (ASkipList.IndexOf(AFigureToRes) = -1) then Result.Add(AFigureToRes); end; //*** Вернет подключенные объекты (на другом листе) к соединителю, что подключен к ь-э переходу function GetConnectedObjectsFromBetweenFloorConnector(AConnObject: TConnectorObject): TRapList; var IndexFigure: Integer; ConnectedFigures: TRapList; ListOfPassage: TF_CAD; ConnOfPassage: TConnectorObject; i: Integer; begin Result := nil; ListOfPassage := GetListOfPassage(AConnObject.FID_ListToPassage); if ListOfPassage <> nil then begin ConnOfPassage := TConnectorObject(GetFigureByID(ListOfPassage, AConnObject.FID_ConnToPassage)); if ConnOfPassage <> nil then begin ConnectedFigures := TRapList.Create; for i := 0 to ConnOfPassage.JoinedOrtholinesList.Count - 1 do ConnectedFigures.Add(TOrthoLine(ConnOfPassage.JoinedOrtholinesList.List^[i])); Result := ConnectedFigures; end; end; end; procedure GetObjectsFromOrtholineConnector(AConnector: TConnectorObject); var ConnRaiseType: TConnRaiseType; //ConnObject: TConnectorObject; FigureToResult: TFigure; i: integer; ConnectedObjectsFromBetweenFloorConnector: TRapList; begin if AClearConnToRes then begin if AConnector.JoinedConnectorsList.Count = 0 then AddFigureToResult(AConnector) else for i := 0 to AConnector.JoinedConnectorsList.Count - 1 do begin FigureToResult := TConnectorObject(AConnector.JoinedConnectorsList.List^[i]); AddFigureToResult(FigureToResult); //Result.Add(FigureToResult); end; end else begin ConnRaiseType := AConnector.FConnRaiseType; if (ConnRaiseType = crt_BetweenFloorUp) or (ConnRaiseType = crt_BetweenFloorDown) then begin ConnectedObjectsFromBetweenFloorConnector := GetConnectedObjectsFromBetweenFloorConnector(AConnector); if ConnectedObjectsFromBetweenFloorConnector <> nil then begin for i := 0 to ConnectedObjectsFromBetweenFloorConnector.Count - 1 do begin FigureToResult := TFigure(ConnectedObjectsFromBetweenFloorConnector.List^[i]); if FigureToResult is TOrtholine then AddFigureToResult(FigureToResult);//Result.Add(FigureToResult); end; ConnectedObjectsFromBetweenFloorConnector.Free; end; end else begin for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList.List^[i]); if JoinedLine <> TOrthoLine(AFigure) then AddFigureToResult(JoinedLine); //Result.Add(JoinedLine); end; for i := 0 to AConnector.JoinedConnectorsList.Count - 1 do begin FigureToResult := TConnectorObject(AConnector.JoinedConnectorsList.List^[i]); AddFigureToResult(FigureToResult); //Result.Add(FigureToResult); end; end; end; end; begin Result := TList.Create; if AFigure is TConnectorObject then begin if TConnectorObject(AFigure).ConnectorType = ct_Clear then begin for i := 0 to TConnectorObject(AFigure).JoinedOrtholinesList.Count - 1 do begin FigureToResult := TOrthoLine(TConnectorObject(AFigure).JoinedOrtholinesList.List^[i]); AddFigureToResult(FigureToResult);//Result.Add(FigureToResult); end; end else for i := 0 to TConnectorObject(AFigure).JoinedConnectorsList.Count - 1 do begin JoinedConnObject := TConnectorObject(TConnectorObject(AFigure).JoinedConnectorsList.List^[i]); for j := 0 to JoinedConnObject.JoinedOrtholinesList.Count - 1 do begin FigureToResult := TOrthoLine(JoinedConnObject.JoinedOrtholinesList.List^[j]); AddFigureToResult(FigureToResult); //Result.Add(FigureToResult); end; end; end else if AFigure is TOrthoLine then begin // Сторона 1 //ConnObject := TConnectorObject(TOrthoLine(AFigure).JoinConnector1); //ConnRaiseType := ConnObject.FConnRaiseType; //if (ConnRaiseType = crt_BetweenFloorUp) or (ConnRaiseType = crt_BetweenFloorDown) then //begin // ConnectedObjectsFromBetweenFloorConnector := GetConnectedObjectsFromBetweenFloorConnector(ConnObject); // if ConnectedObjectsFromBetweenFloorConnector <> nil then // for i := 0 to ConnectedObjectsFromBetweenFloorConnector.Count - 1 do // begin // FigureToResult := TFigure(ConnectedObjectsFromBetweenFloorConnector.List^[i]); // if FigureToResult is TOrtholine then // Result.Add(FigureToResult); // end; //end //else //begin // for i := 0 to ConnObject.JoinedOrtholinesList.Count - 1 do // begin // JoinedLine := TOrthoLine(ConnObject.JoinedOrtholinesList.List^[i]); // if JoinedLine <> TOrthoLine(AFigure) then // Result.Add(JoinedLine); // end; // for i := 0 to ConnObject.JoinedConnectorsList.Count - 1 do // begin // FigureToResult := TConnectorObject(ConnObject.JoinedConnectorsList.List^[i]); // Result.Add(FigureToResult); // end; //end; // Сторона 2 //ConnObject := TConnectorObject(TOrthoLine(AFigure).JoinConnector2); //ConnRaiseType := ConnObject.FConnRaiseType; //if (ConnRaiseType = crt_BetweenFloorUp) or (ConnRaiseType = crt_BetweenFloorDown) then //begin // ConnectedObjectsFromBetweenFloorConnector := GetConnectedObjectsFromBetweenFloorConnector(ConnObject); // if ConnectedObjectsFromBetweenFloorConnector <> nil then // for i := 0 to ConnectedObjectsFromBetweenFloorConnector.Count - 1 do // begin // FigureToResult := TFigure(ConnectedObjectsFromBetweenFloorConnector.List^[i]); // if FigureToResult is TOrtholine then // Result.Add(FigureToResult); // end; //end //else //begin // for i := 0 to ConnObject.JoinedOrtholinesList.Count - 1 do // begin // JoinedLine := TOrthoLine(ConnObject.JoinedOrtholinesList.List^[i]); // if JoinedLine <> TOrthoLine(AFigure) then // Result.Add(JoinedLine); // end; // for i := 0 to ConnObject.JoinedConnectorsList.Count - 1 do // begin // FigureToResult := TConnectorObject(ConnObject.JoinedConnectorsList.List^[i]); // Result.Add(FigureToResult); // end; //end; GetObjectsFromOrtholineConnector(TConnectorObject(TOrthoLine(AFigure).JoinConnector1)); GetObjectsFromOrtholineConnector(TConnectorObject(TOrthoLine(AFigure).JoinConnector2)); end; end; function GetConnectorsOtherSides(aConnector: TConnectorObject): TList; var JoinedLine: TOrtholine; RaiseConn: TConnectorObject; i: Integer; begin Result := TList.Create; for i := 0 to aConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(aConnector.JoinedOrtholinesList[i]); if JoinedLine.JoinConnector1 <> aConnector then Result.Add(JoinedLine.JoinConnector1); if JoinedLine.JoinConnector2 <> aConnector then Result.Add(JoinedLine.JoinConnector2); end; // трассы через с-п RaiseConn := GetRaiseConn(aConnector); if RaiseConn <> nil then begin for i := 0 to RaiseConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(RaiseConn.JoinedOrtholinesList[i]); if not JoinedLine.FIsRaiseUpDown then begin if JoinedLine.JoinConnector1 <> RaiseConn then Result.Add(JoinedLine.JoinConnector1); if JoinedLine.JoinConnector2 <> RaiseConn then Result.Add(JoinedLine.JoinConnector2); end; end; end; end; function GetEndPointByHouse(aHouse: THouse; aCurrentWA: TConnectorObject): TConnectorObject; var i, j: Integer; Joined: TConnectorObject; AllTrace: TList; begin Result := nil; try for i := 0 to aHouse.fJoined.Count - 1 do begin Joined := TConnectorObject(aHouse.fJoined[i]); AllTrace := GetAllTraceInCAD(Joined, aCurrentWA); if (AllTrace <> nil) and (AllTrace.Count > 0) then begin Result := Joined; exit; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.GetEndPointByHouse', E.Message); end; end; procedure SetLineStatusInfo(aLineParams: PLineFigureParams); var i: integer; vList: TF_CAD; vFigure: TOrthoLine; begin try vList := GetListByID(aLineParams.ListID); if vList <> nil then begin vFigure := TOrthoLine(GetFigureByID(vList, aLineParams.FigureID)); if vFigure = nil then vFigure := TOrthoLine(GetFigureByIDInSCSFigureGroups(vList, aLineParams.FigureID)); if vFigure <> nil then begin vFigure.FCableFullnessSide1 := aLineParams.FullnesCableSide1; vFigure.FCableFullnessSide2 := aLineParams.FullnesCableSide2; vFigure.FCableChannelFullness := aLineParams.ChannelFullness; vFigure.FCableChannelClosedSide1 := aLineParams.ClosedTypeForChannelSide1; vFigure.FCableChannelClosedSide2 := aLineParams.ClosedTypeForChannelSide1; vFigure.FDefectDegree := aLineParams.DefectObjDegree; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.SetLineStatusInfo', E.Message); end; end; procedure SetConnStatusInfo(aConnParams: PConnFigureParams); var i: integer; vList: TF_CAD; vFigure: TConnectorObject; begin try vList := GetListByID(aConnParams.ListID); if vList <> nil then begin vFigure := TConnectorObject(GetFigureByID(vList, aConnParams.FigureID)); if vFigure = nil then vFigure := TConnectorObject(GetFigureByIDInSCSFigureGroups(vList, aConnParams.FigureID)); if vFigure <> nil then begin vFigure.FConnFullness := aConnParams.Fullness; vFigure.FDefectDegree := aConnParams.DefectObjDegree; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.SetConnStatusInfo', E.Message); end; end; procedure LoadSubWithMaster(aFName: string); var Jpeg: TJpegImage; Bmp: TBMPObject; begin try aFName := AnsiLowerCaseFileName(aFName); // подложка if pos('.scb', aFName) <> 0 then begin FSCS_Main.LoadSubstrate(aFName); end else // арх. план if pos('.sca', aFName) <> 0 then begin FSCS_Main.LoadFPlan(aFName); end else // BMP if pos('.bmp', aFName) <> 0 then begin GCadForm.PCad.InsertBitmap(1, 0, 0, aFName, false, false); end else // JPG & JPEG if (pos('.jpg', aFName) <> 0) or (pos('.jpeg', aFName) <> 0) then begin Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, aFName, false, false)); Jpeg := TJpegImage.create; Jpeg.LoadFromFile(aFName); Bmp.Picture.Width := Jpeg.Width; Bmp.Picture.Height := Jpeg.Height; Bmp.Picture.Canvas.Draw(0, 0, Jpeg); //Bmp.Picture.PixelFormat := pf24bit; FreeAndNil(Jpeg); end // один из векторых чертежей else begin LoadDXFFileWithName(GCadForm.PCad, aFName); end; GCadForm.PCad.DeselectAll(0); except on E: Exception do AddExceptionToLogEx('U_Common.LoadSubWithMaster', E.Message); end; end; procedure CreateVerticalOnConnector(aConnector: TConnectorObject; aHeight: Double); var ConnectedConn: TConnectorObject; VertConn: TConnectorObject; VertLine: TOrthoLine; x, y, z: double; i: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ObjParams: TObjectParams; begin BaseBeginUpdate; try x := AConnector.ActualPoints[1].x; y := AConnector.ActualPoints[1].y; z := AConnector.ActualZOrder[1]; // создать подъем-спуск коннектор VertConn := TConnectorObject.Create(x, y, AHeight, AConnector.LayerHandle, mydsNormal, GCadForm.PCad); VertConn.ConnectorType := ct_Clear; // создать вертикаль линия VertLine := TOrthoLine.Create(x, y, AHeight, x, y, z, 1,ord(psSolid), clBlack, 0, AConnector.LayerHandle, mydsNormal, GCadForm.PCad, False); VertLine.SetJConnector1(TConnectorObject(AConnector)); VertLine.SetJConnector2(TConnectorObject(VertConn)); VertLine.ActualZOrder[1] := AConnector.ActualZOrder[1]; VertLine.ActualZOrder[2] := VertConn.ActualZOrder[1]; SetLineFigureCoordZInPM(VertLine.ID, 1, VertLine.ActualZOrder[1]); SetLineFigureCoordZInPM(VertLine.ID, 2, VertLine.ActualZOrder[2]); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), VertConn, False); VertConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(VertConn.ID, VertConn.Name); ObjParams := GetFigureParams(VertConn.ID); VertConn.Name := ObjParams.Name; VertConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(AConnector.LayerHandle), VertLine, False); VertLine.Name := cCadClasses_Mes32; SetNewObjectNameInPM(VertLine.ID, VertLine.Name); ObjParams := GetFigureParams(VertLine.ID); VertLine.Name := ObjParams.Name; VertLine.FIndex := ObjParams.MarkID; VertLine.FIsVertical := True; VertLine.CalculLength := VertLine.LengthCalc; VertLine.LineLength := VertLine.CalculLength; SetLineFigureLengthInPM(VertLine.ID, VertLine.LineLength); VertLine.ReCreateCaptionsGroup(True, false); VertLine.UpdateLengthTextBox(True, false); VertLine.ReCreateNotesGroup(True); VertLine.ShowCaptions := False; VertLine.ShowNotes := False; VertLine.IsShowBlock := False; // *** for i := 0 to VertConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(VertConn.JoinedOrtholinesList[i]); if JoinedLine <> VertLine then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, false); JoinedLine.ReCreateDrawFigureBlock; end; end; VertConn.LockMove := False;//True; VertConn.LockModify := True; VertLine.LockMove := False; VertLine.LockModify := True; SetConnBringToFront(AConnector); SetConnBringToFront(VertConn); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('U_Common.CreateVerticalTrace', E.Message); end; BaseEndUpdate; end; procedure CreateVerticalOnPointObject(aPointObject: TConnectorObject; aHeight: Double); var ConnectedConn: TConnectorObject; VertConn: TConnectorObject; VertLine: TOrthoLine; x, y, z: double; i: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; JoinedConnBase: TConnectorObject; ObjParams: TObjectParams; TempRaisedConnectors: TList; CurIndex: Integer; begin BaseBeginUpdate; try x := APointObject.ActualPoints[1].x; y := APointObject.ActualPoints[1].y; z := APointObject.ActualZOrder[1]; // создать присоединенный коннектор ConnectedConn := TConnectorObject.Create(x, y, z, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), ConnectedConn, False); ConnectedConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); ObjParams := GetFigureParams(ConnectedConn.ID); ConnectedConn.Name := ObjParams.Name; ConnectedConn.FIndex := ObjParams.MarkID; // создать вертикаль коннектор VertConn := TConnectorObject.Create(x + 10, y - 10, AHeight, APointObject.LayerHandle, mydsNormal, GCadForm.PCad); VertConn.ConnectorType := ct_Clear; // создать вертикаль линия VertLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, AHeight, 1,ord(psSolid), clBlack, 0, APointObject.LayerHandle, mydsNormal, GCadForm.PCad, False); VertLine.SetJConnector1(TConnectorObject(ConnectedConn)); VertLine.SetJConnector2(TConnectorObject(VertConn)); VertLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1]; VertLine.ActualZOrder[2] := VertConn.ActualZOrder[1]; SetLineFigureCoordZInPM(VertLine.ID, 1, VertLine.ActualZOrder[1]); SetLineFigureCoordZInPM(VertLine.ID, 2, VertLine.ActualZOrder[2]); // приконнектить подъем SnapConnectorToPointObject(ConnectedConn, APointObject, true); ConnectedConn.MoveConnector(APointObject.ActualPoints[1].x - ConnectedConn.ActualPoints[1].x, APointObject.ActualPoints[1].y - ConnectedConn.ActualPoints[1].y, false, false); VertConn.MoveConnector(-10, 10, False); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), VertConn, False); VertConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(VertConn.ID, VertConn.Name); ObjParams := GetFigureParams(VertConn.ID); VertConn.Name := ObjParams.Name; VertConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(APointObject.LayerHandle), VertLine, False); VertLine.Name := cCadClasses_Mes32; SetNewObjectNameInPM(VertLine.ID, VertLine.Name); ObjParams := GetFigureParams(VertLine.ID); VertLine.Name := ObjParams.Name; VertLine.FIndex := ObjParams.MarkID; VertLine.FIsVertical := True; VertConn.LockMove := False;//True; VertConn.LockModify := True; VertLine.LockMove := False; VertLine.LockModify := True; ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; // переподсоединить трассы к подъему TempRaisedConnectors := TList.Create; for i := 0 to APointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject.JoinedConnectorsList[i]); if JoinedConn <> ConnectedConn then TempRaisedConnectors.Add(JoinedConn); end; // отвязка for i := 0 to TempRaisedConnectors.Count - 1 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); UnsnapConnectorFromPointObject(JoinedConn, APointObject, true); end; // перепривязка к вершине CurIndex := TempRaisedConnectors.Count - 1; // вязать без сортировок for i := CurIndex downto 0 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); SnapConnectorToConnector(JoinedConn, VertConn, true); VertConn := JoinedConn; end; if TempRaisedConnectors <> nil then FreeAndNil(TempRaisedConnectors); VertLine.CalculLength := VertLine.LengthCalc; VertLine.LineLength := VertLine.CalculLength; SetLineFigureLengthInPM(VertLine.ID, VertLine.LineLength); VertLine.ReCreateCaptionsGroup(True, false); VertLine.UpdateLengthTextBox(True, false); VertLine.ReCreateNotesGroup(True); VertLine.ShowCaptions := False; VertLine.ShowNotes := False; VertLine.IsShowBlock := False; // *** for i := 0 to VertConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(VertConn.JoinedOrtholinesList[i]); if JoinedLine <> VertLine then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, false); JoinedLine.ReCreateDrawFigureBlock; end; end; SetConnBringToFront(APointObject); SetConnBringToFront(VertConn); RefreshCAD(GCadForm.PCad); SetNewObjectNameInPM(VertConn.ID, VertConn.Name); except on E: Exception do AddExceptionToLogEx('U_Common.CreateVerticalOnPointObject', E.Message); end; BaseEndUpdate; end; // Tolik // вертикальная линия по двум точкам procedure CreateVerticalOnTwoPointObjects(aPointObject1, APointObject2: TConnectorObject; aHeight: Double); var ConnectedConn: TConnectorObject; VertConn: TConnectorObject; VertLine: TOrthoLine; x, y, z: double; i: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; JoinedConnBase: TConnectorObject; ObjParams: TObjectParams; TempRaisedConnectors: TList; CurIndex: Integer; begin BaseBeginUpdate; try x := APointObject1.ActualPoints[1].x; y := APointObject1.ActualPoints[1].y; z := APointObject1.ActualZOrder[1]; // создать присоединенный коннектор ConnectedConn := TConnectorObject.Create(x, y, z, APointObject1.LayerHandle, mydsNormal, GCadForm.PCad); ConnectedConn.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(APointObject1.LayerHandle), ConnectedConn, False); ConnectedConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnectedConn.ID, ConnectedConn.Name); ObjParams := GetFigureParams(ConnectedConn.ID); ConnectedConn.Name := ObjParams.Name; ConnectedConn.FIndex := ObjParams.MarkID; // создать вертикаль коннектор VertConn := TConnectorObject.Create(x + 10, y - 10, AHeight, APointObject1.LayerHandle, mydsNormal, GCadForm.PCad); VertConn.ConnectorType := ct_Clear; // создать вертикаль линия VertLine := TOrthoLine.Create(x, y, z, x + 10, y - 10, AHeight, 1,ord(psSolid), clBlack, 0, APointObject1.LayerHandle, mydsNormal, GCadForm.PCad, False); VertLine.SetJConnector1(TConnectorObject(ConnectedConn)); VertLine.SetJConnector2(TConnectorObject(VertConn)); VertLine.ActualZOrder[1] := ConnectedConn.ActualZOrder[1]; VertLine.ActualZOrder[2] := VertConn.ActualZOrder[1]; SetLineFigureCoordZInPM(VertLine.ID, 1, VertLine.ActualZOrder[1]); SetLineFigureCoordZInPM(VertLine.ID, 2, VertLine.ActualZOrder[2]); // приконнектить подъем SnapConnectorToPointObject(ConnectedConn, APointObject1, true); ConnectedConn.MoveConnector(APointObject1.ActualPoints[1].x - ConnectedConn.ActualPoints[1].x, APointObject1.ActualPoints[1].y - ConnectedConn.ActualPoints[1].y, false, false); // Tolik SnapConnectorToPointObject(VertConn, APointObject2, true); VertConn.MoveConnector(APointObject2.ActualPoints[1].x - VertConn.ActualPoints[1].x, APointObject2.ActualPoints[1].y - VertConn.ActualPoints[1].y, false, false); // VertConn.MoveConnector(-10, 10, False); // СОЗДАТЬ НА КАД =========================================== GCadForm.PCad.AddCustomFigure (GLN(APointObject1.LayerHandle), VertConn, False); VertConn.Name := cCadClasses_Mes12; SetNewObjectNameInPM(VertConn.ID, VertConn.Name); ObjParams := GetFigureParams(VertConn.ID); VertConn.Name := ObjParams.Name; VertConn.FIndex := ObjParams.MarkID; GCadForm.PCad.AddCustomFigure (GLN(APointObject1.LayerHandle), VertLine, False); VertLine.Name := cCadClasses_Mes32; SetNewObjectNameInPM(VertLine.ID, VertLine.Name); ObjParams := GetFigureParams(VertLine.ID); VertLine.Name := ObjParams.Name; VertLine.FIndex := ObjParams.MarkID; VertLine.FIsVertical := True; VertConn.LockMove := True; VertConn.LockModify := True; VertLine.LockMove := False; VertLine.LockModify := True; ConnectedConn.LockMove := True; ConnectedConn.LockModify := True; { // переподсоединить трассы к подъему TempRaisedConnectors := TList.Create; for i := 0 to APointObject1.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(APointObject1.JoinedConnectorsList[i]); if JoinedConn <> ConnectedConn then TempRaisedConnectors.Add(JoinedConn); end; // отвязка for i := 0 to TempRaisedConnectors.Count - 1 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); UnsnapConnectorFromPointObject(JoinedConn, APointObject1, true); end; // перепривязка к вершине CurIndex := TempRaisedConnectors.Count - 1; // вязать без сортировок for i := CurIndex downto 0 do begin JoinedConn := TConnectorObject(TempRaisedConnectors[i]); SnapConnectorToConnector(JoinedConn, VertConn, true); VertConn := JoinedConn; end; if TempRaisedConnectors <> nil then FreeAndNil(TempRaisedConnectors); } VertLine.CalculLength := VertLine.LengthCalc; VertLine.LineLength := VertLine.CalculLength; SetLineFigureLengthInPM(VertLine.ID, VertLine.LineLength); VertLine.ReCreateCaptionsGroup(True, false); VertLine.UpdateLengthTextBox(True, false); VertLine.ReCreateNotesGroup(True); VertLine.ShowCaptions := False; VertLine.ShowNotes := False; VertLine.IsShowBlock := False; // *** for i := 0 to VertConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(VertConn.JoinedOrtholinesList[i]); if JoinedLine <> VertLine then begin JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, false); JoinedLine.ReCreateDrawFigureBlock; end; end; SetConnBringToFront(APointObject1); SetConnBringToFront(VertConn); RefreshCAD(GCadForm.PCad); SetNewObjectNameInPM(VertConn.ID, VertConn.Name); except on E: Exception do AddExceptionToLogEx('U_Common.CreateVerticalOnPointObject', E.Message); end; BaseEndUpdate; end; function CheckOtherConnectorsOnLevel(aSelf: TConnectorObject; X, Y: Double): TList; var i, j: integer; GetConn: TConnectorObject; GetLine: TOrthoLine; isVertical: Boolean; begin Result := nil; try // IsVertical isVertical := False; if aSelf.JoinedConnectorsList.Count = 0 then begin for i := 0 to aSelf.JoinedOrtholinesList.Count - 1 do begin GetLine := TOrthoLine(aSelf.JoinedOrtholinesList[i]); if GetLine.FIsVertical then begin isVertical := True; Break; end; end; end else begin for i := 0 to aSelf.JoinedConnectorsList.Count - 1 do begin GetConn := TConnectorObject(aSelf.JoinedConnectorsList[i]); for j := 0 to GetConn.JoinedOrtholinesList.Count - 1 do begin GetLine := TOrthoLine(GetConn.JoinedOrtholinesList[j]); if GetLine.FIsVertical then begin isVertical := True; Break; end; end; end; end; if not isVertical then exit; Result := TList.Create; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTConnectorObject) then begin GetConn := TConnectorObject(GCadForm.PCad.Figures[i]); if GetConn <> aSelf then if GetConn.IsPointIn(X, Y) then begin if GetConn.ConnectorType <> ct_Clear then Result.Add(GetConn) else if GetConn.JoinedConnectorsList.Count = 0 then Result.Add(GetConn); end; end; end; except on E: Exception do AddExceptionToLogEx('U_Common.CheckOtherConnectorsOnLevel', E.Message); end; end; procedure SetLiteStatus(aStatus: Boolean); var isPrjOpen: Boolean; begin try GLiteVersion := aStatus; if GLiteVersion then begin FSCS_Main.mainFormat.Visible := False; FSCS_Main.mainTools.Visible := False; FSCS_Main.tbsToolsExpert.Visible := False; //29.12.2011 FSCS_Main.tbLineExpert.Visible := False; FSCS_Main.tbRectangleExpert.Visible := False; FSCS_Main.tbEllipseExpert.Visible := False; FSCS_Main.tbCircleExpert.Visible := False; FSCS_Main.tbArcExpert.Visible := False; FSCS_Main.tbElipticArcExpert.Visible := False; FSCS_Main.tbPolyLineExpert.Visible := False; FSCS_Main.tbPointExpert.Visible := False; FSCS_Main.tbTextExpert.Visible := False; FSCS_Main.tbRichTextExpert.Visible := False; FSCS_Main.tbKnifeExpert.Visible := False; FSCS_Main.tbHDimLineExpert.Visible := False; FSCS_Main.tbVDimLineExpert.Visible := False; //29.03.2012 FSCS_Main.tbWallRectExpert.Visible := False; //29.03.2012 FSCS_Main.tbWallPathExpert.Visible := False; FSCS_Main.tbHouseExpert.Visible := False; //29.03.2012 FSCS_Main.tbWallRectNoob.Visible := False; //29.03.2012 FSCS_Main.tbWallPathNoob.Visible := False; FSCS_Main.tbHouseNoob.Visible := False; FSCS_Main.aMasterAutoTrace.Visible := False; FSCS_Main.aMasterAutoTraceElectric.Visible := False; FSCS_Main.aCreateNormsOnCad.Visible := False; FSCS_Main.aManual_Interfaces.Visible := False; end else begin FSCS_Main.mainFormat.Visible := True; FSCS_Main.mainTools.Visible := True; FSCS_Main.tbsToolsExpert.Visible := True; //29.12.2011 FSCS_Main.tbLineExpert.Visible := True; FSCS_Main.tbRectangleExpert.Visible := True; FSCS_Main.tbEllipseExpert.Visible := True; FSCS_Main.tbCircleExpert.Visible := True; FSCS_Main.tbArcExpert.Visible := True; FSCS_Main.tbElipticArcExpert.Visible := True; FSCS_Main.tbPolyLineExpert.Visible := True; FSCS_Main.tbPointExpert.Visible := True; FSCS_Main.tbTextExpert.Visible := True; FSCS_Main.tbRichTextExpert.Visible := True; FSCS_Main.tbKnifeExpert.Visible := True; FSCS_Main.tbHDimLineExpert.Visible := True; FSCS_Main.tbVDimLineExpert.Visible := True; //29.03.2012 FSCS_Main.tbWallRectExpert.Visible := True; //29.03.2012 FSCS_Main.tbWallPathExpert.Visible := True; FSCS_Main.tbHouseExpert.Visible := True; //29.03.2012 FSCS_Main.tbWallRectNoob.Visible := True; //29.03.2012 FSCS_Main.tbWallPathNoob.Visible := True; FSCS_Main.tbHouseNoob.Visible := True; FSCS_Main.aMasterAutoTrace.Visible := True; FSCS_Main.aMasterAutoTraceElectric.Visible := True; FSCS_Main.aCreateNormsOnCad.Visible := True; FSCS_Main.aManual_Interfaces.Visible := True; end; isPrjOpen := CheckIsOpenProject(false); if FSCS_Main.Visible then //16.08.2012 - если только запуск программы, то нефиг вызывать одно и тоже несколько раз FSCS_Main.SetMenuStatus(isPrjOpen); except on E: Exception do AddExceptionToLogEx('U_Common.SetLiteStatus', E.Message); end; end; function CheckJoinVertical(aObject: TConnectorObject): Boolean; var i, j: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; begin Result := false; try if aObject.ConnectorType = ct_clear then begin for i := 0 to aObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(aObject.JoinedOrtholinesList[i]); if JoinedLine.FIsVertical then begin Result := True; Break; end; end; end else begin for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if JoinedLine.FIsVertical then begin Result := True; Break; end; end; if Result then //#From Oleg# //15.09.2010 Break; //// BREAK //// end; end; except on E: Exception do AddExceptionToLogEx('U_Common.CheckJoinVertical', E.Message); end; end; procedure PutObjectOnHeight(aObject: TConnectorObject; aHeight: Double); var i, j: integer; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; begin try AObject.ActualZOrder[1] := aHeight; if aObject.ConnectorType = ct_Clear then begin for i := 0 to aObject.JoinedOrtholinesList.Count - 1 do begin JoinedLine := aObject.JoinedOrtholinesList[i]; if JoinedLine.JoinConnector1 = aObject then begin SetLineFigureCoordZInPM(JoinedLine.ID, 1, aObject.ActualZOrder[1]); JoinedLine.ActualZOrder[1] := aObject.ActualZOrder[1]; end; if JoinedLine.JoinConnector2 = aObject then begin SetLineFigureCoordZInPM(JoinedLine.ID, 2, aObject.ActualZOrder[1]); JoinedLine.ActualZOrder[2] := aObject.ActualZOrder[1]; end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, true); JoinedLine.ReCreateNotesGroup(True); end; end else begin // установить новые значения for i := 0 to aObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := aObject.JoinedConnectorsList[i]; JoinedConn.ActualZOrder[1] := aObject.ActualZOrder[1]; for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := JoinedConn.JoinedOrtholinesList[j]; if JoinedLine.JoinConnector1 = JoinedConn then begin SetLineFigureCoordZInPM(JoinedLine.ID, 1, aObject.ActualZOrder[1]); JoinedLine.ActualZOrder[1] := aObject.ActualZOrder[1]; end; if JoinedLine.JoinConnector2 = JoinedConn then begin SetLineFigureCoordZInPM(JoinedLine.ID, 2, aObject.ActualZOrder[1]); JoinedLine.ActualZOrder[2] := aObject.ActualZOrder[1]; end; JoinedLine.CalculLength := JoinedLine.LengthCalc; JoinedLine.LineLength := JoinedLine.CalculLength; SetLineFigureLengthInPM(JoinedLine.ID, JoinedLine.LineLength); JoinedLine.UpdateLengthTextBox(True, true); JoinedLine.ReCreateNotesGroup(True); end; SetConFigureCoordZInPM(JoinedConn.ID, JoinedConn.ActualZOrder[1]); end; end; SetConFigureCoordZInPM(aObject.ID, aHeight); except on E: Exception do AddExceptionToLogEx('U_Common.PutObjectOnHeight', E.Message); end; end; function GetJoinedVerticalObjects(AObject: TFigure; AOnlyConnectorCoordZ: PDouble=nil): TList; var FiguresToFind: TList; NextFiguresToFind: TList; LookedFigures: TList; ConnectedFigures: TList; i: Integer; Figure: TFigure; procedure AddFigureToRes(AFigureToRes: TFigure); begin if (AOnlyConnectorCoordZ = nil) or ((AFigureToRes is TConnectorObject) and (TConnectorObject(AFigureToRes).ActualZOrder[1] = AOnlyConnectorCoordZ^)) then Result.Add(AFigureToRes); end; begin Result := TList.Create; FiguresToFind := TList.Create; NextFiguresToFind := TList.Create; LookedFigures := TList.Create; FiguresToFind.Add(AObject); while FiguresToFind.Count > 0 do begin for i := 0 to FiguresToFind.Count - 1 do begin Figure := TFigure(FiguresToFind[i]); // Если коннектор, или вертикальная трасса if (Figure is TConnectorObject) or ((Figure is TOrthoLine) and (TOrthoLine(Figure).FIsVertical)) then begin AddFigureToRes(Figure); //Result.Add(Figure); // ищем подключенные объекты ConnectedFigures := GetConnectedFigures(Figure, true, LookedFigures); NextFiguresToFind.Assign(ConnectedFigures, laOr); ConnectedFigures.Free; end; LookedFigures.Add(Figure); end; // Следующий набор объектов для поиска FiguresToFind.Assign(NextFiguresToFind, laCopy); NextFiguresToFind.Clear; end; NextFiguresToFind.Free; LookedFigures.Free; FiguresToFind.Free; end; function GetJoinedVerticalConnectorByCoordZ(AStartConnector: TConnectorObject; ACoordZ: Double): TConnectorObject; var Connectors: TList; begin Result := nil; Connectors := GetJoinedVerticalObjects(AStartConnector, @ACoordZ); if Connectors.Count > 0 then if (TObject(Connectors[0]) is TConnectorObject) then Result := TConnectorObject(Connectors[0]); Connectors.Free; end; function GetCADLayerNumByComponIsLine(AIsLine: Integer): Integer; begin Result := lnSCSCommon; if IsArchComponByIsLine(AIsLine) then Result := lnArch; end; procedure DefineCurrLayerByCompon; var Compon: TSCSComponent; begin if (GCadForm <> nil) and (GCadForm.FCreateObjectOnClick = true) then begin Compon := F_NormBase.GetActualSelectedComponent; if Compon <> nil then begin GCadForm.CurrentLayer := GetCADLayerNumByComponIsLine(Compon.IsLine); end; end; end; procedure DropCreateObjectOnClickMode; begin if (GCadForm.FCreateObjectOnClick) then FSCS_Main.aToolSelect.Execute; end; procedure BlockToNormalSize(ABlock: TBlock; AMaxSideSize: Integer); var Bnd: TDoubleRect; w, h: double; PixelsPerMm: Double; PxCount: Double; ZoomOut: Double; CurrMaxSideSize: Double; begin Bnd := ABlock.GetBoundRect; w := abs(Bnd.Right - Bnd.Left); h := abs(Bnd.Bottom - Bnd.Top); // Переводим мм в пиксели w := w * GCadForm.PCad.DotsPerMilOrig; h := h * GCadForm.PCad.DotsPerMilOrig; ////ABlock.ow // // перевести в мм // w := w * GCadForm.PCad.MapScale; // h := h * GCadForm.PCad.MapScale; // // // Переводим мм в пиксели // // PixelsPerInch / 25,4 - количество точек в 1 мм // PixelsPerMm := (GCadForm.PixelsPerInch / 25.4); // w := w * PixelsPerMm; // h := h * PixelsPerMm; // Определяем макс. кол-во пикселей, выходящее за границы CurrMaxSideSize := h; PxCount := h - AMaxSideSize; if PxCount < (w - AMaxSideSize) then begin CurrMaxSideSize := w; PxCount := w - AMaxSideSize; end; if PxCount > 0 then begin // Определяем коэфф. в сколько раз нужно уменьшить ZoomOut := (CurrMaxSideSize - PxCount) / CurrMaxSideSize; //StretchBitmap(ABitmap, Round(ABitmap.Height/ZoomOut), Round(ABitmap.Width/ZoomOut)); ABlock.Scale(ZoomOut, ZoomOut, ABlock.ap1); end; end; procedure Remove3DModelStream; var fFileName: string; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; begin try //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); //08.09.2011 fFileName := TempPath + '3dmodel.pwd'; fFileName := GetAnsiTempPath + '3dmodel.pwd'; DeleteFile(fFileName); except on E: Exception do AddExceptionToLogEx('U_Common.Remove3DModelStream', E.Message); end; end; function CreateTraceByPoints(APCAD: TPowerCad; AP1, AP2: TDoublePoint; aPosTraceBetweenPM: boolean = false; aH1: double = 0; aH2: double = 0): TOrtholine; var LHandle: Integer; LineHeight: Double; Conn1, Conn2: TConnectorObject; function AddConnector(APoint: PDoublePoint): TConnectorObject; begin Result := TConnectorObject.Create(APoint^.x, APoint^.y, LineHeight, LHandle, mydsNormal, APCAD); Result.ConnectorType := ct_Clear; APCAD.AddCustomFigure(GLN(LHandle), Result, false); //SnapConnectorToOrtholine(Result, Result); SetConnBringToFront(Result); end; begin LHandle := APCAD.GetLayerHandle(lnSCSCommon); LineHeight := TF_CAD(APCAD.Parent).FLineHeight; if aPosTraceBetweenPM then Result := TOrthoLine.Create(AP1.x, AP1.y, aH1, AP2.x, AP2.y, aH2, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, APCAD) else Result := TOrthoLine.Create(AP1.x, AP1.y, LineHeight, AP2.x, AP2.y, LineHeight, 1, ord(psSolid), clBlack, 0, LHandle, mydsNormal, APCAD); APCAD.AddCustomFigure(GLN(LHandle), Result, false); APCAD.OrderFigureToFront(TOrtholine(Result).CaptionsGroup); Result.SetJConnector1(AddConnector(@AP1)); Result.SetJConnector2(AddConnector(@AP2)); end; function CreateTraceByConnectors(aCAD: TF_CAD; aConn1, aConn2: TConnectorObject; aOrthogonally: Boolean=false; aTraceBetweenPM: Boolean = False): TOrtholine; var ConnIH, ConnH: Double; SelectedList: TList; //MiddlePt: TDoublePoint; MiddleConn: TConnectorObject; Conn1Pt, Conn2Pt: TDoublePoint; begin ConnIH := -100000; ConnH := -100000; if (aConn1.ConnectorType <> ct_Clear) then ConnIH := aConn1.ActualZOrder[1]; if (aConn2.ConnectorType <> ct_Clear) then ConnH := aConn2.ActualZOrder[1]; {if aOrthogonally then begin aOrthogonally := false; // Проверка нужно ли создать ортогональную линию if Not CmpFloatByCP(aConn1.ActualPoints[1].x, aConn2.ActualPoints[1].x) then begin MiddlePt.x := aConn1.ActualPoints[1].x; MiddlePt.y := aConn2.ActualPoints[1].y; aOrthogonally := true; DefinedMiddleX := true; end else if Not CmpFloatByCP(aConn1.ActualPoints[1].y, aConn2.ActualPoints[1].y) then begin MiddlePt.y := aConn1.ActualPoints[1].y; MiddlePt.x := aConn2.ActualPoints[1].x; aOrthogonally := true; end; end;} //if aOrthogonally then //begin // Conn1Pt := aConn1.ActualPoints[1]; // Conn2Pt := aConn2.ActualPoints[1]; //end; if ((ConnIH = -100000) or (ConnH = -100000)) then Result := CreateTraceByPoints(aCAD.PCad, aConn1.ActualPoints[1], aConn2.ActualPoints[1], False) else Result := CreateTraceByPoints(aCAD.PCad, aConn1.ActualPoints[1], aConn2.ActualPoints[1], True, ConnIH, ConnH); if aConn1.ConnectorType = ct_Clear then SnapConnectorToConnector(TConnectorObject(Result.JoinConnector1), aConn1) else SnapConnectorToPointObject(TConnectorObject(Result.JoinConnector1), aConn1, False, aTraceBetweenPM); if aConn2.ConnectorType = ct_Clear then SnapConnectorToConnector(TConnectorObject(Result.JoinConnector2), aConn2) else SnapConnectorToPointObject(TConnectorObject(Result.JoinConnector2), aConn2, False, aTraceBetweenPM); // NEW FROM OLEG: //06.08.2013 - востановление соединителя после снепа // Олег че то закоментил по итогу {if TConnectorObject(Result.JoinConnector1).JoinedConnectorsList.Count > 0 then if aConn1 <> TConnectorObject(Result.JoinConnector1).JoinedConnectorsList[0] then aConn1 := TConnectorObject(Result.JoinConnector1).JoinedConnectorsList[0]; if TConnectorObject(Result.JoinConnector2).JoinedConnectorsList.Count > 0 then if aConn2 <> TConnectorObject(Result.JoinConnector2).JoinedConnectorsList[0] then aConn2 := TConnectorObject(Result.JoinConnector2).JoinedConnectorsList[0];} //////////// восстановить высоты ИМЕННО объектов к которым прицепили трассу (* Иногда АВ-хи скрытые дает по первому принципу автосоздания трасс *) (* оставим пока так *) //LAST VER - Иногда глючит if Not FileExists(ExeDir + '\NoCorrectZ.ini') then begin // RefreshCAD(GCadForm.PCad); // SetProjectChanged(True); try if (ConnIH <> -100000) and (assigned(aConn1)) then // check //if aConn1.ClassName = 'TConnectorObject' then begin if aConn1.ActualZOrder[1] <> ConnIH then begin ChangeObjZ(aConn1, ConnIH); end; end; except end; try if (ConnH <> -100000) and (assigned(aConn2)) then // check //if aConn2.ClassName = 'TConnectorObject' then begin if aConn2.ActualZOrder[1] <> ConnH then begin ChangeObjZ(aConn2, ConnH); end; end; except end; end; (* пробуем так *) (* так хреново - создает лишние с/п если к примеру уже был с/п if Result.JoinConnector1 <> nil then if TConnectorObject(Result.JoinConnector1).ActualZOrder[1] <> ConnIH then ChangeObjZ(TConnectorObject(Result.JoinConnector1), ConnIH); if Result.JoinConnector2 <> nil then if TConnectorObject(Result.JoinConnector2).ActualZOrder[1] <> ConnH then ChangeObjZ(TConnectorObject(Result.JoinConnector2), ConnH); *) {if (aConn1.ConnectorType <> ct_Clear) and (aConn2.ConnectorType <> ct_Clear) then begin if aConn1.ActualZOrder[1] <> ConnIH then ChangeObjZ(aConn1, ConnIH); if aConn2.ActualZOrder[1] <> ConnH then ChangeObjZ(aConn2, ConnH); end;} //Tolik if ((not aTraceBetweenPM) or (ConnIH = -100000) or (ConnH = -100000))then begin // if (aCAD.FLineHeight <> Result.ActualZOrder[1]) or (aCAD.FLineHeight <> Result.ActualZOrder[2]) then begin SelectedList := TList.Create; SelectedList.Add(Result); RaiseLineOnHeight(Result, aCAD.FLineHeight, SelectedList); SetProjectChanged(True); SelectedList.Free; end; end; if aOrthogonally then begin // При автосоздании м-э чаще aConn1=Шк, aConn2=Соед. из м-э Conn1Pt := Result.JoinConnector1.Ap1; Conn2Pt := Result.JoinConnector2.Ap1; if Not CmpFloatByCP(Conn1Pt.x, Conn2Pt.x) and Not CmpFloatByCP(Conn1Pt.y, Conn2Pt.y) then begin MiddleConn := DivideLineSimple(Result); if MiddleConn <> nil then begin //MiddleConn.Move(Conn2Pt.x-MiddleConn.ActualPoints[1].x, Conn1Pt.y-MiddleConn.ActualPoints[1].y); MiddleConn.Move(Conn1Pt.x-MiddleConn.ActualPoints[1].x, Conn2Pt.y-MiddleConn.ActualPoints[1].y); end; end; end; end; function DivTraceOnPt(ATrace: TOrtholine; APt: TDoublePoint; ATraceList: TList): TConnectorObject; var i: Integer; NewConn: TConnectorObject; begin Result := nil; //29.07.2013 if Not (PointNear(ATrace.ActualPoints[1], APt) or PointNear(ATrace.ActualPoints[2], APt)) then if Not (PointNear(ATrace.ActualPoints[1], APt, 0.3) or PointNear(ATrace.ActualPoints[2], APt, 0.3)) then //if Not (EQDP(ATrace.ActualPoints[1], APt) or EQDP(ATrace.ActualPoints[2], APt)) then begin NewConn := DivideLineSimple(ATrace, @APt); if ATraceList <> nil then for i := 0 to NewConn.JoinedOrtholinesList.Count - 1 do begin if TOrtholine(NewConn.JoinedOrtholinesList[i]) <> ATrace then ATraceList.Add(TOrtholine(NewConn.JoinedOrtholinesList[i])); end; Result := NewConn; end; end; function GetMinConnector(AConn1, AConn2: TConnectorObject): TConnectorObject; var dist1, dist2: Double; begin Result := AConn1; dist1 := GetLineLenght(AConn1.ActualPoints[1], DoublePoint(0,0)); dist2 := GetLineLenght(AConn2.ActualPoints[1], DoublePoint(0,0)); if dist2 < dist1 then Result := AConn2; end; procedure ChangeObjZ(aObject: TConnectorObject; aZ: Double); var i, j: integer; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ObjFromRaise: TConnectorObject; ZCoord: Double; mess: string; begin try ZCoord := aZ; // Соединитель ----------------------------------------------------- if aObject.ConnectorType = ct_Clear then begin // Он не с-п и на нем нет с-п if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then CreateRaiseOnConnector(aObject, ZCoord) else // на нем есть с-п if GetRaiseConn(aObject) <> nil then begin ChangeRaiseOnConnector(aObject, ZCoord); // SP !!! // CheckDeleteAllRaises(GCadForm.PCad); end else // это с-п if (aObject.FConnRaiseType = crt_OnFloor) then begin ObjFromRaise := aObject.FObjectFromRaise; if ZCoord = ObjFromRaise.ActualZOrder[1] then begin mess := cSCSObjectProp_Mes1; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012 end; end else begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012 end; end end else // Объект ---------------------------------------------------------- begin // Он не с-п и на нем нет с-п if (aObject.FConnRaiseType = crt_None) and (GetRaiseConn(aObject) = nil) then begin if aObject.JoinedConnectorsList.Count = 0 then begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, ZCoord); end else CreateRaiseOnPointObject(aObject, ZCoord); end else // на нем есть с-п if GetRaiseConn(aObject) <> nil then begin // только подъем-спуск begin if aObject.JoinedConnectorsList.Count = 0 then begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, ZCoord); end else begin ChangeRaiseOnPointObject(aObject, ZCoord); // SP !!! // CheckDeleteAllRaises(GCadForm.PCad); end; end; end else // это с-п if (aObject.FConnRaiseType = crt_OnFloor) then begin ObjFromRaise := aObject.FObjectFromRaise; if ZCoord = ObjFromRaise.ActualZOrder[1] then begin mess := cSCSObjectProp_Mes1; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012 end; end else begin aObject.ActualZOrder[1] := ZCoord; SetConFigureCoordZInPM(aObject.ID, aObject.ActualZOrder[1]);//24.10.2012 end; end; end; except on E: Exception do AddExceptionToLogEx('TF_ConnectorProperties.ChangeConnZ', E.Message); end; end; function AutoCreateTraces(aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer; var CAD: TF_CAD; Figures: TList; FFigure: TFigure; //ConnI, ConnJ, Conn: TConnectorObject; Conn, ConnTmp: TConnectorObject; Conn1, Conn2: TConnectorObject; //24.06.2013 ConnIH, ConnH: Double; i, j, k: Integer; Traces: TList; Trace: TOrtholine; CanWhile: Boolean; ConnectorsCount: Integer; TraceExsistFromTo: TStringList; idFrom, idTo: string; TestConn: TConnectorObject; NoNearObjectList: TIntList; ProgressCount: integer; //24.06.2013 SelectedList: TList; function FindNearObject(AObj: TConnectorObject): TConnectorObject; var CurrConDist, ConnDist: Double; Conn: TConnectorObject; j: Integer; begin Result := nil; ConnDist := 0; // Ищем самый ближний т.о. for j := 0 to Figures.Count - 1 do begin Conn := TConnectorObject(Figures[j]); if Conn <> AObj then begin CurrConDist := GetLineLenght(Conn.ActualPoints[1], AObj.ActualPoints[1]); if (CurrConDist > 0) and ((ConnDist = 0) or (CurrConDist < ConnDist)) then begin //if Conn.Handle > AObj.Handle then //begin // idFrom := inttostr(AObj.Handle); // idTo := inttostr(Conn.Handle); //end //else //begin // idFrom := inttostr(Conn.Handle); // idTo := inttostr(AObj.Handle); //end; //if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) = -1 then begin Traces := GetAllTraceInCAD(Conn, AObj); // Если нету подключения трассами if Traces = nil then begin Result := Conn; ConnDist := CurrConDist; end else begin //TraceExsistFromTo.Values[idFrom + '_to_' + idTo] := '1'; //TraceExsistFromTo.Add(idFrom + '_to_' + idTo); end; FreeAndNil(Traces); end; end; end; end; end; function FiguresCompare(Item1, Item2: Pointer): Integer; var dist1, dist2: Double; begin dist1 := GetLineLenght(TConnectorObject(Item1).ActualPoints[1], DoublePoint(0,0)); dist2 := GetLineLenght(TConnectorObject(Item2).ActualPoints[1], DoublePoint(0,0)); Result := 0; if dist1 < dist2 then Result := -1 else if dist1 > dist2 then Result := 1; end; begin Result := 0; CAD := GCadForm; if Not aSimulate then begin CAD.SaveForUndo(uat_None, true, False); BeginProgress; end; try {//29.07.2013 Figures := TList.Create; // Формируем список точ. объектов for i := 0 to CAD.PCad.FigureCount - 1 do begin FFigure := TFigure(CAD.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin Conn := TConnectorObject(FFigure); if (Conn.ConnectorType = ct_NB) and (Conn.FTrunkName = '') then begin if Conn.Selected or (aSimulate and aSimulateForAllObj) then Figures.Add(FFigure); end; end; end;} Figures := GetConnFiguresForAutoCreateTraces(CAD, aSimulate, aSimulateForAllObj, aSimulateForAnyTrace); Figures.Sort(@FiguresCompare); finally if Not aSimulate then EndProgress; end; try if Figures.Count > 0 then begin TraceExsistFromTo := TStringList.Create; NoNearObjectList := TIntList.Create; if Not aSimulate then BeginProgress('', Figures.Count); ProgressCount := Figures.Count; try i := 0; while i < Figures.Count do begin Conn := TConnectorObject(Figures[i]); ConnectorsCount := 0; CanWhile := true; while CanWhile do begin Conn1 := Conn; //if NoNearObjectList.IndexOf(Conn.Handle) = -1 then //begin Conn2 := FindNearObject(Conn); // if Conn2 = nil then // NoNearObjectList.Add(Conn.Handle); //end //else // Conn2 := nil; if Conn2 <> nil then begin // Если у найденного ближнего объекта есть более ближний объект, то ничего не соединяем //if NoNearObjectList.IndexOf(Conn2.Handle) = -1 then //begin ConnTmp := FindNearObject(Conn2); // if (ConnTmp = nil) then // NoNearObjectList.Add(Conn2.Handle); //end //else // ConnTmp := nil; //if (ConnTmp <> nil) and (ConnTmp <> Conn2) then if (ConnTmp <> nil) and (ConnTmp <> Conn2) and (ConnTmp <> Conn1) then if GetLineLenght(Conn2.ActualPoints[1], ConnTmp.ActualPoints[1]) < GetLineLenght(Conn2.ActualPoints[1], Conn1.ActualPoints[1]) then begin Conn2 := nil; //Conn1 := ConnTmp; // Перемещаем объект Conn в конец списка Figures.Delete(i); Figures.Add(Conn); i := i - 1; Break; //// BREAK //// end; end; if Conn2 <> nil then begin Result := Result + 1; if Not aSimulate then begin {//24.06.2013 - moved to CreateTraceByConnectors ConnIH := Conn1.ActualZOrder[1]; ConnH := Conn2.ActualZOrder[1]; Trace := CreateTraceByPoints(CAD.PCad, Conn1.ActualPoints[1], Conn2.ActualPoints[1]); SnapConnectorToPointObject(TConnectorObject(Trace.JoinConnector1), Conn1); SnapConnectorToPointObject(TConnectorObject(Trace.JoinConnector2), Conn2); // 19.06.2013 IGOR // так кривовато //if CAD.FLineHeight <> ConnIH then // CreateRaiseOnPointObject(Conn1, CAD.FLineHeight, TConnectorObject(Trace.JoinConnector1)); //if CAD.FLineHeight <> ConnH then // CreateRaiseOnPointObject(Conn2, CAD.FLineHeight, TConnectorObject(Trace.JoinConnector2)); // 19.06.2013 IGOR // Лучше сделаем так if Conn1.ActualZOrder[1] <> ConnIH then ChangeObjZ(Conn1, ConnIH); if Conn2.ActualZOrder[1] <> ConnH then ChangeObjZ(Conn2, ConnH); if (CAD.FLineHeight <> Trace.ActualZOrder[1]) or (CAD.FLineHeight <> Trace.ActualZOrder[2]) then begin SelectedList := TList.Create; SelectedList.Add(Trace); RaiseLineOnHeight(Trace, CAD.FLineHeight, SelectedList); SetProjectChanged(True); SelectedList.Free; end; // 19.06.2013 IGOR} Trace := CreateTraceByConnectors(CAD, Conn1, Conn2); //24.06.2013 ConnectorsCount := ConnectorsCount + 1; { if Conn1.Handle > Conn2.Handle then begin idFrom := inttostr(Conn2.Handle); idTo := inttostr(Conn1.Handle); end else begin idFrom := inttostr(Conn1.Handle); idTo := inttostr(Conn2.Handle); end; if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) = -1 then TraceExsistFromTo.Add(idFrom + '_to_' + idTo); //Добавить все имеющиеся подключения с обеих коннекторов... for k := 0 to Figures.Count - 1 do begin TestConn := TConnectorObject(Figures[k]); // найти в списке другие подключения от коннектора Conn2 if TestConn <> Conn2 then begin if TestConn.Handle > Conn2.Handle then begin idFrom := inttostr(Conn2.Handle); idTo := inttostr(TestConn.Handle); end else begin idFrom := inttostr(TestConn.Handle); idTo := inttostr(Conn2.Handle); end; if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) <> -1 then begin if TestConn.Handle > Conn1.Handle then begin idFrom := inttostr(Conn1.Handle); idTo := inttostr(TestConn.Handle); end else begin idFrom := inttostr(TestConn.Handle); idTo := inttostr(Conn1.Handle); end; if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) = -1 then TraceExsistFromTo.Add(idFrom + '_to_' + idTo); end; end; // найти в списке другие подключения от коннектора Conn1 if TestConn <> Conn1 then begin if TestConn.Handle > Conn1.Handle then begin idFrom := inttostr(Conn1.Handle); idTo := inttostr(TestConn.Handle); end else begin idFrom := inttostr(TestConn.Handle); idTo := inttostr(Conn1.Handle); end; if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) <> -1 then begin if TestConn.Handle > Conn2.Handle then begin idFrom := inttostr(Conn2.Handle); idTo := inttostr(TestConn.Handle); end else begin idFrom := inttostr(TestConn.Handle); idTo := inttostr(Conn2.Handle); end; if TraceExsistFromTo.IndexOf(idFrom + '_to_' + idTo) = -1 then TraceExsistFromTo.Add(idFrom + '_to_' + idTo); end; end; end; } end else begin if aSimulateForAnyTrace then Exit ///// EXIT ///// else begin Figures.Delete(i); Figures.Add(Conn); i := i - 1; Break; //// BREAK //// end; end; end else begin Application.ProcessMessages; CanWhile := false; if Not aSimulate then begin if (i mod 2) = 0 then begin Dec(ProgressCount); if ProgressCount > 0 then StepProgress; end; end; end; end; if ConnectorsCount > 0 then if Not aSimulate then begin Dec(ProgressCount); if ProgressCount > 0 then StepProgress; end; i := i + 1; end; finally if Not aSimulate then EndProgress; end; FreeAndNil(TraceExsistFromTo); FreeAndNil(NoNearObjectList); end; finally Figures.Free; end; end; function AutoCreateTracesParallel(aSrcFigure: TFigure; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer; var CAD: TF_CAD; Figures: TList; FFigure: TFigure; Conn: TConnectorObject; i: Integer; Trace: TOrtholine; function FiguresCompare(Item1, Item2: Pointer): Integer; var dist1, dist2: Double; begin dist1 := GetLineLenght(TConnectorObject(Item1).ActualPoints[1], DoublePoint(0,0)); dist2 := GetLineLenght(TConnectorObject(Item2).ActualPoints[1], DoublePoint(0,0)); Result := 0; if dist1 < dist2 then Result := -1 else if dist1 > dist2 then Result := 1; end; begin Result := 0; if aSrcFigure <> nil then if CheckFigureByClassName(aSrcFigure, cTConnectorObject) then begin CAD := GCadForm; if Not aSimulate then begin CAD.SaveForUndo(uat_None, true, False); BeginProgress; end; try Figures := TList.Create; // Формируем список точ. объектов for i := 0 to CAD.PCad.FigureCount - 1 do begin FFigure := TFigure(CAD.PCad.Figures[i]); if (FFigure <> aSrcFigure) and CheckFigureByClassName(FFigure, cTConnectorObject) then begin Conn := TConnectorObject(FFigure); if (Conn.ConnectorType = ct_NB) and (Conn.FTrunkName = '') then begin if Conn.Selected or (aSimulate and aSimulateForAllObj) then Figures.Add(FFigure); end; end; end; Figures.Sort(@FiguresCompare); finally if Not aSimulate then EndProgress; end; if Figures.Count > 0 then begin if Not aSimulate then BeginProgress('', Figures.Count); try for i := 0 to Figures.Count - 1 do begin Conn := TConnectorObject(Figures[i]); Trace := CreateTraceByConnectors(CAD, TConnectorObject(aSrcFigure), Conn); if Trace <> nil then Inc(Result); StepProgress; end; finally Figures.Free; if Not aSimulate then EndProgress; end; end; end; end; function AutoCreateTracesToTraceList(aTraces: TList; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): Integer; const ptDelta = 0.3; var TraceList: TList; CAD: TF_CAD; ConnFigures: TList; Conn1, Conn2: TConnectorObject; i: Integer; IsOrthoTrace: Boolean; function IsNearPt(aPt1, aPt2: TDoublePoint; var aNearDist, aCurrDist: Double): Boolean; begin Result := false; aCurrDist := GetLineLenght(aPt1, aPt2); if (aCurrDist > 0) and ((aNearDist = 0) or (aCurrDist < aNearDist)) then begin aNearDist := aCurrDist; Result := true; end; end; function FindNearObject(AObj: TConnectorObject): TConnectorObject; var CurrConDist, ConnDist: Double; CrossPtTrace: TOrtholine; CrossPt, CurrCrossPt: TDoublePoint; Trace: TOrtholine; NewTraces: TList; //Conn: TConnectorObject; i: Integer; begin Result := nil; ConnDist := 0; CrossPtTrace := nil; // Ищем самую ближнюю часть трассы i := 0; while i < TraceList.Count do begin Trace := TOrtholine(TraceList[i]); if Trace.JoinConnector1 <> nil then if IsNearPt(Trace.JoinConnector1.ActualPoints[1], AObj.ActualPoints[1], ConnDist, CurrConDist) then begin Result := TConnectorObject(Trace.JoinConnector1); CrossPtTrace := nil; end; if Trace.JoinConnector2 <> nil then if IsNearPt(Trace.JoinConnector2.ActualPoints[1], AObj.ActualPoints[1], ConnDist, CurrConDist) then begin Result := TConnectorObject(Trace.JoinConnector2); CrossPtTrace := nil; end; CurrCrossPt := AObj.ActualPoints[1]; PointToLineByAngle(Trace.ActualPoints[1], Trace.ActualPoints[2], CurrCrossPt); // Если точка пересечения не рядом, тогда расматриваем ее для создания трассы if isPointinLine(Trace.ActualPoints[1], Trace.ActualPoints[2], CurrCrossPt, 0, 0.1) then if (GetLineLength(Trace.ActualPoints[1], CurrCrossPt) >= ptDelta) and (GetLineLength(Trace.ActualPoints[2], CurrCrossPt) >= ptDelta) then if IsNearPt(CurrCrossPt, AObj.ActualPoints[1], ConnDist, CurrConDist) then begin Result := nil; CrossPtTrace := Trace; CrossPt := CurrCrossPt; end; Inc(i); end; if (Result = nil) and (CrossPtTrace <> nil) then begin NewTraces := TList.Create; Result := DivTraceOnPt(CrossPtTrace, CrossPt, NewTraces); TraceList.Assign(NewTraces, laOr); NewTraces.Free; end; end; begin //Tolik Result := 0; // TraceList := TList.Create; TraceList.Assign(aTraces); CAD := GCadForm; if Not aSimulate then begin CAD.SaveForUndo(uat_None, true, False); BeginProgress; end; try ConnFigures := GetConnFiguresForAutoCreateTraces(CAD, aSimulate, aSimulateForAllObj, aSimulateForAnyTrace); finally if Not aSimulate then EndProgress; end; if ConnFigures.Count > 0 then begin if Not aSimulate then BeginProgress('', ConnFigures.Count); try for i := 0 to ConnFigures.Count - 1 do begin Conn1 := TConnectorObject(ConnFigures[i]); Conn2 := FindNearObject(Conn1); if Conn2 <> nil then begin Result := Result + 1; if Not aSimulate then begin //Trace := CreateTraceByConnectors(CAD, Conn1, Conn2); IsOrthoTrace := (Abs(Conn1.ActualPoints[1].x - Conn2.ActualPoints[1].x) > ptDelta) and (Abs(Conn1.ActualPoints[1].y - Conn2.ActualPoints[1].y) > ptDelta); CreateTraceByConnectors(CAD, Conn1, Conn2, IsOrthoTrace); end else begin if aSimulateForAnyTrace then Break; //// BREAK //// end; end; if Not aSimulate then StepProgress; end; finally if Not aSimulate then EndProgress; end; end; ConnFigures.Free; TraceList.Free; end; function AutoCreateTracesMaster(aSrcFigure: TFigure): Boolean; var Values: TStringList; ValIdx: Integer; viToMain: Integer; viParallel: Integer; viTree: Integer; Traces: TList; aDisableItem1: boolean; begin Result := false; Traces := GetAllNoConnectedTraces(GCadForm); Values := TStringList.Create; viToMain := -1; aDisableItem1 := True; if Traces.Count > 0 then begin //viToMain := Values.Add(cCommon_Mes27_4); // Прокладка трасс к магистрали (основной трассе) aDisableItem1 := False; end; viToMain := Values.Add(cCommon_Mes27_4); // Прокладка трасс к магистрали (основной трассе) viParallel := Values.Add(cCommon_Mes27_3); // прокладка по типу звезда (параллельная) viTree := Values.Add(cCommon_Mes27_2); // обычная прокладка PauseProgressByMode(true); try ValIdx := InputRadio(ApplicationName, cCommon_Mes27_1, nil{Values}, 0, aDisableItem1); finally PauseProgressByMode(false); end; if ValIdx <> -1 then begin Result := true; if ValIdx = viToMain then AutoCreateTracesToTraceList(Traces) else if ValIdx = viParallel then AutoCreateTracesParallel(aSrcFigure) else if ValIdx = viTree then AutoCreateTraces; end; Values.Free; Traces.Free; end; function GetConnFiguresForAutoCreateTraces(aCad: TF_CAD; aSimulate: Boolean=false; aSimulateForAllObj:Boolean=false; aSimulateForAnyTrace: Boolean=false): TList; var i: Integer; FFigure: TFigure; Conn: TConnectorObject; begin Result := TList.Create; // Формируем список точ. объектов for i := 0 to aCAD.PCad.FigureCount - 1 do begin FFigure := TFigure(aCAD.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin Conn := TConnectorObject(FFigure); if (Conn.ConnectorType = ct_NB) and (Conn.FTrunkName = '') then begin if Conn.Selected or (aSimulate and aSimulateForAllObj) then Result.Add(FFigure); end; end; end; end; procedure DivideTracesOnRoowWalls(aCad: TF_CAD); var Figures: TList; Cabinets: TList; FFigure: TFigure; Obj: TObject; Trace: TOrtholine; Cabinet: TCabinet; CabinetExt: TCabinetExt; Seg: TPLSegment; PointCnt: Integer; p1,p2: TDoublePoint; i, j, k, SegNbr: Integer; pArr: TDoublePointArr; {procedure DivTraceOnPt(ATrace: TOrtholine; APt: TDoublePoint); var i: Integer; NewConn: TConnectorObject; begin if Not (PointNear(ATrace.ActualPoints[1], APt) or PointNear(ATrace.ActualPoints[2], APt)) then begin NewConn := DivideLineSimple(ATrace, @APt); for i := 0 to NewConn.JoinedOrtholinesList.Count - 1 do begin if TOrtholine(NewConn.JoinedOrtholinesList[i]) <> ATrace then Figures.Add(TOrtholine(NewConn.JoinedOrtholinesList[i])); end; end; end;} procedure DivTraceOnCross(ATrace: TOrtholine; AP1, AP2: TDoublePoint); var p: TDoublePoint; begin if GetIntersectionPoint(ATrace.ActualPoints[1], ATrace.ActualPoints[2], AP1,AP2, p,false) then DivTraceOnPt(ATrace, p, Figures); //if Not (PointNear(ATrace.ActualPoints[1], p) or PointNear(ATrace.ActualPoints[2], p)) then //begin // NewConn := DivideLineSimple(ATrace, @p); // AddTraceFromNewConn(NewConn, ATrace); //end; end; procedure DivTraceOnArcCross(ATrace: TOrthoLine; ACenterPt, AP1: TDoublePoint; APolyLine: TPolyLine; ASeg: TPLSegment; ASegNbr: Integer); var rad: Double; icnt: Integer; np1,np2: TDoublePoint; begin rad := GetLineLenght(AP1, ACenterPt); if GetLineCircleIntersection(ATrace.ActualPoints[1], ATrace.ActualPoints[2], ACenterPt, rad, np1,np2, icnt,false) then begin if iCnt > 0 then begin if APolyLine.isPointInSegment(ASegNbr,np1.x,np1.y) then DivTraceOnPt(ATrace, np1, Figures); end; if iCnt > 1 then begin if APolyLine.isPointInSegment(ASegNbr,np2.x,np2.y) then DivTraceOnPt(ATrace, np2, Figures); end; end; end; begin Figures := TList.Create; Cabinets := TList.Create; for i := 0 to aCAD.PCad.FigureCount - 1 do begin FFigure := TFigure(aCAD.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTOrtholine) then begin if FFigure.Selected then Figures.Add(FFigure); end else if CheckFigureByClassName(FFigure, cTCabinet) then begin if TCabinet(Obj).FType <> ct_Virtual then Cabinets.Add(FFigure); end else if CheckFigureByClassName(FFigure, cTCabinetExt) then Cabinets.Add(FFigure); end; aCAD.SaveForUndo(uat_None, true, False); if Cabinets.Count > 0 then begin BeginProgress; try i := 0; while i < Figures.Count do begin Trace := TOrtholine(Figures[i]); for j := 0 to Cabinets.Count - 1 do begin Obj := TObject(Cabinets[j]); if Obj is TCabinet then begin Cabinet := TCabinet(Obj); DivTraceOnCross(Trace, Cabinet.ap1, Cabinet.ap2); DivTraceOnCross(Trace, Cabinet.ap2, Cabinet.ap3); DivTraceOnCross(Trace, Cabinet.ap3, Cabinet.ap4); DivTraceOnCross(Trace, Cabinet.ap4, Cabinet.ap1); end else if Obj is TCabinetExt then begin CabinetExt := TCabinetExt(Obj); SetLength(pArr, 0); CabinetExt.GetLinearInterSections(Trace.ActualPoints[1], Trace.ActualPoints[2], pArr); for k := 0 to Length(pArr) - 1 do begin if IsPointInLine(Trace.ActualPoints[1], Trace.ActualPoints[2], pArr[k], 1) then DivTraceOnPt(Trace, pArr[k], Figures); end; SetLength(pArr, 0); {PointCnt := CabinetExt.PointCount; if Not CabinetExt.Closed then PointCnt := CabinetExt.PointCount - 1; for SegNbr := 1 to PointCnt do begin Seg := TPLSegment(CabinetExt.Segments[SegNbr-1]); p1 := CabinetExt.actualpoints[SegNbr]; if SegNbr = PointCnt then p2 := CabinetExt.actualpoints[1] else p2 := CabinetExt.actualpoints[SegNbr+1]; if Seg.SType = sLine then DivTraceOnCross(Trace, p1, p2) else if Seg.SType = sArc then DivTraceOnArcCross(Trace, Seg.CPoint1, p1, CabinetExt, Seg, SegNbr); end;} end; end; i := i + 1; end; finally EndProgress; end; end; Cabinets.Free; Figures.Free; end; procedure ApplySectionSideForTraces(aCad: TF_CAD); var Figures: TList; FFigure: TFigure; SCSList: TSCSList; SCSObj: TSCSCatalog; SCSCompon: TSCSComponent; Trace: TOrtholine; i, j: Integer; SectSize, CompSectSize: Double; begin Figures := TList.Create; for i := 0 to aCAD.PCad.FigureCount - 1 do begin FFigure := TFigure(aCAD.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTOrtholine) then if FFigure.Selected then Figures.Add(FFigure); end; if Figures.Count > 0 then begin aCAD.SaveForUndo(uat_None, true, False); BeginProgress; try SCSList := GetSCSListByCAD(aCad); for i := 0 to Figures.Count - 1 do begin Trace := TOrtholine(Figures[i]); SCSObj := SCSList.GetCatalogFromReferencesBySCSID(Trace.ID); if SCSObj <> nil then begin SectSize := 0; for j := 0 to SCSObj.ComponentReferences.Count - 1 do begin SCSCompon := SCSObj.ComponentReferences[j]; if CheckSysNameIsCableChannel(SCSCompon.ComponentType.SysName) then begin CompSectSize := SCSCompon.GetPropertyValueAsFloat(pnSectionSize); if CompSectSize > 0 then if (SectSize = 0) OR (CompSectSize < SectSize) then SectSize := CompSectSize; end; end; if SectSize > 0 then aCad.AutoDivideTraceOnAppendCable(Trace, SectSize); end; end; finally EndProgress; end; end; Figures.Free; end; procedure SetConnComponToTraces(aCad: TF_CAD; ACompon: TSCSComponent; AStep: Double; ASetToConnectors: Boolean); var Figures: TList; AccessibleTraces: TList; FFigure: TFigure; StepPC: Double; i: Integer; Trace: TOrthoLine; StartConn: TConnectorObject; StepFigures: TList; LookedFigures: TList; // Сравнение трасс какая ближе к началу координат function TracesCompare(Item1, Item2: Pointer): Integer; var dist11, dist12, dist21, dist22: Double; dist1, dist2: Double; begin dist11 := GetLineLenght(TOrthoLine(Item1).ActualPoints[1], DoublePoint(0,0)); dist12 := GetLineLenght(TOrthoLine(Item1).ActualPoints[2], DoublePoint(0,0)); dist21 := GetLineLenght(TOrthoLine(Item2).ActualPoints[1], DoublePoint(0,0)); dist22 := GetLineLenght(TOrthoLine(Item2).ActualPoints[2], DoublePoint(0,0)); dist1 := Min(dist11, dist12); dist2 := Min(dist21, dist22); Result := 0; if dist1 < dist2 then Result := -1 else if dist1 > dist2 then Result := 1; end; function SetComponsToTrace(ATrace: TOrthoLine; ASetToStartPt: Boolean; AStartPt, AEndPt: TDoublePoint; var ALastPt: TDoublePoint): Boolean; var ComponCount: Integer; TraceLen: Double; i, j: Integer; Traces: TList; Trace: TOrthoLine; Conn: TConnectorObject; NextPt, TmpPt: TDoublePoint; TmpLen: Double; begin Result := false; TraceLen := GetLineLenght(AStartPt, AEndPt); ComponCount := Trunc(TraceLen / StepPC); if ComponCount > 0 then begin Traces := TList.Create; Traces.Add(ATrace); //i := 1; //if ASetToStartPt then // i := 0; i := 0; NextPt := AStartPt; // Если не устанавливать в стартовую точку if Not ASetToStartPt then begin i := 1; NextPt := MPoint(AStartPt, AEndPt, StepPC); end; while i <= ComponCount do begin //NextPt := MPoint(AStartPt, AEndPt, StepPC * i); for j := 0 to Traces.Count - 1 do begin Trace := TOrthoLine(Traces[j]); Conn := nil; if IsPointInLine(Trace.ActualPoints[1], Trace.ActualPoints[2], NextPt, 1) then Conn := DivTraceOnPt(Trace, NextPt, Traces); // Устанавливаем компонент в новый соединитель if Conn <> nil then begin NextPt := Conn.ActualPoints[1]; // На создании соединителя м.б. небольшое смещение CopyComponentToSCSObject(Conn.ID, ACompon.ID); if Conn.JoinedConnectorsList.Count > 0 then NextPt := TConnectorObject(Conn.JoinedConnectorsList[0]).ActualPoints[1]; ALastPt := NextPt; Result := true; TmpPt := MPoint(NextPt, AEndPt, StepPC); TmpLen := GetLineLenght(NextPt, TmpPt); NextPt := TmpPt; end; end; i := i + 1; end; // Учитываем новые разделенные трассы в список доступных AccessibleTraces.Assign(Traces, laOr); Traces.Free; end; end; // AStartConn - соединитель трассы с коротого смотрим // AStartPt - на будущее - стартовая точка с которой смотрим - если устанавливаем через пустые соединители procedure Step(ATrace: TOrthoLine; AStartConn: TConnectorObject; AStartPtOffset: Double=0; AStepIndex: Integer=0); var //TraceLen: Double; EndConn: TConnectorObject; JoinedTraces: TList; Trace: TOrthoLine; i: Integer; StartPt, EndPt, LastPt: TDoublePoint; SetToStartPt: Boolean; NextTracePtOffset: Double; // Смещение стартовой точки следующей трассы begin if (LookedFigures.IndexOf(ATrace) = -1) and (AccessibleTraces.IndexOf(ATrace) <> -1) then begin StepFigures.Add(ATrace); LookedFigures.Add(ATrace); EndConn := nil; if ATrace.JoinConnector1 = AStartConn then EndConn := TConnectorObject(ATrace.JoinConnector2) else if ATrace.JoinConnector2 = AStartConn then EndConn := TConnectorObject(ATrace.JoinConnector1); if EndConn <> nil then begin NextTracePtOffset := 0; SetToStartPt := false; StartPt := AStartConn.ActualPoints[1]; EndPt := EndConn.ActualPoints[1]; if AStartPtOffset <> 0 then StartPt := MPoint(StartPt, EndPt, AStartPtOffset); if LookedFigures.IndexOf(AStartConn) = -1 then begin // Устанавливаем в соединитель if ASetToConnectors then CopyComponentToSCSObject(AStartConn.ID, ACompon.ID); LookedFigures.Add(AStartConn); end; if Not ASetToConnectors then begin // Если по смещению попадаем не на соединитель if Not PointNear(StartPt, AStartConn.ActualPoints[1]) then SetToStartPt := true; end; if SetComponsToTrace(ATrace, SetToStartPt, StartPt, EndPt, LastPt) then begin // Если не устанавливаем на соединители, вычисляем смещение от начальной точки для следующих трасс if Not ASetToConnectors then begin NextTracePtOffset := StepPC - GetLineLenght(LastPt, EndPt); if NextTracePtOffset < 0 then NextTracePtOffset := 0; end; end; LookedFigures.Add(EndConn); if ASetToConnectors then begin // Устанавливаем в соединитель CopyComponentToSCSObject(EndConn.ID, ACompon.ID); end; // от соединителя ищем другие трассы JoinedTraces := GetAllConnectedTraces(EndConn); for i := 0 to JoinedTraces.Count - 1 do begin Trace := TOrthoLine(JoinedTraces[i]); Step(Trace, EndConn, NextTracePtOffset, AStepIndex+1); end; JoinedTraces.Free; end; StepFigures.Delete(StepFigures.Count-1); end; end; begin Figures := TList.Create; for i := 0 to aCAD.PCad.FigureCount - 1 do begin FFigure := TFigure(aCAD.PCad.Figures[i]); if CheckFigureByClassName(FFigure, cTOrtholine) then begin if FFigure.Selected then Figures.Add(FFigure); end; end; aCAD.SaveForUndo(uat_None, true, False); if Figures.Count > 0 then begin BeginProgress; try StepPC := AStep * (1000/ aCAD.PCad.MapScale); AccessibleTraces := TList.Create; AccessibleTraces.Assign(Figures); LookedFigures := TList.Create; StepFigures := TList.Create; // Сортируем трассы Figures.Sort(@TracesCompare); for i := 0 to Figures.Count - 1 do begin Trace := TOrthoLine(Figures[i]); StartConn := GetMinConnector(TConnectorObject(Trace.JoinConnector1), TConnectorObject(Trace.JoinConnector2)); Step(Trace, StartConn); end; finally StepFigures.Free; LookedFigures.Free; AccessibleTraces.Free; EndProgress; end; end; Figures.Free; end; procedure MirrorFigure(AFigure: TFigure); begin AFigure.Mirror(AFigure.CenterPoint, AFigure.CenterPoint); end; procedure MoveFigures(AFigures: TList; x, y: Double); var i: integer; Figure: TFigure; SavedMoveAllPoints: Boolean; Path: TNetPath; begin for i := 0 to AFigures.Count - 1 do begin Figure := TFigure(AFigures[i]); if Figure is TNet then begin if ssCtrl in GGlobalShiftState then begin Path := TNet(Figure).SelPath; if Path <> nil then begin Path.FPointsOffset := Path.FPointsOffset + (x+y); TNet(Figure).RefreshPaths; end; Continue; //// CONTINUE //// end; SavedMoveAllPoints := TNet(Figure).FMoveAllPoints; TNet(Figure).FMoveAllPoints := true; end; Figure.Move(x, y); if Figure is TNet then TNet(Figure).FMoveAllPoints := SavedMoveAllPoints; end; end; procedure RotateFigure(AFigure: TFigure; Angle: Double); var AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; pt: TDoublePoint; begin AngleRad := Angle / 180 * pi; //if Not (AFigure is TNet) then // pt := AFigure.ActualPoints[1] //else if TNet(AFigure).Points.Count > 0 then // pt := PDoublePoint(TNet(AFigure).Points[0])^ //else // pt := DoublePoint(0, 0); Bnd := AFigure.GetBoundRect; //pt := DoublePoint((figMaxX+figMinX)/2,(figMaxY+figMinY)/2); pt := DoublePoint((Bnd.Left + Bnd.Right)/2, (Bnd.Top + Bnd.Bottom)/2); AFigure.Rotate(AngleRad, pt); //AFigure.DrawFigure.Rotate(AngleRad, AFigure.CenterPoint); //AFigure.FDrawFigureAngle := AFigure.FDrawFigureAngle + AngleRad; //if AFigure.FDrawFigureAngle >= 2 * pi then // AFigure.FDrawFigureAngle := AFigure.FDrawFigureAngle - 2 * pi; //Bnd := AFigure.DrawFigure.GetBoundRect; //AFigure.GrpSizeX := Bnd.Right - Bnd.Left; //AFigure.GrpSizeY := Bnd.Bottom - Bnd.Top; RefreshCAD(GCadForm.PCad); end; procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor); type TRGB = record B, G, R: Byte; end; pRGB = ^TRGB; pByteArray = ^TByteArray; TByteArray = array[0..32767] of Byte; TRectList = array[1..4] of TPoint; var x, y, W, H, v1, v2: Integer; Dest, Src: pRGB; VertArray: array of pByteArray; Bmp: TBitmap; procedure SinCos(AngleRad: Double; var ASin, ACos: Double); begin ASin := Sin(AngleRad); ACos := Cos(AngleRad); end; function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double): TRectList; var DX, DY: Integer; SinAng, CosAng: Double; function RotPoint(PX, PY: Integer): TPoint; begin DX := PX - Center.x; DY := PY - Center.y; Result.x := Center.x + Round(DX * CosAng - DY * SinAng); Result.y := Center.y + Round(DX * SinAng + DY * CosAng); end; begin SinCos(Angle * (Pi / 180), SinAng, CosAng); Result[1] := RotPoint(Rect.Left, Rect.Top); Result[2] := RotPoint(Rect.Right, Rect.Top); Result[3] := RotPoint(Rect.Right, Rect.Bottom); Result[4] := RotPoint(Rect.Left, Rect.Bottom); end; function Min(A, B: Integer): Integer; begin if A < B then Result := A else Result := B; end; function Max(A, B: Integer): Integer; begin if A > B then Result := A else Result := B; end; function GetRLLimit(const RL: TRectList): TRect; begin Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x)); Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y)); Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x)); Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y)); end; procedure Rotate; var x, y, xr, yr, yp: Integer; ACos, ASin: Double; Lim: TRect; begin W := Bmp.Width; H := Bmp.Height; SinCos(-Angle * Pi / 180, ASin, ACos); Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0), Angle)); Bitmap.Width := Lim.Right - Lim.Left; Bitmap.Height := Lim.Bottom - Lim.Top; Bitmap.Canvas.Brush.Color := BackColor; Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height)); for y := 0 to Bitmap.Height - 1 do begin Dest := Bitmap.ScanLine[y]; yp := y + Lim.Top; for x := 0 to Bitmap.Width - 1 do begin xr := Round(((x + Lim.Left) * ACos) - (yp * ASin)); yr := Round(((x + Lim.Left) * ASin) + (yp * ACos)); if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then begin Src := Bmp.ScanLine[yr]; Inc(Src, xr); Dest^ := Src^; end; Inc(Dest); end; end; end; begin Bitmap.PixelFormat := pf16Bit; Bmp := TBitmap.Create; try Bmp.Assign(Bitmap); W := Bitmap.Width - 1; H := Bitmap.Height - 1; if Frac(Angle) <> 0.0 then Rotate else case Trunc(Angle) of -360, 0, 360, 720: Exit; 90, 270: begin Bitmap.Width := H + 1; Bitmap.Height := W + 1; SetLength(VertArray, H + 1); v1 := 0; v2 := 0; if Angle = 90.0 then v1 := H else v2 := W; for y := 0 to H do VertArray[y] := Bmp.ScanLine[Abs(v1 - y)]; for x := 0 to W do begin Dest := Bitmap.ScanLine[x]; for y := 0 to H do begin v1 := Abs(v2 - x) * 3; with Dest^ do begin B := VertArray[y, v1]; G := VertArray[y, v1 + 1]; R := VertArray[y, v1 + 2]; end; Inc(Dest); end; end end; 180: begin for y := 0 to H do begin Dest := Bitmap.ScanLine[y]; Src := Bmp.ScanLine[H - y]; Inc(Src, W); for x := 0 to W do begin Dest^ := Src^; Dec(Src); Inc(Dest); end; end; end; else Rotate; end; finally Bmp.Free; end; end; function GetArcLen(Radius, RadAngle: Double): Double; begin // Длина дуги радиуса R с радианной мерой a, равна R*a // Через градусную меру n длина дуги выражается формулой (pi * R * n)/180 Result := Radius * RadAngle; end; function GetArcLen(CenterPoint, LinePoint: TDoublePoint; RadAngle: Double): Double; begin Result := GetLineLenght(CenterPoint, LinePoint) * RadAngle; end; function GetArcLenByPoints(p1, p2, ArcCenter: TDoublePoint; AInverted: Boolean): Double; var PointsAng: Double; begin PointsAng := 0; if AInverted 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); end; function GetPolylineFromArc(ACornerCount: Integer; cp:TdoublePoint; radius, ArcAng: Double; p1, p2: PDoublePoint): TDoublePointArr; var AngleStep: Double; pt, StartPt: TDoublePoint; i: Integer; {function ChoicePtByAngle(Ang: Double): Boolean; begin Result := false; pt := p1^; TempPt := GetRelativePointbyAngleFloat(ArcAng, cp, pt); if EQDP(pt, p2^) then pt := p1^ else pt := p2^; end;} begin SetLength(Result, 0); AngleStep := ArcAng / ACornerCount; for i := 0 to ACornerCount - 1 do begin if i = 0 then begin if (p1 <> nil) or (p2 <> nil) then begin if (p1 <> nil) and (p2 <> nil) then begin {if Not AInverted then begin if GetRadOfLine(cp, p1^) > GetRadOfLine(cp, p2^) then pt := p2^ else pt := p1^; end else begin if GetRadOfLine(cp, p1^) < GetRadOfLine(cp, p2^) then pt := p2^ else pt := p1^; end;} pt := p1^; pt := GetRelativePointbyAngleFloat(ArcAng, cp, pt); if PointNear(pt, p2^, 1) then //if EQDP(pt, p2^) then pt := p1^ else pt := p2^; end else if (p1 <> nil) and (ArcAng = 360) then pt := p1^; StartPt := pt; end else begin pt := cp; pt.y := pt.y - radius; end; end else //15.09.2011 pt := GetRelativePointbyAngleFloat(AngleStep, cp, pt); pt := GetRelativePointbyAngleFloat(AngleStep * i, cp, StartPt); SetLength(Result, Length(Result)+1); Result[i] := pt; end; end; function GetLinesAngle(AP1, AP2, AP3, AP4: TDoublePoint): Double; begin // Координаты отрезков заданы точками (x1,y1)-(x2,y2) (x3,y3)-(x4,y4) // a = arctg[(y2 - y1)/(x2 - x1)] - arctg[(y4 - y3)/(x4 - x3)] Result := ArcTanh((AP2.y - AP1.y)/(AP2.x - AP1.x)) - ArcTanh((AP4.y - AP3.y)/(AP4.x - AP3.x)); end; function GetAreaFromPolygon3D(APoints: PDoublePointArr): Double; var IsResult: Boolean; begin Result := 0; IsResult := false; if Length(APoints^) > 2 then begin if EQDP(APoints^[0], APoints^[Length(APoints^)-1]) then begin // Треугольник if Length(APoints^) = 4 then begin Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2]); IsResult := true; end else // Трапеция if Length(APoints^) = 5 then begin Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2])+ GetTriangleArea3D(APoints^[2], APoints^[3], APoints^[0]); IsResult := true; end else // 5-ти угольник if Length(APoints^) = 6 then begin Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2])+ GetTriangleArea3D(APoints^[2], APoints^[3], APoints^[4])+ GetTriangleArea3D(APoints^[2], APoints^[4], APoints^[0]); IsResult := true; end else // 6-ти угольник if Length(APoints^) = 7 then begin Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2])+ GetTriangleArea3D(APoints^[2], APoints^[3], APoints^[4])+ GetTriangleArea3D(APoints^[4], APoints^[5], APoints^[0])+ // внутр-триугольник GetTriangleArea3D(APoints^[0], APoints^[2], APoints^[4]); IsResult := true; end else // 7-ти угольник if Length(APoints^) = 8 then begin Result := Result + GetTriangleArea3D(APoints^[0], APoints^[1], APoints^[2])+ GetTriangleArea3D(APoints^[2], APoints^[3], APoints^[4])+ GetTriangleArea3D(APoints^[4], APoints^[5], APoints^[6])+ GetTriangleArea3D(APoints^[6], APoints^[7], APoints^[0])+ // внутр-триугольник GetTriangleArea3D(APoints^[0], APoints^[2], APoints^[4])+ GetTriangleArea3D(APoints^[4], APoints^[6], APoints^[0]); IsResult := true; end; end; end; if Not IsResult then Result := GetAreaFromPolygon(APoints^); end; function GetPerimetrFromPolygon(APoints: PDoublePointArr): Double; var i: Integer; p1, p2: PDoublePoint; begin Result := 0; for i := 1 to Length(APoints^) do Result := Result + GetLineLenght(APoints^[i-1], APoints^[i]); end; procedure GetLinesNearPoints(ap1, ap2, bp1, bp2: PDoublePoint; var ap, bp: TDoublePoint); var APoints, BPoints: TList; i, j: Integer; LastDist, Dist: Double; begin ap := Doublepoint(0,0,0); bp := Doublepoint(0,0,0); APoints := TList.Create; APoints.Add(ap1); APoints.Add(ap2); BPoints := TList.Create; BPoints.Add(bp1); BPoints.Add(bp2); LastDist := -1; for i := 0 to APoints.Count - 1 do begin for j := 0 to BPoints.Count - 1 do begin Dist := GetLineLength(PDoublePoint(APoints[i])^, PDoublePoint(BPoints[j])^); if (LastDist = -1) or (Dist < LastDist) then begin LastDist := Dist; ap := PDoublePoint(APoints[i])^; bp := PDoublePoint(BPoints[j])^; end; end; end; APoints.Free; BPoints.Free; end; function IsConvexPolygon(APoints: PDoublePointArr; ALastPtInFirst: Boolean): Integer; // http://algolist.manual.ru/maths/geom/polygon/convex_or.php // Для выпуклого многоугольника все векторные произведения смежных сторон будут одинакового знака, // а если это не так, то будет присутствовать и произведение противоположного знака. var i,j,k: Integer; flag: Integer; z: Double; PtCount: Integer; begin Result := pltNone; PtCount := Length(APoints^); if ALastPtInFirst then PtCount := PtCount - 1; if PtCount > 2 then begin flag := 0; for i := 0 to PtCount - 1 do begin j := (i + 1) mod PtCount; k := (i + 2) mod PtCount; z := (APoints^[j].x - APoints^[i].x) * (APoints^[k].y - APoints^[j].y); z := z - (APoints^[j].y - APoints^[i].y) * (APoints^[k].x - APoints^[j].x); if z < 0 then flag := flag or 1 else if z > 0 then flag := flag or 2; if flag = 3 then begin Result := pltConcave; // вогнутый Exit; ///// EXIT ///// //Break; //// BREAK //// end; end; if flag <> 0 then Result := pltConvex // выпуклый else Result := pltNone; end; end; function OverlapDoubleRects(const R1, R2: TDoubleRect): Boolean; begin Result := False; // Если R1.Left или R1.Right между R2.Left и R2.Right (Проверка по горизонтали) if ((R1.Left >= R2.Left) and (R1.Left <= R2.Right)) or ((R1.Right >= R2.Left) and (R1.Right <= R2.Right)) then begin // Если R1.Top или R1.Bottom между R2.Top и R2.Bottom (Проверка по Вертикали) if ((R1.Top >= R2.Top) and (R1.Top <= R2.Bottom)) or ((R1.Bottom >= R2.Top) and (R1.Bottom <= R2.Bottom)) then Result := True else // Если R2.Top или R2.Bottom между R1.Top и R1.Bottom (Проверка по Вертикали) if ((R2.Top >= R1.Top) and (R2.Top <= R1.Bottom)) or ((R2.Bottom >= R1.Top) and (R2.Bottom <= R1.Bottom)) then Result := True; end else // Если R2.Left или R2.Right между R1.Left и R1.Right (Проверка по горизонтали) if ((R2.Left >= R1.Left) and (R2.Left <= R1.Right)) or ((R2.Right >= R1.Left) and (R2.Right <= R1.Right)) then begin // Если R1.Top или R1.Bottom между R2.Top и R2.Bottom (Проверка по Вертикали) if ((R1.Top >= R2.Top) and (R1.Top <= R2.Bottom)) or ((R1.Bottom >= R2.Top) and (R1.Bottom <= R2.Bottom)) then Result := True else // Если R2.Top или R2.Bottom между R1.Top и R1.Bottom (Проверка по Вертикали) if ((R2.Top >= R1.Top) and (R2.Top <= R1.Bottom)) or ((R2.Bottom >= R1.Top) and (R2.Bottom <= R1.Bottom)) then Result := True; end; end; function CorrectAngle(aAngle: Double; AStep: Integer=360): Double; begin Result := aAngle; while Result > AStep do Result := Result - AStep; while Result < 0 do Result := Result + AStep; end; function GetTextHeight(FontHandle: HWND; AFont: TFont): Double; var DC: HDC; {SaveFont: HFONT; TTM: TTextMetric; StrHgt:integer;} mRes: Boolean; LogFnt : TLogFont; oldFont,newFont : HFont; IsTrueTypeFont : Boolean; fFontStyle : TFontStyles; fFontName : TFontName; fFontColor : TColor; Metrics: TTextMetric; begin Result := 0; {DC := GetDC(0); if (DC <> 0) then begin SaveFont := SelectObject(DC, FontHandle); mRes := GetTextMetrics(DC,TTM); if (mRes) then StrHgt:=TTM.tmHeight+TTM.tmExternalLeading; SelectObject(DC, SaveFont); ReleaseDC(0,DC); Result := StrHgt; end;} LogFnt.lfHeight := AFont.Height; //10; LogFnt.lfWidth := 10; LogFnt.lfEscapement := 0; LogFnt.lfWeight := FW_REGULAR; LogFnt.lfItalic := 0; LogFnt.lfUnderline := 0; LogFnt.lfStrikeOut := 0; LogFnt.lfCharSet := DEFAULT_CHARSET; LogFnt.lfOutPrecision := OUT_DEFAULT_PRECIS; LogFnt.lfClipPrecision := CLIP_DEFAULT_PRECIS; LogFnt.lfQuality := DEFAULT_QUALITY; LogFnt.lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE; StrPCopy(LogFnt.lfFaceName, AFont.Name); //StrPCopy(LogFnt.lfFaceName, 'Arial'); newFont := CreateFontIndirect(LogFnt); DC := GetDC(0); if DC <> 0 then begin oldFont := SelectObject(DC,newFont); ZeroMemory(@Metrics, SizeOf(Metrics)); mRes := GetTextMetrics(DC, Metrics); if mRes then Result := Metrics.tmHeight; SelectObject(DC,oldFont); ReleaseDC(0,DC); end; end; procedure GetTextSize(AFontSize: Integer; AStyles: TFontStyles; const AFontName, AText: String; AStrings: TStrings; var h, w: Double; AStrH: Pointer=nil); var tmpCanvas: TCanvas; i: Integer; Str: String; DefinedH: Boolean; tw: Integer; Strings: TStrings; begin h := 0; w := 0; if AStrH <> nil then Integer(AStrH^) := 0; Strings := TStringList.Create; if (AStrings = nil) and (AText <> '') then begin Strings.Text := AText; end else if (assigned(AStrings)) then Strings.Text := AStrings.Text; if Strings <> nil then begin tmpCanvas := TCanvas.Create; tmpCanvas.Handle := GetDC(0); if tmpCanvas.Handle <> 0 then begin tmpCanvas.Font.Name := AFontName; tmpCanvas.Font.Size := AFontSize; tmpCanvas.Font.Style := AStyles; //h := tmpCanvas.TextHeight('W'); //w := tmpCanvas.TextWidth('W'); DefinedH := false; for i := 0 to Strings.Count - 1 do begin Str := Strings[i]; if Not DefinedH and (Str <> '') then begin h := tmpCanvas.TextHeight(Str); // Если не удалось определить высоту с этим шрифтом, то пробуем для Arial if h = 0 then begin tmpCanvas.Font.Name := 'Arial'; h := tmpCanvas.TextHeight(Str); end; DefinedH := true; if AStrH <> nil then Integer(AStrH^) := Trunc(h); end; tw := tmpCanvas.TextWidth(Str); if tw > w then w := tw; end; ReleaseDC(0,tmpCanvas.Handle); end; tmpCanvas.Free; h := h / 4 * Strings.Count + 1; w := (w + 3) / 4; if Strings = nil then Strings.Free; end; end; function DefineFrameByPrinter(aRect: TDoubleRect): TDoubleRect; var PSD: TPrinterSetupDialog; DPIX: double; DPIY: double; OFFX: double; OFFY: double; OFFMMX: double; OFFMMY: double; begin Result := aRect; PSD := TPrinterSetupDialog.Create(nil); try if PSD.Execute then begin if (Printer <> nil) then begin DPIX := GetDeviceCaps(Printer.Handle, LOGPIXELSX); DPIY := GetDeviceCaps(Printer.Handle, LOGPIXELSY); OFFX := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX); OFFY := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY); OFFMMX := (OFFX / DPIX) * 25.4; OFFMMY := (OFFY / DPIY) * 25.4; Result.Top := Round3(aRect.Top - OFFMMY); if Result.Top < 0 then Result.Top := 1; // Учитываем что слева смещение не сделано // OFFMMX * 2 = под край печатаемой области справа Result.Right := Round3(OFFMMX * 2 + (aRect.Right - OFFMMX)); if Result.Right < 0 then Result.Right := 1; Result.Bottom := Round3(OFFMMY * 2 + (aRect.Bottom - OFFMMY)); if Result.Bottom < 0 then Result.Bottom := 1; end; end; finally PSD.Free; end; end; function GetMultipleFromNB:Boolean; //From Dimon ;) var Side1,Side2: String; CurrDat: PObjectData; SCSComponInNormBase: TSCSComponent; j: integer; begin Result := false; SCSComponInNormBase := nil; CurrDat := F_NormBase.Tree_Catalog.selected.data; if CurrDat <> nil then if (CurrDat.ItemType in [itComponLine, itComponCon, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner]) then begin if SCSComponInNormBase = nil then begin SCSComponInNormBase := TSCSComponent.Create(F_NormBase); //Создание нового компона end; SCSComponInNormBase.Clear; begin SCSComponInNormBase.Clear; SCSComponInNormBase.LoadComponentByID(CurrDat.ObjectID, true, true, false);//Загружаем его интерфейсы.А больше ничего и не нужно end; end; for j := 0 to SCSComponInNormBase.Interfaces.Count - 1 do begin if TSCSInterface(SCSComponInNormBase.Interfaces[j]).TypeI = itFunctional then begin //Так как у функциональных онтерфейсов SideSection одинаковый запоминаем первый попавшийся Result := Boolean(TSCSInterface(SCSComponInNormBase.Interfaces[j]).Multiple); break; end; end; SCSComponInNormBase.Clear; FreeAndNil(SCSComponInNormBase); end; //Функция сравнивает параметры выбранного компонента из дерева с тем, что уже имеется на каде Function CheckComponentsForSideSection(CurrCompon: TSCSComponent):Boolean; //From Dimon ;) var Side1,Side2: String; CurrDat: PObjectData; SCSComponInNormBase: TSCSComponent; j: integer; begin Result := false; SCSComponInNormBase := nil; CurrDat := F_NormBase.Tree_Catalog.selected.data; if CurrDat <> nil then if (CurrDat.ItemType in [itComponLine, itComponCon, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner]) then begin if SCSComponInNormBase = nil then begin SCSComponInNormBase := TSCSComponent.Create(F_NormBase); //Создание нового компона end; SCSComponInNormBase.Clear; begin SCSComponInNormBase.Clear; SCSComponInNormBase.LoadComponentByID(CurrDat.ObjectID, true, true, false);//Загружаем его интерфейсы.А больше ничего и не нужно end; end; for j := 0 to SCSComponInNormBase.Interfaces.Count - 1 do begin if TSCSInterface(SCSComponInNormBase.Interfaces[j]).TypeI = itFunctional then begin //Так как у функциональных онтерфейсов SideSection одинаковый запоминаем первый попавшийся Side1 := TSCSInterface(SCSComponInNormBase.Interfaces[j]).SideSection; break; end; end; for j := 0 to CurrCompon.Interfaces.Count - 1 do begin //То же самое с проверяемым компоном if TSCSInterface(CurrCompon.Interfaces[j]).TypeI = itFunctional then begin Side2 := TSCSInterface(CurrCompon.Interfaces[j]).SideSection; break; end; end; SCSComponInNormBase.Clear; FreeAndNil(SCSComponInNormBase); //Сверяем если одинаковые, можно делать различные махинации if Side1 = Side2 then result := true; end; // TODO 5: Пересмотреть где Figures.count используется через for в движке PowerCAD и по возможности юзать for // TODO 6: Учесть сорт список на undo/redo, копировании листа, дублировании объектов end.