DIAdem 9.x, View, Flags: Punkte kopieren, (Pointmem in Version 8)

Question

DIAdem 9.x, View, Flags: Punkte kopieren, (Pointmem in Version 8)
Ich habe in DIAdem Version 8.1 eine Auswertung im Modul View erstellt.
In einer Kurve müssen genau 4 Punkte markiert werden.
Beschreibung:
Ein Layout wird geladen, Kanäle ausgewählt, der Cursor (Messmodus, Fadenkreuz) eingestellt und positioniert.
Verwendet wird nun die Interaction und die Bedienung mit Icon (Function Pointmem) genau 4 x.
Die Daten (Y-Werte) werden in einem Kanal in ihrer Bedienungsreihenfolge abgelegt.
In DIAdem 9.1 ist die Bedienung ähnlich, das Ergebnis leider nicht gleich.
Es muss das Icon "Flags setzen" bedient werden.
1.Wie kann das mit Script aufgerufen/voreingestellt werden?
Es werden jetzt 4 Punkte (Flags) gesetzt.
Mit dem Icon "Flagsunkte kopieren" werden die Daten in einen freien Kanal kopiert.
Leider ist die Reihenfolge NICHT mit der Bedienung identisch.
2. Wie können Punkt in der Reihenfolge ihrer Bedienung abgelegt werden?
3. Kann nach jeder Bedienung der markierte Punkt in einem Kanal abgelegt werden?
Attachments:
ViewKraftSpitzen.zip ‏1 KB

Answer 1

Sehr geehrter Herr Miele,
in Diadem 9 sind die Parameter des Moduls Diadem VIEW als Objekte und Unterobjekte organisiert.
Anbei der VBS-Code für das Setzen der Cursors und das Kopieren der Daten, der Ihnen die Vorgehensweise aufzeigen soll.
Über die Diadem-Hilfe -> Funktionen, Befehle und Variablen ->
Diadem VIEW -> Objekte haben Sie Zugriff auf die einzelnen Methoden
und Eigenschaften.
Sub SetCursor
  dim x1, x2
  View.ActiveSheet.Cursor.Type = "Band" ' Sets band cursor
  x1 = (CMin("Channel1")+CMax("Channel1"))/2    ' Defines x position of the cursor
  x2 = x1+0.5
   View.ActiveSheet.Cursor.X1 = x1
  View.ActiveSheet.Cursor.X2 = x2
  call MsgBoxSetPos(10,
10)            
' Positions message box
  call MsgBoxDisp("Please select a range", , , , 3)  ' Outputs message
  call InterActionOn()  ' Stops script, DIAdem can now be evaluated
end sub ' procedure SetCursor
sub CopyChannels
  dim X1, X2, P1, P2, Pn
  X1 = View.ActiveSheet.Cursor.X1 ' Evaluates cursor position 
  X2 = View.ActiveSheet.Cursor.X2
  if X1>X2 then           ' Exchanges positions if x1>x2
    X2 = View.ActiveSheet.Cursor.X1
    X1 = View.ActiveSheet.Cursor.X2
  end If
  P1 = PNo("Channel1", X1)    ' Determines point number witin x-channels
  P2 = PNo("Channel1", X2)
  Pn = (P2-P1)+1          ' No of values
  View.Autorefresh = 0
  if CNo("TimeCopy") <>0 then call ChnDel("TimeCopy")
  if CNo("VibrationCopy")<>0 then call ChnDel("VibrationCopy")
  if CNo("SoundCopy")<>0 then call ChnDel("SoundCopy")
  call ChnAlloc("TimeCopy", Pn)  ' Prepares channels
  call ChnAlloc("VibrationCopy", Pn)
  call ChnAlloc("SoundCopy", Pn)
  call DataBlCopy("Time", P1, Pn, "TimeCopy", 1)  ' Copies area
  call DataBlCopy("Vibration", P1, Pn, "VibrationCopy", 1)
  call DataBlCopy("Sound level", P1, Pn, "SoundCopy", 1)
  View.Autorefresh = 1
end sub ' procedure CopyChannels
Und hier der Aufruf:
  call OpenandPrepView() ' Panel initialization
  call SetCursor()       ' Positions cursor
  call CopyChannels()    ' Copies defined curve area
Mit freundlichen Grüßen
Indiana