//{$DEFINE CADImport6} unit U_ImportDXF; interface uses windows, Dialogs, PowerCad, SysUtils, U_Cad, DrawObjects, Clipbrd, Classes, PCTypesUtils, Math, ShellApi, tlhelp32, forms, FastStrings, Messages, Graphics, Controls, StdCtrls, ExtDlgs, ExtCtrls, {$IF Defined(CADImport6)} DXFImage_EXP, ExtData, sgFunction, sgTools, {$ELSE} DXF, sgFunction, ExtData, sgTools, {$IFEND} DXFConv, {Extrusion,} U_DXFEngineSCS, PCDrawing, DWG, HPGL2, SVG, CGM, U_Common_Classes, sgConsts, MVFont, U_SCSLists, {Tolik} SGLines, SGLists, JPEG, IniFiles, U_BaseOptions; procedure LoadDXFFile(aPCad: TPowerCad); //Tolik -- 04/03/2016 -- procedure LoadDXFFileNew(aPCad: TPowerCad; aTitle, aFilter: string; aFile: String=''; aAllowScale: Boolean=true; aLoadAsPicture: Boolean = False); // //procedure LoadDXFFileNew(aPCad: TPowerCad; aTitle, aFilter: string; aFile: String=''; aAllowScale: Boolean=true); procedure LoadDXFFileWithName(aPCad: TPowerCad; aFName: string); function ImportDXF(aFileName: string): Boolean; function ConvertDWGToDXF(aDWGFileName: string): string; function DxfColorToColor(aColor: Integer): Longint; function GetImportLayerNbr(aCad: TPCDrawing; aDxfLayer: TsgDXFLayer): Integer; // NEW function ModificatePoint(aP: TFPoint): TFPoint; function PointToString(const P: TFPoint): string; function ImportTextFont(Sender: TObject): string; function GetDXFBlock(aID: Integer): TBlock; function CheckAnyText(aStr: string): Boolean; //Tolik // Function ConvUtf8ToStr(aString: string): string; //function utf16decode(encodeIn: string):string; function utf16decode(encodeIn: string; IsUnicode: Boolean = False):string; Procedure ImportOleToFrame(Sender: TObject); // Tolik - - function DWG_Dxf_VerToString(const Version: TsgDWGVersion): string; // type TF_Import = class(TObject) FEntitiesCount: Integer; FTextPrevPt: TFPoint; FTextUsePrevPt: Boolean; //Tolik LoadViewPort: Boolean; LeftTopPoint, RightBottomPoint: TFPoint; // границы ViewPort -- левая верхняя и нижняя правая точки CurrentBlockHandle: Integer; HandleList, BlockHandleList: TStringList; MTextBlockHandleList: TStringList; ActPort: TsgDXFVPort; FCanConvertFromUnicode: Boolean; // 14/02/2017 -- // function ImportText(Sender: TObject): TFigure; // Tolik Function ImportTextWithParams(Sender: TObject; aFCadParams: PsgCADIterate; aMatrix: TFMatrix): TFigure; // Function ImportMText(Sender: Tobject): TFigure; function ImportSolid(Sender: TObject): TFigure; function ImportLine(Sender: TObject): TFigure; function ImportPoint(Sender: TObject): TFigure; function ImportEllipse(Sender: TObject): TFigure; function ImportArc(Sender: TObject): TFigure; function ImportCircle(Sender: TObject): TFigure; function ImportPolyLine(Sender: TObject): TFigure; function ImportAttdef(Sender: TObject): TFigure; function ImportSpline(Sender: TObject): TFigure; function ImportLeader(Sender: TObject): TFigure; function ImportHatch(Sender: TObject): TList;//TFigure; function ImportViewPortBegin(Sender: TObject): TFigure; function ImportViewPortEnd(Sender: TObject): TFigure; // Tolik 12/12/0216-- попытка поднять WipeOut function ImportWipeOut(Sender: TObject): TFigure; // // Tolik -- 01/02/2016 function ReadCADEntities(Entity: TsgDXFEntity): Integer; function ReadCADTXTEntities(Entity: TsgDXFEntity): Integer; // function ReadCADEntities(Entity: TsgDXFEntity; WithOutText: Boolean = true; CanScale: Boolean = true): Integer; // function FinishReadCADEntities(Entity: TsgDXFEntity): Integer; //function FinishReadCADEntitiesWithOutText(Entity: TsgDXFEntity): Integer; // function ReadCADEntitiesWithText(Entity: TsgDXFEntity): Integer; Procedure SimpleReadCADEntities(Entity: TsgDXFEntity); function CheckIsLoaded(Entity: TsgDXFEntity): Boolean; // constructor Create; end; // *** var F_Import: TF_Import; IsModelExist: Boolean = False; IsBlockInBlockExist: Boolean = False; TxtFile: TStringList; FCADParams: TsgCADIterate; FDXFObjectsList: TList; FDXFBlocksList: TList; // Tolik HandleList: TStringList; AlternateFileNameToLoad: String; // 28/09/2017 -- Tolik -- имя преобразованного файла, если грузим версию 2018 // // Formats {$IF Defined(CADImport6)} ImgDXF: TsgDXFImage; {$ELSE} ImgDXF: TsgCADDXFImage; {$IFEND} ImgDWG: TsgDWGImage; ImgSVG: TsgSVGImage; ImgHPGL: TsgHPGLImage; NumberOfPartsInSpline: Integer = 10; LimitDXFPolyCount: integer = 500; // Tolik 02/03/2017 -- LimitDXFSplinePointCount: Integer = 500; LoadSplineByControlPointsFirst: Boolean = False; // // Tolik --13/12/2016 -- CanLoadAllObjects: Boolean; // можно ли загрузить все примитивы // MTextList: TList; // Tolik 07/10/2019 -- список свойств МТекста, обнаруженного на первом проходе implementation uses U_ProtectionCommon, {LoadDXF, }USCS_Main, U_Common, U_BaseCommon, PCDrawBox, U_Constants, U_Layers, CADImage,{Tolik--26/01/2016} U_BaseConstants, {Tolik 01/08/2019 -- }U_BaseSettings; //Tolik // перепроверить try..except. //Tolik -- 08/02/2016 -- признак текста типа '\U+' или '_U+' к сожалению, приходит не // всегда, нужно еще смотреть в параметрах текста свойство IsUnicodeText // function utf16decode(encodeIn: string):string; function DWG_Dxf_VerToString(const Version: TsgDWGVersion): string; begin Result := 'AC10'; case Version of acR09: Result := Result + '04'; acR10: Result := Result + '06'; acR11: Result := Result + '07'; //!!! not sure acR12: Result := Result + '09'; acR13: Result := Result + '13'; acR14: Result := Result + '14'; acR2000: Result := Result + '15'; acR2004: Result := Result + '18'; acR2007: Result := Result + '21'; acR2010: Result := Result + '24'; acR2013: Result := Result + '27'; end; end; function Utf8ToUnicode_(Dest: PWideChar; MaxDestChars: Cardinal; Source: PAnsiChar; SourceBytes: Cardinal): Cardinal; begin Result := 0; if Source = nil then Exit; if (Dest <> nil) and (MaxDestChars > 0) then begin Result := Cardinal(UnicodeFromLocaleChars(CP_UTF8, MB_ERR_INVALID_CHARS, Source, Integer(SourceBytes), Dest, Integer(MaxDestChars))); if (Result > 0) and (Result <= MaxDestChars) then begin if (SourceBytes = Cardinal(-1)) and (Dest[Result - 1] = #0) then Exit; if Result = MaxDestChars then begin if (Result > 1) and (Word(Dest[Result - 1]) >= $DC00) and (Word(Dest[Result - 1]) <= $DFFF) then Dec(Result); end else Inc(Result); Dest[Result - 1] := #0; end; end else Result := Cardinal(UnicodeFromLocaleChars(CP_UTF8, 0, Source, Integer(SourceBytes), nil, 0)); end; /// Tolik 17/10/2019 -- Старая закомменчена, новая переписана function utf16decode(encodeIn: string; IsUnicode: Boolean = False):string; var presult,psource: PAnsiChar; buf, code:Integer; encode: string; //tmpch: Char; tmpch: AnsiChar; i, StringL: integer; wString: WideString; wChar: WideChar; PWChar: PWideChar; AnsiResult, AnsiStr, s: AnsiString; begin // Tolik 08/04/2019 { if IsUnicode then begin Result := enCodeIn; exit; end; } // // Tolik - 09/02/2016 -- Result := ''; if encodeIn = '' then Exit; // Tolik --08/02/2016 -- // if (Pos('\U+', encodeIn) = 0) and (Pos('_U+', encodeIn) = 0) then if ((Pos('\U+', encodeIn) = 0) and (Pos('_U+', encodeIn) = 0) and (not isUnicode)) then Result := encodeIn else begin try //encode := FastReplace(encodein, '\U+', '\x', True); AnsiStr := AnsiString(encodeIn); SetLength(AnsiResult, length(AnsiStr)); presult := PAnsiChar(AnsiResult); psource := PAnsiChar(AnsiStr); // Tolik --08/02/2016 -- if ((Pos('\U+', encodeIn) = 0) and (Pos('_U+', encodeIn) = 0) and isUnicode) then begin //encode := UTF8Decode(encodeIn); StringL := Length(AnsiStr); SetLength(wString, StringL); //wString := UTF8Decode(encodeIn); //SetLength(result, length(encode)); //presult:=pchar(result); //psource:=pchar(encode); //StringL := Utf8ToUnicode(PWideChar(wString), StringL+1, PChar(encodeIn), StringL); StringL := Utf8ToUnicode_(PWideChar(wString), StringL+1, PAnsiChar(AnsiStr), StringL); //StringL := Utf8ToUnicode(PWideChar(wString), StringL+1, PAnsiChar(encodeIn), StringL); if StringL > 0 then SetLength(WString, StringL-1) else WString := ''; Result := wString; if Result = '' then Result := EnCodeIn; end else begin // while psource^<>#0 do begin if (psource^='\') or (psource^='_') then begin tmpch := psource^; inc(psource); if psource^='U' then begin inc(psource); if psource^='+' then begin //inc(psource); //psource^:='x'; SetString(s,psource,5); s[1] := 'x'; Val(s,buf,code); if buf>=$100 then begin s:=WideChar(buf); presult^:=s[1]; end else //presult^:=chr(buf); presult^:= AnsiChar(AnsiChar(buf)); // Tolik 27/03/2019 Inc(psource,5); end else begin presult^ := tmpch; inc(presult); presult^ := 'U'; // '\' end end else presult^ := tmpch; // '\' end else begin presult^:=psource^; Inc(psource); end; Inc(presult); end; SetLength(AnsiResult, presult - pAnsichar(AnsiResult)); Result := AnsiResult; end; except result:='error'; end; end; SetLength(AnsiResult, 0); SetLength(wString, 0); end; (* function utf16decode(encodeIn: string; IsUnicode: Boolean = False):string; var presult,psource:PChar; s:string; buf,code:Integer; encode: string; tmpch: Char; i: integer; wString: WideString; wChar: WideChar; PWChar: PWideChar; StringL: Integer; begin // Tolik 08/04/2019 { if IsUnicode then begin Result := enCodeIn; exit; end; } // // Tolik - 09/02/2016 -- Result := ''; if encodeIn = '' then Exit; // Tolik --08/02/2016 -- // if (Pos('\U+', encodeIn) = 0) and (Pos('_U+', encodeIn) = 0) then if ((Pos('\U+', encodeIn) = 0) and (Pos('_U+', encodeIn) = 0) and (not isUnicode)) then Result := encodeIn else begin try //encode := FastReplace(encodein, '\U+', '\x', True); encode := encodeIn; SetLength(result, length(encode)); presult:=pchar(result); psource:=pchar(encode); // Tolik --08/02/2016 -- if ((Pos('\U+', encodeIn) = 0) and (Pos('_U+', encodeIn) = 0) and isUnicode) then begin //encode := UTF8Decode(encodeIn); StringL := Length(encodeIn); SetLength(wString, StringL); //wString := UTF8Decode(encodeIn); //SetLength(result, length(encode)); //presult:=pchar(result); //psource:=pchar(encode); //StringL := Utf8ToUnicode(PWideChar(wString), StringL+1, PChar(encodeIn), StringL); StringL := Utf8ToUnicode(PWideChar(wString), StringL+1, PAnsiChar(encodeIn), StringL); if StringL > 0 then SetLength(WString, StringL-1) else WString := ''; Result := AnsiString(wString); if Result = '' then Result := EnCodeIn; { while psource^<>#0 do begin tmpch := psource^; if ((TmpCh <> ' ') and (Word(TmpCh) > 127)) then begin s := inttostr(Word(TmpCh)); if Length(s) < 4 then s := '0' + s; s := 'x' + s; Val(s,buf,code); if buf>=$100 then begin s:=WideChar(buf); presult^:=s[1]; end else presult^:=chr(buf); end else begin presult^ := tmpch; end; Inc(presult); Inc(psource); end; } end else begin // while psource^<>#0 do begin if (psource^='\') or (psource^='_') then begin tmpch := psource^; inc(psource); if psource^='U' then begin inc(psource); if psource^='+' then begin //inc(psource); //psource^:='x'; SetString(s,psource,5); s[1] := 'x'; Val(s,buf,code); if buf>=$100 then begin s:=WideChar(buf); presult^:=s[1]; end else //presult^:=chr(buf); presult^:=Char(AnsiChar(buf)); // Tolik 27/03/2019 Inc(psource,5); end else begin presult^ := tmpch; inc(presult); presult^ := 'U'; // '\' end end else presult^ := tmpch; // '\' end else begin presult^:=psource^; Inc(psource); end; Inc(presult); end; SetLength(result, presult - pchar(Result)); end; except result:='error'; end; end; end; *) // Если юзать, то переработать на посимвольную обработку {function ConvUtf8ToStr(aString: String): String; Var Prefix: string; ss, sss: string; w: UTF8String; ww: WideString; i, j: Integer; ch: PWideChar; p: Pointer; currPos : integer; wChar: WideChar; Delagain: Boolean; simbolCode: Integer; StringChanged: Boolean; function HexToInt(h: string): integer; var i, c: integer; begin val('$'+h, i, c); if c > 0 then HexToInt := -1 else HexToInt := i; end; begin j := Pos('\U+', aString); if j = 0 then Result := aString else begin // Define Prefix Prefix := ''; if j > 1 then begin j := j - 1; for i := 1 to j do begin Prefix := Prefix + aString[i]; end; end; j := Length(Prefix); ss := aString; // get string without Prefix Delete(ss, Pos(Prefix, ss),j); // Deleting Delimiters delAgain := true; While DelAgain do begin DelAgain := False; if Pos('\U+', ss) <> 0 then begin DelAgain := True; Delete(ss,Pos('\U+', ss),3); end; end; // Result := ''; ww := ''; sss := ''; i := 1; While i <= Length(ss) do begin if ss[i] <> ' ' then begin sss := ''; for j := 1 to 4 do begin sss := sss + ss[i]; Inc(i); end; simbolCode := HexToInt(sss); wChar := WideChar(simbolCode); ww := ww+wChar; Result := AnsiString(ww); end else begin ww := ww + ' '; Inc(i); end; end; Result := Prefix + AnsiString(ww); end; end; } function GetColor(Sender: TObject): integer; var C: TColor; CBack: TColor; begin result := clBlack; CBack := GCadForm.PCad.PageColor; //C := TsgDXFPolyLine(Sender).Color; //Poly.Color := EntColor(TsgDXFSolid(Sender), nil); C := EntColor(TsgDXFEntity(Sender), FCADParams.Insert); if C = clNone then begin if (GetBValue(CBack) < 56) and (GetRValue(CBack) < 56) and (GetGValue(CBack) < 56) then C := clWhite; if (GetBValue(CBack) > 200) and (GetRValue(CBack) > 200) and (GetGValue(CBack) > 200) then C := clBlack; end; Result := C; end; function ConvertDWGToDXF(aDWGFileName: string): string; var ProgStr: string; ParamStr: string; fromDir, outDir: string; SCSTmpDir: string; c1: Cardinal; pe: TProcessEntry32; s1: string; x: integer; FContinue: boolean; begin try Result := ''; ProgStr := GetEXEDir + '\DWG\DWG.exe'; SCSTmpDir := GetPathToSCSTmpDir; if DirectoryExists(SCSTmpDir + '\DWG') then FullRemoveDir(SCSTmpDir + '\DWG', true, true); CreateDir(SCSTmpDir + '\DWG'); CreateDir(SCSTmpDir + '\DWG\OUT'); fromDir := SCSTmpDir + '\DWG'; outDir := SCSTmpDir + '\DWG\OUT'; CopyFile(PChar(aDWGFileName), PChar(fromDir + '\temp.dwg'), False); ParamStr := fromDir + ' ' + outDir + ' ' + '"ACAD12" "DXF" "0" "0"'; ShellExecute(FSCS_Main.Handle, 0, PChar(ProgStr), PChar(ParamStr), 0, SW_HIDE); Result := outDir + '\temp.dxf'; repeat X := 0; FContinue := True; c1 := CreateToolHelp32Snapshot(TH32CS_SnapProcess, 0); try pe.dwSize := sizeof(pe); if Process32First(c1, pe) then repeat s1 := ExtractFileName(pe.szExeFile); if s1 = 'DWG.exe' then begin inc(x); FContinue := False; end; until not Process32Next(c1, pe); finally CloseHandle(c1); end; until FContinue; except on E: Exception do AddExceptionToLogEx('U_ImportDXF.ConvertDWGToDXF', E.Message); end; end; procedure LoadDXFFile(aPCad: TPowerCad); var i, Count: Integer; OpenDXF: TOpenDialog; tempstr: string; DXFObject: TFigureGrp; Bnd: TDoubleRect; Cad_X, Cad_Y, Cad_CenterX, Cad_CenterY: Double; Dxf_X, Dxf_Y, Dxf_CenterX, Dxf_CenterY: Double; ScaleDelta: Double; fContinue: Boolean; iFileHandle: Integer; iFileLength: Integer; iBytesRead: Integer; // Tolik 08/04/2019 -- //buffer: PChar; buffer: PAnsiChar; // TempStream: TMemoryStream; mess: string; vLayer: TLayer; DXFFileName, DWGFileName, TXTFileName: string; // begin OpenDXF := TOpenDialog.Create(nil); with OpenDXF do begin InitialDir := GetEXEDir + '\DXF'; Title := cImport_Mes4; Filter := cImport_Mes5; DefaultExt := '*.dxf, *.dwg'; FileName := ''; Options := [ofReadOnly,ofHideReadOnly,ofPathMustExist,ofFileMustExist]; end; if OpenDXF.Execute then begin try BeginProgress; tempstr := AnsiLowerCase(OpenDXF.FileName); GCadForm.CurrentLayer := 1; if pos('.wmf', OpenDXF.FileName) <> 0 then aPCad.ImportWMF(1, OpenDXF.FileName, False) else begin DXFFileName := OpenDXF.FileName; // ****************** DWG - DXF ************************************** if pos('.dwg', OpenDXF.FileName) <> 0 then begin DWGFileName := OpenDXF.FileName; DXFFileName := ConvertDWGToDXF(DWGFileName); end; // ****************** DWG - DXF ************************************** aPCad.DeselectAll(0); fContinue := False; try iFileLength := 0; iFileHandle := FileOpen(DXFFileName, fmShareDenyNone); if iFileHandle > 0 then begin iFileLength := FileSeek(iFileHandle,0,2); if iFileLength > 0 then begin FileSeek(iFileHandle,0,0); //Tolik 08/04/2019 - - //Buffer := PChar(AllocMem(iFileLength + 1)); Buffer := PAnsiChar(AllocMem(iFileLength + 1)); // iBytesRead := FileRead(iFileHandle, Buffer^, iFileLength); if iBytesRead = iFileLength then begin try TempStream := TMemoryStream.Create; TempStream.WriteBuffer(Buffer^, iBytesRead); DeleteFile(GetTempDir + '\temp~.dxf~'); TempStream.SaveToFile(GetTempDir + '\temp~.dxf~'); fContinue := True; finally TempStream.Free; end; end; end; end; finally FileClose(iFileHandle); if iFileLength > 0 then FreeMem(Buffer); end; if Not fContinue then begin ShowMessage(cImport_Mes1 + DXFFileName); end else begin // удалить старый DeleteDxfLayers(aPCad); FDXFObjectsList := TList.create; aPCad.SCSImportDXF(GetTempDir + '\temp~.dxf~', False, True); // Обновить менеджер слоев if F_LayersDialog.Showing then F_LayersDialog.UpdateLayersList; // выделить обьекты на дхф слоях aPCad.DeselectAll(0); for i := 10 to aPCad.Layers.Count - 1 do if TLayer(aPCad.Layers[i]).IsDxf then aPCad.SelectAll(i); aPCad.GroupSelection; if aPCad.Selection.Count > 0 then begin DXFObject := TFigureGrp(aPCad.Selection[0]); Cad_X := aPCad.WorkWidth - 20 - 5; Cad_Y := aPCad.WorkHeight - 5 - 5; Cad_CenterX := aPCad.WorkWidth / 2 + 7.5; Cad_CenterY := aPCad.WorkHeight / 2; Bnd := DXFObject.GetBoundRect; Dxf_X := abs(Bnd.Right - Bnd.Left); Dxf_Y := abs(Bnd.Bottom - Bnd.Top); if Dxf_X < 0.01 then Dxf_X := 0.01; if Dxf_Y < 0.01 then Dxf_Y := 0.01; // SCALE ScaleDelta := Min(Cad_X / Dxf_X, Cad_Y / Dxf_Y); if ScaleDelta <> 1 then begin mess := cImport_Mes3; //if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cImport_Mes2, MB_YESNO) = IDYes then //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cImport_Mes2, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PWideChar(mess), cImport_Mes2, MB_YESNO) = IDYes then begin if ScaleDelta > 0.001 then DXFObject.Scale(ScaleDelta, ScaleDelta); end; end; Bnd := DXFObject.GetBoundRect; Dxf_X := abs(Bnd.Right - Bnd.Left); Dxf_Y := abs(Bnd.Bottom - Bnd.Top); Dxf_CenterX := DXFObject.CenterPoint.x; Dxf_CenterY := DXFObject.CenterPoint.y; if ScaleDelta > 0.001 then DXFObject.move(Cad_CenterX - Dxf_CenterX, Cad_CenterY - Dxf_CenterY); end; aPCad.SetHScrollPosition(0, True); end; if pos('.dwg', OpenDXF.FileName) <> 0 then begin if DirectoryExists(GetPathToSCSTmpDir + '\DWG') then FullRemoveDir(GetPathToSCSTmpDir + '\DWG', true, true); end; end; except on E: Exception do AddExceptionToLogEx('U_ImportDXF.LoadDXFFile', E.Message); end; EndProgress; end; FreeAndNil(OpenDXF); end; // by IGOR 28/09/2017 -- procedure CallDosAppRedirect( szCmd :PChar; {dwWait : DWORD;} var sRes, sErr, sErrShow :string ); var sa :TSecurityAttributes; si :TStartupInfo; pi :TProcessInformation; hReadOut :THandle; { pipe handles for redirecting STDOUT } hWriteOut :THandle; hReadIn :THandle; { pipe handles for redirecting STDIN } hWriteIn :THandle; bTest :Boolean; dwRead : DWORD; // Tolik 20/12/2019 //FBuffer :array[0..255] of Char; FBuffer :array[0..255] of AnsiChar; // sCmd :string; i :Integer; begin FillChar( sa, SizeOf(sa), 0 ); sa.nLength := SizeOf( sa ); sa.bInheritHandle := True; sa.lpSecurityDescriptor := nil; { Create pipe for output redirection } if (not CreatePipe( hReadOut, // read end of the pipr hWriteOut, // write end of the pipe @sa, // security attributes 0)) then begin // bytes reserved - default 0. sErr := sErr+'redirection error'; sErrShow := 'Ошибка при перенаправлении стандартного вывода'; Exit; end; { Create pipe for input redirection. } { It is not really used, but I need valid handles for safety } if (not CreatePipe( hReadIn, hWriteIn, @sa, 0)) then begin sErr := 'redirection error'; sErrShow := 'Ошибка при перенаправления стандартного ввода'; CloseHandle( hReadOut ); CloseHandle( hWriteOut ); Exit; end; { Make child process use hWriteOut as standard out, and make } { sure it does not show on screen. } FillChar( si, SizeOf(si), 0 ); si.cb := Sizeof(si); si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; si.wShowWindow := SW_HIDE; si.hStdInput := hWriteIn; si.hStdOutput := hWriteOut; si.hStdError := hWriteOut; if (not CreateProcess( nil, PChar(szCmd), nil, nil, True, 0, nil, nil, si, pi)) then begin sErr := 'application start error'; sErrShow := 'Ошибка при старте команды'; CloseHandle( hReadOut ); CloseHandle( hWriteOut ); CloseHandle( hReadIn ); CloseHandle( hWriteIn ); Exit; end; CloseHandle( hWriteOut ); { child process uses it !!} CloseHandle( hReadIn ); while( True ) do begin bTest := ReadFile( hReadOut, // handle of the read end of our pipe FBuffer, // address of buffer that receives data 255, // number of bytes to read dwRead, // number of bytes really read nil ); // non-overlapped. if (not bTest) then begin {sErr := 'application output reading error ('+IntToStr(GetLastError)+')'#13#10; sErrShow := 'Ошибка чтения перенаправленного вывода';} Break; end; { pipe done - normal exit } if (dwRead = 0) then Break; { Process extracted data } FBuffer[ dwRead ] := #0; // Tolik 20/12/2019 -- //sRes := sRes + StrPas( FBuffer ); sRes := sRes + AnsiString(StrPas( FBuffer )); // end; { Wait for CONSPAWN to finish } if (WaitForSingleObject( pi.hProcess, 20000 ) = WAIT_TIMEOUT) then begin sErr := 'application timeout'; sCmd := StrPas( szCmd ); i := Pos( '\', sCmd ); while i > 0 do begin sCmd := Copy( sCmd, i+1, Length(sCmd)-i); i := Pos( '\', sCmd ); end; sErrShow := 'Команда '''+sCmd+''' исполняется слищком долго'; end; { Close all remaining handles } CloseHandle (pi.hProcess); CloseHandle (pi.hThread ); CloseHandle( hReadOut ); CloseHandle( hWriteIn ); end; // Tolik 04/01/2018 -- Function CheckFileAutocad2018(Var aFileName: String): Boolean; Var //aCadVer: string; aCadVer: AnsiString; f: TextFile; aproc: TFPointProc; TempDir: String; currDirName: String; sRes, sErr, sErrShow, sCmd, sParams: string; ProcCount: integer; Begin Result := true; assignFile(f, aFileName); reset(f); aCadVer := ''; read(f, aCadVer); CloseFile(f); if Pos('AC1032', aCadVer) = 1 then begin TempDir := ExtractSCSTempDir; try if Fileexists(TempDir + '!TmpDWg.dwg') then SysUtils.DeleteFile(TempDir + '!TmpDWg.dwg'); except on E: Exception do begin Result := False; ShowMessage('Cant delete temp dwg file!'); exit; end; end; currDirName := GetEXEDir; sRes := ''; sErr := ''; sErrShow := ''; //CallDosAppRedirect( PChar('c:\windows\system32\cmd.exe'), sRes, sErr, sErrShow); //sCmd := 'c:\tmp\DWG\convdwg.exe'; sCmd := currDirName + '\DWG\convdwg.exe'; sParams := ' /F ' + aFileName +' /O '+ TempDir +'!TmpDWg.dwg /V R2010 /T Version'; CallDosAppRedirect( PChar(sCmd + sParams), sRes, sErr, sErrShow); ProcCount := 0; while Pos('Stopped', sRes) > 0 do begin inc(ProcCount); sRes[Pos('Stopped', sRes)] := ' '; end; if ProcCount = 6 then begin //ShowMessage('Success!') aFileName := TempDir + '!TmpDWg.dwg'; // success converting file AlternateFileNameToLoad := TempDir + '!TmpDWg.dwg'; end else begin Showmessage('Cant convert File!!!'); // converting file error AlternateFileNameToLoad := ''; Result := False; exit; end; end; end; procedure LoadDXFFileNew(aPCad: TPowerCad; aTitle, aFilter: string; aFile: String=''; aAllowScale: Boolean=true; aLoadAsPicture: Boolean = False); var i, Count: Integer; OpenDXF: TOpenDialog; tempstr: string; DXFObject: TFigureGrp; Bnd: TDoubleRect; Cad_X, Cad_Y, Cad_CenterX, Cad_CenterY: Double; Dxf_X, Dxf_Y, Dxf_CenterX, Dxf_CenterY: Double; ScaleDelta: Double; fContinue: Boolean; iFileHandle: Integer; iFileLength: Integer; iBytesRead: Integer; //buffer: PChar; buffer: PAnsiChar; // Tolik 28/03/2019 TempStream: TMemoryStream; mess: string; vLayer: TLayer; DXFFileName, DWGFileName, TXTFileName: string; vDxfFigure: TFigure; LHandle: Integer; //Tolik vDxfObject: TObject; Block: TBlock; SavedCadScale: Integer; LoadasImage: Boolean; PictObject: TBMPObject; vBmp: TBitmap; vJpeg: TJpegImage; PixelsCount: Int64; AFigure: TFigure; ABlock: TBlock; k: Integer; RightScaleFormat: boolean; InputString, NumberString: string; PictureScale: Integer; InputChar: Char; SimpleObjectsCount: Integer; PolyLinesPointsCount: Integer; //Tolik -- WasLoadAsImageQuery: Boolean; UserDimLine: Boolean; BmpHandle: TFigHandle;// Tolik 12/08/2021 -- // // 03/03/2016 -- function GetImagePixelFormat(ImgWidth, ImgHeight, qw: Integer): TPixelFormat; var i : Integer; bitarray : array[1..5] of Integer; j: Int64; imgSize: Double; begin Result := pf1bit; // Tolik 10/10/2019 -- bitArray[1] := 4; bitArray[2] := 3; bitArray[3] := 2; bitArray[4] := 1; bitArray[5] := 1; // //bitArray[1] := 32; //bitArray[2] := 24; //bitArray[3] := 16; //bitArray[4] := 8; //bitArray[5] := 1; for i := 1 to 5 do begin // Tolik 10/09/2019 -- imgSize := ImgWidth*ImgHeight; imgSize := ABS(imgSize); imgSize := imgSize * bitArray[i]; if i = 5 then imgSize := imgSize/8; j := Round(imgSize); //j := Round(ABS(ImgWidth*ImgHeight*bitArray[i]) div 8); // if j < 100000000 { 200000000 } then begin case i of 1: Result := pf32bit; 2: Result := pf24bit; 3: Result := pf16Bit; 4: Result := pf8bit; 5: Result := pf1bit; end; Break; //// BREAK ////; end; end; end; // Tolik -- загрузить как картинку procedure LoadFileAsPicture; var tempRect: TFRect; tempR: TRect; xx,yy: Double; xxx, yyy: Integer; aPort: TsgDXFViewport; LoadInViewPort: Boolean; ImgClipping: TsgClipping; mybmp: TBitMap; aspR: double; p: TFPoint; begin // проверочка, если файл Автокад 2018 ... if not CheckFileAutocad2018(aFile) then exit; // Tolik 28/09/2017 -- if AlternateFileNameToLoad <> '' then tempStr := AlternateFileNameToLoad; // if Pos('.dxf', tempstr) <> 0 then begin {$IF Defined(CADImport6)} ImgDXF := TsgDXFImage.Create; {$ELSE} ImgDXF:= TsgCADDXFImage.Create; {$IFEND} ImgDXF.LoadFromFile(aFile); end else if Pos('.dwg', tempstr) <> 0 then begin ImgDWG := TsgDWGImage.Create; // Tolik LoadInViewPort := False; // { CADPreview := True; ImgDWG.DrawRectInt(); ImgDWG.SetVisibleArea(); } ImgDWG.LoadFromFile(aFile); ImgDWG.GetExtents; // -- по идее это должно само выставить модель рисунка как CurrentLayout -- if AlternateFileNameToLoad = '' then // если сконвертили файл - вопрос не задаем if not WasLoadAsImageQuery then if (ImgDWG.Converter.ActiveVPort <> nil) then LoadInViewPort := (MessageModal('- ' + cImportDWG_Msg1, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES); aspR := ImgDwg.Height / ImgDWG.Width; if LoadInViewPort then begin xx := ImgDWG.Scale.X; yy := ImgDWG.Scale.Y; aPort := TsgDXFViewport(ImgDWG.Converter.ActiveVPort); if (ImgDWG.Converter.ActiveVPort <> nil) then begin begin aspR := 1/ImgDWG.Converter.ActiveVPort.ViewAspectRatio; tempRect.Left := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.X - (ImgDWG.Converter.ActiveVPort.ViewAspectRatio * ImgDWG.Converter.ActiveVPort.ViewHeight) / 2 + 100; tempRect.Top := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.Y - ImgDWG.Converter.ActiveVPort.ViewHeight/2 + 100; tempRect.Right := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.X + (ImgDWG.Converter.ActiveVPort.ViewAspectRatio * ImgDWG.Converter.ActiveVPort.ViewHeight) / 2 - 100; tempRect.Bottom := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.Y + ImgDWG.Converter.ActiveVPort.ViewHeight/2 - 100; { tempRect.Left := ImgDWG.Converter.ActiveVPort.UcsOrigin.X - (ImgDWG.Converter.ActiveVPort.ViewAspectRatio * ImgDWG.Converter.ActiveVPort.ViewHeight) / 2; tempRect.Top := ImgDWG.Converter.ActiveVPort.UcsOrigin.Y - ImgDWG.Converter.ActiveVPort.ViewHeight/2; tempRect.Right := ImgDWG.Converter.ActiveVPort.UcsOrigin.X + (ImgDWG.Converter.ActiveVPort.ViewAspectRatio * ImgDWG.Converter.ActiveVPort.ViewHeight) / 2; tempRect.Bottom := ImgDWG.Converter.ActiveVPort.UcsOrigin.Y + ImgDWG.Converter.ActiveVPort.ViewHeight/2;} //BoundaryList := ImgDWG.Converter.ActiveVPort.GetBoundariesAsPoints(ImgDWG.Converter); { tempRect.Left := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.X - (ImgDWG.Converter.ActiveVPort.ViewAspectRatio * ImgDWG.Converter.ActiveVPort.ViewHeight) / 2; tempRect.Top := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.Y - ImgDWG.Converter.ActiveVPort.ViewHeight / 2; tempRect.Right := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.X + (ImgDWG.Converter.ActiveVPort.ViewAspectRatio * ImgDWG.Converter.ActiveVPort.ViewHeight) / 2; tempRect.Bottom := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.Y + ImgDWG.Converter.ActiveVPort.ViewHeight / 2; } { tempRect.Left := 0; //tempRect.Left := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.X - (ImgDWG.Converter.ActiveVPort.ViewAspectRatio * ImgDWG.Converter.ActiveVPort.ViewHeight) / 2; //tempRect.Top := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.Y - ImgDWG.Converter.ActiveVPort.ViewHeight / 2; tempRect.Top := 0; //tempRect.Right := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.X + (ImgDWG.Converter.ActiveVPort.ViewAspectRatio * ImgDWG.Converter.ActiveVPort.ViewHeight) / 2; tempRect.Right := ImgDWG.AbsWidth; //tempRect.Bottom := ImgDWG.Converter.ActiveVPort.ViewCenterPoint.Y + ImgDWG.Converter.ActiveVPort.ViewHeight / 2; tempRect.Bottom := ImgDWG.AbsHeight; //ImgDWG.SetClippingRectExt(tempRect); //ImgDWG.SetClippingRectExt(TsgDXFViewport(ImgDWG.Converter.ActiveVPort).Rect); //ImgDWG.Center //ImgDWG.Clipping := } ImgClipping.ClipMode := 3; ImgClipping.ClipRect := tempRect; ImgDWG.Clipping := ImgClipping; { tempRect.Left := 0; tempRect.Top := 0; tempRect.Bottom := 1000; tempRect.Right := 1000; //ImgDWG.DrawingBox := tempRect; //ImgDWG.Converter.ViewPortCut := true; tempRect := ImgDWG.ViewRectangle; } end; end; end; {tempRect.Left := 100; tempRect.Top := 100; tempRect.Right := 200; tempRect.Bottom := 200;} //ImgDWG.SetClippingRectExt(F_Import.ActPort.Box); //ImgDWG.SetVisibleArea(); //ImgDWG.Converter.Draw //ImgDWG.Converter. end; if ((ImgDWG <> nil) or (ImgDXF<> nil)) then begin // Tolik -- LHandle := aPCad.GetLayerHandle(1); DXFObject := TFigureGrp.create(LHandle, aPCad); PictureScale := 1; RightScaleFormat := False; NumberString := '123456789'; while not RightScaleFormat do begin RightScaleFormat := True; InputString:= InputBox(cImport_Mes15, '(1..9)', '5'); if (Length(InputString) < 0) or (Length(InputString) > 1) then RightScaleFormat := False; if RightScaleFormat and (Pos(InputString, NumberString)>0) then PictureScale := StrToInt(InputString) else RightScaleFormat := False; end; // { tempR.Top := 0; tempR.Left := 0; tempR.Bottom := 200; tempR.Right := 200; vBmp := TBitmap.Create; vBmp.Width := 1000*PictureScale; // for instance vBmp.Height := 1000*PictureScale; // for instance ImgDWG.DrawRect(vBmp.Canvas.Handle, tempRect, tempR); vBmp.SaveToFile('d:\1.bmp'); vBmp.Free; tempRect.Top := 0; tempRect.Left := 0; tempRect.Bottom := 200; tempRect.Right := 200; vBmp := TBitmap.Create; vBmp.Width := 1000*PictureScale; // for instance vBmp.Height := 1000*PictureScale; // for instance ImgDWG.DrawRect(vBmp.Canvas.Handle, tempRect, tempR); vBmp.SaveToFile('d:\2.bmp'); vBmp.Free; } vJpeg := TJPEGImage.Create; vBmp := TBitmap.Create; vBmp.Width := 1000*PictureScale; // for instance if Assigned(ImgDWG) then begin vBmp.PixelFormat := GetImagePixelFormat(1000*PictureScale, Round(1000*PictureScale * aspR), PictureScale); try vBmp.Height := Round(1000 * aspR)*PictureScale; except on E: Exception do begin vBmp.PixelFormat := pf8bit; vBmp.Height := Round(1000 * aspR)*PictureScale; end; end; {vBmp.Width := Abs(round(tempRect.Right - tempRect.Left)); vBmp.Height := Abs(round(tempRect.Bottom - tempRect.Top));} vBmp.Canvas.StretchDraw(Rect(0, 0, vBmp.Width, vBmp.Height), ImgDWG); //vBmp.Canvas.Draw(0,0, ImgDWG); //ImgDWG.DrawRect(vBmp.Canvas.Handle, tempRect, Rect(0, 0, vBmp.Width, vBmp.Height)); //ImgDWG.DrawRect(vBmp.Canvas.Handle, tempRect, Rect(0, 0, vBmp.Width, vBmp.Height)); {tempR.Left := Round(tempRect.Left); tempR.Top := Round(tempRect.Top); tempR.Bottom := Round(tempRect.Bottom); tempR.Right := Round(tempRect.Right); vBmp.Canvas.StretchDraw(Tempr, ImgDWG); } (*mybmp := TBitMap.Create; mybmp.width := 1000;//ImgDWG.Width; mybmp.Height := 1000;//Imgdwg.Height; //vBmp.Canvas.Assign(myCanv); mybmp.Canvas.StretchDraw(Rect(0, 0, vBmp.Width, vBmp.Height), ImgDWG); mybmp.Canvas.MoveTo(0,0); mybmp.Canvas.Pen.Color := clBlack; mybmp.Canvas.Pen.Width := 3; xxx := Round((vBmp.Width - ImgDWG.Converter.ActiveVPort.ViewAspectRatio *ImgDWG.Converter.ActiveVPort.ViewHeight)/2); yyy := Round((vBmp.Height - ImgDWG.Converter.ActiveVPort.ViewHeight)/2); mybmp.Canvas.MoveTo(xxx, yyy); // вправо xxx := xxx + Round((ImgDWG.Converter.ActiveVPort.ViewAspectRatio *ImgDWG.Converter.ActiveVPort.ViewHeight)/2); mybmp.Canvas.LineTo(xxx, yyy); // вниз yyy := yyy + Round(ImgDWG.Converter.ActiveVPort.ViewHeight); mybmp.Canvas.LineTo(xxx, yyy); // влево xxx := xxx + Round((ImgDWG.Converter.ActiveVPort.ViewAspectRatio *ImgDWG.Converter.ActiveVPort.ViewHeight)/2); mybmp.Canvas.LineTo(xxx, yyy); // вверх yyy := yyy + Round(ImgDWG.Converter.ActiveVPort.ViewHeight); mybmp.Canvas.LineTo(xxx, yyy); //mybmp.Canvas.Refresh; //vBmp.Canvas.Assign(myCanv); vbmp.Canvas.CopyRect(rect(0,0,vbmp.Width,vbmp.Height) , mybmp.Canvas, rect(0,0,myBmp.width,myBmp.height)); *) end else begin vBmp.PixelFormat := GetImagePixelFormat(1000*PictureScale, Round(1000*PictureScale * ImgDXF.Height / ImgDXF.Width), PictureScale); try vBmp.Height := Round(1000 * ImgDXF.Height / ImgDXF.Width)*PictureScale; except on E: Exception do begin vBmp.PixelFormat := pf8bit; vBmp.Height := Round(1000 * ImgDXF.Height / ImgDXF.Width)*PictureScale; end; end; vBmp.Canvas.StretchDraw(Rect(0, 0, vBmp.Width, vBmp.Height), ImgDXF); end; vJpeg.Assign(vBmp); // Tolik -- 14/12/2016 -- если будет, то не запишется, нужно удалить, а то упадет if FileExists(GetTempDir + '\TempLoad.jpg') then SysUtils.DeleteFile(GetTempDir + '\TempLoad.jpg'); // vJpeg.SaveToFile(GetTempDir + '\TempLoad.jpg'); vbmp.Free; //myCanv.free; //Tolik 12/08/2021 -- так низзя -- будет АВ если пользоатель отменит действие //PictObject := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0,GetTempDir + '\TempLoad.jpg', false, false, True)); //нужно вот так: BmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0,GetTempDir + '\TempLoad.jpg', false, false, True); PictObject := nil; if BmpHandle <> -1 then PictObject := TBMPObject(BmpHandle); // vJpeg.Free; //GCadForm.PCad.Figures.Remove(PictObject); //DXFObject.AddToGrp(PictObject); if PictObject <> nil then begin Cad_X := aPCad.WorkWidth - 20 - 5; Cad_Y := aPCad.WorkHeight - 5 - 5; Cad_CenterX := aPCad.WorkWidth / 2 + 7.5; Cad_CenterY := aPCad.WorkHeight / 2; Bnd := PictObject.GetBoundRect; Dxf_X := abs(Bnd.Right - Bnd.Left); Dxf_Y := abs(Bnd.Bottom - Bnd.Top); if Dxf_X < 0.01 then Dxf_X := 0.01; if Dxf_Y < 0.01 then Dxf_Y := 0.01; // SCALE if aAllowScale then begin ScaleDelta := Min(Cad_X / Dxf_X, Cad_Y / Dxf_Y); { if ScaleDelta <> 1 then begin mess := cImport_Mes3; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cImport_Mes2, MB_YESNO) = IDYes then begin} PictObject.Scale(ScaleDelta, ScaleDelta); //DXFObject.Scale(ScaleDelta, ScaleDelta); { end; end;} end; Bnd := PictObject.GetBoundRect; Dxf_X := abs(Bnd.Right - Bnd.Left); Dxf_Y := abs(Bnd.Bottom - Bnd.Top); Dxf_CenterX := PictObject.CenterPoint.x; Dxf_CenterY := PictObject.CenterPoint.y; PictObject.move(Cad_CenterX - Dxf_CenterX, Cad_CenterY - Dxf_CenterY); //aPCad.AddCustomFigure(1, DXFObject, False); } aPCad.SetHScrollPosition(0, True); end else UserDimLine := False; //Tolik 12/08/2021 -- end else begin UserDimLine := False; //Tolik 12/08/2021 -- Exit; end; end; function GetLoadedObjCount: Integer; var i, Counter: Integer; FFigure: TFigure; procedure GetFigureCount(aFigure: TFigure); var i: integer; currFigure: TFigure; begin if (not (aFigure is TFigureGRP)) then begin Inc(Result); if aFigure.classname = 'TPolyline' then // Tolik -- 11/05/2016 -- если будет более 50000 -- будет тормозить на отрисовке, // поэтому предлагать преобразовать в растр PolyLinesPointsCount := PolyLinesPointsCount + TPolyLine(aFigure).PointCount; end else begin Inc(Result); for i := 0 to TFigureGRp(aFigure).InFigures.Count - 1 do begin currFigure := TFigure(TFigureGRp(aFigure).InFigures[i]); GetFigureCount(currFigure); end; end; end; begin Result := 0; for i := 0 to FDXFObjectsList.Count - 1 do begin FFigure := TFigure(FDXFObjectsList[i]); GetFigureCount(FFigure); end; end; begin // Tolik ImgDWG := nil; ImgDXF := nil; CanLoadAllObjects := True; WasLoadAsImageQuery := False; AlternateFileNameToLoad := ''; UserDimLine := GisUserDimLine; // OpenDXF := TOpenDialog.Create(nil); if aFile = '' then begin with OpenDXF do begin InitialDir := ExtractDirByCategoryType(dctDXF);//ExtractSaveDirForCategory('DXF');//GetEXEDir + '\DXF'; Title := aTitle; Filter := aFilter; DefaultExt := '*.dxf, *.dwg, *.svg, *.prn, *.plt'; FileName := ''; Options := [ofReadOnly,ofHideReadOnly,ofPathMustExist,ofFileMustExist]; end; if OpenDXF.Execute then aFile := OpenDXF.FileName else UserDimLine := False; // Tolik 12/08/2021 -- end; if aFile <> '' then begin // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctDXF, ExtractFileDir(aFile)); try // BeginProgress; tempstr := AnsiLowerCase(aFile); GCadForm.CurrentLayer := 1; if pos('.wmf', aFile) <> 0 then begin try aPCad.ImportWMF(1, aFile, False); except end; end else begin DXFFileName := aFile; // Tolik -- импортировать как растровое изображение if aLoadasPicture then LoadFileAsPicture else begin // ****************** DWG - DXF ************************************** if pos('.dwg', aFile) <> 0 then begin // DWGFileName := aFile; // DXFFileName := ConvertDWGToDXF(DWGFileName); end; // ****************** DWG - DXF ************************************** aPCad.DeselectAll(0); fContinue := False; try iFileLength := 0; iFileHandle := FileOpen(DXFFileName, fmShareDenyNone); if iFileHandle > 0 then begin iFileLength := FileSeek(iFileHandle,0,2); if iFileLength > 0 then begin FileSeek(iFileHandle,0,0); //Buffer := PChar(AllocMem(iFileLength + 1)); Buffer := PAnsiChar(AllocMem(iFileLength + 1)); iBytesRead := FileRead(iFileHandle, Buffer^, iFileLength); if iBytesRead = iFileLength then begin try TempStream := TMemoryStream.Create; TempStream.WriteBuffer(Buffer^, iBytesRead); DeleteFile(GetTempDir + '\temp~.dxf~'); TempStream.SaveToFile(GetTempDir + '\temp~.dxf~'); fContinue := True; finally TempStream.Free; end; end; end; end; finally FileClose(iFileHandle); if iFileLength > 0 then FreeMem(Buffer); end; if Not fContinue then begin ShowMessage(cImport_Mes1 + DXFFileName); UserDimLine := False; end else begin // удалить старый DeleteDxfLayers(aPCad); FDXFObjectsList := TList.create; FDXFBlocksList := TList.Create; // Tolik --12/02/2016 -- // записать текущий скейл када и изменить его до 400 -- нуно для более-менее корректного подъема текста // (при масштабе меньше 100% шрифты могут отображаться некорректно из-за округления масштабирования) if FSCS_Main.tbCADToolsExpert.Visible then SavedCadScale := StrToInt(FSCS_Main.cbScaleExpert.Text) else SavedCadScale := StrToInt(FSCS_Main.cbScaleNoob.Text); if GCadForm.PCad.ZoomScale <> 400 then begin GCadForm.SetZoomScale(400); RefreshCAD(GCadForm.PCad); end; if ImportDXF(DXFFileName) then begin // Обновить менеджер слоев if F_LayersDialog.Showing then F_LayersDialog.UpdateLayersList; // выделить обьекты на дхф слоях LHandle := aPCad.GetLayerHandle(1); DXFObject := TFigureGrp.create(LHandle, aPCad); // Tolik LoadasImage := False; PolyLinesPointsCount := 0; // количество точек в полилиниях SimpleObjectsCount := GetLoadedObjCount; if not LoadAsimage then begin if not CanLoadAllObjects then //LoadasImage := (MessageBox(FSCS_Main.Handle, cImport_Mes16, PAnsiChar(cImport_Mes14_1), MB_YESNO) = IDYes); //LoadasImage := (MessageBox(FSCS_Main.Handle, cImport_Mes16, PAnsiChar(cImport_Mes14_1), MB_YESNO) = IDYes); LoadasImage := (MessageBox(FSCS_Main.Handle, PChar(cImport_Mes16), PChar(cImport_Mes14_1), MB_YESNO) = IDYes); end; // если больше 5000 примитивов или больше 50000 точек в полилиниях - предложить загрузить как картинку // if FDXFObjectsList.Count > 5000 then // 10/05/2016 -- выполнен рекурсивный расчет(если более 50000 - в растр) if not LoadAsImage then begin if (SimpleObjectsCount > 50000) or (PolyLinesPointsCount > 50000) then // if FDXFObjectsList.Count > 5000 then //LoadasImage := (MessageBox(FSCS_Main.Handle, cImport_Mes14, PAnsiChar(cImport_Mes14_1), MB_YESNO) = IDYes); //LoadasImage := (MessageBoxA(FSCS_Main.Handle, cImport_Mes14, PAnsiChar(cImport_Mes14_1), MB_YESNO) = IDYes); LoadasImage := (MessageBox(FSCS_Main.Handle, PChar(cImport_Mes14), PChar(cImport_Mes14_1), MB_YESNO) = IDYes); end; // если как картинку if LoadasImage then begin // Tolik -- WasLoadAsImageQuery := True; LoadFileAsPicture; // Tolik 04/03/2016 -- // если грузим как картинку, нужно уничтожить построенные фигуры, чтобы освободить память // фигуры for i := 0 to FDXFObjectsList.Count - 1 do begin aFigure := TFigure(FDXFObjectsList[i]); if Assigned(AFigure) then begin k := FDXFBlocksList.Count - 1; While k >= 0 do begin if (Assigned(FDXFBlocksList[k]) and (TBlock(FDXFBlocksList[k]).ID = AFigure.ID)) then FDXFBlocksList[k] := nil; dec(k); end; end; FreeAndNil(AFigure); end; //блоки (если есть) FDXFBlocksList.Pack; for i := 0 to FDXFBlocksList.Count - 1 do begin if Assigned(FDXFBlocksList[i]) then TBlock(FDXFBlocksList[i]).Free; end; // { LHandle := aPCad.GetLayerHandle(1); DXFObject := TFigureGrp.create(LHandle, aPCad); PictureScale := 1; RightScaleFormat := False; NumberString := '123456789'; while not RightScaleFormat do begin RightScaleFormat := True; InputString:= InputBox(cImport_Mes15, '(1..9)', '7'); if (Length(InputString) < 0) or (Length(InputString) > 1) then RightScaleFormat := False; if RightScaleFormat and (Pos(InputString, NumberString)>0) then PictureScale := StrToInt(InputString) else RightScaleFormat := False; end; // vJpeg := TJPEGImage.Create; vBmp := TBitmap.Create; vBmp.Width := 1000*PictureScale; // for instance if Assigned(ImgDWG) then begin vBmp.PixelFormat := GetImagePixelFormat(1000*PictureScale, Round(1000*PictureScale * ImgDwg.Height / ImgDWG.Width), PictureScale); vBmp.Height := Round(1000 * ImgDwg.Height / ImgDWG.Width)*PictureScale; vBmp.Canvas.StretchDraw(Rect(0, 0, vBmp.Width, vBmp.Height), ImgDWG); end else begin vBmp.PixelFormat := GetImagePixelFormat(1000*PictureScale, Round(1000*PictureScale * ImgDXF.Height / ImgDXF.Width), PictureScale); vBmp.Height := Round(1000 * ImgDXF.Height / ImgDXF.Width)*PictureScale; vBmp.Canvas.StretchDraw(Rect(0, 0, vBmp.Width, vBmp.Height), ImgDXF); end; vJpeg.Assign(vBmp); vJpeg.SaveToFile(GetTempDir + '\TempLoad.jpg'); vbmp.Free; PictObject := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0,GetTempDir + '\TempLoad.jpg', false, false)); vJpeg.Free; GCadForm.PCad.Figures.Remove(PictObject); DXFObject.AddToGrp(PictObject); } end else // не картинка begin for i := 0 to FDXFObjectsList.Count - 1 do begin vDxfFigure := TFigure(FDXFObjectsList[i]); // Tolik -- 04/02/2016 -- закомментил, так как исправил нахождение текстом своего блока и теперь, по идее, текст // сидит там, где надо (в своем блоке), а проверка на nil происходит ранее, до добавления в список { if vDxfFigure <> nil then begin if vDxfFigure.Cname = 'TText' then begin Block := TBlock(FDXFObjectsList[i]); vDxfFigure := TFigure(BLock); end; end;} DXFObject.AddToGrp(vDxfFigure); //28.04.2011 DXFObject.InFigures.Add(vDxfFigure); end; Cad_X := aPCad.WorkWidth - 20 - 5; Cad_Y := aPCad.WorkHeight - 5 - 5; Cad_CenterX := aPCad.WorkWidth / 2 + 7.5; Cad_CenterY := aPCad.WorkHeight / 2; Bnd := DXFObject.GetBoundRect; Dxf_X := abs(Bnd.Right - Bnd.Left); Dxf_Y := abs(Bnd.Bottom - Bnd.Top); if Dxf_X < 0.01 then Dxf_X := 0.01; if Dxf_Y < 0.01 then Dxf_Y := 0.01; // SCALE if aAllowScale then begin ScaleDelta := Min(Cad_X / Dxf_X, Cad_Y / Dxf_Y); if ScaleDelta <> 1 then begin // Tolik --09/03/2016 -- if not LoadasImage then begin mess := cImport_Mes3; //if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cImport_Mes2, MB_YESNO) = IDYes then //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cImport_Mes2, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cImport_Mes2), MB_YESNO) = IDYes then begin DXFObject.Scale(ScaleDelta, ScaleDelta); end; end else DXFObject.Scale(ScaleDelta, ScaleDelta); end; end; Bnd := DXFObject.GetBoundRect; Dxf_X := abs(Bnd.Right - Bnd.Left); Dxf_Y := abs(Bnd.Bottom - Bnd.Top); Dxf_CenterX := DXFObject.CenterPoint.x; Dxf_CenterY := DXFObject.CenterPoint.y; DXFObject.move(Cad_CenterX - Dxf_CenterX, Cad_CenterY - Dxf_CenterY); aPCad.AddCustomFigure(1, DXFObject, False); end; FreeAndNil(FDXFObjectsList); FreeAndNil(FDXFBlocksList); aPCad.SetHScrollPosition(0, True); end else UserDimLine := False; // Tolik 11/08/2021 -- // Tolik 12/02/2016 -- // Возвращаем масштаб на место if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.cbScaleExpert.Text := IntToStr(SavedCadScale) else FSCS_Main.cbScaleNoob.Text := IntToStr(SavedCadScale); if GCadForm.PCad.ZoomScale <> SavedCadScale then begin GCadForm.SetZoomScale(SavedCadScale); RefreshCAD(GCadForm.PCad); end; // end; if pos('.dwg', aFile) <> 0 then begin if DirectoryExists(GetPathToSCSTmpDir + '\DWG') then FullRemoveDir(GetPathToSCSTmpDir + '\DWG', true, true); end; end; end; except on E: Exception do begin AddExceptionToLogEx('U_ImportDXF.LoadDXFFileNew', E.Message); UserDimLine := False; end; end; //EndProgress; end else UserDimLine := False; FreeAndNil(OpenDXF); //Tolik --02/03/2016 -- if Assigned(ImgDWG) then FreeAndNil(ImgDWG); if Assigned(ImgDXF) then FreeAndNil(ImgDXF); AlternateFileNameToLoad := ''; // 28/09/2017 -- Tolik GisUserDimLine := UserDimLine; end; procedure LoadDXFFileWithName(aPCad: TPowerCad; aFName: string); var i, Count: Integer; tempstr: string; DXFObject: TFigureGrp; Bnd: TDoubleRect; Cad_X, Cad_Y, Cad_CenterX, Cad_CenterY: Double; Dxf_X, Dxf_Y, Dxf_CenterX, Dxf_CenterY: Double; ScaleDelta: Double; fContinue: Boolean; iFileHandle: Integer; iFileLength: Integer; iBytesRead: Integer; // Tolik 08/04/2019 -- //buffer: PChar; buffer: PAnsiChar; // TempStream: TMemoryStream; mess: string; vLayer: TLayer; DXFFileName, DWGFileName, TXTFileName: string; vDxfFigure: TFigure; LHandle: Integer; begin try BeginProgress; DXFFileName := aFName; tempstr := AnsiLowerCase(DXFFileName); GCadForm.CurrentLayer := 1; aPCad.DeselectAll(0); fContinue := False; try iFileLength := 0; iFileHandle := FileOpen(DXFFileName, fmShareDenyNone); if iFileHandle > 0 then begin iFileLength := FileSeek(iFileHandle,0,2); if iFileLength > 0 then begin FileSeek(iFileHandle,0,0); // Tolik 08/04/2019 -- //Buffer := PChar(AllocMem(iFileLength + 1)); Buffer := PAnsiChar(AllocMem(iFileLength + 1)); // iBytesRead := FileRead(iFileHandle, Buffer^, iFileLength); if iBytesRead = iFileLength then begin try TempStream := TMemoryStream.Create; TempStream.WriteBuffer(Buffer^, iBytesRead); DeleteFile(GetTempDir + '\temp~.dxf~'); TempStream.SaveToFile(GetTempDir + '\temp~.dxf~'); fContinue := True; finally TempStream.Free; end; end; end; end; finally FileClose(iFileHandle); if iFileLength > 0 then FreeMem(Buffer); end; if Not fContinue then begin ShowMessage(cImport_Mes1 + DXFFileName); end else begin // удалить старый DeleteDxfLayers(aPCad); FDXFObjectsList := TList.create; FDXFBlocksList := TList.Create; if ImportDXF(DXFFileName) then begin // Обновить менеджер слоев if F_LayersDialog.Showing then F_LayersDialog.UpdateLayersList; // выделить обьекты на дхф слоях LHandle := aPCad.GetLayerHandle(1); DXFObject := TFigureGrp.create(LHandle, aPCad); for i := 0 to FDXFObjectsList.Count - 1 do begin vDxfFigure := TFigure(FDXFObjectsList[i]); DXFObject.AddToGrp(vDxfFigure); //28.04.2011 DXFObject.InFigures.Add(vDxfFigure); end; FreeAndNil(FDXFObjectsList); FreeAndNil(FDXFBlocksList); Cad_X := aPCad.WorkWidth - 20 - 5; Cad_Y := aPCad.WorkHeight - 5 - 5; Cad_CenterX := aPCad.WorkWidth / 2 + 7.5; Cad_CenterY := aPCad.WorkHeight / 2; Bnd := DXFObject.GetBoundRect; Dxf_X := abs(Bnd.Right - Bnd.Left); Dxf_Y := abs(Bnd.Bottom - Bnd.Top); if Dxf_X < 0.01 then Dxf_X := 0.01; if Dxf_Y < 0.01 then Dxf_Y := 0.01; // SCALE ScaleDelta := Min(Cad_X / Dxf_X, Cad_Y / Dxf_Y); if ScaleDelta <> 1 then begin mess := cImport_Mes3; //if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cImport_Mes2, MB_YESNO) = IDYes then //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cImport_Mes2, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PWideChar(mess), cImport_Mes2, MB_YESNO) = IDYes then begin DXFObject.Scale(ScaleDelta, ScaleDelta); end; end; Bnd := DXFObject.GetBoundRect; Dxf_X := abs(Bnd.Right - Bnd.Left); Dxf_Y := abs(Bnd.Bottom - Bnd.Top); Dxf_CenterX := DXFObject.CenterPoint.x; Dxf_CenterY := DXFObject.CenterPoint.y; DXFObject.move(Cad_CenterX - Dxf_CenterX, Cad_CenterY - Dxf_CenterY); aPCad.AddCustomFigure(1, DXFObject, False); aPCad.SetHScrollPosition(0, True); end; end; except on E: Exception do AddExceptionToLogEx('U_ImportDXF.LoadDXFFileWithName', E.Message); end; EndProgress; end; function DxfColorToColor(aColor: Integer): Longint; const AcadColorTable: array [0..255] of Longint = ( $0,$FF,$FFFF,$FF00,$FFFF00,$FF0000,$FF00FF,$0,$4C4C4C,$A5A5A5,$FF,$7F7FFF,$A5, $5252A5,$7F,$3F3F7F,$4C,$26264C,$26,$131326,$3FFF,$7F9FFF,$29A5,$5267A5,$1F7F, $3F4F7F,$134C,$262F4C,$926,$131726,$7FFF,$7FBFFF,$52A5,$527CA5,$3F7F,$3F5F7F, $264C,$26394C,$1326,$131C26,$BFFF,$7FDFFF,$7CA5,$5291A5,$5F7F,$3F6F7F,$394C, $26424C,$1C26,$132126,$FFFF,$7FFFFF,$A5A5,$52A5A5,$7F7F,$3F7F7F,$4C4C,$264C4C, $2626,$132626,$FFBF,$7FFFDF,$A57C,$52A591,$7F5F,$3F7F6F,$4C39,$264C42,$261C, $132621,$FF7F,$7FFFBF,$A552,$52A57C,$7F3F,$3F7F5F,$4C26,$264C39,$2613,$13261C, $FF3F,$7FFF9F,$A529,$52A567,$7F1F,$3F7F4F,$4C13,$264C2F,$2609,$132617,$FF00, $7FFF7F,$A500,$52A552,$7F00,$3F7F3F,$4C00,$264C26,$2600,$132613,$3FFF00,$9FFF7F, $29A500,$67A552,$1F7F00,$4F7F3F,$134C00,$2F4C26,$92600,$172613,$7FFF00,$BFFF7F, $52A500,$7CA552,$3F7F00,$5F7F3F,$264C00,$394C26,$132600,$1C2613,$BFFF00,$DFFF7F, $7CA500,$91A552,$5F7F00,$6F7F3F,$394C00,$424C26,$1C2600,$212613,$FFFF00,$FFFF7F, $A5A500,$A5A552,$7F7F00,$7F7F3F,$4C4C00,$4C4C26,$262600,$262613,$FFBF00,$FFDF7F, $A57C00,$A59152,$7F5F00,$7F6F3F,$4C3900,$4C4226,$261C00,$262113,$FF7F00,$FFBF7F, $A55200,$A57C52,$7F3F00,$7F5F3F,$4C2600,$4C3926,$261300,$261C13,$FF3F00,$FF9F7F, $A52900,$A56752,$7F1F00,$7F4F3F,$4C1300,$4C2F26,$260900,$261713,$FF0000,$FF7F7F, $A50000,$A55252,$7F0000,$7F3F3F,$4C0000,$4C2626,$260000,$261313,$FF003F,$FF7F9F, $A50029,$A55267,$7F001F,$7F3F4F,$4C0013,$4C262F,$260009,$261317,$FF007F,$FF7FBF, $A50052,$A5527C,$7F003F,$7F3F5F,$4C0026,$4C2639,$260013,$26131C,$FF00BF,$FF7FDF, $A5007C,$A55291,$7F005F,$7F3F6F,$4C0039,$4C2642,$26001C,$261321,$FF00FF,$FF7FFF, $A500A5,$A552A5,$7F007F,$7F3F7F,$4C004C,$4C264C,$260026,$261326,$BF00FF,$DF7FFF, $7C00A5,$9152A5,$5F007F,$6F3F7F,$39004C,$42264C,$1C0026,$211326,$7F00FF,$BF7FFF, $5200A5,$7C52A5,$3F007F,$5F3F7F,$26004C,$39264C,$130026,$1C1326,$3F00FF,$9F7FFF, $2900A5,$6752A5,$1F007F,$4F3F7F,$13004C,$2F264C,$90026,$171326,$545454,$767676, $989898,$BABABA,$DCDCDC,$FFFFFF); begin try Result := AcadColorTable[abs(aColor) mod 256]; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; function PointToString(const P: TFPoint): string; begin Result := ' X='+ FloatToStr(P.X)+ ' Y='+ FloatToStr(P.Y)+ ' Z='+ FloatToStr(P.Z); end; constructor TF_Import.Create; begin ZeroMemory(@FTextPrevPt, SizeOf(TFPoint)); FTextUsePrevPt := false; end; function IsRectInRect(rect1, rect2 : TFRect) : boolean; begin if ((((rect1.left>=rect2.left)and(rect1.left<=rect2.right)) or ((rect1.left<=rect2.left)and(rect1.right>=rect2.left)) ) and ( ((rect1.top>=rect2.top)and(rect1.top<=rect2.bottom)) or ((rect1.top<=rect2.top)and(rect1.bottom>=rect2.top)) ) ) then Result:=true else Result:=false; end; // Tolik -- 01/02/2016 function TF_Import.ReadCADEntities(Entity: TsgDXFEntity): Integer; // Function TF_Import.ReadCADEntities(Entity: TsgDXFEntity; WithOutText: Boolean = true; CanScale: Boolean = true): Integer; const PS: array[psSolid..psDashDot] of string = ('psSolid','psDash','psDot','psDashDot'); var S: string; L: TsgDXFLayer; C: TColor; St: TPenStyle; a: single; ResEntity: TFigure; Blk: TBlock; Cad: TPCDrawing; inBox: boolean; MaxBlockSize: double; //Tolik FiguresList: TList; k: Integer; f: TextFile; { ss, sss: string; w: UTF8String; ww: WideString; i, j: Integer; ch: PWideChar; p: Pointer; currPos : integer; wChar: WideChar; Delagain: Boolean; simbolCode: Integer; StringChanged: Boolean; } function HexToInt(h: string): integer; var i, c: integer; begin val('$'+h, i, c); if c > 0 then HexToInt := -1 else HexToInt := i; end; // Tolik Procedure AddEntity(rEntity: TFigure); var i: Int64; begin if REntity <> nil then begin Blk := nil; // фигура не в блоке if FCADParams.Insert <> nil then i := FCADParams.Insert.Handle; if ((FCADParams.Insert = nil) and (F_Import.CurrentBlockHandle = -1)) then begin //Tolik if Entity.EntType = ceCurvePolygon then FDXFObjectsList.Insert(0,REntity) else // FDXFObjectsList.Add(REntity); end else // фигура в блоке begin Cad := TPCDrawing(GCadForm.PCad); { if F_Import.CurrentBlockHandle = -1 then Blk := GetDXFBlock(FCADParams.Insert.Handle) else Blk := GetDXFBlock(StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle]));} if (FCADParams.Insert <> nil) and (F_Import.CurrentBlockHandle = -1) then Blk := GetDXFBlock(FCADParams.Insert.Handle) else if F_Import.CurrentBlockHandle <> -1 then Blk := GetDXFBlock(StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle])); // такой блок уже есть, внести фигуру в него if Blk <> nil then begin // 16.01.2014 //Blk.AddFigure(ResEntity); Blk.AddFigure(REntity, False); end else // блока нет, создать и внести в него фигуру begin // if FCADParams.Insert.Visible then begin // inc(FBlockCount); Blk := TBlock.Create(REntity.LayerHandle, Cad); Blk.AddFigure(REntity); if F_Import.CurrentBlockHandle <> -1 then Blk.ID := StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle]) else Blk.ID := FCADParams.Insert.Handle; // Tolik if Entity.EntType = ceCurvePolygon then begin FDXFBlocksList.Insert(0, Blk); FDXFObjectsList.Insert(0, Blk); end // else begin FDXFBlocksList.Add(Blk); FDXFObjectsList.Add(Blk); end; end; { else dec(FEntitiesCount);} end; end; end; F_Import.CurrentBlockHandle := -1; end; (* // Tolik Procedure AddEntity(rEntity: TFigure); begin if REntity <> nil then begin // фигура не в блоке if FCADParams.Insert = nil then begin //Tolik if Entity.EntType = ceCurvePolygon then FDXFObjectsList.Insert(0,REntity) else // FDXFObjectsList.Add(REntity); end else // фигура в блоке begin Cad := TPCDrawing(GCadForm.PCad); Blk := GetDXFBlock(FCADParams.Insert.Handle); // такой блок уже есть, внести фигуру в него if Blk <> nil then begin // 16.01.2014 //Blk.AddFigure(ResEntity); Blk.AddFigure(REntity, False); end else // блока нет, создать и внести в него фигуру begin if FCADParams.Insert.Visible then begin // inc(FBlockCount); Blk := TBlock.Create(REntity.LayerHandle, Cad); Blk.AddFigure(REntity); Blk.ID := FCADParams.Insert.Handle; // Tolik if Entity.EntType = ceCurvePolygon then begin FDXFBlocksList.Insert(0, Blk); FDXFObjectsList.Insert(0, Blk); end // else begin FDXFBlocksList.Add(Blk); FDXFObjectsList.Add(Blk); end; end else dec(FEntitiesCount); end; end; end; end; *) begin F_Import.CurrentBlockHandle := -1; try Result := 0; Inc(FEntitiesCount); //29.10.2012 // S := #13#10'ClassName=' + Entity.ClassName + '; Entity name=' + utf16decode(Entity.EntName); DoScale2D(FCADParams); // calculates 2d scale and rotation // layer L := EntLayer(Entity, FCADParams.Insert); // if L <> nil then S := S + ' layer = ' + L.Name; // color // S := S + ' style = ' + PS[EntStyle(Entity)]; C := EntColor(Entity, FCADParams.Insert); St := EntStyle(Entity); {if C = clNone then S := S + ' color=black/white' else S := S + ' color = ' + IntToHex(C, -6) + ' (' + ColorToString(C) + ')';} // particular properties // TxtFile.Add(S); // Такое лучше не делать - сбивается оригинальный цвет иногда //Entity.Color := C; inBox := True; //так криво получается - нужно еще смотреть как обойти ситуации как файлах: "D:\WORK\СКС\! DWG_TESTS\" "A-203 FIRST FLOOR PLAN.dwg" Drawing5.dwg //if FCADParams.Insert <> nil then //begin // if FCADParams.Insert.Block <> nil then // begin // if Not IsRectInRect(FCADParams.Insert.Block.Box, Entity.Box) then // inBox := False; // end; //end; ResEntity := nil; {AssignFile(f, 'd:\Tolik\ARC.txt'); reset(f); append(f); writeln(f,TObject(Entity).ClassName); close(f);} if inBox then begin case Entity.EntType of ceLine: ResEntity := ImportLine(Entity); cePoint: ResEntity := ImportPoint(Entity); ceCircle: begin (* if FCADParams.Insert <> nil then begin if TsgDXFCircle(Entity).ZThick <> $FFFFFF then begin if (FCADParams.Insert.Count > 0) or (FCADParams.Insert.Owner <> nil) {or ((FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0))} then begin if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) and (abs(FCADParams.Insert.Scale.X) > 1) then begin //if (TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left) then //if (TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left) then MaxBlockSize := 0; if FCADParams.Insert.Count = 1 then begin MaxBlockSize := abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left); if abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom); end else begin MaxBlockSize := abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left); if abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom); end; if (TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < MaxBlockSize then begin TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFCircle(Entity).ZThick := $FFFFFF; end; end else begin TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFCircle(Entity).ZThick := $FFFFFF; end; end; //if FCADParams.Insert.Owner <> nil then //if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) // and (FCADParams.Insert.Count > 0) then //begin // TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); // TsgDXFCircle(Entity).ZThick := $FFFFFF; //end; //if FCADParams.Insert.Count > 0 then //begin // TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); // TsgDXFCircle(Entity).ZThick := $FFFFFF; //end; end; end; *) ResEntity := ImportCircle(Entity); end; ceArc: begin (* -- Tolik 20/01/2016 -- вкинуто в импорт эллипса -- if FCADParams.Insert <> nil then begin if TsgDXFArc(Entity).ZThick <> $FFFFFF then begin if (FCADParams.Insert.Count > 0) or (FCADParams.Insert.Owner <> nil) {or ((FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0))} then begin if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) and (abs(FCADParams.Insert.Scale.X) > 1) then begin //if (TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left) then //if (TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left) then MaxBlockSize := 0; if FCADParams.Insert.Count = 1 then begin MaxBlockSize := abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left); if abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom); end else begin MaxBlockSize := abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left); if abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom); end; if (TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < MaxBlockSize then begin TsgDXFArc(Entity).Radius := TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFArc(Entity).ZThick := $FFFFFF; end; end else begin TsgDXFArc(Entity).Radius := TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFArc(Entity).ZThick := $FFFFFF; end; end; end; end; *) ResEntity := ImportArc(Entity); end; ceEllipse: begin (* if FCADParams.Insert <> nil then begin if TsgDXFEllipse(Entity).ZThick <> $FFFFFF then begin if (FCADParams.Insert.Count > 0) or (FCADParams.Insert.Owner <> nil) {or ((FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0))} then begin if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) and (abs(FCADParams.Insert.Scale.X) > 1) then begin //if (TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left) then //if (TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left) then MaxBlockSize := 0; if FCADParams.Insert.Count = 1 then begin MaxBlockSize := abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left); if abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom); end else begin MaxBlockSize := abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left); if abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom); end; if (TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < MaxBlockSize then begin TsgDXFEllipse(Entity).Radius := TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFEllipse(Entity).ZThick := $FFFFFF; end; end else begin TsgDXFEllipse(Entity).Radius := TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFEllipse(Entity).ZThick := $FFFFFF; end; end; end; end; *) ResEntity := ImportEllipse(Entity); end; cePolyline, cePath: ResEntity := ImportPolyLine(Entity); ceLWPolyline: ResEntity := ImportPolyLine(Entity); // Tolik -- 12/12/2016 -- на пробу ceWipeOut: // ResEntity := ImportWipeOut(Entity); CanLoadAllObjects := False; // ceSpline: ResEntity := ImportSpline(Entity); ceLeader: ResEntity := ImportLeader(Entity); ceText: ResEntity := ImportText(Entity); //Tolik -- 13/02/2016 -- ceMText: ImportMText(Entity); ceAttdef, ceAttrib: ResEntity := ImportAttdef(Entity); ceSolid, ce3dFace: ResEntity := ImportSolid(Entity); cePolyPolygon, ceGradient, ceGradientPolygon, ceCurvePolygon, ceHatch: // Tolik begin FiguresList := ImportHatch(Entity); for k := 0 to FiguresList.Count - 1 do begin AddEntity(TFigure(FiguresList[k])); end; FreeAndNil(FiguresList); end; ceViewport: begin Result := 1; ResEntity := ImportViewPortBegin(Entity); //ViewPort - see dxfimage.pas TsgDXFImage.DrawViewPort end; ceEntity: ; ce3DSolid: ;//ResEntity := ImportSolid(Entity); // Tolik --12/12/2016 -- ceOle2Frame: //ImportOleToFrame(Entity); CanLoadAllObjects := False; // Tolik -- 02/01/2016 -- это все мы пока не обрабатываем, (А ОНО ЕСТЬ!) ceTrace : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceTRACE) '); CanLoadAllObjects := False; ceHelix : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceHELIX) '); CanLoadAllObjects := False; ceInsert : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceINSERT) '); CanLoadAllObjects := False; ceDimension : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceDIMENTION) '); CanLoadAllObjects := False; ceTolerance : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceTOLERANCE) '); CanLoadAllObjects := False; ceShape : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceSHAPE) '); CanLoadAllObjects := False; ceImageEnt : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceImageEnt) '); CanLoadAllObjects := False; ceRegion : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceRegion) '); CanLoadAllObjects := False; ceBody : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceBody) '); CanLoadAllObjects := False; cePattern : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (cePattern) '); CanLoadAllObjects := False; {ceOle2Frame : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceOle2Frame) ');} ceACADTable : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceACADTable) '); CanLoadAllObjects := False; ceFlatPoly : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceFlatPoly) '); CanLoadAllObjects := False; ceFlatHatch : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceFlatHatch) '); CanLoadAllObjects := False; ceXRef : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceXRef) '); CanLoadAllObjects := False; ceProxy : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceProxy) '); CanLoadAllObjects := False; { ceWipeOut : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceWipeOut) ');} ceMLine : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceMLine) '); CanLoadAllObjects := False; ceMPolygon : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceMPolygon) '); CanLoadAllObjects := False; ceSurface : //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceSurface) '); CanLoadAllObjects := False; {ceTable : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceTABLE) ');} // // Tolik 30/12/2015 -- скинуть константы в лог тех объектов, классы которых не определены в обработчике // скину в ЛОГ, чтоб хотя бы понимать, что не обрабатываем else //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! Entity.EntType = ' + IntToStr(Ord(Entity.EntType))); CanLoadAllObjects := False; // end; end; if ResEntity <> nil then AddEntity(ResEntity); except on E: Exception do AddExceptionToLogEx('TF_Import.ReadCADEntities', E.Message); end; end; function TF_Import.ReadCADTXTEntities(Entity: TsgDXFEntity): Integer; const PS: array[psSolid..psDashDot] of string = ('psSolid','psDash','psDot','psDashDot'); var S: string; L: TsgDXFLayer; C: TColor; St: TPenStyle; a: single; ResEntity: TFigure; Blk: TBlock; Cad: TPCDrawing; inBox: boolean; MaxBlockSize: double; //Tolik FiguresList: TList; i, k: Integer; j: Int64; LayerNbr, LHandle: Integer; aPoint: TDoublePoint; rect: TRectangle; { ss, sss: string; w: UTF8String; ww: WideString; i, j: Integer; ch: PWideChar; p: Pointer; currPos : integer; wChar: WideChar; Delagain: Boolean; simbolCode: Integer; StringChanged: Boolean; } function HexToInt(h: string): integer; var i, c: integer; begin val('$'+h, i, c); if c > 0 then HexToInt := -1 else HexToInt := i; end; // Tolik Procedure AddEntity(rEntity: TFigure); begin if REntity <> nil then begin // фигура не в блоке if FCADParams.Insert = nil then begin //Tolik if Entity.EntType = ceCurvePolygon then FDXFObjectsList.Insert(0,REntity) else // FDXFObjectsList.Add(REntity); end else // фигура в блоке begin Cad := TPCDrawing(GCadForm.PCad); Blk := GetDXFBlock(FCADParams.Insert.Handle); // такой блок уже есть, внести фигуру в него if Blk <> nil then begin // 16.01.2014 //Blk.AddFigure(ResEntity); Blk.AddFigure(REntity, False); end else // блока нет, создать и внести в него фигуру begin if FCADParams.Insert.Visible then begin // inc(FBlockCount); Blk := TBlock.Create(REntity.LayerHandle, Cad); Blk.AddFigure(REntity); Blk.ID := FCADParams.Insert.Handle; // Tolik if Entity.EntType = ceCurvePolygon then begin FDXFBlocksList.Insert(0, Blk); FDXFObjectsList.Insert(0, Blk); end // else begin FDXFBlocksList.Add(Blk); FDXFObjectsList.Add(Blk); end; end else dec(FEntitiesCount); end; end; end; end; begin try Result := 0; begin case Entity.EntType of { ceText: ResEntity := ImportTextWithParams(Entity, TsgDxfText(Entity).Converter.Params, TsgDXFText(Entity).GetMatrix); } ceMText: begin (* for i := 0 to TsgDxfMText(Entity).Block.Count - 1 do begin { ResEntity := ImportTextWithParams(TsgDxfMText(Entity).Block.Entities[i], TsgDxfMText(Entity).Converter.Params, TsgDxfMText(Entity).GetMatrix); if ResEntity <> nil then AddEntity(ResEntity);} j := TsgDxfText(TsgDxfMText(Entity).Block.Entities[i]).Handle; //TsgDxfText(TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).Block.Entities[k]).XScale := TsgDxfInsert(Entity).Scale.X; //TsgDxfText(TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).Block.Entities[k]).Scale := TsgDxfInsert(Entity).Scale.Y; F_Import.HandleList.Add(IntToStr(j)); j := TsgDxfMText(Entity).Handle; if j <> 0 then F_Import.BlockHandleList.Add(IntToStr(j)); if i = 0 then begin Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFMText(Entity).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Rect := TRectangle.create(TsgDXFMText(Entity).Block.Box.Left, TsgDXFMText(Entity).Block.Box.Top, TsgDXFMText(Entity).Block.Box.Right, TsgDXFMText(Entity).Block.Box.Bottom, Round(TsgDXFMText(Entity).Block.Box.Right - TsgDXFMText(Entity).Block.Box.Left), ord(psClear), clNone, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); blk := TBlock.Create(LHandle, Cad); //Blk.AddFigure(Rect); FDXFBlocksList.Add(Blk); // j := Blk.ID; Blk.ID := J; F_Import.BlockHandleList.Add(IntToStr(j)); end else F_Import.BlockHandleList.Add(IntToStr(j)); end; *) end; ceInsert : begin for i := 0 to TsgDxfInsert(Entity).Block.Count - 1 do begin if TsgDXFEntity(TsgDxfInsert(Entity).Block.Entities[i]) is TsgDXFMText then begin j := TsgDXFMText(TsgDxfInsert(Entity).Block.Entities[i]).Handle; F_Import.MTextBlockHandleList.Add(InttoStr(j)); // блок текста в блоке for k := 0 to TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).Block.Count - 1 do begin //ResEntity := ImportTextWithParams(TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).Block.Entities[k], TsgDxfInsert(Entity).Converter.Params, TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).gETmATRIX); { ResEntity := ImportTextWithParams(TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).Block.Entities[k], TsgDxfInsert(Entity).Converter.Params, TsgDxfInsert(Entity).gETmATRIX); if ResEntity <> nil then AddEntity(ResEntity);} j := TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).Block.Entities[k].Handle; //TsgDxfText(TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).Block.Entities[k]).XScale := TsgDxfInsert(Entity).Scale.X; //TsgDxfText(TsgDxfMText(TsgDxfInsert(Entity).Block.Entities[i]).Block.Entities[k]).Scale := TsgDxfInsert(Entity).Scale.Y; F_Import.HandleList.Add(IntToStr(j)); j := TsgDxfInsert(Entity).Handle; F_Import.BlockHandleList.Add(IntToStr(j)); end; end else if TsgDXFEntity(TsgDxfInsert(Entity).Block.Entities[i]) is TsgDXFText then begin {ResEntity := ImportTextWithParams(TsgDxfInsert(Entity).Block.Entities[i], TsgDxfInsert(Entity).Converter.Params, TsgDxfInsert(Entity).GetMatrix); if ResEntity <> nil then AddEntity(ResEntity);} j := TSgDXFText(TsgDxfInsert(Entity).Block.Entities[i]).Handle; // TsgDxfText(Entity).Handle; F_Import.HandleList.Add(IntToStr(j)); j := TsgDxfInsert(Entity).Handle; F_Import.BlockHandleList.Add(IntToStr(j)); end; end; end; end; end; except on E: Exception do AddExceptionToLogEx('TF_Import.ReadCADEntities', E.Message); end; end; Procedure TF_Import.SimpleReadCADEntities(Entity: TsgDXFEntity); const PS: array[psSolid..psDashDot] of string = ('psSolid','psDash','psDot','psDashDot'); var S: string; L: TsgDXFLayer; C: TColor; St: TPenStyle; a: single; ResEntity: TFigure; Blk: TBlock; Cad: TPCDrawing; inBox: boolean; MaxBlockSize: double; //Tolik FiguresList: TList; i,j, k: Integer; { ss, sss: string; w: UTF8String; ww: WideString; i, j: Integer; ch: PWideChar; p: Pointer; currPos : integer; wChar: WideChar; Delagain: Boolean; simbolCode: Integer; StringChanged: Boolean; } function HexToInt(h: string): integer; var i, c: integer; begin val('$'+h, i, c); if c > 0 then HexToInt := -1 else HexToInt := i; end; // Tolik Procedure AddEntity(rEntity: TFigure); begin if REntity <> nil then begin // фигура не в блоке if FCADParams.Insert = nil then begin //Tolik if Entity.EntType = ceCurvePolygon then FDXFObjectsList.Insert(0,REntity) else // FDXFObjectsList.Add(REntity); end else // фигура в блоке begin Cad := TPCDrawing(GCadForm.PCad); Blk := GetDXFBlock(FCADParams.Insert.Handle); // такой блок уже есть, внести фигуру в него if Blk <> nil then begin // 16.01.2014 //Blk.AddFigure(ResEntity); Blk.AddFigure(REntity, False); end else // блока нет, создать и внести в него фигуру begin Blk := TBlock.Create(REntity.LayerHandle, Cad); Blk.AddFigure(REntity); Blk.ID := FCADParams.Insert.Handle; // Tolik if Entity.EntType = ceCurvePolygon then begin FDXFBlocksList.Insert(0, Blk); FDXFObjectsList.Insert(0, Blk); end // else begin FDXFBlocksList.Add(Blk); FDXFObjectsList.Add(Blk); end; end; end; end; end; begin try // Result := 0; Inc(FEntitiesCount); //29.10.2012 // S := #13#10'ClassName=' + Entity.ClassName + '; Entity name=' + utf16decode(Entity.EntName); DoScale2D(FCADParams); // calculates 2d scale and rotation // layer L := EntLayer(Entity, FCADParams.Insert); if L <> nil then S := S + ' layer = ' + L.Name; // color //S := S + ' style = ' + PS[EntStyle(Entity)]; C := EntColor(Entity, FCADParams.Insert); St := EntStyle(Entity); { if C = clNone then S := S + ' color=black/white' else S := S + ' color = ' + IntToHex(C, -6) + ' (' + ColorToString(C) + ')'; // particular properties TxtFile.Add(S);} // Такое лучше не делать - сбивается оригинальный цвет иногда //Entity.Color := C; inBox := True; //так криво получается - нужно еще смотреть как обойти ситуации как файлах: "D:\WORK\СКС\! DWG_TESTS\" "A-203 FIRST FLOOR PLAN.dwg" Drawing5.dwg //if FCADParams.Insert <> nil then //begin // if FCADParams.Insert.Block <> nil then // begin // if Not IsRectInRect(FCADParams.Insert.Block.Box, Entity.Box) then // inBox := False; // end; //end; ResEntity := nil; if inBox then begin case Entity.EntType of ceLine: ResEntity := ImportLine(Entity); cePoint: ResEntity := ImportPoint(Entity); ceCircle: begin if FCADParams.Insert <> nil then begin if TsgDXFCircle(Entity).ZThick <> $FFFFFF then begin if (FCADParams.Insert.Count > 0) or (FCADParams.Insert.Owner <> nil) {or ((FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0))} then begin if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) and (abs(FCADParams.Insert.Scale.X) > 1) then begin //if (TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left) then //if (TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left) then MaxBlockSize := 0; if FCADParams.Insert.Count = 1 then begin MaxBlockSize := abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left); if abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom); end else begin MaxBlockSize := abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left); if abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom); end; if (TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < MaxBlockSize then begin TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFCircle(Entity).ZThick := $FFFFFF; end; end else begin TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFCircle(Entity).ZThick := $FFFFFF; end; end; //if FCADParams.Insert.Owner <> nil then //if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) // and (FCADParams.Insert.Count > 0) then //begin // TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); // TsgDXFCircle(Entity).ZThick := $FFFFFF; //end; //if FCADParams.Insert.Count > 0 then //begin // TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); // TsgDXFCircle(Entity).ZThick := $FFFFFF; //end; end; end; ResEntity := ImportCircle(Entity); end; ceArc: begin if FCADParams.Insert <> nil then begin if TsgDXFArc(Entity).ZThick <> $FFFFFF then begin if (FCADParams.Insert.Count > 0) or (FCADParams.Insert.Owner <> nil) {or ((FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0))} then begin if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) and (abs(FCADParams.Insert.Scale.X) > 1) then begin //if (TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left) then //if (TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left) then MaxBlockSize := 0; if FCADParams.Insert.Count = 1 then begin MaxBlockSize := abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left); if abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom); end else begin MaxBlockSize := abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left); if abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom); end; if (TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < MaxBlockSize then begin TsgDXFArc(Entity).Radius := TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFArc(Entity).ZThick := $FFFFFF; end; end else begin TsgDXFArc(Entity).Radius := TsgDXFArc(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFArc(Entity).ZThick := $FFFFFF; end; end; end; end; ResEntity := ImportArc(Entity); end; ceEllipse: begin if FCADParams.Insert <> nil then begin if TsgDXFEllipse(Entity).ZThick <> $FFFFFF then begin if (FCADParams.Insert.Count > 0) or (FCADParams.Insert.Owner <> nil) {or ((FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0))} then begin if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) and (abs(FCADParams.Insert.Scale.X) > 1) then begin //if (TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left) then //if (TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < // abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left) then MaxBlockSize := 0; if FCADParams.Insert.Count = 1 then begin MaxBlockSize := abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left); if abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom); end else begin MaxBlockSize := abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left); if abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom); end; if (TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < MaxBlockSize then begin TsgDXFEllipse(Entity).Radius := TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFEllipse(Entity).ZThick := $FFFFFF; end; end else begin TsgDXFEllipse(Entity).Radius := TsgDXFEllipse(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFEllipse(Entity).ZThick := $FFFFFF; end; end; end; end; ResEntity := ImportEllipse(Entity); end; cePolyline, cePath: ResEntity := ImportPolyLine(Entity); ceLWPolyline: ResEntity := ImportPolyLine(Entity); ceSpline: ResEntity := ImportSpline(Entity); ceLeader: ResEntity := ImportLeader(Entity); // Tolik -- 02/01/2016 ceText: ResEntity := ImportText(Entity); {ceText: begin if FCADParams.Insert <> nil then ResEntity := ImportText(Entity); end;} // ceAttdef, ceAttrib: ResEntity := ImportAttdef(Entity); ceSolid, ce3dFace: ResEntity := ImportSolid(Entity); cePolyPolygon, ceGradient, ceGradientPolygon, ceCurvePolygon, ceHatch: // Tolik if FCADParams.Insert <> nil then // Tolik begin FiguresList := ImportHatch(Entity); for k := 0 to FiguresList.Count - 1 do begin AddEntity(TFigure(FiguresList[k])); end; FreeAndNil(FiguresList); end; ceViewport: begin //Result := 1; ResEntity := ImportViewPortBegin(Entity); //ViewPort - see dxfimage.pas TsgDXFImage.DrawViewPort end; ceEntity: ; // Tolik -- 02/01/2016 -- это все мы пока не обрабатываем, (А ОНО ЕСТЬ!) ceTrace : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceTRACE) '); ceHelix : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceHELIX) '); ceInsert : begin for i := 0 to TsgDxfInsert(Entity).Count - 1 do SimpleReadCADEntities(TsgDXFEntity(TsgDxfInsert(Entity).Entities[i])); //inc(FBlockCount); //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceINSERT) '); end; ceDimension : begin for i := 0 to TsgDxfDimension(Entity).Count - 1 do SimpleReadCADEntities(TsgDXFEntity(TsgDxfDimension(Entity).Entities[i])); AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceDIMENTION) '); end; ceTolerance : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceTOLERANCE) '); ceMText : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceMTEXT) '); //AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceMTEXT) '); ceShape : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceSHAPE) '); ceImageEnt : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceImageEnt) '); ceRegion : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceRegion) '); ceBody : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceBody) '); cePattern : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (cePattern) '); ceOle2Frame : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceOle2Frame) '); ceACADTable : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceACADTable) '); ceFlatPoly : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceFlatPoly) '); ceFlatHatch : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceFlatHatch) '); ceXRef : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceXRef) '); ceProxy : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceProxy) '); ceWipeOut : // Tolik --12/12/2016 -- {AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceWipeOut) ');} ResEntity := ImportWipeOut(Entity); // ceMLine : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceMLine) '); ceMPolygon : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceMPolygon) '); ceSurface : AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! (ceSurface) '); // ce3DSolid: begin end // ;//ResEntity := ImportSolid(Entity); // Tolik 30/12/2015 -- скинуть константы в лог тех объектов, классы которых не определены в обработчике // скину в ЛОГ, чтоб хотя бы понимать, что не обрабатываем else AddExceptionToLogSilent('TF_Import.ReadCADEntities : The object is not processed! Entity.EntType = ' + IntToStr(Ord(Entity.EntType))); // end end; if ResEntity <> nil then begin AddEntity(ResEntity); //inc(ReadedEntCount); end; except on E: Exception do AddExceptionToLogEx('TF_Import.ReadCADEntities', E.Message); end; end; function TF_Import.CheckIsLoaded(Entity: TsgDXFEntity): Boolean; begin Result := False; if HandleList.IndexOf(inttostr(Entity.Handle)) = -1 then Result := True; end; function TF_Import.FinishReadCADEntities(Entity: TsgDXFEntity): Integer; begin case Entity.EntType of ceViewport: begin Result := 1; ImportViewPortEnd(Entity); end; else Result := 0; end; end; //procedure cbLayoutsChange(Sender: TObject); //begin // if cbLayouts.Items.Objects[cbLayouts.ItemIndex] <> nil then // TsgDXFImage(Image1.Picture.Graphic).CurrentLayout := TsgDXFImage(Image1.Picture.Graphic).Layouts[cbLayouts.ItemIndex]; //end; function TF_Import.ImportSolid(Sender: TObject): TFigure; var P: TFPoint; S: string; I: Integer; Vertex: TsgDXFVertex; Cad: TPCDrawing; Poly: TPolyline; Points: TDoublePointArr; LayerNbr, LHandle: Integer; begin try Result := nil; // Tolik -- 05/01/2016 if not TsgDXFSolid(Sender).Visible then Exit; // SetLength(points, 4); {$IF Defined(CADImport6)} P := PtXMat(TsgDXFSolid(Sender).Point, FCADParams.Matrix); {$ELSE} // Tolik -- 20/01/2016 -- P := FPointXMat(TsgDXFSolid(Sender).Point, FCADParams.Matrix); // if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; {$IFEND} { S := S + ' P1: '; S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z); S := S + #13#10;} P := ModificatePoint(P); points[0].x := P.x; points[0].y := P.y; points[0].z := P.z; {$IF Defined(CADImport6)} P := PtXMat(TsgDXFSolid(Sender).Point1, FCADParams.Matrix); {$ELSE} P := FPointXMat(TsgDXFSolid(Sender).Point1, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // {$IFEND} {S := S + ' P2: '; S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z); S := S + #13#10;} P := ModificatePoint(P); points[1].x := P.x; points[1].y := P.y; points[1].z := P.z; {$IF Defined(CADImport6)} P := PtXMat(TsgDXFSolid(Sender).Point3, FCADParams.Matrix); {$ELSE} P := FPointXMat(TsgDXFSolid(Sender).Point3, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; {$IFEND} {S := S + ' P3: '; S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z); S := S + #13#10;} P := ModificatePoint(P); points[2].x := P.x; points[2].y := P.y; points[2].z := P.z; {$IF Defined(CADImport6)} P := PtXMat(TsgDXFSolid(Sender).Point2, FCADParams.Matrix); {$ELSE} P := FPointXMat(TsgDXFSolid(Sender).Point2, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; {$IFEND} {S := S + ' P4: '; S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z);} P := ModificatePoint(P); points[3].x := P.x; points[3].y := P.y; points[3].z := P.z; //TxtFile.Add(S); if not TsgDXFSolid(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; /// //**************************************************************************// Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFSolid(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, True, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Poly.Color := TsgDXFSolid(Sender).Pen.Color; Poly.Width := TsgDXFSolid(Sender).Pen.Width; {$ELSE} Poly.color := GetColor(Sender); if RoundUp(TsgDXFSolid(Sender).LineWeight) >= 0 then Poly.Width := RoundUp(TsgDXFSolid(Sender).LineWeight) else Poly.Width := 1; {$IFEND} Poly.Style := ord(entstyle(TsgDXFSolid(Sender))); Result := Poly; //Tolik SetLength(Points, 0); // except on E: Exception do AddExceptionToLogEx('TF_Import.ImportSolid', E.Message); end; end; function TF_Import.ImportLine(Sender: TObject): TFigure; var P1, P2: TFPoint; S: string; Cad: TPCDrawing; Line: TLine; LayerNbr, LHandle: Integer; //C: Integer; c: int64; begin try Result := nil; // Tolik -- 05/01/2016 if not TsgDXFLine(Sender).Visible then Exit; { if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(TsgDXFLine(Sender).Point.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(TsgDXFLine(Sender).Point.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(TsgDXFLine(Sender).Point.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(TsgDXFLine(Sender).Point.y, F_Import.RightBottomPoint.y) = 1)) then Exit; if ((CompareValue(TsgDXFLine(Sender).Point1.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(TsgDXFLine(Sender).Point1.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(TsgDXFLine(Sender).Point1.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(TsgDXFLine(Sender).Point1.y, F_Import.RightBottomPoint.y) = 1)) then Exit; end;} { S := ' LineWeight=' + FloatToStr(TsgDXFLine(Sender).LineWeight) + '; '; S := S + ' LineTypeScale=' + FloatToStr(TsgDXFLine(Sender).LineTypeScale) + '; '; S := S + ' ZThick=' + FloatToStr(TsgDXFLine(Sender).ZThick) + '; '; S := S + #13#10;} {$IF Defined(CADImport6)} P1 := PtXMat(TsgDXFLine(Sender).Point, FCADParams.Matrix); {$ELSE} P1 := FPointXMat(TsgDXFLine(Sender).Point, FCADParams.Matrix); {P1 := TsgDXFLine(Sender).Point; //if Extruded(TsgDXFLine(Sender).Extrusion) then DoExtrusion(P1, TsgDXFLine(Sender).Extrusion); P1 := FPointXMat(P1, FCADParams.Matrix);} // {$IFEND} {S := S + ' Begin point: '; S := S + #13#10; S := S + ' X=' + FloatToStr(P1.X); S := S + ' Y=' + FloatToStr(P1.Y); S := S + ' Z=' + FloatToStr(P1.Z); S := S + #13#10;} {$IF Defined(CADImport6)} P2 := PtXMat(TsgDXFLine(Sender).Point1, FCADParams.Matrix); {$ELSE} P2 := FPointXMat(TsgDXFLine(Sender).Point1, FCADParams.Matrix); // Tolik --26/01/2016 // обрезать по ViewPort -- if FCadParams.Insert <> nil then c := FCadParams.Insert.Handle else c := -1; if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P1.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P1.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P1.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P1.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; if ((CompareValue(P2.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P2.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P2.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P2.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // {P2 := TsgDXFLine(Sender).Point1; //if Extruded(TsgDXFLine(Sender).Extrusion) then DoExtrusion(P2, TsgDXFLine(Sender).Extrusion); P2 := FPointXMat(P2, FCADParams.Matrix);} // {$IFEND} {S := S + ' End point: '; S := S + #13#10; S := S + ' X=' + FloatToStr(P2.X); S := S + ' Y=' + FloatToStr(P2.Y); S := S + ' Z=' + FloatToStr(P2.Z); TxtFile.Add(S); } if not TsgDXFLine(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //**************************************************************************// Cad := TPCDrawing(GCadForm.PCad); P1 := ModificatePoint(P1); P2 := ModificatePoint(P2); // Line := TLine.create(1, 1, 100, 100, 2, ord(psSolid), clBlack, 0, GCadForm.PCad.GetLayerHandle(0), mydsNormal, GCadForm.PCad); //GCadForm.PCad.AddCustomFigure(1, TFigure(SLine), false); // Result := Line; // exit; LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Line := TLine(Cad.Line(LayerNbr, P1.X, P1.Y, P2.x, P2.y, 1, 0, 0, 0, False)); Line := TLine.create(P1.X, P1.Y, P2.x, P2.y, 1, 0, 0, 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Line.color := TsgDXFLine(Sender).Color; Line.Width := TsgDXFLine(Sender).Pen.Width; {$ELSE} Line.color := GetColor(Sender); Line.Width := RoundUp(TsgDXFLine(Sender).LineWeight); if Line.width < 1 then Line.width := 1; {$IFEND} Line.Style := ord(entstyle(TsgDXFLine(Sender))); Result := Line; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportLine', E.Message); end; end; function TF_Import.ImportPoint(Sender: TObject): TFigure; var P: TFPoint; S: string; Point: TVertex; Cad: TPCdrawing; LayerNbr, LHandle: Integer; begin try Result := nil; {$IF Defined(CADImport6)} P := PtXMat(TsgDXFPoint(Sender).Point, FCADParams.Matrix); {$ELSE} // Tolik -- 20/01/2016 -- //P := FPointXMat(TsgDXFPoint(Sender).Point, FCADParams.Matrix); P := TsgDXFPoint(Sender).Point; if Extruded(TsgDXFPoint(Sender).Extrusion) then DoExtrusion(P, TsgDXFPoint(Sender).Extrusion); P := FPointXMat(P, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // {$IFEND} {S := ' Point: ' + #13#10 + PointToString(P); S := S + #13#10;} if not TsgDXFPoint(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //// Cad := TPCDrawing(GCadForm.PCad); P := ModificatePoint(P); LayerNbr := GetImportLayerNbr(Cad, TsgDXFPoint(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Point := TVertex(Cad.Vertex(LayerNbr, P.X, P.y, false)); Point := TVertex.create(P.X, P.y, LHandle, mydsNormal, Cad); Point.Color := GetColor(Sender); Result := Point; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportPoint', E.Message); end; end; function TF_Import.ImportEllipse(Sender: TObject): TFigure; var P: TFPoint; S: string; Ellipse: TEllipse; ElpArc: TElpArc; Cad: TPCDrawing; LayerNbr, LHandle: Integer; Radx, rady: double; a1, a2, a, blk_ang, ta: double; Poly: TPolyline; P1: TDoublePoint; z: double; R: TFRect; Aaa: TsgArc; P11, P22: TPoint; summ: Double; TempPoint: TFPoint; modscalex, modscaley: double; // Tolik - - MaxX, MaxY,MinX, MinY: double; function CheckEllipse: Boolean; var i: Integer; begin Result := True; if TsgDXFEllipse(Sender).PolyPoints.Count > 5 then begin MaxX := TsgDXFEllipse(Sender).Points[0].X; MaxY := TsgDXFEllipse(Sender).Points[0].Y; MinX := TsgDXFEllipse(Sender).Points[0].X; MinY := TsgDXFEllipse(Sender).Points[0].Y; // Get Bounds for i := 1 to TsgDXFEllipse(Sender).PolyPoints.Count - 1 do begin if MaxX < TsgDXFEllipse(Sender).Points[i].X then MaxX := TsgDXFEllipse(Sender).Points[i].X; if MaxY < TsgDXFEllipse(Sender).Points[i].Y then MaxY := TsgDXFEllipse(Sender).Points[i].Y; if MinX > TsgDXFEllipse(Sender).Points[i].X then MinX := TsgDXFEllipse(Sender).Points[i].X; if MinY > TsgDXFEllipse(Sender).Points[i].Y then MinY := TsgDXFEllipse(Sender).Points[i].Y; end; // check the CenterPoint + Radius if ((P.X >= MinX) and (P.X <=MaxX) and (P.Y >= MinY) and (P.Y <= MaxY)) then // if Right CenterPoint - check with Radius begin if (((P.X - RadX) >= MinX) and ((P.X + RadX) <=MaxX) and ((P.Y - RadY) >= MinY) and ((P.Y + RadY) <= MaxY)) then Result := True else Result := False; end else Result := False; end; end; // begin try Result := nil; {$IF Defined(CADImport6)} P := PtXMat(TsgDXFEllipse(Sender).Point, FCADParams.Matrix); z := round(TsgDXFEllipse(Sender).Extrusion.z); if z < 0 then begin TempPoint := TsgDXFEllipse(Sender).Point; TempPoint.X := - (TsgDXFEllipse(Sender).Point.X); P := PtXMat(TempPoint, FCADParams.Matrix); end; {$ELSE} // Tolik -- 20/01/2016 -- // P := FPointXMat(TsgDXFEllipse(Sender).Point, FCADParams.Matrix); P := TsgDXFEllipse(Sender).Point; if Extruded(TsgDXFEllipse(Sender).Extrusion) then DoExtrusion(P, TsgDXFEllipse(Sender).Extrusion); P := FPointXMat(P, FCADParams.Matrix); // z := round(TsgDXFEllipse(Sender).Extrusion.z); if z < 0 then begin TempPoint := TsgDXFEllipse(Sender).Point; TempPoint.X := - (TsgDXFEllipse(Sender).Point.X); DoExtrusion(p, TsgDXFEllipse(Sender).Extrusion); P := FPointXMat(TempPoint, FCADParams.Matrix); end; {$IFEND} {S := S + ' Center point: '; S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z); S := S + #13#10; S := S + ' Start Angle: ' + FloatToStr(TsgDXFEllipse(Sender).StartAngle); S := S + #13#10; S := S + ' End Angle: ' + FloatToStr(TsgDXFEllipse(Sender).EndAngle); S := S + #13#10; S := S + ' Rx: ' + FloatToStr(TsgDXFEllipse(Sender).Radius); S := S + ' Ry: ' + FloatToStr(TsgDXFEllipse(Sender).Radius * TsgDXFEllipse(Sender).Ratio); TxtFile.Add(S);} if not TsgDXFEllipse(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //**************************************************************************// Aaa := EntArc(TsgDXFArc(Sender), FCADParams); R.Left := Round(Aaa.Rect.Left); R.Top := Round(Aaa.Rect.Top); R.Right := Round(Aaa.Rect.Right); R.Bottom := Round(Aaa.Rect.Bottom); P11.X := Round(Aaa.Point1.X); P11.Y := Round(Aaa.Point1.Y); P22.X := Round(Aaa.Point2.X); P22.Y := Round(Aaa.Point2.Y); summ := P11.x + P11.Y + P22.X + P22.y; if DoubleCMP(summ, P11.X) or DoubleCMP(summ, P22.X) or DoubleCMP(summ, P11.Y) or DoubleCMP(summ, P22.Y)then begin if z = 0 then exit; end; if (P11.X = P22.X) and (P11.Y = P22.Y) then begin if z = 0 then exit; end; if (P11.X = 0) AND (P22.X = 0) and (P11.Y = 0) AND (P22.Y = 0) then begin if z = 0 then exit; end; {TODO} // изначально было P.x := - P.X; - но оно тут по ходу не всегда нужно // возможно будут файлы для которых нужно такое преобразование - по правильному сделано через TempPoint //if z < 0 then // P.x := - P.X; Cad := TPCDrawing(GCadForm.PCad); Radx := TsgDXFEllipse(Sender).Radius; Rady := TsgDXFEllipse(Sender).Radius * TsgDXFEllipse(Sender).Ratio; if FCADParams.Insert <> nil then begin if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(TsgDxfEntity(Sender)) >= 0) then begin Radx := TsgDXFEllipse(Sender).Radius * Abs(FCADParams.Insert.Scale.x); Rady := TsgDXFEllipse(Sender).Radius * Abs(FCADParams.Insert.Scale.y); end; end; // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X - RadX, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.X + RadX, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y - RadY, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1) or (CompareValue(P.Y + RadY, F_Import.RightBottomPoint.y) = 1) ) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; P := ModificatePoint(P); LayerNbr := GetImportLayerNbr(Cad, TsgDXFEllipse(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); blk_ang := FCADParams.Angle; // blk_ang := FCADParams.Insert.Angle; a := TsgDXFEllipse(Sender).Angle; a1 := TsgDXFEllipse(Sender).StartAngle; a2 := TsgDXFEllipse(Sender).EndAngle; if (TsgDXFEllipse(Sender).StartAngle = 180) and (TsgDXFEllipse(Sender).EndAngle = 540) then beep; while Round(a1) >= 360 do a1 := a1 - 360; while Round(a2) >= 360 do a2 := a2 - 360; blk_ang := DegToRad(FCADParams.Angle); // blk_ang := DegToRad(FCADParams.Insert.Angle); a1 := DegToRad(a1); a2 := DegToRad(a2); // Tolik -- 20/01/2016 -- {if FCADParams.Insert <> nil then begin Radx := TsgDXFEllipse(Sender).Radius * Abs(FCADParams.Insert.Scale.x); Rady := TsgDXFEllipse(Sender).Radius * Abs(FCADParams.Insert.Scale.y); end; } // ЭТО ЭЛЛИПС if DoubleCMP(a1, a2) then begin if ord(Cad.VerticalZero) = 1 then if ord(Cad.HorizontalZero) = 0 then a := 2 * pi - (a + blk_ang); // Ellipse := TEllipse(Cad.Ellipse(LayerNbr, P.X, P.Y, Radx, Rady, a, 1, 0, 0, ord(bsClear), 0, False)); // Tolik -- 21/01/2016 if CheckEllipse then Ellipse := TEllipse.create(P.X, P.Y, RadX, RadY, a, 1, 0, 0, ord(bsClear), 0, LHandle, mydsNormal, Cad) else begin RadX := (MaxX - MinX ) / 2; RadY := (MaxY - MinY) / 2; P.X := (MinX + MaxX) / 2; P.Y := (MinY + MaxY) / 2; P.Z := 0; P.V[0] := P.X; P.V[1] := P.y; P.V[2] := 1; P := FPointXMat(P, FCADParams.Matrix); P := ModificatePoint(P); Ellipse := TEllipse.create(P.X, P.Y, RadX, RadY, a, 1, 0, 0, ord(bsClear), 0, LHandle, mydsNormal, Cad); // //Ellipse := TEllipse.create(P.X, P.Y, Radx, Rady, a, 1, 0, 0, ord(bsClear), 0, LHandle, mydsNormal, Cad); end; {$IF Defined(CADImport6)} Ellipse.color := TsgDXFEllipse(Sender).Color; Ellipse.Width := TsgDXFEllipse(Sender).Pen.Width; {$ELSE} Ellipse.color := GetColor(Sender); Ellipse.Width := RoundUp(TsgDXFEllipse(Sender).LineWeight); if Ellipse.width < 0 then Ellipse.width := 1; {$IFEND} Ellipse.Style := ord(entstyle(TsgDXFEllipse(Sender)));; Result := Ellipse; end else // ЭТО ЭЛЛИПТИЧЕСКАЯ АРКА begin // корректировать с учетом системы PowerCad if ord(Cad.VerticalZero) = 1 then begin if ord(Cad.HorizontalZero) = 0 then begin a1 := 2 * pi - a1; a2 := 2 * pi - a2; ta := a1; a1 := a2; a2 := ta; // IGOR 22.10.2013 - Нашелся DWG в котором так не нужно делать // возможно по аналогии с арками нужно дорулить... //a := 2 * pi - (a + blk_ang); end; end; if z < 0 then begin a1 := pi - a1; a2 := pi - a2; ta := a1; a1 := a2; a2 := ta; end; if FCADParams.XScale < 0 then begin // IGOR 22.10.2013 - Нашелся DWG в котором так не нужно делать // возможно по аналогии с арками нужно дорулить... //a := a - pi; end; //////// IGOR 22.10.2013 - Добавим изменения на подобие как делается в арках: // SCALE ОБЫЧНЫЕ !!! modscalex := abs(FCADParams.XScale); modscaley := abs(FCADParams.YScale); //// IGOR 22.10.2013 - В данном случае не зависимо от скейлов: //if (DoubleCMP(modscalex, 1) and DoubleCMP(modscaley, 1)) then begin a1 := a1 + (pi * 2 - blk_ang); a2 := a2 + (pi * 2 - blk_ang); if FCADParams.XScale < 0 then begin a1 := a1 + 2 * (pi - a1); a2 := a2 + 2 * (pi - a2); ta := a2; a2 := a1; a1 := ta; a1 := a1 + (2 * pi - 2 * blk_ang); a2 := a2 + (2 * pi - 2 * blk_ang); end; // здесь было создание просто арки end; //else (* begin a := 2 * pi - blk_ang; if FCADParams.XScale < 0 then begin a := a - pi; end; // а здесь было создание арки а затем с нее кривой бизье end; *) //////////// ElpArc := TElpArc.create(P.X, P.Y, Radx, Rady, a1, a2, a, 1, 0, 0, ord(bsClear), 0, ord(asOpen), LHandle, mydsNormal, Cad); ElpArc.Draw(Cad.DEngine, False); {$IF Defined(CADImport6)} ElpArc.color := TsgDXFEllipse(Sender).Color; ElpArc.Width := TsgDXFEllipse(Sender).Pen.Width; {$ELSE} ElpArc.color := GetColor(Sender); ElpArc.Width := RoundUp(TsgDXFEllipse(Sender).LineWeight); if ElpArc.width < 0 then ElpArc.width := 1; {$IFEND} ElpArc.Style := ord(entstyle(TsgDXFEllipse(Sender))); P1.x := P.x; P1.y := P.y; P1.z := P.z; Poly := TPolyline(ElpArc.DuplicateAsBezier); // Cad.AddCustomFigure(LayerNbr, Poly, False); // Cad.Figures.Remove(ElpArc); FreeAndNil(ElpArc); Poly.Rotate(a, P1); Result := Poly; end; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportEllipse', E.Message); end; end; function TF_Import.ImportArc(Sender: TObject): TFigure; var P: TFPoint; P1: TDoublePoint; S: string; Arc: TArc; ElpArc: TElpArc; Ellipse: TEllipse; Poly: TPolyline; Cad: TPCDrawing; LayerNbr, LHandle: Integer; Rad, Rad1: double; a, a1, a2, ta: double; modscalex, modscaley: double; blk_ang: double; RP: TDoublePoint; da: double; z: double; b: boolean; Aaa: TsgArc; R: TFRect; P11, P22: TPoint; summ: Double; vName: string; TempPoint: TFPoint; MaxX, MaxY,MinX, MinY: double; function CheckEllipse: Boolean; var i: Integer; begin Result := True; if TsgDxfArc(Sender).PolyPoints.Count > 1 then begin MaxX := TsgDxfArc(Sender).Points[0].X; MaxY := TsgDxfArc(Sender).Points[0].Y; MinX := TsgDxfArc(Sender).Points[0].X; MinY := TsgDxfArc(Sender).Points[0].Y; // Get Bounds for i := 1 to TsgDxfArc(Sender).PolyPoints.Count - 1 do begin if MaxX < TsgDxfArc(Sender).Points[i].X then MaxX := TsgDxfArc(Sender).Points[i].X; if MaxY < TsgDxfArc(Sender).Points[i].Y then MaxY := TsgDxfArc(Sender).Points[i].Y; if MinX > TsgDxfArc(Sender).Points[i].X then MinX := TsgDxfArc(Sender).Points[i].X; if MinY > TsgDxfArc(Sender).Points[i].Y then MinY := TsgDxfArc(Sender).Points[i].Y; end; // check the CenterPoint + Radius if ((P.X >= MinX) and (P.X <=MaxX) and (P.Y >= MinY) and (P.Y <= MaxY)) then // if Right CenterPoint - check with Radius begin if (((P.X - Abs(TsgDxfArc(Sender).Radius)) >= MinX) and ((P.X + Abs(TsgDxfArc(Sender).Radius)) <=MaxX) and ((P.Y - Abs(TsgDxfArc(Sender).Radius)) >= MinY) and ((P.Y + Abs(TsgDxfArc(Sender).Radius)) <= MaxY)) then Result := True else Result := False; end else Result := False; end; end; begin try Result := nil; // Tolik 05/01/2016 if not TsgDXFArc(Sender).Visible then Exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; // {$IF Defined(CADImport6)} P := PtXMat(TsgDXFArc(Sender).Point, FCADParams.Matrix); z := Round(TsgDXFArc(Sender).Extrusion.z); if z < 0 then begin TempPoint := TsgDXFArc(Sender).Point; TempPoint.X := - (TsgDXFArc(Sender).Point.X); P := PtXMat(TempPoint, FCADParams.Matrix); end; {$ELSE} // Tolik -- 20/01/2016 -- P := FPointXMat(TsgDXFArc(Sender).Point, FCADParams.Matrix); P := TsgDXFArc(Sender).Point; if Extruded(TsgDXFArc(Sender).Extrusion) then DoExtrusion(P, TsgDXFArc(Sender).Extrusion); p := FPointXMat(P, FCADParams.Matrix); // z := Round(TsgDXFArc(Sender).Extrusion.z); //if p.x < 0 then //begin // if (TsgDXFArc(Sender).Point.X > TsgDXFArc(Sender).StartPoint.X) and // (TsgDXFArc(Sender).Point.X > TsgDXFArc(Sender).EndPoint.X) then // begin // TempPoint := TsgDXFArc(Sender).Point; // TempPoint.X := - (TsgDXFArc(Sender).Point.X); // P := FPointXMat(TempPoint, FCADParams.Matrix); // end; //end; // ВОТ ТАК ПРАВИЛЬНО ПО ХОДУ ДЕЛАТЬ ВЕЗДЕ! // Tolik -- ссылка от Игоря, подыбать, може чем помогеть: { http://cadsofttools.com/forum/viewtopic.php?f=15&t=1344&p=2816&hilit=arc+matrix#p2816} if z < 0 then begin TempPoint := TsgDXFArc(Sender).Point; TempPoint.X := - (TsgDXFArc(Sender).Point.X); P := FPointXMat(TempPoint, FCADParams.Matrix); end; {$IFEND} {S := S + ' Center point: '; S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z); S := S + #13#10' Start Angle: ' + FloatToStr(TsgDXFArc(Sender).StartAngle); S := S + #13#10' End Angle: ' + FloatToStr(TsgDXFArc(Sender).EndAngle); S := S + #13#10' Rx: ' + FloatToStr(TsgDXFArc(Sender).Radius); TxtFile.Add(S);} if not TsgDXFArc(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //**************************************************************************// Aaa := EntArc(TsgDXFArc(Sender), FCADParams); R.Left := Round(Aaa.Rect.Left); R.Top := Round(Aaa.Rect.Top); R.Right := Round(Aaa.Rect.Right); R.Bottom := Round(Aaa.Rect.Bottom); P11.X := Round(Aaa.Point1.X); P11.Y := Round(Aaa.Point1.Y); P22.X := Round(Aaa.Point2.X); P22.Y := Round(Aaa.Point2.Y); summ := P11.x + P11.Y + P22.X + P22.y; if DoubleCMP(summ, P11.X) or DoubleCMP(summ, P22.X) or DoubleCMP(summ, P11.Y) or DoubleCMP(summ, P22.Y)then begin if z = 0 then exit; end; if (P11.X = P22.X) and (P11.Y = P22.Y) then begin if z = 0 then exit; end; if (P11.X = 0) AND (P22.X = 0) and (P11.Y = 0) AND (P22.Y = 0) then begin if z = 0 then exit; end; Cad := TPCDrawing(GCadForm.PCad); //P := ModificatePoint(P); // Tolik 02/11/2017 -- LayerNbr := GetImportLayerNbr(Cad, TsgDXFArc(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Rad := TsgDXFArc(Sender).Radius; // Tolik Rad1 := TsgDXFArc(Sender).Radius; if FCadParams.Insert <> nil then begin Rad := TsgDXFArc(Sender).Radius * ABS(FCadParams.Insert.Scale.X); Rad1 := TsgDXFArc(Sender).Radius * ABS(FCadParams.Insert.Scale.Y); {if FCadParams.Insert.Scale.X < 0 then p.x := p.x * (-1); if FCadParams.Insert.Scale.Y < 0 then p.y := p.y* (-1);} end; // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X - Rad, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.X + Rad, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y - Rad1, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1) or (CompareValue(P.Y + Rad1, F_Import.RightBottomPoint.y) = 1) ) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // P := ModificatePoint(P); // Tolik 02/11/2017 -- a1 := TsgDXFArc(Sender).StartAngle; a2 := TsgDXFArc(Sender).EndAngle; while Round(a1) >= 360 do a1 := a1 - 360; while Round(a2) >= 360 do a2 := a2 - 360; blk_ang := DegToRad(FCADParams.Angle); a1 := DegToRad(a1); a2 := DegToRad(a2); // это очень круглый элипс // Tolik 26/04/2017 -- //if DoubleCMP(a1, a2) then if CompareValue(a1,a2) = 0 then // begin a := blk_ang; if ord(Cad.VerticalZero) = 1 then if ord(Cad.HorizontalZero) = 0 then a := 2 * pi - (a + blk_ang); // Ellipse := TEllipse(Cad.Ellipse(LayerNbr, P.X, P.Y, Radx, Rady, a, 1, 0, 0, ord(bsClear), 0, False)); // Tolik -- 16/01/2016 if CheckEllipse then Ellipse := TEllipse.create(P.X, P.Y, Rad, Rad1, a, 1, 0, 0, ord(bsClear), 0, LHandle, mydsNormal, Cad) else begin Rad := (MaxX - MinX ) / 2; Rad1 := (MaxY - MinY) / 2; P.X := (MinX + MaxX) / 2; P.Y := (MinY + MaxY) / 2; P.Z := 0; P.V[0] := P.X; P.V[1] := P.y; P.V[2] := 1; P := FPointXMat(P, FCADParams.Matrix); P := ModificatePoint(P); Ellipse := TEllipse.create(P.X, P.Y, Rad, Rad1, a, 1, 0, 0, ord(bsClear), 0, LHandle, mydsNormal, Cad); { s := ''; S := S + ' Center point: '; S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z); S := S + #13#10' Start Angle: ' + FloatToStr(TsgDXFArc(Sender).StartAngle); S := S + #13#10' End Angle: ' + FloatToStr(TsgDXFArc(Sender).EndAngle); S := S + #13#10' Rx: ' + FloatToStr(Rad); S := S + #13#10' Rx1: ' + FloatToStr(Rad1); AssignFile(f, 'd:\Tolik\ARC.txt'); reset(f); append(f); writeln(f,s); close(f); } end; {$IF Defined(CADImport6)} Ellipse.color := TsgDXFEllipse(Sender).Color; Ellipse.Width := TsgDXFEllipse(Sender).Pen.Width; {$ELSE} Ellipse.color := GetColor(Sender); Ellipse.Width := RoundUp(TsgDXFEllipse(Sender).LineWeight); if Ellipse.width < 0 then Ellipse.width := 1; {$IFEND} Ellipse.Style := ord(entstyle(TsgDXFEllipse(Sender)));; Result := Ellipse; end else // ЭТО АРКА begin // корректировать с учетом системы PowerCad if ord(Cad.VerticalZero) = 1 then begin if ord(Cad.HorizontalZero) = 0 then begin a1 := 2 * pi - a1; a2 := 2 * pi - a2; ta := a1; a1 := a2; a2 := ta; end; end; if z < 0 then begin {TODO} // изначально было P.x := - P.X; - но оно тут по ходу не всегда нужно // возможно будут файлы для которых нужно такое преобразование - по правильному сделано через TempPoint //P.x := - P.X; a1 := pi - a1; a2 := pi - a2; ta := a1; a1 := a2; a2 := ta; end; // SCALE ОБЫЧНЫЕ !!! modscalex := abs(FCADParams.XScale); modscaley := abs(FCADParams.YScale); if (DoubleCMP(modscalex, 1) and DoubleCMP(modscaley, 1)) then begin a1 := a1 + (pi * 2 - blk_ang); a2 := a2 + (pi * 2 - blk_ang); if FCADParams.XScale < 0 then begin a1 := a1 + 2 * (pi - a1); a2 := a2 + 2 * (pi - a2); ta := a2; a2 := a1; a1 := ta; a1 := a1 + (2 * pi - 2 * blk_ang); a2 := a2 + (2 * pi - 2 * blk_ang); end; // Tolik -- 28/12/2015 While ((Comparevalue(a1, (pi*2)) = 1) or (Comparevalue(a1, (pi*2)) = 0)) do a1 := a1 - (pi*2); While ((Comparevalue(a2, (pi*2)) = 1) or (Comparevalue(a2, (pi*2)) = 0)) do a2 := a2 - (pi*2); //сбросить в ноль (при 0 в дабле может быть мусор - типа, мелкое число, но никак не 0, а потом // при создании арки с "не ноль" получится херня кака-то) if ((RoundTo(a1, -10) = 0) or (RoundTo(a1, -10) = -0)) then a1 := 0; if ((RoundTo(a2, -10) = 0) or (RoundTo(a2, -10) = -0)) then a2 := 0; //Tolik -- 28/12/2015 {ArcVals := 'P.X = ' + FormatFloat('0.00', P.X); ArcVals := ArcVals + ' P.Y = ' + FormatFloat('0.00', P.Y); ArcVals := ArcVals + ' Rad = ' + FormatFloat('0.00', Rad); ArcVals := ArcVals + ' a1 = ' + FormatFloat('0.00', a1); ArcVals := ArcVals + ' a2 = ' + FormatFloat('0.00', a2); ArcVals := ArcVals + ' a = ' + FormatFloat('0.00', a); // AssignFile(f, 'd:\Tolik\ARC.txt'); Append(f); Writeln(f, ArcVals); CloseFile(f); } // //Arc := TArc(Cad.Arc(LayerNbr, P.X, P.Y, Rad, a1, a2, 1, 0, 0, 0, 0, 0, False)); Arc := TArc.create(P.X, P.Y, Rad, a1, a2, 1, 0, 0, 0, 0, 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Arc.color := TsgDXFArc(Sender).Color; Arc.Width := TsgDXFArc(Sender).Pen.Width; {$ELSE} Arc.color := GetColor(Sender); Arc.Width := RoundUp(TsgDXFArc(Sender).LineWeight); if Arc.width < 0 then Arc.width := 1; {$IFEND} Arc.Style := ord(entstyle(TsgDXFArc(Sender))); Result := Arc; end else begin a := 2 * pi - blk_ang; if FCADParams.XScale < 0 then begin a := a - pi; end; //Tolik if ((RoundTo(a, -10) = 0) or (RoundTo(a, -10) = -0)) then a := 0; // ElpArc := TElpArc(Cad.ElpArc(LayerNbr, P.X, P.Y, Rad, Rad, a, a1, a2, 1, 0, 0, ord(bsClear), 0, ord(asOpen), False)); // Tolik -- создавать с учетом масштабирования по обеим осям (если есть) //ElpArc := TElpArc.create(P.X, P.Y, Rad, Rad, a1, a2, a, 1, 0, 0, ord(bsClear), 0, ord(asOpen), LHandle, mydsNormal, Cad); //Tolik Rad := TsgDXFArc(Sender).Radius; Rad1 := TsgDXFArc(Sender).Radius; // ElpArc := TElpArc.create(P.X, P.Y, Rad, Rad1, a1, a2, a, 1, 0, 0, ord(bsClear), 0, ord(asOpen), LHandle, mydsNormal, Cad); // ElpArc.Draw(Cad.DEngine, False); {$IF Defined(CADImport6)} ElpArc.color := TsgDXFArc(Sender).Color; ElpArc.Width := TsgDXFArc(Sender).Pen.Width; {$ELSE} ElpArc.color := GetColor(Sender); ElpArc.Width := RoundUp(TsgDXFArc(Sender).LineWeight); if ElpArc.width < 0 then ElpArc.width := 1; {$IFEND} ElpArc.Style := ord(entstyle(TsgDXFArc(Sender))); P1.x := P.x; P1.y := P.y; P1.z := P.z; Poly := TPolyline(ElpArc.DuplicateAsBezier); // Cad.AddCustomFigure(LayerNbr, Poly, False); // Cad.Figures.Remove(ElpArc); FreeAndNil(ElpArc); // Toilk -- 02/01/2016 -- здесь закомментим, так как радийсы уже отмасштабированы ранее, точки должны // быть с адекватными координатами Poly.scale(FCADParams.XScale, FCADParams.YScale, P1); Poly.Rotate(a, P1); Result := Poly; end; end; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportArc', E.Message); end; end; function TF_Import.ImportCircle(Sender: TObject): TFigure; var P: TFPoint; S: string; Circle: TCircle; Cad: TPCDrawing; LayerNbr, LHandle: Integer; z : double; R: TFRect; Aaa: TsgArc; P11, P22: TPoint; summ: double; TempPoint: TFPoint; // Tolik CanImportCircle: boolean; RadX, RadY: Double; Ellipse: TEllipse; // begin try Result := nil; // Tolik -- перенес в начало - нах обрабатывать то, что не импортнем? if not TsgDXFCircle(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; {$IF Defined(CADImport6)} P := PtXMat(TsgDXFCircle(Sender).Point, FCADParams.Matrix); z := round(TsgDXFCircle(Sender).Extrusion.z); if z < 0 then begin TempPoint := TsgDXFCircle(Sender).Point; TempPoint.X := - (TsgDXFCircle(Sender).Point.X); P := PtXMat(TempPoint, FCADParams.Matrix); end; {$ELSE} P := FPointXMat(TsgDXFCircle(Sender).Point, FCADParams.Matrix); z := round(TsgDXFCircle(Sender).Extrusion.z); if z < 0 then begin TempPoint := TsgDXFCircle(Sender).Point; TempPoint.X := - (TsgDXFCircle(Sender).Point.X); P := FPointXMat(TempPoint, FCADParams.Matrix); end; {$IFEND} {S := S + ' Center point: '; S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z); S := S + #13#10' Rx: ' + FloatToStr(TsgDXFCircle(Sender).Radius); TxtFile.Add(S);} {if not TsgDXFCircle(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit;} //**************************************************************************// Aaa := EntArc(TsgDXFArc(Sender), FCADParams); R.Left := Round(Aaa.Rect.Left); R.Top := Round(Aaa.Rect.Top); R.Right := Round(Aaa.Rect.Right); R.Bottom := Round(Aaa.Rect.Bottom); P11.X := Round(Aaa.Point1.X); P11.Y := Round(Aaa.Point1.Y); P22.X := Round(Aaa.Point2.X); P22.Y := Round(Aaa.Point2.Y); summ := P11.x + P11.Y + P22.X + P22.y; if DoubleCMP(summ, P11.X) or DoubleCMP(summ, P22.X) or DoubleCMP(summ, P11.Y) or DoubleCMP(summ, P22.Y)then begin if z = 0 then exit; end; if (P11.X = P22.X) and (P11.Y = P22.Y) then begin if z = 0 then exit; end; if (P11.X = 0) AND (P22.X = 0) and (P11.Y = 0) AND (P22.Y = 0) then begin if z = 0 then exit; end; {TODO} // изначально было P.x := - P.X; - но оно тут по ходу не всегда нужно // возможно будут файлы для которых нужно такое преобразование - по правильному сделано через TempPoint //if z < 0 then // P.x := - P.X; Cad := TPCDrawing(GCadForm.PCad); // P := ModificatePoint(P); LayerNbr := GetImportLayerNbr(Cad, TsgDXFCircle(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Circle := TCircle(Cad.Circle(LayerNbr, P.X, P.Y, TsgDXFCircle(Sender).Radius, 1, 0, 0, ord(bsClear), 0, False)); // Tolik -- 20/12/2016 -- перенесено из ReadCadEntities, так как там оно ломает радиус и уже не понять, // что с ним делать здесь так как не будет адекватного размера радиуса для сравнения по обеим осям (Х и У) // здесь будет правильнее, только немножко переделаем совсем, чтобы при разных радиусах (если скейлы по осям Х и У будут разные) // импортировать эллипс для адекватного отображения картинки CanImportCircle := True; // пока думаем, что импортируем круг RadX := TsgDXFCircle(Sender).Radius; if FCADParams.Insert <> nil then begin // все остальные проверки -- не сработают или сработают неправильно, а нужно только вхождение фигуры в блок if FCADParams.Insert.Block.IndexOfEntity(TsgDXFEntity(Sender)) >= 0 then begin RadX := TsgDxfCircle(Sender).Radius * Abs(FCADParams.Insert.Scale.X); RadY := TsgDxfCircle(Sender).Radius * Abs(FCADParams.Insert.Scale.Y); if CompareValue(RadX, RadY) <> 0 then CanImportCircle := False; end; {if (FCADParams.Insert.Block <> nil) and (FCADParams.Insert.Block.IndexOfEntity(Entity) >= 0) and (abs(FCADParams.Insert.Scale.X) > 1) then begin MaxBlockSize := 0; if FCADParams.Insert.Count = 1 then begin MaxBlockSize := abs(FCADParams.Insert.Box.Right - FCADParams.Insert.Box.left); if abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Box.Top - FCADParams.Insert.Box.Bottom); end else begin MaxBlockSize := abs(FCADParams.Insert.Block.Box.Right - FCADParams.Insert.Block.Box.left); if abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom) > MaxBlockSize then MaxBlockSize := abs(FCADParams.Insert.Block.Box.Top - FCADParams.Insert.Block.Box.Bottom); end; if (TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X)) < MaxBlockSize then begin TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFCircle(Entity).ZThick := $FFFFFF; end; end else begin TsgDXFCircle(Entity).Radius := TsgDXFCircle(Entity).Radius * abs(FCADParams.Insert.Scale.X); TsgDXFCircle(Entity).ZThick := $FFFFFF; end; } end //Tolik -- 02/11/2017 else RadY := RadX; // // Tolik //CanImportCircle := False; if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if {((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X - RadX, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.X + RadX, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y - RadY, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1) or (CompareValue(P.Y + RadY, F_Import.RightBottomPoint.y) = 1) )} ( (CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X - RadX, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y - RadY, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.X + RadX, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1) or (CompareValue(P.Y + RadY, F_Import.RightBottomPoint.y) = 1) ) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; P := ModificatePoint(P); // Tolik -- 20/01/2016 -- если скейлы одинаковые -- импортируем круг if CanImportCircle then begin // Circle := TCircle.create(P.X, P.Y, RadX, 1, 0, 0, ord(bsClear), 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Circle.color := TsgDXFCircle(Sender).Color; Circle.Width := TsgDXFCircle(Sender).Pen.Width; {$ELSE} Circle.color := GetColor(Sender); Circle.Width := RoundUp(TsgDXFCircle(Sender).LineWeight); if Circle.width < 0 then Circle.width := 1; {$IFEND} Circle.Style := ord(entstyle(TsgDXFCircle(Sender))); Result := Circle; end // если скейлы по осям будут разные -- импортируем эллипс else begin Ellipse := TEllipse.create(P.X, P.Y, RadX, RadY, (Pi/2), 1, 0, 0, ord(bsClear), 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Ellipse.color := TsgDXFCircle(Sender).Color; Ellipse.Width := TsgDXFCircle(Sender).Pen.Width; {$ELSE} Ellipse.color := GetColor(Sender); Ellipse.Width := RoundUp(TsgDXFCircle(Sender).LineWeight); if Ellipse.width < 0 then Ellipse.width := 1; {$IFEND} Ellipse.Style := ord(entstyle(TsgDXFCircle(Sender)));; Result := Ellipse; end; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportCircle', E.Message); end; end; { //Tolik function TF_Import.ImportPolyLine(Sender: TObject): TFigure; var P: TFPoint; S: string; I: Integer; Vertex: TsgDXFVertex; Cad: TPCDrawing; Poly: TPolyline; Points: TDoublePointArr; LayerNbr, LHandle: Integer; Count, j, k: Integer; xLine : TsgDXFPolyline; begin try Result := nil; xLine := TsgDXFPolyline(Sender); j := 0; SetLength(points,0); for i := 0 to xLine.PolyPoints.Count - 1 do begin P := xLine.PolyPoints[i]; {$IF Defined(CADImport6) P := PtXMat(P, FCADParams.Matrix); {$ELSE P := FPointXMat(P, FCADParams.Matrix); {$IFEND SetLength(points, j + 1); P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end; if not TsgDXFPolyline(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //**************************************************************************// if TsgDXFPolyLine(Sender).Count = 0 then exit; Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, TsgDXFPolyLine(Sender).Closed, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6) Poly.Color := TsgDXFPolyLine(Sender).Pen.Color; Poly.Width := TsgDXFPolyLine(Sender).Pen.Width; {$ELSE Poly.Color := GetColor(Sender); Poly.Width := RoundUp(TsgDXFPolyLine(Sender).LineWeight); if Poly.width < 0 then Poly.width := 1; {$IFEND Poly.Style := ord(entstyle(TsgDXFPolyline(Sender))); Result := Poly; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportPolyLine', E.Message); end; end; } { function TF_Import.ImportPolyLine(Sender: TObject): TFigure; var P: TFPoint; S: string; I: Integer; Vertex: TsgDXFVertex; Cad: TPCDrawing; Poly: TPolyline; Points: TDoublePointArr; LayerNbr, LHandle: Integer; Count, j, k: Integer; xLine : TsgDXFPolyline; Figure: TFigure; LineType: TsgCADEntities; begin try Result := nil; xLine := TsgDXFPolyline(Sender); LineType := xLine.EntType; Figure := TFigure(xLine); } { if LineType = ceLWPolyLine then begin S := S + ' Vertexes: '; j := 0; SetLength(points,0); k := xLine.Count; k := xLine.PolyPoints.Count; k := xLine.PointCount; k := xLine.Arrows.Count; for i := 0 to xLine.PolyPoints.Count - 1 do begin P := xLine.PolyPoints[i];// PolyPoints[i]; {$IF Defined(CADImport6) P := PtXMat(P, FCADParams.Matrix); {$ELSE P := FPointXMat(P, FCADParams.Matrix); {$IFEND SetLength(points, j + 1); P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end; if not TsgDXFPolyline(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //**************************************************************************// if TsgDXFPolyLine(Sender).Count = 0 then exit; Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Poly := TPolyline(Cad.PolyLine(LayerNbr, points, 1, ord(psSolid), clBlack, 0, ord(bsClear), clBlack, TsgDXFPolyLine(Sender).Closed, False)); Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, TsgDXFPolyLine(Sender).Closed, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6) Poly.Color := TsgDXFPolyLine(Sender).Pen.Color; Poly.Width := TsgDXFPolyLine(Sender).Pen.Width; {$ELSE Poly.Color := GetColor(Sender); Poly.Width := RoundUp(TsgDXFPolyLine(Sender).LineWeight); if Poly.width < 0 then Poly.width := 1; {$IFEND Poly.Style := ord(entstyle(TsgDXFPolyline(Sender))); end else } { begin S := S + ' Vertexes: '; Count := TsgDXFPolyLine(Sender).Count; // SetLength(points, Count); j := 0; for I := 0 to TsgDXFPolyLine(Sender).Count - 1 do begin S := S + #13#10; S := S + ' P' + IntToStr(I + 1) + ': '; Vertex := TsgDXFVertex(TsgDXFPolyLine(Sender).Entities[I]); //31.10.2012 P := PtXMat(Vertex.Point, FCADParams.Matrix); P := TsgDXFPolyLine(Sender).Points[I]; {$IF Defined(CADImport6) P := PtXMat(P, FCADParams.Matrix); {$ELSE P := FPointXMat(P, FCADParams.Matrix); {$IFEND S := S + ' X=' + FloatToStr(P.X); S := S + ' Y=' + FloatToStr(P.Y); S := S + ' Z=' + FloatToStr(P.Z); if not ((P.x = 0) and (P.y = 0) and (P.z = 0)) then begin SetLength(points, j + 1); P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end; end; TxtFile.Add(S); if not TsgDXFPolyline(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //**************************************************************************// if TsgDXFPolyLine(Sender).Count = 0 then exit; Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Poly := TPolyline(Cad.PolyLine(LayerNbr, points, 1, ord(psSolid), clBlack, 0, ord(bsClear), clBlack, TsgDXFPolyLine(Sender).Closed, False)); Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, TsgDXFPolyLine(Sender).Closed, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6) Poly.Color := TsgDXFPolyLine(Sender).Pen.Color; Poly.Width := TsgDXFPolyLine(Sender).Pen.Width; {$ELSE Poly.Color := GetColor(Sender); Poly.Width := RoundUp(TsgDXFPolyLine(Sender).LineWeight); if Poly.width < 0 then Poly.width := 1; {$IFEND Poly.Style := ord(entstyle(TsgDXFPolyline(Sender))); end; Result := Poly; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportPolyLine', E.Message); end; end; } function ParamExists(AParamValue: string): Boolean; var i: integer; CurrParamValue: String; begin Result := false; if ParamCount > 0 then for i := 1 to ParamCount do begin CurrParamValue := ParamStr(i); if CurrParamValue = AParamValue then begin Result := true; Break; //// BREAK //// end; end; end; // /// Tolik - - 20/01/2016 -- старая закомменчена, а здесь пробую поднять точки полилинии, как в примере - через вертексы function TF_Import.ImportPolyLine(Sender: TObject): TFigure; var P: TFPoint; S: string; I: Integer; // Vertex: TsgDXFVertex; Cad: TPCDrawing; Poly: TPolyline; Points: TDoublePointArr; LayerNbr, LHandle: Integer; Count, j: Integer; //Tolik xLine: TsgDXFPolyLine; wLine: TsgDXFLWPolyline; d2Line: Tsg2DPolyline; dwgLine: TsgDWGPolyline; Entity: TsgDXFEntity; aVertex: TsgDXFVertex; ZeroPoint: Boolean; CanAddPoint : Boolean; Line: TLine; // begin try Result := nil; // Tolik 05/01/2016 if not TsgDXFPolyLine(Sender).Visible then Exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; // xLine := TsgDXFPolyLine(Sender); // может быть и так // wLine := TsgDXFLWPolyline(Sender); // d2Line := Tsg2DPolyline(Sender); // dwgLine := TsgDWGPolyline(Sender); j := 0; //S := S + ' Vertexes: '; //for I := 0 to TsgDXFPolyLine(Sender).Count - 1 do //begin // S := S + #13#10; // S := S + ' P' + IntToStr(I + 1) + ': '; // Vertex := TsgDXFVertex(TsgDXFPolyLine(Sender).Entities[I]); //end; if not ParamExists('NoLimitDXFPolyCount') then begin i := xLine.PointCount; if (xLine.PointCount) > LimitDXFPolyCount then begin AddExceptionToLogSilent(Sender.ClassName + ' not loaded. PointCount > ' + IntToStr(LimitDXFPolyCount)); exit; end; end; //**************************************************************************// if xLine.Count = 0 then exit; // может быть и так // wLine := TsgDXFLWPolyline(Sender); // d2Line := Tsg2DPolyline(Sender); // dwgLine := TsgDWGPolyline(Sender); j := 0; //S := S + ' Vertexes: '; //for I := 0 to TsgDXFPolyLine(Sender).Count - 1 do //begin // S := S + #13#10; // S := S + ' P' + IntToStr(I + 1) + ': '; // Vertex := TsgDXFVertex(TsgDXFPolyLine(Sender).Entities[I]); //end; if not (xLine is TsgDWGPolyline) then begin //Tolik // чтобы меньше тормозило SetLength(points, xLine.PolyPoints.Count); // j := 0; ZeroPoint := False; if Sender.ClassName <> 'TsgDXFLWPolyline' then begin // Tolik 21/01/2016 for I := 0 to xLine.PolyPoints.Count - 1 do // и только так делать !!! XLine.Count - не адекват для количества точек // for I := 0 to xLine.Count - 1 do begin P := xLine.PolyPoints[I]; {$IF Defined(CADImport6)} P := PtXMat(P, FCADParams.Matrix); {$ELSE} { if Extruded(TsgDXFPolyline(Sender).Extrusion) then DoExtrusion(P, TsgDXFPolyline(Sender).Extrusion);} // Tolik {if (P.x < 0) or (P.y < 0) then Exit;} P := FPointXMat(P, FCADParams.Matrix); if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // P := xLine.Points[i]; // P := FPointXMat(P, FCADParams.Matrix); {$IFEND} {S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z);} // Tolik -- 18/01/2016 -- if not ((P.x = 0) and (P.y = 0) and (P.z = 0)) then begin P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end; end; end else begin wLine := TsgDXFLWPolyline(Sender); for I := 0 to wLine.PolyPoints.Count - 1 do // и только так делать !!! XLine.Count - не адекват для количества точек // for I := 0 to xLine.Count - 1 do begin P := wLine.PolyPoints[I]; {$IF Defined(CADImport6)} P := PtXMat(P, FCADParams.Matrix); {$ELSE} { if Extruded(TsgDXFPolyline(Sender).Extrusion) then DoExtrusion(P, TsgDXFPolyline(Sender).Extrusion);} // Tolik {if (P.x < 0) or (P.y < 0) then Exit;} P := FPointXMat(P, FCADParams.Matrix); if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // P := xLine.Points[i]; // P := FPointXMat(P, FCADParams.Matrix); {$IFEND} {S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z);} // Tolik -- 18/01/2016 -- if not ((P.x = 0) and (P.y = 0) and (P.z = 0)) then begin P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end else AddExceptionToLogSilent(Sender.ClassName +' Object not loaded --- ! P.x = 0) and (P.y = 0) and (P.z = 0) !!!'); end; end; //Tolik // выставляем длину по факту прочитанных SetLength(points, j); // end else // begin j := 0; //Tolik // чтобы меньше тормозило SetLength(points, xLine.Count); // for I := 0 to xLine.Count - 1 do begin if i > xLine.PointCount then Break; //// BREAK ////; aVertex := TsgDXFVertex(TsgDXFPolyLine(Sender).Entities[I]); {$IF Defined(CADImport6)} P := PtXMat(aVertex.Point, FCADParams.Matrix); //P := PtXMat(P, FCADParams.Matrix); {$ELSE} //P := FPointXMat(aVertex.Point, FCADParams.Matrix); P := aVertex.Point; {if Extruded(TsgDWGPolyline(Sender).Extrusion) then DoExtrusion(P, xLine.Extrusion);} // Tolik {if (P.x < 0) or (P.y < 0) then Exit;} P := FPointXMat(P, FCADParams.Matrix); if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // {$IFEND} {S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z);} if not ((P.x = 0) and (P.y = 0) and (P.z = 0)) then begin P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end else AddExceptionToLogSilent(Sender.ClassName +' Object not loaded --- ! P.x = 0) and (P.y = 0) and (P.z = 0) !!!'); end; //Tolik // выставляем длину по факту прочитанных SetLength(points, j); // end; //TxtFile.Add(S); // Tolik -- 21/01/2016 -- //if Length(Points) > 1 then if Length(Points) > 2 then begin //**************************************************************************// Cad := TPCDrawing(GCadForm.PCad); // LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LayerNbr := GetImportLayerNbr(Cad, xLine.Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Poly := TPolyline(Cad.PolyLine(LayerNbr, points, 1, ord(psSolid), clBlack, 0, ord(bsClear), clBlack, TsgDXFPolyLine(Sender).Closed, False)); Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, xLine.Closed, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Poly.Color := xLine.Pen.Color; Poly.Width := xLine.Pen.Width; {$ELSE} Poly.Color := GetColor(Sender); Poly.Width := RoundUp(xLine.LineWeight); //Poly.Width := RoundUp(TsgDXFPolyLine(Sender).GlobalWeight); - после выруливания отрисовок от скалинга можно юзать, т.к. действит.толщина линии сидит здесь if Poly.width < 0 then Poly.width := 1; {$IFEND} Poly.Style := ord(entstyle(xLine)); Result := Poly; //Tolik SetLength(Points,0); // end else // Tolik 07/11/2017 -- begin if Length(Points) = 2 then begin Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, xLine.Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Line := TLine.create(Points[0].X, Points[0].Y, Points[1].x, Points[1].y, 1, 0, 0, 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Line.color := TsgDXFLine(Sender).Color; Line.Width := TsgDXFLine(Sender).Pen.Width; {$ELSE} Line.color := GetColor(Sender); Line.Width := RoundUp(TsgDXFLine(Sender).LineWeight); if Line.width < 1 then Line.width := 1; {$IFEND} Line.Style := ord(entstyle(TsgDXFLine(Sender))); Result := Line; //Tolik SetLength(Points,0); // end; end; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportPolyLine', E.Message); end; end; // Tolik --12/12/2016 -- function TF_Import.ImportWipeOut(Sender: TObject): TFigure; var P: TFPoint; S: string; I: Integer; // Vertex: TsgDXFVertex; Cad: TPCDrawing; Poly: TPolyline; Points: TDoublePointArr; LayerNbr, LHandle: Integer; Count, j: Integer; //Tolik aWipe: TsgCADWipeout; Entity: TsgDXFEntity; aVertex: TsgDXFVertex; ZeroPoint: Boolean; CanAddPoint : Boolean; f: TextFile; // begin try Result := nil; {if not TsgCADWipeout(Sender).Visible then Exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit;} aWipe := TsgCADWipeout(Sender); j := 0; {AssignFile(f, 'd:\Tolik\ARC.txt'); reset(f); append(f); writeln(f,aWipe.ClassName); close(f);} if not ParamExists('NoLimitDXFPolyCount') then begin i := aWipe.PointCount; // xLine.PointCount; if (aWipe.PointCount) > LimitDXFPolyCount then exit; end; //**************************************************************************// { if aWipe.Count = 0 then exit;} j := 0; begin //Tolik // чтобы меньше тормозило SetLength(points, aWipe.PolyPoints.Count); //SetLength(points, aWipe.ClipPointsCount); // j := 0; ZeroPoint := False; // Tolik 21/01/2016 for I := 0 to aWipe.PolyPoints.Count - 1 do // и только так делать !!! XLine.Count - не адекват для количества точек //for I := 0 to aWipe.ClipPointsCount - 1 do // for I := 0 to xLine.Count - 1 do begin P := aWipe.PolyPoints[I]; {p.X := aWipe.ClipPoints[i].X; p.Y := aWipe.ClipPoints[i].y; p.X := 0; } {$IF Defined(CADImport6)} P := PtXMat(P, FCADParams.Matrix); {$ELSE} { if Extruded(TsgDXFPolyline(Sender).Extrusion) then DoExtrusion(P, TsgDXFPolyline(Sender).Extrusion);} // Tolik {if (P.x < 0) or (P.y < 0) then Exit;} P := FPointXMat(P, FCADParams.Matrix); if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // P := xLine.Points[i]; // P := FPointXMat(P, FCADParams.Matrix); {$IFEND} {S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z);} // Tolik -- 18/01/2016 -- if not ((P.x = 0) and (P.y = 0) and (P.z = 0)) then begin P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end; end; (* begin wLine := TsgDXFLWPolyline(Sender); for I := 0 to wLine.PolyPoints.Count - 1 do // и только так делать !!! XLine.Count - не адекват для количества точек // for I := 0 to xLine.Count - 1 do begin P := wLine.PolyPoints[I]; {$IF Defined(CADImport6)} P := PtXMat(P, FCADParams.Matrix); {$ELSE} { if Extruded(TsgDXFPolyline(Sender).Extrusion) then DoExtrusion(P, TsgDXFPolyline(Sender).Extrusion);} // Tolik {if (P.x < 0) or (P.y < 0) then Exit;} P := FPointXMat(P, FCADParams.Matrix); if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // P := xLine.Points[i]; // P := FPointXMat(P, FCADParams.Matrix); {$IFEND} {S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z);} // Tolik -- 18/01/2016 -- if not ((P.x = 0) and (P.y = 0) and (P.z = 0)) then begin P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end else AddExceptionToLogSilent(Sender.ClassName +' Объект не загружен --- ! P.x = 0) and (P.y = 0) and (P.z = 0) !!!'); end; end;*) //Tolik // выставляем длину по факту прочитанных SetLength(points, j); // end; (* else // begin j := 0; //Tolik // чтобы меньше тормозило SetLength(points, xLine.Count); // for I := 0 to xLine.Count - 1 do begin if i > xLine.PointCount then Break; //// BREAK ////; aVertex := TsgDXFVertex(TsgDXFPolyLine(Sender).Entities[I]); {$IF Defined(CADImport6)} P := PtXMat(aVertex.Point, FCADParams.Matrix); //P := PtXMat(P, FCADParams.Matrix); {$ELSE} //P := FPointXMat(aVertex.Point, FCADParams.Matrix); P := aVertex.Point; {if Extruded(TsgDWGPolyline(Sender).Extrusion) then DoExtrusion(P, xLine.Extrusion);} // Tolik {if (P.x < 0) or (P.y < 0) then Exit;} P := FPointXMat(P, FCADParams.Matrix); if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // {$IFEND} {S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z);} if not ((P.x = 0) and (P.y = 0) and (P.z = 0)) then begin P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end else AddExceptionToLogSilent(Sender.ClassName +' Объект не загружен --- ! P.x = 0) and (P.y = 0) and (P.z = 0) !!!'); end; //Tolik // выставляем длину по факту прочитанных SetLength(points, j); // end; *) // Tolik -- 21/01/2016 -- if Length(Points) > 1 then begin //**************************************************************************// Cad := TPCDrawing(GCadForm.PCad); // LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LayerNbr := GetImportLayerNbr(Cad, aWipe.Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Poly := TPolyline(Cad.PolyLine(LayerNbr, points, 1, ord(psSolid), clBlack, 0, ord(bsClear), clBlack, TsgDXFPolyLine(Sender).Closed, False)); Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, aWipe.Closed, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Poly.Color := aWipe.Pen.Color; Poly.Width := aWipe.Pen.Width; {$ELSE} Poly.Color := clRED;//GetColor(clRED);//GetColor(Sender); Poly.Width := RoundUp(aWipe.LineWeight); //Poly.Width := RoundUp(TsgDXFPolyLine(Sender).GlobalWeight); - после выруливания отрисовок от скалинга можно юзать, т.к. действит.толщина линии сидит здесь if Poly.width < 0 then Poly.width := 1; {$IFEND} Poly.Style := ord(entstyle(aWipe)); Result := Poly; //Tolik SetLength(Points,0); // end; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportPolyLine', E.Message); end; end; Procedure ImportOleToFrame(Sender: TObject); var OleObj: TsgDXFOle2Frame; begin OleObj := TsgDXFOle2Frame(Sender); end; // (* // OLD -- function TF_Import.ImportPolyLine(Sender: TObject): TFigure; var P: TFPoint; S: string; I: Integer; // Vertex: TsgDXFVertex; Cad: TPCDrawing; Poly: TPolyline; Points: TDoublePointArr; LayerNbr, LHandle: Integer; Count, j: Integer; //Tolik xLine: TsgDXFPolyLine; wLine: TsgDXFLWPolyline; d2Line: Tsg2DPolyline; dwgLine: TsgDWGPolyline; Entity: TsgDXFEntity; begin try Result := nil; // Tolik -- 20/01/2016 -- if not TsgDXFPolyLine(Sender).Visible then exit; // xLine := TsgDXFPolyLine(Sender); // может быть и так // wLine := TsgDXFLWPolyline(Sender); // d2Line := Tsg2DPolyline(Sender); // dwgLine := TsgDWGPolyline(Sender); j := 0; //S := S + ' Vertexes: '; //for I := 0 to TsgDXFPolyLine(Sender).Count - 1 do //begin // S := S + #13#10; // S := S + ' P' + IntToStr(I + 1) + ': '; // Vertex := TsgDXFVertex(TsgDXFPolyLine(Sender).Entities[I]); //end; if not ParamExists('NoLimitDXFPolyCount') then begin if (xLine.PointCount) > LimitDXFPolyCount then exit; end; //Tolik // чтобы меньше тормозило SetLength(points, xLine.PointCount); // // Tolik -- begin j := 0; for I := 0 to xLine.PointCount - 1 do begin P := xLine.Points[I]; {$IF Defined(CADImport6)} P := PtXMat(P, FCADParams.Matrix); {$ELSE} // Tolik - 20/01/2016 -- if Extruded(TSgDxfPolyLine(Sender).Extrusion) then DoExtrusion(P, TSgDxfPolyLine(Sender).Extrusion); P := FPointXMat(P, FCADParams.Matrix); // {$IFEND} //S := S + ' X=' + FloatToStr(P.X); //S := S + ' Y=' + FloatToStr(P.Y); //S := S + ' Z=' + FloatToStr(P.Z); if not ((P.x = 0) and (P.y = 0) and (P.z = 0)) then begin //Tolik //SetLength(points, j + 1); // P := ModificatePoint(P); points[j].x := P.x; points[j].y := P.y; points[j].z := P.z; inc(j); end; end; //Tolik // выставляем длину по факту прочитанных SetLength(points, j); // //TxtFile.Add(S); if not xLine.Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //**************************************************************************// if xLine.Count = 0 then exit; Cad := TPCDrawing(GCadForm.PCad); // LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LayerNbr := GetImportLayerNbr(Cad, xLine.Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Poly := TPolyline(Cad.PolyLine(LayerNbr, points, 1, ord(psSolid), clBlack, 0, ord(bsClear), clBlack, TsgDXFPolyLine(Sender).Closed, False)); Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, xLine.Closed, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Poly.Color := xLine.Pen.Color; Poly.Width := xLine.Pen.Width; {$ELSE} Poly.Color := GetColor(Sender); Poly.Width := RoundUp(xLine.LineWeight); //Poly.Width := RoundUp(TsgDXFPolyLine(Sender).GlobalWeight); - после выруливания отрисовок от скалинга можно юзать, т.к. действит.толщина линии сидит здесь if Poly.width < 0 then Poly.width := 1; {$IFEND} Poly.Style := ord(entstyle(xLine)); Result := Poly; //Tolik SetLength(Points,0); // end; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportPolyLine', E.Message); end; end; *) function ImportTextFont(Sender: TObject): string; var vText: TsgDXFText; function ImportMTextFontStyle(AStyle: TmvFontStyles): string; begin if fmBold in AStyle then Result := ' fmBold' + #13#10; if fmItalic in AStyle then Result := Result + ' fmItalic' + #13#10; if fmUnderline in AStyle then Result := Result + ' fmUnderline' + #13#10; if fmStrikeOut in AStyle then Result := Result + ' fmStrikeOut' + #13#10; if fmCondensed in AStyle then Result := Result + ' fmCondensed' + #13#10; if fmUpward in AStyle then Result := Result + ' fmUpward' + #13#10; if fmDownward in AStyle then Result := Result + ' fmDownward' + #13#10; end; begin //Tolik Result := ''; // try vText := TsgDXFText(Sender); if vText.Style <> nil then begin Result := Result + ' Text Style:' + #13#10; Result := Result + ' BigFont=' + vText.Style.BigFont + #13#10; Result := Result + ' WidthFactor=' + FloatToStr(vText.Style.WidthFactor) + #13#10; end; Result := ' Font: Name=' + vText.FontName + '; '; Result := Result + ' Height=' + IntToStr(vText.Font.Height) + '; '; Result := Result + ' Color=$' + IntToHex(vText.Font.Color, 8) + '; ' + #13#10; Result := Result + ' Style:' + #13#10 + ImportMTextFontStyle(vText.Font.Style); Result := Result + ' Thickness=' + FloatToStr(vText.GetThickness); Result := Result + #13#10' Generation=' + IntToStr(vText.Generation); Result := Result + #13#10' VAlign=' + IntToStr(vText.VAlign); Result := Result + #13#10' HAlign=' + IntToStr(vText.HAlign); except on E: Exception do AddExceptionToLogEx('ImportTextFont', E.Message); end; end; function GetDXFBlock(aID: Integer): TBlock; var i: Integer; begin try Result := nil; for i := 0 to FDXFBlocksList.Count - 1 do if aID = TBlock(FDXFBlocksList[i]).ID then begin Result := TBlock(FDXFBlocksList[i]); exit; end; except on E: Exception do AddExceptionToLogEx('CheckDXFBlockExist', E.Message); end; end; function CheckAnyText(aStr: string): Boolean; var i: integer; begin try Result := False; //31.10.2012 for i := 0 to Length(aStr) - 1 do for i := 1 to Length(aStr) do if aStr[i] <> #0 then begin Result := True; exit; end; except on E: Exception do AddExceptionToLogEx('CheckAnyText', E.Message); end; end; function TF_Import.ImportAttdef(Sender: TObject): TFigure; begin try Result := nil; //TxtFile.Add('Tag: '+TsgDXFAttdef(Sender).Tag); if not TsgDXFAttdef(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; Result := ImportText(Sender); //// except on E: Exception do AddExceptionToLogEx('TF_Import.ImportAttdef', E.Message); end; end; (* function TF_Import.ImportText(Sender: TObject): TFigure; var i: Integer; P: TFPoint; P1: TDoublePoint; S: string; LayerNbr, LHandle: Integer; vText: TRichText; Text: TText; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w, txth: double; Cad: TPCDrawing; DxfText: TsgDXFText; a: double; InsideMText: Boolean; IsUnicodeText: Boolean; MText: TsgDXFMText; SHXText: String; SHXUnicodeText: String; Complex: Boolean; ObjText: String; TmpIntVal: Integer; // Tolik aMatrix: TfMatrix; z: Double; TempPoint: TFPoint; VPt: TPoint; ScalePoint: TDoublePoint; ImageScalePoint: TFPoint; TextScale, TextScaleX: Double; sb, si: String; P2: TFPoint; textHandle: int64; oldMaxX, oldMaxY, oldMinX, oldMinY, MaxX, MaxY, MinX, MinY: Double; TopLeftPoint, RightBottomPoint: TFPoint; xChange, yChange: Double; F: TextFile; CanMoveText: Boolean; Counter: Integer; TxtHandle, TxtIndexHandle: Int64; CanAddLines: Boolean; Line: TLine; Blk: TBlock; // Tolik - -для посмотреть границы текстового блока Procedure AddEntity(rEntity: TFigure); var i: Int64; begin if REntity <> nil then begin Blk := nil; // фигура не в блоке if FCADParams.Insert <> nil then i := FCADParams.Insert.Handle; if ((FCADParams.Insert = nil) and (F_Import.CurrentBlockHandle = -1)) then begin FDXFObjectsList.Add(REntity); end else // фигура в блоке begin Cad := TPCDrawing(GCadForm.PCad); { if F_Import.CurrentBlockHandle = -1 then Blk := GetDXFBlock(FCADParams.Insert.Handle) else Blk := GetDXFBlock(StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle]));} if (FCADParams.Insert <> nil) and (F_Import.CurrentBlockHandle = -1) then Blk := GetDXFBlock(FCADParams.Insert.Handle) else if F_Import.CurrentBlockHandle <> -1 then Blk := GetDXFBlock(StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle])); // такой блок уже есть, внести фигуру в него if Blk <> nil then begin // 16.01.2014 //Blk.AddFigure(ResEntity); Blk.AddFigure(REntity, False); end else // блока нет, создать и внести в него фигуру begin // if FCADParams.Insert.Visible then begin // inc(FBlockCount); Blk := TBlock.Create(REntity.LayerHandle, Cad); Blk.AddFigure(REntity); if F_Import.CurrentBlockHandle <> -1 then Blk.ID := StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle]) else Blk.ID := FCADParams.Insert.Handle; // Tolik begin FDXFBlocksList.Add(Blk); FDXFObjectsList.Add(Blk); end; end; { else dec(FEntitiesCount);} end; end; end; F_Import.CurrentBlockHandle := -1; end; // // begin try Result := nil; SHXText := ''; ObjText := ''; SHXUnicodeText := ''; CanMoveText := False; CanAddLines := False; DoScale2D(FCADParams); if Sender is TsgDxfText then begin if not TsgDXFText(Sender).Visible then exit; if FCADParams.Insert <> nil then begin if not FCADParams.Insert.Visible then exit; sb := IntTostr(FCADParams.Insert.Block.Handle); si := IntTostr(FCADParams.Insert.Handle); end; if TsgDXFText(Sender).MText <> nil then begin if (trim(TsgDXFText(Sender).MText.Text) = '') and (trim(TsgDXFText(Sender).SHXText) = '') and (trim(TsgDXFText(Sender).SHXUnicodeText) = '') and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; end; if (trim(TsgDXFText(Sender).SHXText) = '') and (trim(TsgDXFText(Sender).SHXUnicodeText) = '') and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; if FCADParams.Insert <> nil then begin CanAddLines := True; //if FCADParams.Insert.Layer <> nil then begin //if (abs(FCADParams.Insert.Layer.Box.Bottom) = abs(FCADParams.Insert.Layer.Box.Left)) and // (abs(FCADParams.Insert.Layer.Box.Left) = abs(FCADParams.Insert.Layer.Box.Right)) and // (abs(FCADParams.Insert.Layer.Box.Right) = abs(FCADParams.Insert.Layer.Box.Top)) then if (abs(FCADParams.Insert.Box.Bottom) = abs(FCADParams.Insert.Box.Left)) and (abs(FCADParams.Insert.Box.Left) = abs(FCADParams.Insert.Box.Right)) and (abs(FCADParams.Insert.Box.Right) = abs(FCADParams.Insert.Box.Top)) and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; end; end; {$IF Defined(CADImport6)} P := PtXMat(TsgDXFText(Sender).StartPoint, FCADParams.Matrix); {$ELSE} P := FPointXMat(TsgDXFText(Sender).StartPoint, FCADParams.Matrix); //P := FCadParams.Insert.Point; // Tolik -- if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); TextHandle := TsgDXFEntity(Sender).Handle; Exit; end; end; {$IFEND} {S := S + ' Start point: '; S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z); S := S + ' Angle=' + FloatToStr(TsgDXFText(Sender).Rotation + FCADParams.Angle); S := S + #13#10 + ImportTextFont(Sender); S := S + #13#10' Text: ' + utf16decode(TsgDXFText(Sender).Text);} if FTextUsePrevPt then begin FTextUsePrevPt := false; P := FTextPrevPt; { S := S + #13#10'!!! Use prev pt.';} end; //TxtFile.Add(S); // Tolik //F_Import.CurrentBlockHandle := HandleList.IndexOf(IntToStr(TsgDXFText(Sender).Handle)); // //31.10.2012 - проверка доп параметров на выявления текстов типа "\Q0.2617993878" замечено с установленным флагом InsideMText InsideMText := TsgDXFText(Sender).InsideMText; IsUnicodeText := TsgDXFText(Sender).IsUnicodeText; MText := TsgDXFText(Sender).MText; SHXText := TsgDXFText(Sender).SHXText; SHXUnicodeText := TsgDXFText(Sender).SHXUnicodeText; Complex := TsgDXFText(Sender).Complex; // Tolik --08/02/2016 -- // ObjText := utf16decode(TsgDXFText(Sender).Text); //ObjText := utf16decode(TsgDXFText(Sender).Text, TsgDXFText(Sender).IsUnicodeText); {AssignFile(f, 'd:\Tolik\ARC.txt'); reset(f); append(f); writeln(f,TsgDXFText(Sender).Text); CloseFile(f);} ObjText := utf16decode(TsgDXFText(Sender).Text, TsgDXFText(Sender).IsUnicodeText); // //31.10.2012 - не пропускаем служебный текст if InsideMText then if Length(ObjText) > 4 then if (ObjText[1] = '\') and Not TryStrToInt(ObjText[2], TmpIntVal) and TryStrToInt(ObjText[3], TmpIntVal) and (ObjText[4] = '.') then begin FTextPrevPt := P; FTextUsePrevPt := true; Exit; ///// EXIT ///// end; //**************************************************************************// Cad := TPCDrawing(GCadForm.PCad); DxfText := TsgDXFText(Sender); if not CheckAnyText(DxfText.Text) then exit; //Tolik -- for Test -- 03/02/2016 TextHandle := TsgDXFEntity(Sender).Handle; // P := ModificatePoint(P); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); a := DegToRad(DxfText.Rotation) + DegToRad(FCADParams.Angle); if ord(Cad.VerticalZero) = 1 then if ord(Cad.HorizontalZero) = 0 then a := 2 * pi - a; // Tolik -- подровняем угол (отбросить повороты на >360) while (CompareValue(a, 2*pi) = 1) do a := a - 2*pi; // // Tolik -- 20/01/2016 -- так чуть правильнее берет цвет текста DxfText.Color := GetColor(Sender); txth := DxfText.Height; // Tolik -- 16/02/2016 -- if ((FCADParams.Insert <> nil) and (FCADParams.Insert is TsgDXFMText) and (CompareValue(txth, Abs(TsgDXFText(Sender).StartPoint.Y)) = 0) and {(FCadParams.Insert.Block.Count = 1)} (TsgDxfEntity(Sender) is TsgDxfText) and (FCADParams.Insert.Block.Box.Left = cnstBadRect.Left) and (FCADParams.Insert.Block.Box.Top = cnstBadRect.Top) and (FCADParams.Insert.Block.Box.Bottom = cnstBadRect.Bottom) and (FCADParams.Insert.Block.Box.Right = cnstBadRect.Right) ) then CanMoveText := True; // // Tolik -- 29/01/2016 -- //txth := Txth*DxfText.Scale*FCadParams.YScale; txth := Txth*FCadParams.YScale; //else //Tolik -- а вот здесь ХЗкак правильно применять, т к в разных файлах по-разному приходит //txth := Txth*DxfText.Scale; {if FCADParams.Insert <> nil then txth := txth * FCADParams.Insert.Scale.Y;} // // Text := TText(cad.TextOut(LayerNbr, P.x, P.y, 0, txth, 0, DxfText.Text, DxfText.FontName, DxfText.Font.Charset, DxfText.Color, False)); Text := TText.Create(P.x, P.y, txth, 0, utf16decode(DxfText.Text, TsgDXFText(Sender).IsUnicodeText), DxfText.FontName, DxfText.Font.Charset, DxfText.Color, LHandle, mydsNormal, Cad); // Tolik //Text.Scale(1, DxfText.Scale); // begin Text.TextLength := 0; Text.TextHeight := 0; Text.setRegionPoints; end; //Text.UpdateBounds(RightBottomPoint.X, RightBottomPoint.Y, TopLeftPoint.X, TopLeftPoint.Y); P1.x := P.X; P1.y := P.y; P1.z := P.z; // Tolik -- 16/02/2016 -- // Text.Move(0, - txth); //if CanMoveText then //begin {P := FCadParams.Insert.Point; P := ModificatePoint(P); Text.Move(P.X - Text.CenterPoint.x, P.Y - Text.CenterPoint.Y );} // Text.Move((P.X - Text.TextHeight/2) - P.X, (P.Y - Text.TextLength/2) - P.Y ); //end //else // Tolik -- для посмотреть if FCadParams.Insert <> nil then begin s := utf16decode(DxfText.Text, TsgDXFText(Sender).IsUnicodeText) + ' -- Box : Left = ' + FloatToStr(FCADParams.Insert.Block.Box.Left) + ' Right = ' + FloatToStr(FCADParams.Insert.Block.Box.Right) + ' Top = ' + FloatToStr(FCADParams.Insert.Block.Box.Top) + ' Bottom = ' + FloatToStr(FCADParams.Insert.Block.Box.Bottom) + ' --> ' + TsgDxfEntity(Sender).ClassName; end else begin s := utf16decode(DxfText.Text, TsgDXFText(Sender).IsUnicodeText) + ' -- WithOut Block Insert -- ' + TsgDxfEntity(Sender).ClassName; end; AssignFile(F, 'd:\Tolik\Arc.txt'); Append(f); Writeln(F, S); CloseFile(F); // Text.Move(0, -txth); Text.rotate(a, P1); // Если многострочный текст -- вычисляем сдвиг if FCadParams.Insert <> nil then begin //CanAddLines := True; if ((FCADParams.Insert is TsgDXFMText) and (FCADParams.Insert.Block.Count > 1)) then begin //MovePoint := FPointXMat(FCADParams.Insert.Block.Offset, FCADParams.Matrix); //MovePoint := ModificatePoint(MovePoint); TopLeftPoint.X := FCADParams.Insert.Block.Box.Left; TopLeftPoint.Y := FCADParams.Insert.Block.Box.Top; TopLeftPoint.Z := 0; TopLeftPoint := FPointXMat(TopLeftPoint, FCADParams.Matrix); TopLeftPoint := ModificatePoint(TopLeftPoint); RightBottomPoint.X := FCADParams.Insert.Block.Box.Right; RightBottomPoint.Y := FCADParams.Insert.Block.Box.Bottom; RightBottomPoint.Z := 0; RightBottomPoint := FPointXMat(RightBottomPoint, FCADParams.Matrix); RightBottomPoint := ModificatePoint(RightBottomPoint); Txth := (ABS(RightBottomPoint.Y) - ABS(TopLeftPoint.Y))/(TsgDXFMText(FCADParams.Insert).Block.Count); //Text.Scale(0, Txth/Text.TextHeight); TxtHandle := TsgDXFText(Sender).Handle; Counter := 0; for i := 0 to (TsgDXFMText(FCADParams.Insert).Block.Count - 1) do begin if TxtHandle = TsgDXFText(TsgDXFMText(FCADParams.Insert).Block[i]).Handle then Break; //// BREAK ////; Inc(Counter); end; if Counter > 0 then //Text.Move(0, -Txth*Counter); Text.Move(0, Text.TextHeight*Counter*1.2); end; end; if CanAddLines then //box begin (* LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Line := TLine.create(TopLeftPoint.X, TopLeftPoint.Y, RightBottomPoint.X, TopLeftPoint.Y, 1, 0, 0, 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Line.color := TsgDXFLine(Sender).Color; Line.Width := TsgDXFLine(Sender).Pen.Width; {$ELSE} //Line.color := GetColor(Sender); Line.color := clRED; Line.Width := RoundUp(TsgDXFLine(Sender).LineWeight); if Line.width < 1 then Line.width := 3; {$IFEND} Line.Style := Ord(psSolid);//ord(entstyle(TsgDXFLine(Sender))); AddEntity(line); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Line := TLine.create(RightBottomPoint.X, TopLeftPoint.Y, RightBottomPoint.X, RightBottomPoint.Y, 1, 0, 0, 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Line.color := TsgDXFLine(Sender).Color; Line.Width := TsgDXFLine(Sender).Pen.Width; {$ELSE} //Line.color := GetColor(Sender); Line.color := clRED; Line.Width := RoundUp(TsgDXFLine(Sender).LineWeight); if Line.width < 1 then Line.width := 3; {$IFEND} Line.Style := ord(psSolid);//ord(entstyle(TsgDXFLine(Sender))); AddEntity(line); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Line := TLine.create(RightBottomPoint.X, RightBottomPoint.Y, TopLeftPoint.X, RightBottomPoint.Y, 1, 0, 0, 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Line.color := TsgDXFLine(Sender).Color; Line.Width := TsgDXFLine(Sender).Pen.Width; {$ELSE} //Line.color := GetColor(Sender); Line.color := clRED; Line.Width := RoundUp(TsgDXFLine(Sender).LineWeight); if Line.width < 1 then Line.width := 3; {$IFEND} Line.Style := Ord(psSolid);//ord(entstyle(TsgDXFLine(Sender))); AddEntity(line); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Line := TLine.create(TopLeftPoint.X, RightBottomPoint.Y, TopLeftPoint.X, TopLeftPoint.Y, 1, 0, 0, 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Line.color := TsgDXFLine(Sender).Color; Line.Width := TsgDXFLine(Sender).Pen.Width; {$ELSE} //Line.color := GetColor(Sender); Line.color := clRED; Line.Width := RoundUp(TsgDXFLine(Sender).LineWeight); if Line.width < 1 then Line.width := 3; {$IFEND} Line.Style := Ord(psSolid);//ord(entstyle(TsgDXFLine(Sender))); AddEntity(line); CanAddLines := False; *) (* end end // Tolik -- T S G D X F M T E X T -- не придет (его итератор схряцает и разложит на TsgDxfText) else if Sender is TsgDxfMText then begin end; Result := Text; EXIT; vText := TRichText.create(-100, -100, -100, -100, 1, ord(psSolid), clBlack, ord(psClear), clBlack, LHandle, mydsNormal, Cad); vText.re.WordWrap := false; vText.re.Font.Name := DxfText.FontName; vText.re.Font.Charset := DxfText.Font.Charset; vText.re.Font.Size := trunc(txth * 4); vText.re.Font.Style := []; vText.re.Font.Color := DxfText.Color; vText.re.Lines.Clear; vText.re.Lines.Add(DxfText.Text); // получить свойства xCanvas := TMetafileCanvas.Create(vText.Metafile, 0); xCanvas.Font.Name := vText.re.Font.Name; xCanvas.Font.Size := vText.re.Font.Size; xCanvas.Font.Style := vText.re.Font.Style; GetTextMetrics(xCanvas.Handle, TM); if vText.re.Lines.Count > 1 then h := TM.tmHeight / 4 * vText.re.Lines.Count + 1 else h := TM.tmHeight / 4 * vText.re.Lines.Count; w := 0; for i := 0 to vText.re.Lines.Count - 1 do begin if w < xCanvas.TextWidth(vText.Re.Lines[i]) then w := xCanvas.TextWidth(vText.Re.Lines[i]); end; w := (w + 3) / 4 ; FreeAndNil(xCanvas); // пересоздать с новыми свойствами if vText <> nil then FreeAndNil(vText); vText := TRichText.create(P.x, P.y, P.x + w, P.y + h, 1, ord(psSolid), clBlack, ord(bsClear), clNone, LHandle, mydsNormal, GCadForm.PCad); vText.re.WordWrap := false; vText.re.Font.Name := DxfText.FontName; vText.re.Font.Charset := DxfText.Font.Charset; vText.re.Font.Size := trunc(txth * 4); vText.re.Font.Style := []; vText.re.Font.Color := DxfText.Color; vText.re.Lines.Clear; vText.re.Lines.Add(DxfText.Text); P1.x := P.X; P1.y := P.y; P1.z := P.z; vText.Move(0, - (txth/2 + h/2)); vText.rotate(a, P1); Cad.AddCustomFigure(LayerNbr, vText, false); except on E: Exception do AddExceptionToLogEx('TF_Import.ImportText', E.Message); end; end; *) function TF_Import.ImportText(Sender: TObject): TFigure; var i: Integer; P: TFPoint; P1: TDoublePoint; S: string; LayerNbr, LHandle: Integer; vText: TRichText; Text: TText; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w, txth: double; Cad: TPCDrawing; DxfText: TsgDXFText; a: double; InsideMText: Boolean; IsUnicodeText: Boolean; MText: TsgDXFMText; SHXText: String; SHXUnicodeText: String; Complex: Boolean; ObjText: String; TmpIntVal: Integer; // Tolik aMatrix: TfMatrix; z: Double; TempPoint: TFPoint; VPt: TPoint; ScalePoint: TDoublePoint; ImageScalePoint: TFPoint; TextScale, TextScaleX: Double; sb, si: String; P2: TFPoint; textHandle: int64; oldMaxX, oldMaxY, oldMinX, oldMinY, MaxX, MaxY, MinX, MinY: Double; TopLeftPoint, RightBottomPoint: TFPoint; xChange, yChange: Double; F: TextFile; CanMoveText: Boolean; Counter: Integer; TxtHandle, TxtIndexHandle: Int64; MovePoint: TFPoint; Blk: TBlock; j: Int64; BoxLPoint, BoxRPoint: TFPoint; RBoxLPoint, RBoxRPoint, CPoint: TDoublePoint; Boxwidth, BoxHeight, BoxW, BoxH: Double; ScaleCoef: Double; Rect: TRectangle; // Tolik - -для посмотреть границы текстового блока Procedure AddEntity(rEntity: TFigure); var i: Int64; begin if REntity <> nil then begin Blk := nil; // фигура не в блоке if FCADParams.Insert <> nil then i := FCADParams.Insert.Handle; if ((FCADParams.Insert = nil) and (F_Import.CurrentBlockHandle = -1)) then begin FDXFObjectsList.Add(REntity); end else // фигура в блоке begin Cad := TPCDrawing(GCadForm.PCad); { if F_Import.CurrentBlockHandle = -1 then Blk := GetDXFBlock(FCADParams.Insert.Handle) else Blk := GetDXFBlock(StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle]));} if (FCADParams.Insert <> nil) and (F_Import.CurrentBlockHandle = -1) then Blk := GetDXFBlock(FCADParams.Insert.Handle) else if F_Import.CurrentBlockHandle <> -1 then Blk := GetDXFBlock(StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle])); // такой блок уже есть, внести фигуру в него if Blk <> nil then begin // 16.01.2014 //Blk.AddFigure(ResEntity); Blk.AddFigure(REntity, False); end else // блока нет, создать и внести в него фигуру begin // if FCADParams.Insert.Visible then begin // inc(FBlockCount); Blk := TBlock.Create(REntity.LayerHandle, Cad); Blk.AddFigure(REntity); if F_Import.CurrentBlockHandle <> -1 then Blk.ID := StrToInt64(F_Import.BlockHandleList[F_Import.CurrentBlockHandle]) else Blk.ID := FCADParams.Insert.Handle; // Tolik begin FDXFBlocksList.Add(Blk); FDXFObjectsList.Add(Blk); end; end; { else dec(FEntitiesCount);} end; end; end; F_Import.CurrentBlockHandle := -1; end; // // Tolik -- 18/04/2017 -- удаление управляющих символов из строки function My_Trim(const S: string): string; var I, L: Integer; begin Result := ''; L := Length(S); if L > 0 then begin I := 0; while (I < L) do begin Inc(I); if S[I] >= ' ' then Result := Result + S[I]; end; end; end; // begin try Result := nil; SHXText := ''; ObjText := ''; SHXUnicodeText := ''; CanMoveText := False; // Tolik DoScale2D(FCADParams); // if Sender is TsgDxfText then begin if not TsgDXFText(Sender).Visible then exit; if FCADParams.Insert <> nil then begin if not FCADParams.Insert.Visible then exit; sb := IntTostr(FCADParams.Insert.Block.Handle); si := IntTostr(FCADParams.Insert.Handle); end; if TsgDXFText(Sender).MText <> nil then begin if (trim(TsgDXFText(Sender).MText.Text) = '') and (trim(TsgDXFText(Sender).SHXText) = '') and (trim(TsgDXFText(Sender).SHXUnicodeText) = '') and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; end; if (trim(TsgDXFText(Sender).SHXText) = '') and (trim(TsgDXFText(Sender).SHXUnicodeText) = '') and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; if FCADParams.Insert <> nil then begin //if FCADParams.Insert.Layer <> nil then begin //if (abs(FCADParams.Insert.Layer.Box.Bottom) = abs(FCADParams.Insert.Layer.Box.Left)) and // (abs(FCADParams.Insert.Layer.Box.Left) = abs(FCADParams.Insert.Layer.Box.Right)) and // (abs(FCADParams.Insert.Layer.Box.Right) = abs(FCADParams.Insert.Layer.Box.Top)) then if (abs(FCADParams.Insert.Box.Bottom) = abs(FCADParams.Insert.Box.Left)) and (abs(FCADParams.Insert.Box.Left) = abs(FCADParams.Insert.Box.Right)) and (abs(FCADParams.Insert.Box.Right) = abs(FCADParams.Insert.Box.Top)) and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; end; end; {$IF Defined(CADImport6)} P := PtXMat(TsgDXFText(Sender).StartPoint, FCADParams.Matrix); {$ELSE} P := FPointXMat(TsgDXFText(Sender).StartPoint, FCADParams.Matrix); { if FCADParams.Insert <> nil then P := FPointXMat(TsgDXFText(Sender).StartPoint, FCADParams.Insert.GetMatrix);} BoxLPoint := FPointXMat(TsgDXFText(Sender).Box.TopLeft, FCADParams.Matrix); BoxRPoint := FPointXMat(TsgDXFText(Sender).Box.BottomRight, FCADParams.Matrix); BoxLPoint := ModificatePoint(BoxLPoint); BoxRPoint := ModificatePoint(BoxRPoint); //P := FCadParams.Insert.Point; // Tolik -- if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); TextHandle := TsgDXFEntity(Sender).Handle; Exit; end; end; {$IFEND} {S := S + ' Start point: '; S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z); S := S + ' Angle=' + FloatToStr(TsgDXFText(Sender).Rotation + FCADParams.Angle); S := S + #13#10 + ImportTextFont(Sender); S := S + #13#10' Text: ' + utf16decode(TsgDXFText(Sender).Text);} if FTextUsePrevPt then begin FTextUsePrevPt := false; P := FTextPrevPt; { S := S + #13#10'!!! Use prev pt.';} end; //TxtFile.Add(S); // Tolik F_Import.CurrentBlockHandle := HandleList.IndexOf(IntToStr(TsgDXFText(Sender).Handle)); // //31.10.2012 - проверка доп параметров на выявления текстов типа "\Q0.2617993878" замечено с установленным флагом InsideMText InsideMText := TsgDXFText(Sender).InsideMText; IsUnicodeText := TsgDXFText(Sender).IsUnicodeText; MText := TsgDXFText(Sender).MText; SHXText := TsgDXFText(Sender).SHXText; SHXUnicodeText := TsgDXFText(Sender).SHXUnicodeText; Complex := TsgDXFText(Sender).Complex; // Tolik --08/02/2016 -- // ObjText := utf16decode(TsgDXFText(Sender).Text); //ObjText := utf16decode(TsgDXFText(Sender).Text, TsgDXFText(Sender).IsUnicodeText); {AssignFile(f, 'd:\Tolik\ARC.txt'); reset(f); append(f); writeln(f,TsgDXFText(Sender).Text); CloseFile(f);} // Tolik -- 14/02/2017 -- // ObjText := utf16decode(TsgDXFText(Sender).Text, TsgDXFText(Sender).IsUnicodeText); //Tolik 18/04/2017 -- //ObjText := utf16decode(My_Trim(TsgDXFText(Sender).Text), (TsgDXFText(Sender).IsUnicodeText or (SHXUnicodeText<>''))); // Tolik 16/10/2019 -- {if TsgDxfText(Sender).IsShxFont then ObjText := utf16decode(My_Trim(TsgDXFText(Sender).ShxText), (TsgDXFText(Sender).IsUnicodeText or (SHXUnicodeText<>''))) else } ObjText := utf16decode(My_Trim(TsgDXFText(Sender).Text), (TsgDXFText(Sender).IsUnicodeText or (SHXUnicodeText<>''))); // // //31.10.2012 - не пропускаем служебный текст if InsideMText then if Length(ObjText) > 4 then if (ObjText[1] = '\') and Not TryStrToInt(ObjText[2], TmpIntVal) and TryStrToInt(ObjText[3], TmpIntVal) and (ObjText[4] = '.') then begin FTextPrevPt := P; FTextUsePrevPt := true; Exit; ///// EXIT ///// end; //**************************************************************************// Cad := TPCDrawing(GCadForm.PCad); DxfText := TsgDXFText(Sender); if Trim(My_Trim(DxfText.Text)) = '' then exit; if not CheckAnyText(DxfText.Text) then exit; //Tolik -- for Test -- 03/02/2016 TextHandle := TsgDXFEntity(Sender).Handle; // P := ModificatePoint(P); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); a := DegToRad(DxfText.Rotation) + DegToRad(FCADParams.Angle); if a <> 0 then if ord(Cad.VerticalZero) = 1 then if ord(Cad.HorizontalZero) = 0 then a := 2 * pi - a; // Tolik -- подровняем угол (отбросить повороты на >360) while (CompareValue(a, 2*pi) = 1) do a := a - 2*pi; txth := DxfText.Height; // // Tolik -- 20/01/2016 -- так чуть правильнее берет цвет текста DxfText.Color := GetColor(Sender); // Tolik -- текст на пробу из параметров родительского блока {if (FCadParams.Insert = nil) or ((FCadParams.Insert <> nil) and not (FCADParams.Insert is TsgDxfMText)) then txth := DxfText.Height else begin TopLeftPoint.x := FCADParams.Insert.Block.Box.Left; TopLeftPoint.Y := FCADParams.Insert.Block.Box.Top; TopLeftPoint.Z := 0; RightBottomPoint.X := FCADParams.Insert.Block.Box.Right; RightBottomPoint.Y := FCADParams.Insert.Block.Box.Bottom; RightBottomPoint.Z := 0; TopLeftPoint := ModificatePoint(FPointXMat(TopLeftPoint, FCADParams.Matrix)); RightBottomPoint := ModificatePoint(FPointXMat(RightBottomPoint, FCADParams.Matrix)); TopLeftPoint := FPointXMat(TopLeftPoint, DxfText.GetMatrix); RightBottomPoint := FPointXMat(RightBottomPoint, DxfText.GetMatrix); txth := ABS(ABS(TopLeftPoint.Y) - ABS(RightBottomPoint.Y) )/ FCadParams.Insert.Block.Count; end;} // Tolik -- 16/02/2016 -- if ((FCADParams.Insert <> nil) and (FCADParams.Insert is TsgDXFMText) and (CompareValue(txth, Abs(TsgDXFText(Sender).StartPoint.Y)) = 0) and {(FCadParams.Insert.Block.Count = 1)} (TsgDxfEntity(Sender) is TsgDxfText) and (FCADParams.Insert.Block.Box.Left = cnstBadRect.Left) and (FCADParams.Insert.Block.Box.Top = cnstBadRect.Top) and (FCADParams.Insert.Block.Box.Bottom = cnstBadRect.Bottom) and (FCADParams.Insert.Block.Box.Right = cnstBadRect.Right) ) then CanMoveText := True; // // Tolik -- 29/01/2016 -- //txth := Txth*DxfText.Scale*FCadParams.YScale*2; //txth := Txth*DxfText.Scale*FCadParams.YScale*FCadParams.XScale; txth := Txth*DxfText.Scale*FCadParams.YScale; //txth := Txth*FCadParams.YScale; //else //Tolik -- а вот здесь ХЗкак правильно применять, т к в разных файлах по-разному приходит //txth := Txth*DxfText.Scale; {if FCADParams.Insert <> nil then txth := txth * FCADParams.Insert.Scale.Y;} // // Text := TText(cad.TextOut(LayerNbr, P.x, P.y, 0, txth, 0, DxfText.Text, DxfText.FontName, DxfText.Font.Charset, DxfText.Color, False)); // Tolik -- 04/02/2017 -- //Text := TText.Create(P.x, P.y, txth, 0, utf16decode(DxfText.Text, TsgDXFText(Sender).IsUnicodeText), DxfText.FontName, DxfText.Font.Charset, DxfText.Color, LHandle, mydsNormal, Cad); //Text := TText.Create(P.x, P.y, txth, 0, utf16decode(My_Trim(DxfText.Text), (TsgDXFText(Sender).IsUnicodeText or (SHXUnicodeText <> ''))), DxfText.FontName, DxfText.Font.Charset, DxfText.Color, LHandle, mydsNormal, Cad); Text := TText.Create(P.x, P.y, txth, 0, ObjText, DxfText.FontName, DxfText.Font.Charset, DxfText.Color, LHandle, mydsNormal, Cad); // // Tolik 03/10/2019 -- if DxfText.Font.Style <> [] then begin Text.Font.Style := []; if fmBold in DxfText.Font.Style then Text.Font.Style := Text.Font.Style + [fsBold]; if fmItalic in DxfText.Font.Style then Text.Font.Style := Text.Font.Style + [fsItalic]; if fmUnderline in DxfText.Font.Style then Text.Font.Style := Text.Font.Style + [fsUnderLine]; if fmStrikeOut in DxfText.Font.Style then Text.Font.Style := Text.Font.Style + [fsStrikeOut]; // Эти три есть только в автокаде... пока непонятно как прикрутить ... { if ((fmCondensed in DxfText.Font.Style) or (fmUpward in DxfText.Font.Style) or (fmDownward in DxfText.Font.Style)) then beep;} end; // Tolik //Text.Scale(1, DxfText.Scale); // begin Text.TextLength := 0; Text.TextHeight := 0; Text.setRegionPoints; end; //Text.UpdateBounds(RightBottomPoint.X, RightBottomPoint.Y, TopLeftPoint.X, TopLeftPoint.Y); P1.x := P.X; P1.y := P.y; P1.z := P.z; // center if ((DxfText.HAlign = 0) or (DxfText.HAlign = 1) or (DxfText.HAlign = 4)) then begin if a <> 0 then begin RBoxLPoint.x := BoxLPoint.X; RBoxRPoint.x := BoxRPoint.x; RBoxLPoint.y := BoxLPoint.y; RBoxRPoint.y := BoxRPoint.y; {cPoint.x := (BoxRPoint.x + BoxLPoint.x)/2; cPoint.y := (BoxRPoint.y + BoxLPoint.y)/2; cPoint.z := 0;} RBoxRPoint := PCTypesUtils.RotatePoint(RBoxLPoint, RBoxRPoint, -a); //RBoxLPoint := PCTypesUtils.RotatePoint(cPoint, RBoxLPoint, a); //BoxLPoint.X := RBoxLPoint.x; BoxRPoint.x := RBoxRPoint.x; //BoxLPoint.y := RBoxLPoint.y; BoxRPoint.y := RBoxRPoint.y; end; // { BoxW := BoxRPoint.x - BoxLPoint.x; BoxW := Sqr(BoxW); BoxH := BoxRPoint.y - BoxLPoint.y; BoxH := Sqr(BoxH); Boxwidth := sqrt(BoxW + BoxH); } Boxwidth := BoxRPoint.x - BoxLPoint.x; if BoxWidth < 0 then Boxwidth := Boxwidth * (-1); if compareValue(Boxwidth, Text.TextLength) = 1 then begin Text.Move((Boxwidth - Text.TextLength)/2, -Text.TextHeight); if Text.TextLength > 0 then begin ScaleCoef := Boxwidth/Text.TextLength; Text.Scale(ScaleCoef, ScaleCoef); end; end else begin Text.BoxWidth := Boxwidth; // Tolik 18/10/2019 -- Text.Move(0, -txth); end; end else //Text.Move(0, -txth); // Text.rotate(a, P1); {if FCadParams.Insert <> nil then begin if FCADParams.Insert is TsgDXFMText then begin MovePoint := FPointXMat(FCADParams.Insert.Block.Offset, FCADParams.Matrix); MovePoint := ModificatePoint(MovePoint); TopLeftPoint.X := FCADParams.Insert.Block.Box.Left; TopLeftPoint.Y := FCADParams.Insert.Block.Box.Top; TopLeftPoint.Z := 0; TopLeftPoint := FPointXMat(TopLeftPoint, FCADParams.Matrix); TopLeftPoint := ModificatePoint(TopLeftPoint); RightBottomPoint.X := FCADParams.Insert.Block.Box.Right; RightBottomPoint.Y := FCADParams.Insert.Block.Box.Bottom; RightBottomPoint.Z := 0; RightBottomPoint := FPointXMat(RightBottomPoint, FCADParams.Matrix); RightBottomPoint := ModificatePoint(RightBottomPoint); Txth := Abs(Abs(FCADParams.Insert.Block.Box.Bottom) - Abs(FCADParams.Insert.Block.Box.Top))/FCADParams.Insert.Block.Count; //MovePoint.y := -MovePoint.y; Counter := 0; TxtHandle := TsgDXFText(Sender).Handle; { for i := FCADParams.Insert.Block.Count - 1 Downto 0 do //for i := 0 to FCADParams.Insert.Block.Count - 1 do begin Inc(Counter); TxtIndexHandle := FCADParams.Insert.Block[i].Handle; if TxtHandle = TxtIndexHandle then Break; //// BREAK ////; end; Text.Move(0, -(txth )*Counter); end else Text.Move(0, -txth); end else} Text.Move(0, -txth); Text.rotate(a, P1); end // Tolik -- T S G D X F M T E X T -- не придет (его итератор схряцает и разложит на TsgDxfText) else if Sender is TsgDxfMText then begin end; Result := Text; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportText', E.Message); end; end; function TF_Import.ImportTextWithParams(Sender: TObject; aFCadParams: PsgCADIterate; aMatrix: TFMatrix): TFigure; var i: Integer; P: TFPoint; P1: TDoublePoint; S: string; LayerNbr, LHandle: Integer; vText: TRichText; Text: TText; TM: TTextMetric; xCanvas: TMetafileCanvas; h, w, txth: double; Cad: TPCDrawing; DxfText: TsgDXFText; a: double; InsideMText: Boolean; IsUnicodeText: Boolean; MText: TsgDXFMText; SHXText: String; SHXUnicodeText: String; Complex: Boolean; ObjText: String; TmpIntVal: Integer; // Tolik //aMatrix: TfMatrix; z: Double; TempPoint: TFPoint; VPt: TPoint; ScalePoint: TDoublePoint; ImageScalePoint: TFPoint; TextScale, TextScaleX: Double; sb, si: String; P2: TFPoint; LoadedText: TsgDxfText; // begin try Result := nil; SHXText := ''; ObjText := ''; SHXUnicodeText := ''; if Sender is TsgDxfText then begin if not TsgDXFText(Sender).Visible then exit; if aFCADParams.Insert <> nil then begin if not aFCADParams.Insert.Visible then exit; sb := IntTostr(aFCADParams.Insert.Block.Handle); si := IntTostr(aFCADParams.Insert.Handle); end; if TsgDXFText(Sender).MText <> nil then begin if (trim(TsgDXFText(Sender).MText.Text) = '') and (trim(TsgDXFText(Sender).SHXText) = '') and (trim(TsgDXFText(Sender).SHXUnicodeText) = '') and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; end; if (trim(TsgDXFText(Sender).SHXText) = '') and (trim(TsgDXFText(Sender).SHXUnicodeText) = '') and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; if aFCADParams.Insert <> nil then begin //if FCADParams.Insert.Layer <> nil then begin //if (abs(FCADParams.Insert.Layer.Box.Bottom) = abs(FCADParams.Insert.Layer.Box.Left)) and // (abs(FCADParams.Insert.Layer.Box.Left) = abs(FCADParams.Insert.Layer.Box.Right)) and // (abs(FCADParams.Insert.Layer.Box.Right) = abs(FCADParams.Insert.Layer.Box.Top)) then if (abs(aFCADParams.Insert.Box.Bottom) = abs(aFCADParams.Insert.Box.Left)) and (abs(aFCADParams.Insert.Box.Left) = abs(aFCADParams.Insert.Box.Right)) and (abs(aFCADParams.Insert.Box.Right) = abs(aFCADParams.Insert.Box.Top)) and (trim(TsgDXFText(Sender).Text) = '') then begin s := s; exit; end; end; end; { if FCADParams.Insert <> nil then begin LoadedText := TsgDxfText.Create; LoadedText.Assign(Sender); FCadParams.Insert.Converter.Loads(LoadedText); end; } {$IF Defined(CADImport6)} P := PtXMat(TsgDXFText(Sender).StartPoint, FCADParams.Matrix); {$ELSE} // Tolik -- 02/01/2015 P := FPointXMat(TsgDXFText(Sender).StartPoint, FCADParams.Matrix); P := FPointXMat(TsgDXFText(Sender).StartPoint, aMatrix); //P := FPointXMat(TsgDXFText(Sender).StartPoint, TsgDXFText(Sender).GetMatrix); // if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.Y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.Y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; // {$IFEND} {S := S + ' Start point: '; S := S + #13#10' X=' + FloatToStr(P.X); S := S + #13#10' Y=' + FloatToStr(P.Y); S := S + #13#10' Z=' + FloatToStr(P.Z); S := S + ' Angle=' + FloatToStr(TsgDXFText(Sender).Rotation + aFCADParams.Angle); S := S + #13#10 + ImportTextFont(Sender); S := S + #13#10' Text: ' + utf16decode(TsgDXFText(Sender).Text);} if FTextUsePrevPt then begin FTextUsePrevPt := false; P := FTextPrevPt; { S := S + #13#10'!!! Use prev pt.';} end; //TxtFile.Add(S); //31.10.2012 - проверка доп параметров на выявления текстов типа "\Q0.2617993878" замечено с установленным флагом InsideMText InsideMText := TsgDXFText(Sender).InsideMText; IsUnicodeText := TsgDXFText(Sender).IsUnicodeText; MText := TsgDXFText(Sender).MText; SHXText := TsgDXFText(Sender).SHXText; SHXUnicodeText := TsgDXFText(Sender).SHXUnicodeText; Complex := TsgDXFText(Sender).Complex; // Tolik 14/02/2017 -- // ObjText := utf16decode(TsgDXFText(Sender).Text, TsgDXFText(Sender).IsUnicodeText); ObjText := utf16decode(TsgDXFText(Sender).Text, (TsgDXFText(Sender).IsUnicodeText or (SHXUnicodeText <> ''))); // //31.10.2012 - не пропускаем служебный текст if InsideMText then if Length(ObjText) > 4 then if (ObjText[1] = '\') and Not TryStrToInt(ObjText[2], TmpIntVal) and TryStrToInt(ObjText[3], TmpIntVal) and (ObjText[4] = '.') then begin FTextPrevPt := P; FTextUsePrevPt := true; Exit; ///// EXIT ///// end; { if not TsgDXFText(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; } //**************************************************************************// Cad := TPCDrawing(GCadForm.PCad); DxfText := TsgDXFText(Sender); if not CheckAnyText(DxfText.Text) then exit; P := ModificatePoint(P); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); a := DegToRad(DxfText.Rotation) + DegToRad(FCADParams.Angle); if ord(Cad.VerticalZero) = 1 then if ord(Cad.HorizontalZero) = 0 then a := 2 * pi - a; // Tolik -- 20/01/2016 -- так чуть правильнее берет цвет текста DxfText.Color := GetColor(Sender); txth := DxfText.Height; // Tolik -- 29/01/2016 -- // if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then txth := Txth*DxfText.Scale*aFCadParams.YScale; //else // txth := Txth*DxfText.Scale; if aFCADParams.Insert <> nil then txth := txth * aFCADParams.Insert.Scale.Y; // // Text := TText(cad.TextOut(LayerNbr, P.x, P.y, 0, txth, 0, DxfText.Text, DxfText.FontName, DxfText.Font.Charset, DxfText.Color, False)); // Tolik -- 04/02/2017 -- // Text := TText.Create(P.x, P.y, txth, 0, utf16decode(DxfText.Text, TsgDXFText(Sender).IsUnicodeText), DxfText.FontName, DxfText.Font.Charset, DxfText.Color, LHandle, mydsNormal, Cad); Text := TText.Create(P.x, P.y, txth, 0, utf16decode(DxfText.Text, (TsgDXFText(Sender).IsUnicodeText or (SHXUnicodeText <> ''))), DxfText.FontName, DxfText.Font.Charset, DxfText.Color, LHandle, mydsNormal, Cad); // // Tolik //Text.Scale(1, DxfText.Scale); // begin Text.TextLength := 0; Text.TextHeight := 0; Text.setRegionPoints; end; P1.x := P.X; P1.y := P.y; P1.z := P.z; // Tolik // Text.Scale(FCADParams.XScale*DxfText.Scale, FCADParams.YScale); // Text.Move(0, - txth); Text.rotate(a, P1); Result := Text; end except on E: Exception do AddExceptionToLogEx('TF_Import.ImportText', E.Message); end; end; Function TF_Import.ImportMText(Sender: Tobject): TFigure; var i: Integer; begin if FCadParams.Insert <> nil then if not FCadParams.Insert.Visible then exit; for i := 0 to TsgDxfMText(Sender).Block.Count - 1 do // F_Import.ReadCADTXTEntities(TsgDXFMText(Sender).Block.Entities[i]); F_Import.ReadCADEntities(TsgDXFMText(Sender).Block.Entities[i]); end; // Tolik -- 02/03/2017 -- старая закомменчена (см -- ниже) // здесь дописано с параметром импортировать сплайн только по контролам function TF_Import.ImportSpline(Sender: TObject): TFigure; var vSpline: TsgDXFSpline absolute Sender; P: TFPoint; // S: string; I, j: Integer; pLine: TPolyline; Cad: TPCDrawing; LayerNbr, LHandle: Integer; PCAD: TPowerCad; PolyPoints: TDoublePointArr; SinglePoint: TDoublePoint; aCad: TF_Cad; // PointFound: Boolean; // BuildByPolyPoints: boolean; CanLoadByControlPoints: Boolean; begin try Result := nil; if not TsgDXFSpline(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFSpline(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); SetLength(PolyPoints,0); // результирующий набор точек для построения сплайна // если выставлено "Импортировать сплайны по контрольным точкам ", то // пытаемся сразу поднять сплайн по контрольным точкам if LoadSplineByControlPointsFirst then begin CanLoadByControlPoints := True; if not (vSpline.ControlCount > 0) then CanLoadByControlPoints := False else begin //Tolik // ограничение на количество точек if not ParamExists('NoLimitDXFPolyCount') then begin if (vSpline.ControlCount) > LimitDXFSplinePointCount then CanLoadByControlPoints := False; end; end; if CanLoadByControlPoints then begin j := 0; // чтобы меньше тормозило SetLength(PolyPoints, vSpline.ControlCount); // for I := 0 to vSpline.ControlCount - 1 do begin { S := S + #13#10 + ' P' + IntToStr(I + 1) + ': ';} {$IF Defined(CADImport6)} P := PtXMat(PFPoint(vSpline.Controls[I])^, FCADParams.Matrix); {$ELSE} //Tolik -- 11/02/2016 -- //P := vSpline.Controls[I]; P := FPointXMat(vSpline.Controls[I], FCADParams.Matrix); //P := ModificatePoint(P); // Tolik 02/11/2017 -- //P := FPointXMat(vSpline.Controls[I], FCADParams.Matrix); // P := FPointXMat(TFPoint(vSpline.Controls[I]), FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end end; P := ModificatePoint(P); // Tolik 02/11/2017 -- {$IFEND} if ((P.X <> 0) or (P.Y <> 0) or (P.Z <> 0)) then begin SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[j] := SinglePoint; inc(j); end; end; SetLength(PolyPoints,j); end else // если контрольных точек нет -- попытаемся поднять по точкам begin if ((vSpline.PolyPoints.Count) < (LimitDXFSplinePointCount)) then // Подъем по полипоинтам Begin SetLength(PolyPoints,0); SetLength(PolyPoints, vSpline.PolyPoints.Count); for i := 0 to vSpline.PolyPoints.Count - 1 do begin p := vSpline.PolyPoints[i]; {$IF Defined(CADImport6)} P := PtXMat(PFPoint(P)^, FCADParams.Matrix); {$ELSE} P := FPointXMat(P, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); SetLength(PolyPoints, 0); Exit; end; end; {$IFEND} P := ModificatePoint(P); SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[i] := SinglePoint; end; end else AddExceptionToLogSilent(Sender.ClassName + ' not loaded. PointCount = ' + IntToStr(vSpline.PolyPoints.Count) + ' and ControlPoints.Count = ' + IntToStr(vSpline.ControlCount)); end; end // здесь поднимаем, как было else begin if ((vSpline.PolyPoints.Count) < (LimitDXFSplinePointCount)) then // Подъем по полипоинтам Begin SetLength(PolyPoints,0); SetLength(PolyPoints, vSpline.PolyPoints.Count); for i := 0 to vSpline.PolyPoints.Count - 1 do begin p := vSpline.PolyPoints[i]; {$IF Defined(CADImport6)} P := PtXMat(PFPoint(P)^, FCADParams.Matrix); {$ELSE} P := FPointXMat(P, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); SetLength(PolyPoints, 0); Exit; end; end; {$IFEND} P := ModificatePoint(P); SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[i] := SinglePoint; end; end // если превышен лимит, можно попробовать поднять по контрольным точкам // (будет кривовато, но, все же, лучше, чем никак ) else begin if vSpline.ControlCount > 0 then begin j := 0; //Tolik // ограничение на количество точек if not ParamExists('NoLimitDXFPolyCount') then begin if (vSpline.ControlCount) > LimitDXFSplinePointCount then begin SetLength(PolyPoints, 0); // на всякий AddExceptionToLogSilent(Sender.ClassName + ' not loaded. PointCount = ' + IntToStr(vSpline.PolyPoints.Count) + 'and ControlPointCount = ' + IntToStr(vSpline.ControlCount)); exit; end; end; // чтобы меньше тормозило SetLength(PolyPoints, vSpline.ControlCount); // for I := 0 to vSpline.ControlCount - 1 do begin { S := S + #13#10 + ' P' + IntToStr(I + 1) + ': ';} {$IF Defined(CADImport6)} P := PtXMat(PFPoint(vSpline.Controls[I])^, FCADParams.Matrix); {$ELSE} //Tolik -- 11/02/2016 -- //P := vSpline.Controls[I]; P := FPointXMat(vSpline.Controls[I], FCADParams.Matrix); //P := ModificatePoint(P); //-- Tolik 02/11/2017 -*- //P := FPointXMat(vSpline.Controls[I], FCADParams.Matrix); // P := FPointXMat(TFPoint(vSpline.Controls[I]), FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end end; P := ModificatePoint(P); // Tolik -- 02/11/2017 -- {$IFEND} if ((P.X <> 0) or (P.Y <> 0) or (P.Z <> 0)) then begin SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[j] := SinglePoint; inc(j); end; end; SetLength(PolyPoints,j); end; end; end; // Dear Tolik, LOOK To isByAngles flag: // True: // Spline is built by Fit-points using BeginningTangent and EndingTangent // False: // Spline is built by control points and knots. // Best regards, Tolik! if Length(PolyPoints) > 0 then begin pLine := TPolyline.create(PolyPoints, 2, ord(psSolid), clBlack{xSpline.Color}, ord(bsClear), clBlack, 0, vSpline.Closed, Cad.GetLayerHandle(LayerNbr), mydsNormal, Cad); {$IF Defined(CADImport6)} PLine.Color := TsgDXFPolyLine(Sender).Pen.Color; PLine.Width := TsgDXFPolyLine(Sender).Pen.Width; {$ELSE} PLine.Color := GetColor(Sender); pLine.Width := RoundUp(TsgDXFPolyLine(Sender).LineWeight); if PLine.width < 0 then PLine.width := 1; {$IFEND} PLine.Style := ord(entstyle(TsgDXFPolyline(Sender))); SetLength(PolyPoints, 0); Result := pLine; end; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportSpline', E.Message); end; end; (* // Tolik -- 11/02/2016 -- старая закомменчена (см -- ниже)/ function TF_Import.ImportSpline(Sender: TObject): TFigure; var vSpline: TsgDXFSpline absolute Sender; P: TFPoint; // S: string; I, j: Integer; pLine: TPolyline; Cad: TPCDrawing; LayerNbr, LHandle: Integer; PCAD: TPowerCad; PolyPoints: TDoublePointArr; SinglePoint: TDoublePoint; aCad: TF_Cad; // PointFound: Boolean; // BuildByPolyPoints: boolean; begin try Result := nil; if not TsgDXFSpline(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFSpline(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); // Dear Tolik, LOOK To isByAngles flag: // True: // Spline is built by Fit-points using BeginningTangent and EndingTangent // False: // Spline is built by control points and knots. // Best regards, Tolik! SetLength(PolyPoints,0); if ((vSpline.PolyPoints.Count) < (LimitDXFPolyCount * 3)) then // Подъем по полипоинтам Begin SetLength(PolyPoints,0); SetLength(PolyPoints, vSpline.PolyPoints.Count); for i := 0 to vSpline.PolyPoints.Count - 1 do begin p := vSpline.PolyPoints[i]; {$IF Defined(CADImport6)} P := PtXMat(PFPoint(P)^, FCADParams.Matrix); {$ELSE} P := FPointXMat(P, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; {$IFEND} P := ModificatePoint(P); SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[i] := SinglePoint; end; end // если превышен лимит, можно попробовать поднять по контрольным точкам // (будет кривовато, но, все же, лучше, чем никак ) else begin if vSpline.ControlCount > 0 then begin j := 0; //Tolik // ограничение на количество точек if not ParamExists('NoLimitDXFPolyCount') then begin if (vSpline.ControlCount) > LimitDXFPolyCount then exit; end; // чтобы меньше тормозило SetLength(PolyPoints, vSpline.ControlCount); // for I := 0 to vSpline.ControlCount - 1 do begin { S := S + #13#10 + ' P' + IntToStr(I + 1) + ': ';} {$IF Defined(CADImport6)} P := PtXMat(PFPoint(vSpline.Controls[I])^, FCADParams.Matrix); {$ELSE} //Tolik -- 11/02/2016 -- //P := vSpline.Controls[I]; P := FPointXMat(vSpline.Controls[I], FCADParams.Matrix); P := ModificatePoint(P); //P := FPointXMat(vSpline.Controls[I], FCADParams.Matrix); // P := FPointXMat(TFPoint(vSpline.Controls[I]), FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end end; {$IFEND} if ((P.X <> 0) or (P.Y <> 0) or (P.Z <> 0)) then begin SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[j] := SinglePoint; inc(j); end; end; SetLength(PolyPoints,j); end; end; if Length(PolyPoints) > 0 then begin pLine := TPolyline.create(PolyPoints, 2, ord(psSolid), clBlack{xSpline.Color}, ord(bsClear), clBlack, 0, vSpline.Closed, Cad.GetLayerHandle(LayerNbr), mydsNormal, Cad); {$IF Defined(CADImport6)} PLine.Color := TsgDXFPolyLine(Sender).Pen.Color; PLine.Width := TsgDXFPolyLine(Sender).Pen.Width; {$ELSE} PLine.Color := GetColor(Sender); pLine.Width := RoundUp(TsgDXFPolyLine(Sender).LineWeight); if PLine.width < 0 then PLine.width := 1; {$IFEND} PLine.Style := ord(entstyle(TsgDXFPolyline(Sender))); SetLength(PolyPoints, 0); Result := pLine; end; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportSpline', E.Message); end; end; *) (* function TF_Import.ImportSpline(Sender: TObject): TFigure; var vSpline: TsgDXFSpline absolute Sender; P: TFPoint; S: string; I, j: Integer; pLine: TPolyline; Cad: TPCDrawing; LayerNbr, LHandle: Integer; PCAD: TPowerCad; PolyPoints: TDoublePointArr; SinglePoint: TDoublePoint; aCad: TF_Cad; PointFound: Boolean; BuildByPolyPoints: boolean; F: TextFile; //Tolik -- 10/02/2016 -- PrevPoint: TFPoint; // begin try Result := nil; if not TsgDXFSpline(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFSpline(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); //Tolik { AssignFile(f, 'd:\Tolik\ARC.txt'); reset(f); append(f); Writeln(F, 'New Spline: ');} BuildByPolyPoints := False; // Dear Tolik, LOOK To isByAngles flag: // True: // Spline is built by Fit-points using BeginningTangent and EndingTangent // False: // Spline is built by control points and knots. // Best regards, Tolik! SetLength(PolyPoints,0); j := 0; i := vSpline.FitCount; S := ''; i := vSpline.Count; if vSpline.FitCount > 0 then begin BuildByPolyPoints := True; end; if not BuildByPolyPoints then begin if vSpline.ControlCount > 0 then begin j := 0; {S := S + ' Control points of Spline: ';} //Tolik // ограничение на количество точек if not ParamExists('NoLimitDXFPolyCount') then begin if (vSpline.ControlCount) > LimitDXFPolyCount then exit; end; // чтобы меньше тормозило SetLength(PolyPoints, vSpline.ControlCount); // for I := 0 to vSpline.ControlCount - 1 do begin { S := S + #13#10 + ' P' + IntToStr(I + 1) + ': ';} {$IF Defined(CADImport6)} P := PtXMat(PFPoint(vSpline.Controls[I])^, FCADParams.Matrix); {$ELSE} //Tolik -- 11/02/2016 -- P := vSpline.Controls[I]; P := FPointXMat(P, FCADParams.Matrix); P := ModificatePoint(P); //P := FPointXMat(vSpline.Controls[I], FCADParams.Matrix); // P := FPointXMat(TFPoint(vSpline.Controls[I]), FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end end; {$IFEND} {S := S + PointToString(P);} SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[j] := SinglePoint; inc(j); // end; {S := S + #13#10;} SetLength(PolyPoints,j); end; // CloseFile(F); {if S <> '' then TxtFile.Add(S);} // Tolik -- 10/02/2016 -- BuildByPolyPoints := vSpline.isByAngles; // Check buid by PolyPoints BuildByPolyPoints := False; if vSpline.ControlCount > 0 then begin i := vSpline.ControlCount; for i := 0 to vSpLine.ControlCount - 1 do begin PointFound := False; for j := 0 to vSpline.PolyPoints.Count - 1 do begin if IsEqualFPoints(vSpLine.ControlPoints[i], vSpline.PolyPoints[j], 0.00001) then begin PointFound := True; Break; end; end; if not PointFound then begin BuildByPolyPoints := True; Break; end; end; end; end; if Length(PolyPoints) = 0 then begin BuildByPolyPoints := True; end; if BuildbyPolyPoints then begin if not ParamExists('NoLimitDXFPolyCount') then begin if ((vSpline.PolyPoints.Count) > (LimitDXFPolyCount * 3)) then exit; end; SetLength(PolyPoints,0); SetLength(PolyPoints, vSpline.PolyPoints.Count); for i := 0 to vSpline.PolyPoints.Count - 1 do begin p := vSpline.PolyPoints[i]; {$IF Defined(CADImport6)} P := PtXMat(PFPoint(P)^, FCADParams.Matrix); {$ELSE} P := FPointXMat(P, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; {$IFEND} Writeln(F, 'New Spline: '); s:=''; P := ModificatePoint(P); s := s + #13#10'Point ' + IntToStr(i) + ':'; s := s + #13#10'P.X = ' + FloatToStr(P.X); s := s + #13#10'P.Y = ' + FloatToStr(P.Y); s := s + #13#10'P.Z = ' + FloatToStr(P.Z); Writeln(F, S); SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[i] := SinglePoint; end; end; pLine := TPolyline.create(PolyPoints, 2, ord(psSolid), clBlack{xSpline.Color}, ord(bsClear), clBlack, 0, vSpline.Closed, Cad.GetLayerHandle(LayerNbr), mydsNormal, Cad); {$IF Defined(CADImport6)} PLine.Color := TsgDXFPolyLine(Sender).Pen.Color; PLine.Width := TsgDXFPolyLine(Sender).Pen.Width; {$ELSE} PLine.Color := GetColor(Sender); pLine.Width := RoundUp(TsgDXFPolyLine(Sender).LineWeight); if PLine.width < 0 then PLine.width := 1; {$IFEND} PLine.Style := ord(entstyle(TsgDXFPolyline(Sender))); Result := pLine; // //Tolik SetLength(PolyPoints, 0); except on E: Exception do AddExceptionToLogEx('TF_Import.ImportSpline', E.Message); end; end; *) (* Не получилось поднять сплайны с преобразованием в кривые Безье (потому что для Фитов нужно еще юзать тангенты, // а для Контрольных точек Кноты...получается кривовато... function TF_Import.ImportSpline(Sender: TObject): TFigure; var vSpline: TsgDXFSpline absolute Sender; P: TFPoint; S: string; I, j: Integer; xSpline: TsgDXFSpline; xPolyLine: TsgDXFPolyline; pLine: TPolyline; Cad: TPCDrawing; LayerNbr, LHandle: Integer; PCAD: TPowerCad; PolyPoints: TDoublePointArr; SinglePoint: TDoublePoint; aCad: TF_Cad; PointFound: Boolean; ConvertToBezie, BuildByPolyPoints: boolean; KnotCounts: Integer; KnotVal: Single; begin try Result := nil; if not TsgDXFSpline(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //Tolik ConvertToBezie := False; BuildByPolyPoints := False; // Dear Tolik, LOOK To isByAngles flag: // True: // Spline is built by Fit-points using BeginningTangent and EndingTangent // False: // Spline is built by control points and knots. // Best regards, Tolik! SetLength(PolyPoints,0); j := 0; i := vSpline.FitCount; S := ''; i := vSpline.Count; if vSpline.FitCount > 0 then begin S := S + ' Fit points of Spline: '; for I := 0 to vSpline.FitCount - 1 do begin S := S + #13#10 + ' P' + IntToStr(I + 1) + ': '; {$IF Defined(CADImport6)} P := PtXMat(PFPoint(vSpline.Fit[I])^, FCADParams.Matrix); {$ELSE} P := FPointXMat(TFPoint(vSpline.Fit[I]), FCADParams.Matrix); {$IFEND} S := S + PointToString(P); //Tolik inc(j); SetLength(PolyPoints, j); P := ModificatePoint(P); SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[j - 1] := SinglePoint; // end; i := vSpline.KnotCount; for i := 0 to vSpline.Knots.Count - 1 do begin end; ConvertToBezie := True; end; i := vSpline.ControlCount; if vSpline.ControlCount > 0 then begin j := 0; S := S + ' Control points of Spline: '; for I := 0 to vSpline.ControlCount - 1 do begin S := S + #13#10 + ' P' + IntToStr(I + 1) + ': '; {$IF Defined(CADImport6)} P := PtXMat(PFPoint(vSpline.Controls[I])^, FCADParams.Matrix); {$ELSE} P := FPointXMat(TFPoint(vSpline.Controls[I]), FCADParams.Matrix); {$IFEND} S := S + PointToString(P); //Tolik inc(j); SetLength(PolyPoints, j); P := ModificatePoint(P); SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[j - 1] := SinglePoint; // end; S := S + #13#10; end; if S <> '' then TxtFile.Add(S); //// //Tolik Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFSpline(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); if Length(PolyPoints) = 0 then begin j := 0; for i := 0 to vSpline.PolyPoints.Count - 1 do begin Inc(j); SetLength(PolyPoints, j); P := vSpline.PolyPoints[i]; {$IF Defined(CADImport6)} P := PtXMat(PFPoint(P)^, FCADParams.Matrix); {$ELSE} P := FPointXMat(TFPoint(P), FCADParams.Matrix); {$IFEND} P := ModificatePoint(P); SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[j - 1] := SinglePoint; end; end; // Check buid by PolyPoints if vSpline.ControlCount > 0 then begin i := vSpline.ControlCount; for i := 0 to vSpLine.ControlCount - 1 do begin PointFound := False; for j := 0 to vSpline.PolyPoints.Count - 1 do begin if IsEqualFPoints(vSpLine.ControlPoints[i], vSpline.PolyPoints[j], 0.00001) then begin PointFound := True; Break; end; end; if not PointFound then begin BuildByPolyPoints := True; Break; end; end; KnotCounts := 0; for i := 0 to vSpline.Knots.Count - 1 do begin KnotVal := vSpline.Knots[i]; if (vSpline.Knots[i] < 0) or (vSpline.Knots[i] > 1) then begin ConvertToBezie := true; BuildByPolyPoints := False; break; end; end; end; { for i := 0 to vSpline.Knots.Count - 1 do begin KnotVal := vSpline.Knots[i]; if (vSpline.Knots[i] <= 0) or (vSpline.Knots[i] >=1) then Inc(KnotCounts); end; if KnotCounts = vSpline.Knots.Count then ConvertToBezie := true; if ConvertToBezie then BuildByPolyPoints := False; end; } if BuildbyPolyPoints then begin SetLength(PolyPoints,0); SetLength(PolyPoints, vSpline.PolyPoints.Count); for i := 0 to vSpline.PolyPoints.Count - 1 do begin p := vSpline.PolyPoints[i]; {$IF Defined(CADImport6)} P := PtXMat(PFPoint(P)^, FCADParams.Matrix); {$ELSE} P := FPointXMat(TFPoint(P), FCADParams.Matrix); {$IFEND} P := ModificatePoint(P); SinglePoint.x := P.X; SinglePoint.y := P.Y; SinglePoint.z := P.Z; PolyPoints[i] := SinglePoint; end; end; pLine := TPolyline.create(PolyPoints, 2, ord(psSolid), clBlack{xSpline.Color}, ord(bsClear), clBlack, 0, vSpline.Closed, Cad.GetLayerHandle(LayerNbr), mydsNormal, Cad); {$IF Defined(CADImport6)} PLine.Color := TsgDXFPolyLine(Sender).Pen.Color; PLine.Width := TsgDXFPolyLine(Sender).Pen.Width; {$ELSE} PLine.Color := GetColor(Sender); pLine.Width := RoundUp(TsgDXFPolyLine(Sender).LineWeight); if PLine.width < 0 then PLine.width := 1; {$IFEND} PLine.Style := ord(entstyle(TsgDXFPolyline(Sender))); if ConvertToBezie then pLine.ConvertToBezier; Result := pLine; // except on E: Exception do AddExceptionToLogEx('TF_Import.ImportSpline', E.Message); end; end; *) function TF_Import.ImportViewPortBegin(Sender: TObject): TFigure; var V: TsgDXFViewPort absolute Sender; S: string; begin Result := nil; {S := 'Rect:' + #13#10' Left= ' + FloatToStr(V.Rect.Left) + #13#10' Top= ' + FloatToStr(V.Rect.Top) + #13#10' Z1= ' + FloatToStr(V.Rect.Z1) + #13#10' Right= ' + FloatToStr(V.Rect.Right) + #13#10' Bottom= ' + FloatToStr(V.Rect.Bottom) + #13#10' Z2= ' + FloatToStr(V.Rect.Z2); S := S + #13#10'---ENTITIES below are displayed in this VIEWPORT---'; TxtFile.Add(S);} if not TsgDXFViewport(Sender).Visible then exit; //// end; function TF_Import.ImportViewPortEnd(Sender: TObject): TFigure; begin Result := nil; //TxtFile.Add('-----ENTITIES above are displayed in VIEWPORT-----'); end; // function ImportDXF(aFileName: string): Boolean; var vFileExt: string; vLayer: TsgDXFLayer; vLayout: TsgDXFLayout; vEntity: TsgDXFEntity; i, j, k: integer; TXTFileName: string; Image1: TImage; Count: Integer; tmat: TFMatrix; //P1: TFPoint; // Tolik ss: string; //f: TextFile; FBlock: TsgDXFBlock; InsEntity: TsgDXFEntity; InsList: TList; AImage: TsgCADImage; aCadver: String; // 14/02/2017 -*- // Tolik -- 02/03/2017 -- ini_file: TIniFile; exeDir: string; // для хранения имени темповой папки приложения //Tolik 02/11/2017 -- itWasMoreThan2013VersFile: Boolean; function GetIniPath: String; begin {$if Defined(ES_GRAPH_SC)} Result := ExeDir + '\' + 'Scs.ini'; {$else} Result := ExtractFilePath(paramstr(0)) + 'Scs.ini'; {$ifend} end; // // by IGOR -- 26/01/2016 -- чтобы достать активный ViewPort { function NewNamedTable(conv: TsgDXFConverter; const AName: string; AClassType: TsgDXFEntityClass): TsgDXFTable; var vTableClass: TsgDXFEntityClass; begin vTableClass := AClassType; if vTableClass = nil then vTableClass := TsgDXFTable; Result := TsgDXFTable(conv.NewNamedEntity(conv.Sections[csTables], vTableClass, AName)); conv.Loads(Result); // to set handle end; function CustomEntByName(conv: TsgDXFConverter; const AName: string; const ASection: TConvSection): TsgDXFEntity; type TsgSectionInfo = record Name: string; ClassType: TsgDXFEntityClass; end; const //Section Tables cnstSectionTABLES = 'TABLES'; cnstTableBLOCK_RECORD = 'BLOCK_RECORD'; cnstTableAPPID = 'APPID'; cnstTableDIMSTYLE = 'DIMSTYLE'; cnstTableLAYER = 'LAYER'; cnstTableLTYPE = 'LTYPE'; cnstTableSTYLE = 'STYLE'; cnstTableUCS = 'UCS'; cnstTableVIEW = 'VIEW'; cnstTableVPORT = 'VPORT'; cnstTableItemClasses: array[TConvSection] of TsgDXFEntityClass = ( TsgDXFTable, TsgDXFBlock, TsgDXFEntity, TsgDXFLineType, TsgDXFLayer, TsgDXFStyle, TsgDXFDimensionStyle, TsgDXFBlockRecord, TsgDXFVport, TsgMLineStyle, TsgDXFImageDef, TsgDXFLayout, TsgDXFAcadTableStyle); // (Name: cnstTableVPORT; ClassType: TsgDXFTable), var vSection: TsgDXFTable; vName: string; begin vSection := TsgDXFTable(conv.Sections[ASection]); vName := cnstTableVPORT; if not Assigned(vSection) then begin vSection := NewNamedTable(conv, vName, TsgDXFTable); conv.Loads(vSection); conv.Sections[ASection] := vSection; end; Result := vSection.FindEntByName(AName); if not Assigned(Result) then begin Result := conv.NewNamedEntity(vSection, cnstTableItemClasses[ASection], AName); conv.Loads(Result); end; end; } // // Tolik 26/02/2016 procedure CheckLoadByViewPort; begin if F_Import.ActPort <> nil then begin // если высота = 0 - писец, вьюшки нет... if CompareValue(F_Import.ActPort.ViewHeight,0) <> 0 then begin F_Import.LoadViewPort := (MessageModal('- ' + cImportDWG_Msg1, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES); // F_Import.ActPort := TsgDXFVport(CustomEntByName(ImgDxf.Converter, sActiveVPort, csVPorts)); // границы видимой области -- на пробу if (F_Import.LoadViewPort {and ImgDXF.Converter.IsHaveActiveVPort}) then begin F_Import.LeftTopPoint.X := F_Import.ActPort.ViewCenterPoint.X - (F_Import.ActPort.ViewAspectRatio * F_Import.ActPort.ViewHeight); F_Import.LeftTopPoint.Y := F_Import.ActPort.ViewCenterPoint.Y - F_Import.ActPort.ViewHeight; F_Import.RightBottomPoint.X := F_Import.ActPort.ViewCenterPoint.X + (F_Import.ActPort.ViewAspectRatio * F_Import.ActPort.ViewHeight); F_Import.RightBottomPoint.Y := F_Import.ActPort.ViewCenterPoint.Y + F_Import.ActPort.ViewHeight; end; end; end; end; // begin Result := false; itWasMoreThan2013VersFile := False; // 02/11/2017 -- AlternateFileNameToLoad := ''; // Tolik 28/09/2017 -- // Tolik 02/03/2017 -- // определить настройки из иника для импорта сплайнов и полилайнов ini_file := nil; try ini_file := TIniFile.Create(GetIniPath); except on E: Exception do AddExceptionToLog('LoadDxfFile Error Reading SCS.ini file', false); end; if ini_file <> nil then begin if ini_file.SectionExists('ImportDXF') then begin LimitDXFSplinePointCount := Ini_File.ReadInteger('ImportDxf', 'SplinePointCount', 500); NumberOfPartsInSpline := Ini_File.ReadInteger('ImportDxf', 'SplinePartsCount', 6); LimitDXFPolyCount := Ini_File.ReadInteger('ImportDxf', 'PolyLinePointCount', 500); LoadSplineByControlPointsFirst := Ini_File.ReadBool('ImportDxf', 'ImportSplineByControlPoints', false); ini_file.Free; end; end; // try vFileExt := ExtractFileExt(LowerCase(aFileName)); F_Import := TF_Import.Create; F_Import.FEntitiesCount := 0; //29.10.2012 // Tolik -- 26/01/2016 F_Import.LoadViewPort := False; // флаг --загружать в пределах видимой области F_Import.HandleList := TStringList.Create; F_Import.BlockHandleList := TStringlist.Create; F_Import.MTextBlockHandleList := TStringList.Create; F_Import.ActPort := nil; F_Import.FCanConvertFromUnicode := False; // DXF // Tolik -- 04/01/2016 Винда позволяет любым регистром расширение написать. Будет другой регистр - хер // что читает (бо не находит) // if pos('.dxf', aFileName) <> 0 then if pos('.dxf', LowerCase(aFileName)) <> 0 then if pos('.dxf', LowerCase(aFileName)) = (Length(aFileName) - 3) then // Tolik 28/09/2017 -- // begin {$IF Defined(CADImport6)} ImgDXF := TsgDXFImage.Create; {$ELSE} ImgDXF := TsgCADDXFImage.Create; {$IFEND} ImgDXF.LoadFromFile(aFileName); // Tolik 04/02/2017 -- версия файла aCadver := DWG_Dxf_VerToString(TsgDWGVersion(ImgDXF.Converter.HeadVarStruct.Version)); if (aCadver <> 'MC0.0') and (aCadver <> 'AC1.2') and (aCadver <> 'AC1.40') and (aCadver <> 'AC1.50') and (aCadver <> 'AC2.10') and (aCadver <> 'AC2.21') and (aCadver <> 'AC1001') and (aCadver <> 'AC2.22') and (aCadver <> 'AC1002') and (aCadver <> 'AC1003') and (aCadver <> 'AC1004') and (aCadver <> 'AC1006') and (aCadver <> 'AC1009') and (aCadver <> 'AC1012') and (aCadver <> 'AC1014') and (aCadver <> 'AC1015') and (aCadver <> 'AC1018') then F_Import.FCanConvertFromUnicode := True; // // for I := 0 to ImgDXF.LayoutsCount - 1 do // cbLayouts.Items.AddObject(ImgDXF.Layouts[I].Name, ImgDXF.Layouts[I]); // cbLayouts.ItemIndex := ImgDXF.Converter.DefaultLayoutIndex; // ImgDXF.CurrentLayout := ImgDXF.Layouts[cbLayouts.ItemIndex]; //ImgDXF.Converter.Sections[]; //P1 := ImgDXF.Scale; // Tolik -- 26/02/2016 -- ImgDXF.GetExtents; // -- по идее это должно само выставить модель рисунка как CurrentLayout -- // но лучше перестраховаться на всякий ... if not ImgDXF.CurrentLayout.IsModel then begin for i := 0 to ImgDXF.LayoutsCount - 1 do begin if ImgDXF.Layouts[i].IsModel then begin ImgDXF.CurrentLayout := ImgDXF.Layouts[i]; break; end; end; // здесь бы, конечно, сообщение влепить.... пока для теста и так сойдет if not ImgDXF.CurrentLayout.IsModel then Exit; end; //ImgDXF.CurrentLayout := ImgDXF.Layouts[0{ImgDXF.Converter.DefaultLayoutIndex}]; //TxtFile := TStringList.Create; {$IF Defined(CADImport6)} FCADParams.Matrix := IdentityMat; {$ELSE} FCADParams.Matrix := cnstIdentityMat; {$IFEND} // ViewPort (by Tolik) 26/02/2016 F_Import.ActPort := ImgDXF.Converter.ActiveVPort; CheckLoadByViewPort; // ImgDXF.Converter.ImportMode := imImport; ImgDXF.Converter.AutoInsert := True; ImgDXF.Converter.Params := @FCADParams; ImgDXF.Converter.NumberOfPartsInSpline := NumberOfPartsInSpline; // Первый проход - читаем блоки текстов -- (а то итератор их разложит) ImgDXF.Converter.AutoInsert := False; ImgDXF.CurrentLayout.Iterate(ImgDXF.Converter, F_Import.ReadCADTXTEntities, F_Import.FinishReadCADEntities); // // Второй проход -- импорт -- ImgDXF.Converter.AutoInsert := True; ImgDXF.CurrentLayout.Iterate(ImgDXF.Converter, F_Import.ReadCADEntities, F_Import.FinishReadCADEntities); //TXTFileName := ChangeFileExt(aFileName, '.txt'); // TxtFile.SaveToFile(TXTFileName); // TxtFile.SaveToFile('c:\dxf.txt'); //FreeAndNil(TxtFile); //Tolik -- 02/03/2016 -- // FreeAndNil(ImgDXF); end; // DWG // Tolik -- 04/01/2016 Винда позволяет любым регистром расширение написать. Будет другой регистр - хер // что читает (бо не находит) // if pos('.dwg', aFileName) <> 0 then if pos('.dwg', LowerCase(aFileName)) <> 0 then if pos('.dwg', LowerCase(aFileName)) = (Length(aFileName) - 3) then // Tolik 28/09/2017 -- // begin ImgDwg := TsgDWGImage.create; // Tolik 27/09/2017 -- если файл AUTOCAD 2018 if not CheckFileAutocad2018(aFileName) then exit else begin if AlternateFileNameToLoad <> '' then F_Import.FCanConvertFromUnicode := True; itWasMoreThan2013VersFile := True; end; // // // Tolik 12/09/2017 -- DWG от автокада выше версии 2013 года хер загрузим (наш CAD VCL его уже не понимает) //ImgDWG.LoadFromFile(aFileName); Try if FileExists(aFileName) then ImgDWG.LoadFromFile(aFileName) else begin ShowMessage('File not found!'); exit; end; Except on E: Exception do begin if itWasMoreThan2013VersFile then showmessage(cImportDWG_Msg2) // сказать пользователю, что писец else Showmessage('Reading file Error!'); exit; // -- выходим, т.к. все равно файл не прочитан end; End; // // Tolik -- 14/02/2017 -- версия файла-- с 2007 -- весь тект идет в юникоде (utf-8) if not F_Import.FCanConvertFromUnicode then begin aCadver := DWG_Dxf_VerToString(TsgDWGVersion(ImgDwg.Converter.HeadVarStruct.Version)); if (aCadver <> 'MC0.0') and (aCadver <> 'AC1.2') and (aCadver <> 'AC1.40') and (aCadver <> 'AC1.50') and (aCadver <> 'AC2.10') and (aCadver <> 'AC2.21') and (aCadver <> 'AC1001') and (aCadver <> 'AC2.22') and (aCadver <> 'AC1002') and (aCadver <> 'AC1003') and (aCadver <> 'AC1004') and (aCadver <> 'AC1006') and (aCadver <> 'AC1009') and (aCadver <> 'AC1012') and (aCadver <> 'AC1014') and (aCadver <> 'AC1015') and (aCadver <> 'AC1018') then F_Import.FCanConvertFromUnicode := True; end; // //ImgDWG.IsWithoutBorder := True; //ImgDWG.UseWinEllipse := True; //ImgDWG.GetExtents; { ImgDWG.Converter.ImportMode := imImport; ImgDWG.Converter.AutoInsert := True; ImgDWG.Converter.Params := @FCADParams; ImgDWG.Converter.NumberOfPartsInSpline := NumberOfPartsInSpline; ImgDWG.LoadFromFile(aFileName);} // for I := 0 to ImgDWG.LayoutsCount - 1 do // cbLayouts.Items.AddObject(ImgDWG.Layouts[I].Name, ImgDWG.Layouts[I]); // cbLayouts.ItemIndex := ImgDWG.Converter.DefaultLayoutIndex; // ImgDWG.CurrentLayout := ImgDWG.Layouts[cbLayouts.ItemIndex]; // Tolik -- 22/01/2016 -- ImgDWG.GetExtents; // -- по идее это должно само выставить модель рисунка как CurrentLayout -- // но лучше перестраховаться на всякий ... if not ImgDWG.CurrentLayout.IsModel then begin for i := 0 to ImgDWG.LayoutsCount - 1 do begin if ImgDWG.Layouts[i].IsModel then begin ImgDWG.CurrentLayout := ImgDWG.Layouts[i]; break; end; end; // здесь бы, конечно, сообщение влепить.... пока для теста и так сойдет if not ImgDWG.CurrentLayout.IsModel then Exit; end; ///ImgDWG.CurrentLayout := ImgDWG.Layouts[0{ImgDWG.Converter.DefaultLayoutIndex}]; // // -- тут пока игрушка !!!! //ImgDWG.CurrentLayout := ImgDWG.Layouts[1]; { ss:=''; // для посмотреть какие типы объектов попадаются на рисунке for k := 0 to ImgDWG.CurrentLayout.Count - 1 do begin if TsgDXFEntity(ImgDWG.CurrentLayout.Entities[k]).Visible then if Pos(TsgDXFEntity(ImgDWG.CurrentLayout.Entities[k]).ClassName, ss) = 0 then ss := ss + (TsgDXFEntity(ImgDWG.CurrentLayout.Entities[k]).ClassName) + ' '; end; AssignFile(f, 'd:\Tolik\ARC.txt'); reset(f); append(f); writeln(f,ss); ss := ''; ss := 'Left Box Corner of DGW Image: '; ss := ss + #13#10'X =' + FloatToStr( ImgDWG.DrawingBox.TopLeft.X); ss := ss + #13#10'Y =' + FloatToStr( ImgDWG.DrawingBox.TopLeft.Y); ss := ss + #13#10'Right Top Corner : '; ss := ss + #13#10'X =' + FloatToStr( ImgDWG.DrawingBox.BottomRight.X); ss := ss + #13#10'Y =' + FloatToStr( ImgDWG.DrawingBox.BottomRight.Y); writeln(f,ss); ss := ' '; ss := ss + #13#10' Image Height = ' + FloatToStr(ImgDWG.AbsHeight); ss := ss + #13#10' Image Width = ' + FloatToStr(ImgDWG.AbsWidth); // -- заместители - нах --- //ImgDWG.Converter.HideWipeouts := True; // --- CenterPoint of Image --- ss := ' '; ss := ss + #13#10' Image Center X = ' + FloatToStr(ImgDWG.Center.X); ss := ss + #13#10' Image Center Y = ' + FloatToStr(ImgDWG.Center.Y); writeln(f,ss); close(f); } // Tolik -- 12/01/2016 --В принципе, единицы измерения в картинке есть, хз как прикрутить, т.к. описания -- хер найдешь, // но вот, что там сидит: (* case ImgDWG.Converter.HeadVarStruct.InsUnits of // -- 0,1,4 - основные единицы измерения (как стандарт), остальные могут попадаться довольно редко // и мало где описаны -- ссылка ниже смотри {https://knowledge.autodesk.com/support/autocad/learn-explore/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-Core/files/GUID-A58A87BB-482B-4042-A00A-EEF55A2B4FD8-htm.html} 0: ; // -- единицы измерения не заданы 1: ; //ShowMessage('mm'); // миллиметры 4: ; //ShowMessage('inch'); // дюймы 2: ; // Feet - футы 3: ; // Miles - мили 5: ; // Centimeters сантиметры 6: ; // Meters метры 7: ; // Kilometers километры 8: ; // MicroInches микродюймы 9: ; // Mils -- хз, сам не понял, что такое (могу предположить, что это Mil - одна тысячная дюйма) 10: ; // Yards ярды 11: ; // Angstroms Ангстремы 12: ; // NanoMeters нанометры 13: ; // Microns микроны 14: ; // DeciMeters дециметры 15: ; // DekaMeters декаметры 16: ; // HectoMeters гектометры 17: ; // GigaMeters гигаметры 18: ; // Astronomical Units астрономические единицы (одна АЕ = средн. расстояние от Земли до Солнца, // это примерно 149 598 000 км ) 19: ; // Light Years световые года -- это понятно 20: ; // Parsecs парсеки -- (1 парсек примерно = 3,2616 светового года) end; *) // //PtDisplaySize := ImgDWG.Converter.HeadVarStruct.PointDisplaySize; // //TxtFile := TStringList.Create; {$IF Defined(CADImport6)} FCADParams.Matrix := IdentityMat; {$ELSE} FCADParams.Matrix := cnstIdentityMat; {$IFEND} ImgDWG.Converter.ImportMode := imImport; ImgDWG.Converter.AutoInsert := True; ImgDWG.Converter.Params := @FCADParams; ImgDWG.Converter.NumberOfPartsInSpline := NumberOfPartsInSpline; // Tolik --26/02/2016 -- ViewPort -- if AlternateFileNameToLoad = '' then begin F_Import.ActPort := ImgDwg.Converter.ActiveVPort; CheckLoadByViewPort; end; // // Tolik -- 01/02/2016 -- try read text only // Чтобы определить вхождения блоков до того, как их уничтожит итератор // Первый проход -- ImgDWG.Converter.AutoInsert := False; ImgDWG.CurrentLayout.Iterate(ImgDWG.Converter, F_Import.ReadCADTXTEntities, F_Import.FinishReadCADEntities); // Второй проход -- импорт -- ImgDWG.Converter.AutoInsert := True; ImgDWG.CurrentLayout.Iterate(ImgDWG.Converter, F_Import.ReadCADEntities, F_Import.FinishReadCADEntities); // // TXTFileName := ChangeFileExt(aFileName, '.txt'); // TxtFile.SaveToFile(TXTFileName); //FreeAndNil(TxtFile); //Tolik -- 02/03/2016 -- // FreeAndNil(ImgDWG); end; // SVG // Tolik -- 04/01/2016 Винда позволяет любым регистром расширение написать. Будет другой регистр - хер // что читает (бо не находит) // if pos('.svg', aFileName) <> 0 then if pos('.svg', LowerCase(aFileName)) <> 0 then if pos('.svg', LowerCase(aFileName)) = (Length(aFileName) - 3) then // Tolik 28/09/2017 -- // begin ImgSVG := TsgSVGImage.Create; ImgSVG.LoadFromFile(aFileName); // for I := 0 to ImgSVG.LayoutsCount - 1 do // cbLayouts.Items.AddObject(ImgSVG.Layouts[I].Name, ImgSVG.Layouts[I]); // cbLayouts.ItemIndex := ImgSVG.Converter.DefaultLayoutIndex; // ImgSVG.CurrentLayout := ImgSVG.Layouts[cbLayouts.ItemIndex]; ImgSVG.CurrentLayout := ImgSVG.Layouts[0{ImgSVG.Converter.DefaultLayoutIndex}]; //TxtFile := TStringList.Create; {$IF Defined(CADImport6)} FCADParams.Matrix := IdentityMat; {$ELSE} FCADParams.Matrix := cnstIdentityMat; {$IFEND} ImgSVG.Converter.ImportMode := imImport; ImgSVG.Converter.AutoInsert := True; ImgSVG.Converter.Params := @FCADParams; ImgSVG.Converter.NumberOfPartsInSpline := NumberOfPartsInSpline; ImgSVG.CurrentLayout.Iterate(ImgSVG.Converter, F_Import.ReadCADEntities, F_Import.FinishReadCADEntities); //TXTFileName := ChangeFileExt(aFileName, '.txt'); // TxtFile.SaveToFile(TXTFileName); // FreeAndNil(TxtFile); FreeAndNil(ImgSVG); end; // PRN & PLT // Tolik --04/12/2016 // if (pos('.prn', aFileName) <> 0) or (pos('.plt', aFileName) <> 0) then if (pos('.prn', LowerCase(aFileName)) <> 0) or (pos('.plt', LowerCase(aFileName)) <> 0) then begin ImgHPGL := TsgHPGLImage.Create; ImgHPGL.LoadFromFile(aFileName); // for I := 0 to ImgHPGL.LayoutsCount - 1 do // cbLayouts.Items.AddObject(ImgHPGL.Layouts[I].Name, ImgHPGL.Layouts[I]); // cbLayouts.ItemIndex := ImgHPGL.Converter.DefaultLayoutIndex; // ImgHPGL.CurrentLayout := ImgHPGL.Layouts[cbLayouts.ItemIndex]; ImgHPGL.CurrentLayout := ImgHPGL.Layouts[0{ImgHPGL.Converter.DefaultLayoutIndex}]; //TxtFile := TStringList.Create; {$IF Defined(CADImport6)} FCADParams.Matrix := IdentityMat; {$ELSE} FCADParams.Matrix := cnstIdentityMat; {$IFEND} ImgHPGL.Converter.ImportMode := imImport; ImgHPGL.Converter.AutoInsert := True; ImgHPGL.Converter.Params := @FCADParams; ImgHPGL.Converter.NumberOfPartsInSpline := NumberOfPartsInSpline; ImgHPGL.CurrentLayout.Iterate(ImgHPGL.Converter, F_Import.ReadCADEntities, F_Import.FinishReadCADEntities); //TXTFileName := ChangeFileExt(aFileName, '.txt'); // TxtFile.SaveToFile(TXTFileName); //FreeAndNil(TxtFile); FreeAndNil(ImgHPGL); end; if F_Import.FEntitiesCount = 0 then begin // PauseProgress(true); try MessageInfo(cImport_Mes13); finally // PauseProgress(false); end; end else Result := true; FreeAndNil(F_Import.HandleList); FreeAndNil(F_Import.BlockHandleList); FreeAndNil(F_Import.MTextBlockHandleList); FreeAndNil(F_Import); except on E: Exception do AddExceptionToLogEx('ImportDXF', E.Message); end; end; function ModificatePoint(aP: TFPoint): TFPoint; var CadHeight, CadWidth: double; begin try result.X := aP.x; result.Y := aP.Y; result.Z := aP.Z; result.V := aP.V; // наша if ord(GCadForm.PCad.VerticalZero) = 1 then begin CadHeight := GCadForm.PCad.WorkHeight; result.y := CadHeight - Result.y; end; // хз if ord(GCadForm.PCad.HorizontalZero) = 1 then begin CadWidth := GCadForm.PCad.WorkWidth; result.x := CadWidth - Result.x; end; except on E: Exception do AddExceptionToLogEx('U_ImportDXF.ModificatePoint', E.Message); end; end; function GetImportLayerNbr(aCad: TPCDrawing; aDxfLayer: TsgDXFLayer): Integer; var i: Integer; NewLayer: TLayer; s: string; aCadver: String; begin try // Tolik --23/02/2016 -- aCadver := ''; // если у фигуры вдруг нету слоя - поднимаем ее на подложку Result := 0; if aDxfLayer = nil then begin Exit; end; // // TODO - проверить работу если имя таки в ютф пришло // Tolik 04/02/2017 -- начиная с версии 2007 автокад пишет в юникоде // Result := aCad.GetLayerNbr(utf16decode(aDxfLayer.Name)) Result := aCad.GetLayerNbr(utf16decode(aDxfLayer.Name, F_Import.FCanConvertFromUnicode)); // if (Result = -1) then Result := aCad.GetLayerNbr(aDxfLayer.Name); if Result = -1 then begin s := aDxfLayer.Name; // Tolik 04/02/2017 -- начиная с версии 2007 автокад пишет в юникоде // NewLayer := TLayer.create(utf16decode(aDxfLayer.Name)); NewLayer := TLayer.create(utf16decode(aDxfLayer.Name, F_Import.FCanConvertFromUnicode)); NewLayer.IsDxf := True; aCad.Layers.Add(NewLayer); Result := aCad.Layers.Count - 1; end; except on E: Exception do AddExceptionToLogEx('U_ImportDXF.GetImportLayerNbr', E.Message); end; end; function TF_Import.ImportHatch(Sender: TObject): TList;//TFigure; var vPolygon: TsgCADPolyPolygon; vHatch: TsgCADHatch; i, j: Integer; Cad: TPCDrawing; LayerNbr, LHandle: Integer; P, P1, P2: TFPoint; points: TDoublePointArr; Line: TLine; Blk: TBlock; Poly: TPolyline; Count, vIndex: Integer; // Tolik LHBack: Integer; vPolygonC: TsgCADCurvePolygon; vList: TF2DPointList; Function GetLayerHandle(LayerNbr: integer): Integer; begin Result := 0; if (LayerNbr < Cad.LayerCount) then begin Result := Integer(Cad.Layers[LayerNbr]); end; end; begin try //Tolik Result := TList.Create; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; /// vPolygon := nil; vPolygonC := nil; Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLine(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); if Sender is TsgCADHatch then vHatch := TsgCADHatch(Sender) else vHatch := nil; if vHatch <> nil then begin if not vHatch.Visible then exit; Count := vHatch.ParsedLines.Count; if Count = 0 then exit; //Tolik --04/10/2017 -- если больше 10000 линий - ставим флажок, что не все можем поднять (чтобы предложило преобразовать в растр) // для того, чтобы не подвисало ... CanLoadAllObjects := False; // if Count > 10000 then Count := 10000; // Blk := TBlock.Create(LHandle, Cad); SetLength(points, Count); for i := 0 to Count - 1 do begin {$IF Defined(CADImport6)} P.X := PFPoint(vHatch.ParsedLines[i]).X; P.Y := PFPoint(vHatch.ParsedLines[i]).Y; P.Z := 0{PFPoint(vHatch.ParsedLines[i]).Z}; P := PtXMat(P, FCADParams.Matrix); {$ELSE} P.X := TFPoint(vHatch.ParsedLines[i]).X; P.Y := TFPoint(vHatch.ParsedLines[i]).Y; P.Z := 0{TFPoint(vHatch.ParsedLines[i]).Z}; P := FPointXMat(P, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; {$IFEND} P := ModificatePoint(P); points[i].x := P.x; points[i].y := P.y; points[i].z := P.Z; end; I := 0; while I < Count do begin P1.x := points[i].x; P1.y := points[i].y; P1.z := points[i].z; P2.x := points[i + 1].x; P2.y := points[i + 1].y; P2.z := points[i + 1].z; Inc(I, 2); Line := TLine.create(P1.X, P1.Y, P2.x, P2.y, 1, 0, 0, 0, LHandle, mydsNormal, Cad); Line.color := GetColor(vHatch); // Tolik 04/10/2017 -- // Blk.AddFigure(Line); if i = (Count - 1) then Blk.AddFigure(Line) else Blk.AddFigure(Line, False); // end; //Tolik //Result := Blk; Result.Add(Blk); end else begin begin if not (Sender is TsgCADCurvePolygon) then begin vPolygon := TsgCADPolyPolygon(Sender); if not vPolygon.Visible then exit; vIndex := 0; SetLength(points, vIndex); for i := 0 to vPolygon.Boundaries.Count - 1 do begin vList := TF2DPointList(vPolygon.Boundaries[i]); if vList.Count < 10000 then begin for j := 0 to vList.Count - 1 do // prepares TPoint array for GDI begin {$IF Defined(CADImport6)} P.X := PFPoint(vList[j]).X; P.Y := PFPoint(vList[j]).Y; P.Z := 0{PFPoint(vList[j]).Z}; P := PtXMat(P, FCADParams.Matrix); {$ELSE} P.X := TF2dPoint(vList[j]).X; P.Y := TF2dPoint(vList[j]).Y; P.Z := 0{PFPoint(vList[j]).Z}; P := FPointXMat(P, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; {$IFEND} P := ModificatePoint(P); inc(vIndex); SetLength(points, vIndex); points[vIndex - 1].x := P.x; points[vIndex - 1].y := P.y; points[vIndex - 1].z := P.Z; end; end else CanLoadAllObjects := False; // if Length(points) > 0 then begin Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, True, LHandle, mydsNormal, Cad); Poly.Color := GetColor(vPolygon); Result.Add(Poly); SetLength(points, 0); vIndex := 0; end; end; end else begin //Tolik if Result.Count = 0 then begin vIndex := 0; vPolygonC := TsgCADCurvePolygon(Sender); // Tolik -- 02/01/2016 -- if not vPolygonC.Visible then Exit; begin // vPolygonC.Converter.DoExtents; for i := 0 to vPolygonc.Boundaries.Count - 1 do begin vList := TF2DPointList(vPolygonc.Boundaries[i]); if vList.Count < 10000 then begin for j := 0 to vList.Count - 1 do // prepares TPoint array for GDI begin {$IF Defined(CADImport6)} P.X := PFPoint(vList[j]).X; P.Y := PFPoint(vList[j]).Y; P.Z := 0{PFPoint(vList[j]).Z}; P := PtXMat(P, FCADParams.Matrix); {$ELSE} P.X := TF2dPoint(vList[j]).X; P.Y := TF2dPoint(vList[j]).Y; P.Z := 0{PFPoint(vList[j]).Z}; //DoExtrusion(P, TsgCADCurvePolygon(Sender).Extrusion); P := FPointXMat(P, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; end; {$IFEND} P := ModificatePoint(P); inc(vIndex); SetLength(points, vIndex); points[vIndex - 1].x := P.x; points[vIndex - 1].y := P.y; points[vIndex - 1].z := P.Z; end; end else CanLoadAllObjects := False; // if Length(points) > 0 then begin Poly := TPolyline.create(points, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, True, LHandle, mydsNormal, Cad); Poly.Color := GetColor(vPolygonC); if vPolygonC.SolidFill then begin vPolygonC.ColorCAD := vPolygonC.FillColor; Poly.Brc := GetColor(vPolygonC); Poly.Brs := ord(bsSolid); end; // тип заливки см здесь, например // vPolygonC.HatchName = 'GRADIENT' и другие ... // пока не дописано, красим все однозначно Result.Add(Poly); SetLength(points, 0); vIndex := 0; end; end; end; end; end; // end; end; //Tolik if Length(points) > 0 then SetLength(points, 0); // except on E: Exception do AddExceptionToLogEx('TF_Import.ImportHatch', E.Message); end; end; function TF_Import.ImportLeader(Sender: TObject): TFigure; var P, P1, P2: TFPoint; S: string; Cad: TPCDrawing; LayerNbr, LHandle: Integer; C: Integer; Leader: TsgDXFLeader; i: integer; points: TDoublePointArr; Poly: TPolyline; Blk: TBlock; Line: TLine; begin try Result := nil; // P2 := PtXMat(TsgDXFLine(Sender).Point1, FCADParams.Matrix); if not TsgDXFLeader(Sender).Visible then exit; if FCADParams.Insert <> nil then if not FCADParams.Insert.Visible then exit; //**************************************************************************// Cad := TPCDrawing(GCadForm.PCad); LayerNbr := GetImportLayerNbr(Cad, TsgDXFLeader(Sender).Layer); LHandle := Cad.GetLayerHandle(LayerNbr); Leader := TsgDXFLeader(Sender); Blk := TBlock.Create(LHandle, Cad); for i := 1 to Leader.ControlCount - 1 do begin P1.X := TFPoint(Leader.ControlPoints[i]).X; P1.Y := TFPoint(Leader.ControlPoints[i]).Y; P1.Z := TFPoint(Leader.ControlPoints[i]).Z; P2.X := TFPoint(Leader.ControlPoints[i - 1]).X; P2.Y := TFPoint(Leader.ControlPoints[i - 1]).Y; P2.Z := TFPoint(Leader.ControlPoints[i - 1]).Z; {$IF Defined(CADImport6)} P1 := PtXMat(P1, FCADParams.Matrix); P2 := PtXMat(P2, FCADParams.Matrix); {$ELSE} P1 := FPointXMat(P1, FCADParams.Matrix); P2 := FPointXMat(P2, FCADParams.Matrix); // Tolik if (F_Import.LoadViewPort and (F_Import.ActPort <> nil)) then begin if ((CompareValue(P1.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P1.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P1.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P1.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end; if ((CompareValue(P2.X, F_Import.LeftTopPoint.X) = -1) or (CompareValue(P2.X, F_Import.RightBottomPoint.X) = 1) or (CompareValue(P2.y, F_Import.LeftTopPoint.y) = -1) or (CompareValue(P2.y, F_Import.RightBottomPoint.y) = 1)) then begin AddExceptionToLogSilent(Sender.ClassName +' Object not loaded. Outside of visible area ! '); Exit; end end; {$IFEND} P1 := ModificatePoint(P1); P2 := ModificatePoint(P2); Line := TLine.create(P1.X, P1.Y, P2.x, P2.y, 1, 0, 0, 0, LHandle, mydsNormal, Cad); {$IF Defined(CADImport6)} Line.color := TsgDXFLine(Sender).Color; Line.Width := TsgDXFLine(Sender).Pen.Width; {$ELSE} Line.color := GetColor(Sender); Line.Width := RoundUp(TsgDXFLine(Sender).LineWeight); if Line.Width < 0 then Line.Width := 1; {$IFEND} Line.Style := ord(entstyle(TsgDXFLine(Sender))); // if i = 1 then // if Leader.Arrowhead then // Line.RowStyle := 1; // Tolik 04/10/2017 -- //Blk.AddFigure(Line) if i = (Leader.ControlCount - 1) then Blk.AddFigure(Line) else Blk.AddFigure(Line, False); // end; Result := Blk; except on E: Exception do AddExceptionToLogEx('TF_Import.ImportLeader', E.Message); end; end; end.