Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Dosyadan maksimum X,Y ve Z değerlerini almak
#1
Merhaba,
Aslında iki problemim var. Hazır cevaba konmamak için ikinci problemi biraz kendim araştıracağım.Eğer bulamazsam sizden yardım rica ederim. 
Problem ; Tedit.Text e adı yazılmış bir dosya olacak. Çalıştır butonuna basıldığında bu dosyadaki  maksimum X , Y ve Z değerini bellekte okuyarak dosyanın en üst satırına; "M118 X<max.> Y<max.> Z<max.> T0" formatında yazılması. Dosya boyutları 10 ile 200mb arasında olabiliyor.

Şimdiden teşekkürler.

Mehmet

Ör: Dosya adı Test.nc
G1 X-12.75 Y-14.17 F4800
G1 X17.25 Y-14.17 E4.3504 F1200
G1 X17.25 Y15.83 E8.7009
G1 X-12.75 Y15.83 E13.0513
G1 X-12.75 Y-14.17 E17.4017
G1 E12.4017 F1500
G1 Z0.470 F420
G1 X-2.47 Y-2.84 F4200
G1 Z0.270 F420
G1 E17.4017 F1500
G1 X-2.47 Y-2.84 F4200
G1 X-2.45 Y-3.38 E17.4282 F600
G1 X-2.21 Y-4.46 E17.4823
G1 X-1.99 Y-4.95 E17.5086
G1 X-1.36 Y-5.86 E17.5628
G1 X-.97 Y-6.22 E17.5887
G1 X-.41 Y-6.59 E17.6216
G1 X.04 Y-7.06 E17.6534
G1 X.96 Y-7.66 E17.7072
G1 X1.47 Y-7.85 E17.7338
G1 X2.69 Y-8.06 E17.7944
G1 X2.77 Y-8.06 E17.7983
G1 X3.99 Y-7.85 E17.8589
G1 X4.59 Y-7.61 E17.8905
G1 X5.51 Y-7.00 E17.9446
G1 X5.94 Y-6.55 E17.9750
G1 X6.54 Y-5.62 E18.0292
G1 X6.73 Y-5.12 E18.0554
G1 X6.92 Y-4.03 E18.1095
G1 X6.91 Y-3.50 E18.1355
G1 X6.67 Y-2.42 E18.1896

İşlemden sonra;
M118 X17.25 Y15.83 Z0.470 T0
G1 X-12.75 Y-14.17 F4800
G1 X17.25 Y-14.17 E4.3504 F1200
G1 X17.25 Y15.83 E8.7009
G1 X-12.75 Y15.83 E13.0513
G1 X-12.75 Y-14.17 E17.4017
G1 E12.4017 F1500
G1 Z0.470 F420
G1 X-2.47 Y-2.84 F4200
G1 Z0.270 F420
G1 E17.4017 F1500
G1 X-2.47 Y-2.84 F4200
G1 X-2.45 Y-3.38 E17.4282 F600
G1 X-2.21 Y-4.46 E17.4823
G1 X-1.99 Y-4.95 E17.5086
G1 X-1.36 Y-5.86 E17.5628
G1 X-.97 Y-6.22 E17.5887
G1 X-.41 Y-6.59 E17.6216
G1 X.04 Y-7.06 E17.6534
G1 X.96 Y-7.66 E17.7072
G1 X1.47 Y-7.85 E17.7338
G1 X2.69 Y-8.06 E17.7944
G1 X2.77 Y-8.06 E17.7983
G1 X3.99 Y-7.85 E17.8589
G1 X4.59 Y-7.61 E17.8905
G1 X5.51 Y-7.00 E17.9446
G1 X5.94 Y-6.55 E17.9750
G1 X6.54 Y-5.62 E18.0292
G1 X6.73 Y-5.12 E18.0554
G1 X6.92 Y-4.03 E18.1095
G1 X6.91 Y-3.50 E18.1355
G1 X6.67 Y-2.42 E18.1896
Cevapla
#2
Büyük dosya şeklinde belirttiğiniz için TStringlist vb önermiyorum. TextFile yapısını araştırmanızı öneriyorum.

Yapı değişken tipi olarak
var dosyadegisken : TextFile
şeklinde verilerek başlar,
AssignFile( dosyadegisken, 'c:\dosyaadi.txt' )
şeklinde ilgili dosya bağlanır ve ReadLn ile satır okunur. Yazmak için WriteLn kullanılır. 

İlk satıra eklemek için yeni bir dosyayı aynı şekilde oluşturup (veya basit bir satırlık tstringlist ile savetofile de olabilir) önce en büyük değerlerin olduğu satırı yazıp, dosyanın tümünü satır satır writeln ile yenisine geçirebilir ya da yeni değerli tek satırlık dosyayı bu defa tfilestream ile açıp diğerini de  copyfrom ile topluca sona ekleyebilirsiniz. 

Teknik çok sayıda ve sihriniz ile sınırlı. 

Dışarıda çalıştığımdan direkt örnek kod yazamadım, kaynak bulursunuz. 

Başarılar.
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif
Cevapla
#3
(05-02-2021, Saat: 09:21)mrmarman Adlı Kullanıcıdan Alıntı: Büyük dosya şeklinde belirttiğiniz için TStringlist vb önermiyorum. TextFile yapısını araştırmanızı öneriyorum.

Yapı değişken tipi olarak
var dosyadegisken : TextFile
şeklinde verilerek başlar,
AssignFile( dosyadegisken, 'c:\dosyaadi.txt' )
şeklinde ilgili dosya bağlanır ve ReadLn ile satır okunur. Yazmak için WriteLn kullanılır. 

İlk satıra eklemek için yeni bir dosyayı aynı şekilde oluşturup (veya basit bir satırlık tstringlist ile savetofile de olabilir) önce en büyük değerlerin olduğu satırı yazıp, dosyanın tümünü satır satır writeln ile yenisine geçirebilir ya da yeni değerli tek satırlık dosyayı bu defa tfilestream ile açıp diğerini de  copyfrom ile topluca sona ekleyebilirsiniz. 

Teknik çok sayıda ve sihriniz ile sınırlı. 

Dışarıda çalıştığımdan direkt örnek kod yazamadım, kaynak bulursunuz. 

Başarılar.

Bilgiler için teşekkürler. Deneyeceğim..
Cevapla
#4
Star 
Çözüm için hazırladığım kaynak kod aşağıdaki şekildedir.

* Eski dosya BAK uzantısı ile değiştirilmektedir.
* MAX değer almış aynı dosya yeniden işleme tabi tutulursa diye öncelikle ilk satıra bakan bir güvenlik önlemi de eklenmiştir. 

function ProcessFile_MaxValuesFirst( aSourceFile : TFileName ): boolean;
 function GetValue( aPrefix: Char; aLine: String ): Double;
 begin
   Result := -1.0;
   FormatSettings.DecimalSeparator := '.';
   aLine := Trim(aLine) + ' ';
   if Pos( aPrefix, aLine ) > 0 then begin
     System.Delete(aLine, 1, Pos( aPrefix, aLine ) );
     Result := StrToFloat( Copy(aLine, 1, Pos(' ', aLine) -1) );
   end;
 end;
var
 LTextFile     : TextFile;
 LTempFileName : String;
 LFileSource,
 LFileTarget   : TFileStream;
 LMaxLine      : String;
 LKeyLine      : TStringStream;
 LLine         : String;
 X, Y, Z       : Double;
begin
 Result        := False;
 X := -1.0;
 Y := -1.0;
 Z := -1.0;
 LMaxLine      := '';
 LTempFileName := ChangeFileExt( aSourceFile, '.tmp' );

 AssignFile( LTextFile, aSourceFile );
 try
   Reset( LTextFile );
   ReadLn( LtextFile, LLine );
   if GetValue( 'M', LLine ) = -1.0 then
   begin
     Reset( LTextFile );
     while not EOF(LTextFile) do begin
       ReadLn( LtextFile, LLine );
       if GetValue( 'X', LLine ) > X then X := GetValue( 'X', LLine );
       if GetValue( 'Y', LLine ) > Y then Y := GetValue( 'Y', LLine );
       if GetValue( 'Z', LLine ) > Z then Z := GetValue( 'Z', LLine );
     end;
     LMaxLine := Format('M118 X%3.2f Y%3.2f Z%3.3f T0', [X, Y, Z]) + sLineBreak;
   end else begin
     MessageDlg( 'HATA : Kaynak dosya daha önce MAX değer almış...', mtWarning, [mbOk], 0 );
   end;
 finally
   CloseFile( LTextFile );
 end;

 if LMaxLine <> '' then begin
   LKeyLine    := TStringStream.Create( LMaxLine );
   LFileSource := TFileStream.Create( aSourceFile,   fmOpenRead or fmShareDenyNone );
   LFileTarget := TFileStream.Create( LTempFileName, fmCreate );
   try
     LkeyLine.Position     := 0;
     LFileTarget.CopyFrom(LKeyLine, LKeyLine.Size);

     LFileSource.Position  := 0;
     LFileTarget.CopyFrom(LFileSource, LFileSource.Size);
     Result := True;
   finally
     FreeAndNil( LKeyLine );
     FreeAndNil( LFileSource );
     FreeAndNil( LFileTarget );
   end;
   if Result then begin
     CopyFile( PChar(aSourceFile),   PChar(ChangeFileExt(aSourceFile, '.bak')), false);
     CopyFile( PChar(LTempFileName), PChar(aSourceFile), false);
     DeleteFile( LTempFileName );
   end;
 end;
end;

Kullanımı :

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if ProcessFile_MaxValuesFirst( ExtractFilePath(ParamStr(0)) + 'test.nc' )
  then ShowMessage( 'İşlem Başarılı...');
end;
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif
Cevapla
#5
Merhaba Muharrem Bey,

İşlerinizin arasında zaman ayırıp ilgi gösterdiğiniz için çok teşekkürler. Harika çalışıyor. 
Çok sağlam bir temel atmıştınız (Hex değiştirme ) , ben sağdan soldan bulduklarımla küçük kodlarla süsledim ve final oldu.

Saygılarımla,

Mehmet
Cevapla
#6
Muharrem hocam tekrar merhaba,

Çok önemli değil ama küçük bir noktayı gözden kaçırmışım  Sad   Programlar Nc kodları oluşturulurken standart karakterler ile başlayan  bilgi satırı da ekliyor.Bu bilgi satırları standart değişmeyen karakterlerdir. Satır başında  " ; " işareti başlayabilir yada  " ( ... ) " parantez içindede olabiliyor. 

Bu durumda XYZ değerleri alınırken, x y z önünde veya arkasında bir karakter varsa yazılım normal olarak ilerlemiyor.
Ör: Aşağıda gibi Layer bilgi notu içindeki "y" veya Helix yazında "x" problem yaratıyor.

Satır başlarında  " ; " ve " ( " karakterleri varsa, bunları görmezden gel veya sil eklenebilir mi ? Yoksa mantıksız  birbirleriyle çakışan bir şey mi istemiş oluyorum.


G1 X-12.75 Y-14.17 F4800
G1 X17.25 Y-14.17 E4.3504 F1200
G1 X17.25 Y15.83 E8.7009
( Layer 10 :Z10 )
G1 X-12.75 Y15.83 E13.0513
G1 X-12.75 Y-14.17 E17.4017
G1 E12.4017 F1500
; Helix angle Z 10
G1 Z0.470 F420
G1 X-2.47 Y-2.84 F4200
G1 Z0.270 F420
G1 E17.4017 F1500
G1 X-2.47 Y-2.84 F4200
G1 X-2.45 Y-3.38 E17.4282 F600
G1 X-2.21 Y-4.46 E17.4823
Cevapla
#7
Merhaba.

- İşlem basit...

LLine ilk karakteri ';' değil ise ( farklı ise ) karşılaştırsın...

ilgili bloğu aşağıdaki şekilde güncelleyin kafidir.
      Reset( LTextFile );
      while not EOF(LTextFile) do begin
        ReadLn( LtextFile, LLine );
        LLine := Trim(LLine);
        if (LLine <> '') AND (LLine[1] <> ';') AND (LLine[1] <> '(') then
        begin
          if GetValue( 'X', LLine ) > X then X := GetValue( 'X', LLine );
          if GetValue( 'Y', LLine ) > Y then Y := GetValue( 'Y', LLine );
          if GetValue( 'Z', LLine ) > Z then Z := GetValue( 'Z', LLine );
        end;
      end;
 



Bütün hali de şu şekilde.


function ProcessFile_MaxValuesFirst( aSourceFile : TFileName ): boolean;
  function GetValue( aPrefix: Char; aLine: String ): Double;
  begin
    Result := -1.0;
    FormatSettings.DecimalSeparator := '.';
    aLine := Trim(aLine) + ' ';
    if Pos( aPrefix, aLine ) > 0 then begin
      System.Delete(aLine, 1, Pos( aPrefix, aLine ) );
      Result := StrToFloat( Copy(aLine, 1, Pos(' ', aLine) -1) );
    end;
  end;
var
  LTextFile     : TextFile;
  LTempFileName : String;
  LFileSource,
  LFileTarget   : TFileStream;
  LMaxLine      : String;
  LKeyLine      : TStringStream;
  LLine         : String;
  X, Y, Z       : Double;
begin
  Result        := False;
  X := -1.0;
  Y := -1.0;
  Z := -1.0;
  LMaxLine      := '';
  LTempFileName := ChangeFileExt( aSourceFile, '.tmp' );

  AssignFile( LTextFile, aSourceFile );
  try
    Reset( LTextFile );
    ReadLn( LtextFile, LLine );
    if GetValue( 'M', LLine ) = -1.0 then
    begin
      Reset( LTextFile );
      while not EOF(LTextFile) do begin
        ReadLn( LtextFile, LLine );
        LLine := Trim(LLine);

        if (LLine <> '') AND (LLine[1] <> ';') AND (LLine[1] <> '(') then
        begin
          if GetValue( 'X', LLine ) > X then X := GetValue( 'X', LLine );
          if GetValue( 'Y', LLine ) > Y then Y := GetValue( 'Y', LLine );
          if GetValue( 'Z', LLine ) > Z then Z := GetValue( 'Z', LLine );
        end;
      end;
      LMaxLine := Format('M118 X%3.2f Y%3.2f Z%3.3f T0', [X, Y, Z]) + sLineBreak;
    end else begin
      MessageDlg( 'HATA : Kaynak dosya daha önce MAX değer almış...', mtWarning, [mbOk], 0 );
    end;
  finally
    CloseFile( LTextFile );
  end;

  if LMaxLine <> '' then begin
    LKeyLine    := TStringStream.Create( LMaxLine );
    LFileSource := TFileStream.Create( aSourceFile,   fmOpenRead or fmShareDenyNone );
    LFileTarget := TFileStream.Create( LTempFileName, fmCreate );
    try
      LkeyLine.Position     := 0;
      LFileTarget.CopyFrom(LKeyLine, LKeyLine.Size);

      LFileSource.Position  := 0;
      LFileTarget.CopyFrom(LFileSource, LFileSource.Size);
      Result := True;
    finally
      FreeAndNil( LKeyLine );
      FreeAndNil( LFileSource );
      FreeAndNil( LFileTarget );
    end;
    if Result then begin
      CopyFile( PChar(aSourceFile),   PChar(ChangeFileExt(aSourceFile, '.bak')), false);
      CopyFile( PChar(LTempFileName), PChar(aSourceFile), false);
      DeleteFile( LTempFileName );
    end;
  end;
end;





Sonuç :
M118 X17.25 Y15.83 Z0.470 T0
G1 X-12.75 Y-14.17 F4800
G1 X17.25 Y-14.17 E4.3504 F1200
G1 X17.25 Y15.83 E8.7009
G1 X-12.75 Y15.83 E13.0513
G1 X-12.75 Y-14.17 E17.4017
G1 E12.4017 F1500
G1 Z0.470 F420
G1 X-2.47 Y-2.84 F4200
;G1 X999.99 Y999.99 F4200
(G1 X999.99 Y999.99 F4200
G1 Z0.270 F420
G1 E17.4017 F1500
G1 X-2.47 Y-2.84 F4200
G1 X-2.45 Y-3.38 E17.4282 F600
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif
Cevapla
#8
Thumbs Up 
Tamamdır.  Teşekkürler !  Shy
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  bir resimden renk kodunu $00584827 seklinde almak sadikacar60 2 639 01-10-2024, Saat: 13:02
Son Yorum: frmman
  PDF dosyasından veri almak Mikdad 11 1.788 07-09-2024, Saat: 10:51
Son Yorum: mrmarman
  SQL' de Değişimde Toplam Almak OZCANK 5 1.729 11-05-2024, Saat: 11:30
Son Yorum: OZCANK
  Donanım bilgilerini almak için geliştirilmiş güzel bir proje burakb44 2 933 02-04-2024, Saat: 16:06
Son Yorum: burakb44
  Aktif olan tarayıcıdan URL bilgisi almak eraendless 7 1.936 15-09-2023, Saat: 08:36
Son Yorum: eraendless



Konuyu Okuyanlar: 1 Ziyaretçi