1777 lines
64 KiB
OpenEdge ABL
1777 lines
64 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "CPruefpunkte"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
|
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
|
|
'==============================================================================
|
|
'
|
|
' File : Pruefpunkte.cls
|
|
' Author : Andreas Schmidt, Reinhard Henning, lindner & partner
|
|
' Date : 14.04.1999
|
|
' Version: 1.01
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' Verwaltung einer Menge von Prüfpunkten wie in der Datenbanktabelle
|
|
' "Pruefpunkte" hinterlegt.
|
|
'
|
|
' Die eigentlichen Prüfpunkte werden hier in einem Objekt der Klasse
|
|
' CPruefpunktCol verwaltet.
|
|
'
|
|
' @see CPruefpunktCol
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' History:
|
|
'
|
|
' Author : Andreas Schmidt, Reinhard Henning, lindner & partner
|
|
' Date : 14.04.1999
|
|
' Version: 1.01
|
|
'
|
|
' Sortierung nach dem useCount-Member neu.
|
|
'
|
|
' Author : Andreas Schmidt, Reinhard Henning, lindner & partner
|
|
' Date : 31.03.1999
|
|
' Version: 1.00
|
|
'
|
|
' Erste dokumentierte Version
|
|
'
|
|
'==============================================================================
|
|
|
|
Option Explicit
|
|
|
|
' Private Member
|
|
' --------------
|
|
Private Const MAX_PP% = 10
|
|
|
|
Private m_lIdentNr As Long
|
|
Private m_sPruefklasseKZ As String
|
|
Private m_Regulierdaten As CRegulierdaten
|
|
Private m_colPP As CPruefpunktCol
|
|
Private m_sInfo As String
|
|
Private m_sFehlerstack As String
|
|
Public m_lngSpezifikationID As Long
|
|
|
|
Public m_bPruefung_nach_MID As Boolean
|
|
Public m_dblRatio As Double
|
|
|
|
Public m_Qp As CPruefpunkt
|
|
Public m_Qi As CPruefpunkt
|
|
Public mstr_Kundenmaterialnr As String
|
|
|
|
' Alle Member neu initialisieren
|
|
'
|
|
Private Sub init()
|
|
m_lIdentNr = 0
|
|
m_sPruefklasseKZ = ""
|
|
'm_sInfo = ""
|
|
m_sFehlerstack = ""
|
|
Set m_colPP = New CPruefpunktCol
|
|
Set m_Regulierdaten = New CRegulierdaten
|
|
End Sub
|
|
|
|
|
|
Public Function getSpezifikationID() As Long
|
|
getSpezifikationID = m_lngSpezifikationID
|
|
End Function
|
|
|
|
|
|
' @return RegulierdatenObject
|
|
'
|
|
Public Function getRegulierdaten() As CRegulierdaten
|
|
Set getRegulierdaten = m_Regulierdaten
|
|
End Function
|
|
|
|
Public Sub setRegulierdaten(Regulierdaten As CRegulierdaten)
|
|
Set m_Regulierdaten = Regulierdaten
|
|
End Sub
|
|
|
|
|
|
' @return Anzahl der definierten Prüfpunkte (0 bis MAX_PP)
|
|
'
|
|
Public Function getPruefpunkteCount() As Integer
|
|
If Not m_colPP Is Nothing Then getPruefpunkteCount = m_colPP.Count()
|
|
End Function
|
|
|
|
' @return Collection von Objekten der Klasse CPruefpunkt
|
|
'
|
|
Public Function getPruefpunkte() As CPruefpunktCol
|
|
Set getPruefpunkte = m_colPP
|
|
End Function
|
|
|
|
' @param colPP Collection von Objekten der Klasse CPruefpunkt
|
|
'
|
|
Public Sub setPruefpunkte(colPP As CPruefpunktCol)
|
|
Set m_colPP = colPP
|
|
End Sub
|
|
|
|
' @param nIndex Index in die Collection der Prüfpunkte
|
|
'
|
|
' @return Objekt vom Typ CPuefpunkt an der Stelle nIndex aus
|
|
' der Collection der Prüfpunkte
|
|
'
|
|
Public Function getPruefpunkt(nIndex As Integer) As CPruefpunkt
|
|
Set getPruefpunkt = m_colPP.Item(nIndex)
|
|
End Function
|
|
|
|
' @return true = Es gibt einen Pruefpunkt mit dem gesuchten Durchfluss
|
|
'
|
|
Public Function hasQ(dQ As Double) As Boolean
|
|
If Not m_colPP Is Nothing Then hasQ = m_colPP.hasQ(dQ)
|
|
End Function
|
|
|
|
Public Sub setIdentNr(lIdentNr As Long)
|
|
m_lIdentNr = lIdentNr
|
|
End Sub
|
|
|
|
' @return Ident-Nr., zu der die Prüfpunkte gehören
|
|
'
|
|
Public Function getIdentNr() As Long
|
|
getIdentNr = m_lIdentNr
|
|
End Function
|
|
|
|
Public Sub setPruefklasseKZ(sPruefklasseKZ As String)
|
|
m_sPruefklasseKZ = sPruefklasseKZ
|
|
End Sub
|
|
|
|
' @return Prüfklasse-Kennzeichen (A, B, HM)
|
|
'
|
|
Public Function getPruefklasseKZ() As String
|
|
getPruefklasseKZ = m_sPruefklasseKZ
|
|
End Function
|
|
|
|
Public Sub setInfo(sInfo As String)
|
|
m_sInfo = sInfo
|
|
End Sub
|
|
|
|
Public Function getInfo() As String
|
|
getInfo = m_sInfo
|
|
End Function
|
|
|
|
' Prüfpunkte zur übergebenen Ident-Nr. und PrüfklasseKZ aus der
|
|
' Datenbank laden
|
|
'
|
|
' @return true = Laden erfolgreich durchgeführt
|
|
'
|
|
Public Function load(ByVal lIdentNr As Long, sPruefklasseKZ As String) As Boolean
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
Dim sSQL As String
|
|
Dim rs As CRecordset
|
|
Dim i As Integer
|
|
Dim sNummer As String
|
|
Dim Pruefzeit As Long
|
|
|
|
Dim sSQL2 As String
|
|
Dim rs2 As CRecordset
|
|
|
|
On Error GoTo loadErr
|
|
|
|
' Prüfpunkte
|
|
' ----------
|
|
Set rs = New CRecordset
|
|
sSQL = "SELECT * FROM "
|
|
sSQL = sSQL & "Pruefpunkte "
|
|
sSQL = sSQL & "WHERE "
|
|
sSQL = sSQL & "IdentNr = " & lIdentNr & " AND "
|
|
sSQL = sSQL & "PruefklasseKZ = " & rs.stringToSQLString(sPruefklasseKZ, True)
|
|
sSQL = sSQL & ";"
|
|
|
|
Set rs2 = New CRecordset
|
|
sSQL2 = "SELECT * from SollwertRegulierung where "
|
|
sSQL2 = sSQL2 & "IdentNr = " & lIdentNr & " AND "
|
|
sSQL2 = sSQL2 & "PruefklasseKZ = " & rs.stringToSQLString(sPruefklasseKZ, True)
|
|
' sSQL2 = sSQL2 & " AND PruefstationNr=" & g_App.PruefstationNr
|
|
|
|
If Not rs2.openRS(sSQL2) Then
|
|
ErrorMsg "Fehler beim Laden der SollwertRegulierdaten: " & Err.Description
|
|
'Exit Function
|
|
End If
|
|
|
|
|
|
If rs2.EOF Then
|
|
Debug.Print sSQL2
|
|
If g_App.PruefstationNr <> 24 Then
|
|
' #20170801
|
|
'ErrorMsg "Es konnten keine SollwertRegulierdaten gefunden werden" & vbCrLf & " für IdentNr=" & lIdentNr & " und sPruefklasseKZ=" & sPruefklasseKZ
|
|
End If
|
|
'Exit Function
|
|
End If
|
|
|
|
If Not rs.openRS(sSQL) Then
|
|
If g_App.PruefstationNr <> 24 Then
|
|
ErrorMsg "DB Fehler beim Laden der Pruefpunkte: " & Err.Description
|
|
End If
|
|
End If
|
|
|
|
If rs.EOF Then
|
|
DebugMsg "Es konnten keine Pruefpunkte geladen werden für " & vbCrLf & "IdentNr=" & lIdentNr & " und PruefklasseKZ=" & sPruefklasseKZ & "."
|
|
Exit Function
|
|
End If
|
|
|
|
Call init
|
|
|
|
m_lIdentNr = rs.getLongValue("IdentNr")
|
|
m_sPruefklasseKZ = rs.getStringValue("PruefklasseKZ")
|
|
|
|
m_sInfo = m_sInfo & rs.getStringValue("Info") & ""
|
|
|
|
|
|
m_sFehlerstack = rs.getStringValue("Fehlerstack")
|
|
|
|
DebugMsg "Prüfpunkte für IdentNr " & m_lIdentNr & " und Prüfklasse '" & sPruefklasseKZ & "' aus DB:"
|
|
|
|
For i = 1 To MAX_PP
|
|
sNummer = Trim(Val(i))
|
|
|
|
Pruefzeit = 60
|
|
If i = MAX_PP Then
|
|
Pruefzeit = 120
|
|
End If
|
|
|
|
If Not rs2.EOF Then
|
|
Pruefzeit = rs2.getLongValue("P" & sNummer & "SollPruefzeit")
|
|
Else
|
|
DebugMsg "Prüfzeit aus DB konnte nicht ermittelt werden"
|
|
End If
|
|
|
|
If Not rs.isFieldNull("Q" & i) Then
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Call Pruefpunkt.setMember( _
|
|
rs.getDoubleValue("Q" & sNummer), _
|
|
rs.getDoubleValue("FGo" & sNummer), _
|
|
rs.getDoubleValue("FGu" & sNummer), , Pruefzeit)
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
DebugMsg " " & i & ". Prüfpunkt Q=" & Pruefpunkt.getQ
|
|
DebugMsg " Prüfzeit: " & Pruefzeit
|
|
DebugMsg " FGo: " & Pruefpunkt.getFGo
|
|
DebugMsg " FGu: " & Pruefpunkt.getFGu
|
|
End If
|
|
Next i
|
|
|
|
' Sollwerte
|
|
' --------
|
|
Call m_Regulierdaten.load(lIdentNr, sPruefklasseKZ)
|
|
|
|
' Prüfpunkte sortieren
|
|
Call sortQ
|
|
|
|
load = True
|
|
Exit Function
|
|
|
|
loadErr:
|
|
Call showError("load")
|
|
Exit Function
|
|
End Function
|
|
|
|
' Prüfpunkte absteigend nach Durchfluss sortieren
|
|
'
|
|
Public Sub sortQ()
|
|
If g_blnPruefpunkteUnsortiert = False Then
|
|
Call m_colPP.sortQ
|
|
End If
|
|
End Sub
|
|
|
|
' Prüfpunkte aufsteigend nach dem useCount-Member sortieren
|
|
'
|
|
Public Sub sortUseCount()
|
|
Call m_colPP.sortUseCount
|
|
End Sub
|
|
|
|
'------------------------------------------------------------------------------
|
|
' Private Funktionalität
|
|
'------------------------------------------------------------------------------
|
|
|
|
' Helper für Fehlerausgaben
|
|
'
|
|
' @param sMethod Name des Aufrufers
|
|
' @param sInfo optionaler Hinweistext
|
|
'
|
|
Private Sub showError(sMethod As String, Optional sInfo As String)
|
|
Call modError.showError("CPruefpunkte." + sMethod, sInfo)
|
|
End Sub
|
|
|
|
|
|
'Public Function CreateMIDPruefpunkteFromBestellcode(objBestellcode As CBestellcode) As Boolean
|
|
' Dim dblNennDurchfluss As Double
|
|
' Dim dblNennDurchfluss_heiss As Double
|
|
' Dim dblDurchflussQ As Double
|
|
'
|
|
' Dim strPruefklasse As String
|
|
'
|
|
' Dim dblVerhaeltnisQ3Q1 As Double
|
|
'
|
|
' Dim strWert As String
|
|
'
|
|
' strWert = objBestellcode.GetWert("Verhaeltnis_Q3_Q1")
|
|
' ' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
' strWert = Replace(strWert, ",", ".")
|
|
' dblVerhaeltnisQ3Q1 = Val(strWert)
|
|
'
|
|
' strWert = objBestellcode.GetWert("Nenndurchfluss")
|
|
' ' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
' strWert = Replace(strWert, ",", ".")
|
|
' dblNennDurchfluss = Val(strWert)
|
|
'
|
|
' If dblVerhaeltnisQ3Q1 = 0 Or dblNennDurchfluss = 0 Then
|
|
' DebugMsg "Die MID Prüfpunkte konnten nicht aus dem Bestellcode '" & objBestellcode.GetBestellcode & "' (Merkmalgruppe = " & objBestellcode.GetMerkmalgruppe & ") ermittelt werden."
|
|
' CreateMIDPruefpunkteFromBestellcode = False
|
|
' Exit Function
|
|
' End If
|
|
'
|
|
'
|
|
' ' Hier sind Nenndurchfluss und Verhältniss Q3/Q1 über den Bestellcode definiert
|
|
' Set m_colPP = New CPruefpunktCol
|
|
'
|
|
' Dim Pruefpunkt As CPruefpunkt
|
|
'
|
|
' ' Prüfpunkte des Kaltwasserzählers
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Q4 = 1.25 * QN
|
|
' dblDurchflussQ = dblNennDurchfluss * 1.25
|
|
' Debug.Print "Q4 = " & dblNennDurchfluss & " {Qn} * " & 1.25 & " {Const} = " & dblDurchflussQ
|
|
'
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo 2
|
|
' Pruefpunkt.setFGu -2
|
|
' Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
' Pruefpunkt.SetTime 60
|
|
' m_colPP.Add Pruefpunkt
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Q3 ist nur eine rechnerische Größe
|
|
' ' und wird nicht geprüft
|
|
' '''''''''''''''''''''''''''''
|
|
' Debug.Print "Q3 = Qn = " & dblNennDurchfluss & " (wird nicht geprüft)"
|
|
'
|
|
' ' Q2 = Q1 * 1.6
|
|
' dblDurchflussQ = 1.6 * dblNennDurchfluss / dblVerhaeltnisQ3Q1
|
|
' Debug.Print "Q2 = 1.6 {Const} * " & dblNennDurchfluss & " {Qn} / " & dblVerhaeltnisQ3Q1 & " {Vq3q1} = " & dblDurchflussQ
|
|
'
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo 2
|
|
' Pruefpunkt.setFGu -2
|
|
' Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
' Pruefpunkt.SetTime 60
|
|
' m_colPP.Add Pruefpunkt
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Q1 = Qn / VQ3Q1
|
|
'
|
|
' dblDurchflussQ = Round(dblNennDurchfluss / dblVerhaeltnisQ3Q1, 3)
|
|
'
|
|
' Debug.Print "Q1 = " & dblNennDurchfluss & " {Qn} / " & dblVerhaeltnisQ3Q1 & " {Vq3Q1} = " & dblDurchflussQ
|
|
'
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo 5
|
|
' Pruefpunkt.setFGu -5
|
|
' Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
' Pruefpunkt.SetTime 120
|
|
' m_colPP.Add Pruefpunkt
|
|
'
|
|
'
|
|
' CreateMIDPruefpunkteFromBestellcode = True
|
|
'End Function
|
|
|
|
|
|
Public Function CreateMIDPruefpunkteFromBestellcode_NEU1(objBestellcode As CBestellcode, AuftragPosition As CAuftragPosition, objIdentNr As CIdentNr) As Boolean
|
|
Dim strKurzBez As String
|
|
Dim strTyp As String
|
|
Dim strTypzusatz As String
|
|
Dim lngNennweite As Long
|
|
Dim lngIdentNr As Long
|
|
Dim strTemp As String
|
|
Dim rs As CRecordset
|
|
|
|
Dim strMetrolog As String
|
|
Dim blnEncoder As Boolean
|
|
Dim strSQL As String
|
|
|
|
Dim dblNenndurchfluss As Double
|
|
Dim dblDurchflussQ As Double
|
|
Dim strPruefklasse As String
|
|
Dim dblVerhaeltnisQ3Q1 As Double
|
|
Dim strWert As String
|
|
|
|
' IdentNr Typ
|
|
' Metrolog
|
|
' Bestellcode Encoder
|
|
' Bestellcode Nennweite
|
|
|
|
lngIdentNr = objIdentNr.getNr
|
|
strKurzBez = objIdentNr.GetKurzBezeichnung
|
|
strTyp = objIdentNr.getTyp
|
|
strTypzusatz = objIdentNr.getTypzusatz
|
|
strMetrolog = AuftragPosition.getMetrolog
|
|
|
|
strTemp = objBestellcode.GetWert("ANZEIGE")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then blnEncoder = True
|
|
If InStr(1, LCase(strTemp), LCase("Hybrid")) > 0 Then blnEncoder = True
|
|
If InStr(1, LCase(strTemp), LCase("Electr ")) > 0 Then blnEncoder = True
|
|
|
|
|
|
strTemp = objBestellcode.GetWert("GWZ_NEBENZAEHLER")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then blnEncoder = True
|
|
strTemp = objBestellcode.GetWert("GWZ_WERKE_UND_ANZEIGE")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then blnEncoder = True
|
|
strTemp = objBestellcode.GetWert("Modultyp")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then blnEncoder = True
|
|
strTemp = objBestellcode.GetWert("Zählwerk")
|
|
If InStr(1, LCase(strTemp), LCase("Encoder")) > 0 Then blnEncoder = True
|
|
|
|
|
|
|
|
strSQL = "SELECT * from MID_Pruefpunkte where aktiv = 1 "
|
|
strSQL = strSQL & " AND (IdentNr = '" & lngIdentNr & "' or IdentNr= 0) "
|
|
strSQL = strSQL & " AND (Kurzbez = '" & strKurzBez & "' or Kurzbez = '*') "
|
|
strSQL = strSQL & " AND (Kurzbez = '" & strKurzBez & "' or Kurzbez = '*') "
|
|
|
|
strSQL = strSQL & " AND (Typ ='" & strTyp & "' or Typ = '*') "
|
|
strSQL = strSQL & " AND (Typzusatz = '" & strTypzusatz & "' or Typzusatz = '*' ) "
|
|
strSQL = strSQL & " AND (Metrolog = '" & strMetrolog & "' or Metrolog = '*' ) "
|
|
strSQL = strSQL & " AND (Nennweite = " & lngNennweite & ") "
|
|
strSQL = strSQL & " AND (Encoder = '" & IIf(blnEncoder, 1, 0) & "' or Encoder = '*') "
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
|
|
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
strWert = objBestellcode.GetWert("Verhaeltnis_Q3_Q1")
|
|
' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
strWert = Replace(strWert, ",", ".")
|
|
dblVerhaeltnisQ3Q1 = Val(strWert)
|
|
m_dblRatio = dblVerhaeltnisQ3Q1
|
|
|
|
strWert = objBestellcode.GetWert("Nenndurchfluss")
|
|
' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
strWert = Replace(strWert, ",", ".")
|
|
dblNenndurchfluss = Val(strWert)
|
|
|
|
If dblVerhaeltnisQ3Q1 = 0 Or dblNenndurchfluss = 0 Then
|
|
DebugMsg "Die MID Prüfpunkte konnten nicht aus dem Bestellcode '" & objBestellcode.GetBestellcode & "' (Merkmalgruppe = " & objBestellcode.GetMerkmalgruppe & ") ermittelt werden."
|
|
CreateMIDPruefpunkteFromBestellcode_NEU1 = False
|
|
Exit Function
|
|
End If
|
|
|
|
m_bPruefung_nach_MID = True
|
|
|
|
' Hier sind Nenndurchfluss und Verhältniss Q3/Q1 über den Bestellcode definiert
|
|
Set m_colPP = New CPruefpunktCol
|
|
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
' Prüfpunkte des Kaltwasserzählers
|
|
'''''''''''''''''''''''''''''
|
|
' wird nach OIML R49-1 (2006) nicht geprüft (nur bei Zulassungsprüfungen)
|
|
' Q4 = 1.25 * QN
|
|
'dblDurchflussQ = dblNennDurchfluss * 1.25
|
|
'Debug.Print "Q4 = " & dblNennDurchfluss & " {Qn} * " & 1.25 & " {Const} = " & dblDurchflussQ
|
|
|
|
'''''''''''''''''''''''''''''
|
|
' Q3
|
|
'
|
|
'''''''''''''''''''''''''''''
|
|
dblDurchflussQ = dblNenndurchfluss
|
|
Debug.Print "Q3 = Qn = " & dblNenndurchfluss
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
If rs.EOF Then
|
|
Pruefpunkt.setFGo rs.getDoubleValue("FGo1")
|
|
Pruefpunkt.setFGu rs.getDoubleValue("FGu1")
|
|
Pruefpunkt.SetTime rs.getDoubleValue("T1")
|
|
Else
|
|
Pruefpunkt.setFGo 2
|
|
Pruefpunkt.setFGu -2
|
|
Pruefpunkt.SetTime 60
|
|
End If
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
|
|
' Q2 = Q1 * 1.6
|
|
dblDurchflussQ = 1.6 * dblNenndurchfluss / dblVerhaeltnisQ3Q1
|
|
Debug.Print "Q2 = 1.6 {Const} * " & dblNenndurchfluss & " {Qn} / " & dblVerhaeltnisQ3Q1 & " {Vq3q1} = " & dblDurchflussQ
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
If rs.EOF Then
|
|
Pruefpunkt.setFGo rs.getDoubleValue("FGo2")
|
|
Pruefpunkt.setFGu rs.getDoubleValue("FGu2")
|
|
Pruefpunkt.SetTime rs.getDoubleValue("T2")
|
|
Else
|
|
Pruefpunkt.setFGo 2
|
|
Pruefpunkt.setFGu -2
|
|
Pruefpunkt.SetTime 60
|
|
End If
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
|
|
'''''''''''''''''''''''''''''
|
|
' Q1 = Qn / VQ3Q1
|
|
|
|
dblDurchflussQ = Round(dblNenndurchfluss / dblVerhaeltnisQ3Q1, 3)
|
|
|
|
Debug.Print "Q1 = " & dblNenndurchfluss & " {Qn} / " & dblVerhaeltnisQ3Q1 & " {Vq3Q1} = " & dblDurchflussQ
|
|
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
If rs.EOF Then
|
|
Pruefpunkt.setFGo rs.getDoubleValue("FGo2")
|
|
Pruefpunkt.setFGu rs.getDoubleValue("FGu2")
|
|
Pruefpunkt.SetTime rs.getDoubleValue("T2")
|
|
Else
|
|
Pruefpunkt.setFGo 5
|
|
Pruefpunkt.setFGu -5
|
|
Pruefpunkt.SetTime 120
|
|
End If
|
|
m_colPP.Add Pruefpunkt
|
|
'''''''''''''''''''''''''''''
|
|
|
|
CreateMIDPruefpunkteFromBestellcode_NEU1 = True
|
|
g_bln_Pruefung_nach_MID = True
|
|
|
|
|
|
End Function
|
|
|
|
|
|
Public Function CreateMIDPruefpunkteFromBestellcode(objBestellcode As CBestellcode) As Boolean
|
|
Dim dblNenndurchfluss As Double
|
|
|
|
Dim dblDurchflussQ As Double
|
|
|
|
Dim strPruefklasse As String
|
|
|
|
Dim dblVerhaeltnisQ3Q1 As Double
|
|
|
|
Dim strWert As String
|
|
|
|
strWert = objBestellcode.GetWert("Verhaeltnis_Q3_Q1")
|
|
' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
strWert = Replace(strWert, ",", ".")
|
|
dblVerhaeltnisQ3Q1 = Val(strWert)
|
|
m_dblRatio = dblVerhaeltnisQ3Q1
|
|
|
|
strWert = objBestellcode.GetWert("Nenndurchfluss")
|
|
' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
strWert = Replace(strWert, ",", ".")
|
|
dblNenndurchfluss = Val(strWert)
|
|
|
|
If dblVerhaeltnisQ3Q1 = 0 Or dblNenndurchfluss = 0 Then
|
|
DebugMsg "Die MID Prüfpunkte konnten nicht aus dem Bestellcode '" & objBestellcode.GetBestellcode & "' (Merkmalgruppe = " & objBestellcode.GetMerkmalgruppe & ") ermittelt werden."
|
|
CreateMIDPruefpunkteFromBestellcode = False
|
|
Exit Function
|
|
End If
|
|
|
|
m_bPruefung_nach_MID = True
|
|
|
|
' Hier sind Nenndurchfluss und Verhältniss Q3/Q1 über den Bestellcode definiert
|
|
Set m_colPP = New CPruefpunktCol
|
|
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
' Prüfpunkte des Kaltwasserzählers
|
|
'''''''''''''''''''''''''''''
|
|
' wird nach OIML R49-1 (2006) nicht geprüft (nur bei Zulassungsprüfungen)
|
|
' Q4 = 1.25 * QN
|
|
'dblDurchflussQ = dblNennDurchfluss * 1.25
|
|
'Debug.Print "Q4 = " & dblNennDurchfluss & " {Qn} * " & 1.25 & " {Const} = " & dblDurchflussQ
|
|
|
|
'''''''''''''''''''''''''''''
|
|
' Q3
|
|
'
|
|
'''''''''''''''''''''''''''''
|
|
dblDurchflussQ = dblNenndurchfluss
|
|
Debug.Print "Q3 = Qn = " & dblNenndurchfluss
|
|
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
|
|
If objBestellcode.GetWert("Nennweite") = 125 And objBestellcode.GetWert("Typ") = "MS" Then
|
|
'neu 24.4.2012 Sonderregel Fehlergrenzen Prüfpunkte nach MID: Q3, Q2 = ±2 statt ±1.5 wenn Bestellcode.Nennweite=125
|
|
DebugMsg "Sonderregel: FG(Q2)=±2 für NW=125 "
|
|
Pruefpunkt.setFGo 2
|
|
Pruefpunkt.setFGu -2
|
|
Else
|
|
' neu RH 29.9.2011
|
|
Pruefpunkt.setFGo 1.5
|
|
Pruefpunkt.setFGu -1.5
|
|
End If
|
|
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
Pruefpunkt.SetTime 60
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
' Q2 = Q1 * 1.6
|
|
dblDurchflussQ = 1.6 * dblNenndurchfluss / dblVerhaeltnisQ3Q1
|
|
Debug.Print "Q2 = 1.6 {Const} * " & dblNenndurchfluss & " {Qn} / " & dblVerhaeltnisQ3Q1 & " {Vq3q1} = " & dblDurchflussQ
|
|
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
|
|
If objBestellcode.GetWert("Nennweite") = 125 And objBestellcode.GetWert("Typ") = "MS" Then
|
|
'neu 24.4.2012 Sonderregel Fehlergrenzen Prüfpunkte nach MID: Q3, Q2 = ±2 statt ±1.5 wenn Bestellcode.Nennweite=125
|
|
DebugMsg "Sonderregel: FG(Q2)=±2 für NW=125 "
|
|
Pruefpunkt.setFGo 2
|
|
Pruefpunkt.setFGu -2
|
|
Else
|
|
' neu RH 29.9.2011
|
|
Pruefpunkt.setFGo 1.5
|
|
Pruefpunkt.setFGu -1.5
|
|
End If
|
|
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
Pruefpunkt.SetTime 60
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
|
|
'''''''''''''''''''''''''''''
|
|
' Q1 = Qn / VQ3Q1
|
|
|
|
dblDurchflussQ = Round(dblNenndurchfluss / dblVerhaeltnisQ3Q1, 3)
|
|
|
|
Debug.Print "Q1 = " & dblNenndurchfluss & " {Qn} / " & dblVerhaeltnisQ3Q1 & " {Vq3Q1} = " & dblDurchflussQ
|
|
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo 5
|
|
' Pruefpunkt.setFGu -5
|
|
' neu RH 29.9.2011
|
|
Pruefpunkt.setFGo 4
|
|
Pruefpunkt.setFGu -4
|
|
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
Pruefpunkt.SetTime 120
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
CreateMIDPruefpunkteFromBestellcode = True
|
|
g_bln_Pruefung_nach_MID = True
|
|
End Function
|
|
|
|
Private Function FehlerRahmenTrompete(intTrompetenKlasse As Integer, Q As Double, Qp As Double) As Double
|
|
' Diese Funktion bestimmt den maximal erlaubten Fehler nach der Trompetenformel
|
|
' nach prEN 1434-1:2004 (D)Seite 13, Kapitel 9.2.2.3 Durchflusssensor
|
|
Select Case intTrompetenKlasse
|
|
Case 1
|
|
FehlerRahmenTrompete = 1 + 0.01 * Qp / Q
|
|
If FehlerRahmenTrompete > 3.5 Then FehlerRahmenTrompete = 3.5
|
|
Case 2
|
|
FehlerRahmenTrompete = 2 + 0.02 * Qp / Q
|
|
If FehlerRahmenTrompete > 5 Then FehlerRahmenTrompete = 5
|
|
Case 3
|
|
FehlerRahmenTrompete = 3 + 0.05 * Qp / Q
|
|
If FehlerRahmenTrompete > 5 Then FehlerRahmenTrompete = 5
|
|
Case Else
|
|
End Select
|
|
End Function
|
|
|
|
'
|
|
'' Reinhard Henning am 17.2.2006
|
|
'' Diese Funktion setzt die Prüfpunkte (Q,FGo,FGu,Prüfzeit)
|
|
'' mit Hilfe der Bestellnummer über Nenndurchfluss,VerhältnisQ3Q1
|
|
'' Für den Fall, daß VerhältnisQ3Q1 die Klasse enthält,
|
|
'' lade die Prüfpunkte wie gehabt
|
|
'Public Sub CreateFromBestellnummer(sBestellnummer As String, sProdukt As String)
|
|
'On Error GoTo Errorhandler
|
|
'
|
|
' Dim objBestellcode As CBestellcode
|
|
' Dim strTemp As String
|
|
' Dim pos As Integer
|
|
' Dim strPruefklasse As String
|
|
' Dim Pruefpunkt As CPruefpunkt
|
|
'
|
|
' Dim Temperatur As Integer
|
|
' Dim dblNennDurchfluss As Double
|
|
' Dim dblVerhaeltnisQ3Q1 As Double
|
|
' Dim dblFehlergrenze As Double
|
|
' Dim intPruefklasse As Integer
|
|
' Dim dblDurchflussQ As Double
|
|
'
|
|
'
|
|
' Set objBestellcode = New CBestellcode
|
|
'
|
|
' 'zum Testen sBestellnummer = "50101DEG1DB11AX" ' 40 1 1.6
|
|
' 'zum Testen sBestellnummer = "50101D111DB11AX" ' A
|
|
'
|
|
' If Not objBestellcode.Load(sBestellnummer, sProdukt) Then
|
|
' ErrorMsg "Der Bestellcode ('" & sBestellnummer & "') konnte nicht (für Produkttyp '" & sProdukt & "') zur Ermittlung der Prüfpunkte ausgewertet werden."
|
|
' Exit Sub
|
|
' End If
|
|
'
|
|
' Select Case objBestellcode.GetWert("Produktbezeichnung")
|
|
' Case "Meistream"
|
|
' ' OK
|
|
' Case Else
|
|
' ErrorMsg "Die Bestimmung der Prüfpunkte für Zähler des Typs '" & sProdukt & "' aus dem Bestellcode ist nicht implementiert."
|
|
' Exit Sub
|
|
' End Select
|
|
'
|
|
'
|
|
' Select Case UCase(objBestellcode.GetWert("Metrolog"))
|
|
' Case "A", "B", "C"
|
|
' ' hier ist eine Metrologische Klasse über den Bestellcode definiert
|
|
' strPruefklasse = Trim(objBestellcode.GetWert("Metrolog"))
|
|
'
|
|
' Debug.Print "Metrolog " & strPruefklasse
|
|
'
|
|
' If Load(m_lIdentNr, strPruefklasse) = True Then
|
|
' ' Es wurden die Prüfpunkte aus der Tabelle 'Pruefpunkte' geladen
|
|
' End If
|
|
' Exit Sub
|
|
' Case "", "1", "2", "3"
|
|
'
|
|
' dblVerhaeltnisQ3Q1 = objBestellcode.GetWert("VerhältnisQ3Q1_numerisch")
|
|
' If dblVerhaeltnisQ3Q1 = 0 Then
|
|
' ErrorMsg "Bestellcode Auswertung: VerhaeltnisQ3Q1 (8. Stelle) ist 0 oder leer"
|
|
' Exit Sub
|
|
' End If
|
|
' ' Hier sind Nenndurchfluss
|
|
' ' und Verhältniss Q3/Q1 über den Bestellcode definiert
|
|
' ' und die Formeln werden herangezogen
|
|
' Set m_colPP = New CPruefpunktCol
|
|
'
|
|
' If Val(objBestellcode.GetWert("Zählerempfindlichkeit_numerisch")) < 130 Then
|
|
' ' Kaltwasser: immer 1. Wert nehmen
|
|
' dblNennDurchfluss = Val(Split(objBestellcode.GetWert("Nenndurchfluss"), " ")(0))
|
|
'
|
|
' If dblNennDurchfluss = 0 Then
|
|
' ErrorMsg "Bestellcode Nenndurchfluss ist '" & objBestellcode.GetWert("Nenndurchfluss") & "' nicht auswertbar."
|
|
' Exit Sub
|
|
' End If
|
|
'
|
|
' ' Prüfpunkte des Kaltwasserzählers
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Q4 = 1.25 * QN
|
|
' dblDurchflussQ = dblNennDurchfluss * 1.25
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo 2
|
|
' Pruefpunkt.setFGu -2
|
|
' Pruefpunkt.setQ dblDurchflussQ
|
|
' Pruefpunkt.SetTime 60
|
|
' m_colPP.Add Pruefpunkt
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Q3 ist nur eine rechnerische Größe
|
|
' ' und wird nicht geprüft
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Q2 = Q1 * 1.6
|
|
' dblDurchflussQ = 1.6 * dblNennDurchfluss / dblVerhaeltnisQ3Q1
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo 2
|
|
' Pruefpunkt.setFGu -2
|
|
' Pruefpunkt.setQ dblDurchflussQ
|
|
' Pruefpunkt.SetTime 60
|
|
' m_colPP.Add Pruefpunkt
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Q1 = Qn / VQ3Q1
|
|
' dblDurchflussQ = dblNennDurchfluss / dblVerhaeltnisQ3Q1
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo 5
|
|
' Pruefpunkt.setFGu -5
|
|
' Pruefpunkt.setQ dblDurchflussQ
|
|
' Pruefpunkt.SetTime 120
|
|
' m_colPP.Add Pruefpunkt
|
|
' Else
|
|
' ' Heiswasser
|
|
' If UBound(Split(objBestellcode.GetWert("Nenndurchfluss"), "|")) = 0 Then
|
|
' ' nur ein Wert vorhanden: 1. Wert nehmen
|
|
' dblNennDurchfluss = Val(Split(objBestellcode.GetWert("Nenndurchfluss"), "|")(0))
|
|
' Else
|
|
' ' mehr Werte vorhanden: 2. Wert nehmen
|
|
' dblNennDurchfluss = Val(Split(objBestellcode.GetWert("Nenndurchfluss"), "|")(1))
|
|
' End If
|
|
' If dblNennDurchfluss = 0 Then
|
|
' ErrorMsg "Bestellcode Nenndurchfluss ist '" & objBestellcode.GetWert("Nenndurchfluss") & "' nicht auswertbar."
|
|
' Exit Sub
|
|
' End If
|
|
'
|
|
' ' Heisswasser Prüfklasse
|
|
' intPruefklasse = 3 ' Zur Zeit gibt es noch keine Möglichkeit
|
|
' 'die Klasse im Bestellcode zu übertragen,
|
|
' 'wenn Feld 8 bereits durch ein VQ3zuQ1 gefüllt ist
|
|
'
|
|
' ' Prüfpunkte des Heisswasserzählers
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Q = QNenn
|
|
' dblDurchflussQ = dblNennDurchfluss
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNennDurchfluss)
|
|
' Pruefpunkt.setFGu -FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNennDurchfluss)
|
|
' Pruefpunkt.setQ dblNennDurchfluss
|
|
' Pruefpunkt.SetTime 60
|
|
' m_colPP.Add Pruefpunkt
|
|
' '''''''''''''''''''''''''''''
|
|
' ' Qt = QNenn / 10
|
|
' dblDurchflussQ = dblNennDurchfluss / 10
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNennDurchfluss)
|
|
' Pruefpunkt.setFGu -FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNennDurchfluss)
|
|
' Pruefpunkt.setQ dblDurchflussQ
|
|
' Pruefpunkt.SetTime 60
|
|
' m_colPP.Add Pruefpunkt
|
|
'
|
|
' ' Qi
|
|
' dblDurchflussQ = dblNennDurchfluss / dblVerhaeltnisQ3Q1
|
|
' Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo FehlerRahmenTrompete(3, dblNennDurchfluss / dblVerhaeltnisQ3Q1, dblNennDurchfluss)
|
|
' Pruefpunkt.setFGu -FehlerRahmenTrompete(3, dblNennDurchfluss / dblVerhaeltnisQ3Q1, dblNennDurchfluss)
|
|
' Pruefpunkt.setQ dblDurchflussQ
|
|
' Pruefpunkt.SetTime 120
|
|
' m_colPP.Add Pruefpunkt
|
|
' End If
|
|
' Case Else
|
|
' ErrorMsg "Metrolog '" & objBestellcode.GetWert("Metrolog") & "' aus Bestellcode ist unbekannt"
|
|
' End Select
|
|
'Exit Sub
|
|
'Errorhandler:
|
|
' ErrorMsg "Fehler " & Err.Number & " in CreateFromBestellnummer('" & sBestellnummer & "','" & sProdukt & "'): " & vbCrLf & Err.Description
|
|
'End Sub
|
|
|
|
' Diese Funktion gibt eine Kopie dieses CPruefpunkte Objektes zurück
|
|
' es enthält ein Kopie der Collection mit kopierten Prüfpunkten
|
|
Public Function GetPruefpunkteKopie() As CPruefpunkte
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
Dim newPruefpunkt As CPruefpunkt
|
|
Dim Regulierdaten As CRegulierdaten
|
|
Dim newPPCol As CPruefpunktCol
|
|
|
|
Set newPPCol = New CPruefpunktCol
|
|
|
|
Set GetPruefpunkteKopie = New CPruefpunkte
|
|
GetPruefpunkteKopie.setIdentNr m_lIdentNr
|
|
GetPruefpunkteKopie.setInfo m_sInfo
|
|
GetPruefpunkteKopie.setPruefklasseKZ m_sPruefklasseKZ
|
|
|
|
Set Regulierdaten = New CRegulierdaten
|
|
Regulierdaten.load m_lIdentNr, m_sPruefklasseKZ
|
|
GetPruefpunkteKopie.setRegulierdaten Regulierdaten
|
|
|
|
For Each Pruefpunkt In m_colPP.getCollection
|
|
Set newPruefpunkt = New CPruefpunkt
|
|
newPruefpunkt.copyFrom Pruefpunkt
|
|
newPPCol.Add newPruefpunkt
|
|
Next
|
|
GetPruefpunkteKopie.setPruefpunkte newPPCol
|
|
End Function
|
|
|
|
|
|
Public Function createFromVakoCode(objVakoCode As CVakoCode, AuftragPosition As CAuftragPosition) As Boolean
|
|
' Diese Funktion wird immer dann ausgeführt, wenn in der Auftragposition ein VakoCode vorhanden ist
|
|
' und dieser durch die Vako_Merkmalswerte ausgewertet werdenn kann
|
|
' es soll allgemein durch den VakoCode auf Prüfpunkte geschlossen werden
|
|
' Wenn keine Prüfpunkte geladen werden konnten, liefert diese Funktion false zurück
|
|
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
Dim PPNr As Integer
|
|
|
|
Dim strKurzBez As String
|
|
Dim strTyp As String
|
|
Dim strTypzusatz As String
|
|
|
|
Dim intNennweite As Integer
|
|
Dim intTemperatur As Integer
|
|
Dim intDruck As Integer
|
|
Dim intBaulaenge As Integer
|
|
Dim strMetrolog As String
|
|
|
|
Dim dblQn As Double
|
|
Dim dblRatio As Double
|
|
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
Dim strAusführungLand As String
|
|
|
|
|
|
|
|
Call init
|
|
|
|
Dim dblNenndurchfluss As Double
|
|
|
|
strMetrolog = AuftragPosition.getMetrolog
|
|
|
|
dblRatio = Val(objVakoCode.GetWert("Ratio"))
|
|
m_dblRatio = dblRatio
|
|
dblQn = Val(objVakoCode.GetWert("Qn"))
|
|
|
|
If Left(objVakoCode.VakoCode, 3) = "WPV" And Val(objVakoCode.GetWert("Nennweite")) = 150 Then
|
|
'' Sonderregel: 29.09.2014: für WPV 150 mit A.Beyer entwickelt
|
|
' Prüfpunkte grundsätzlich nicht nach MID berechnen sondern
|
|
dblQn = 0
|
|
dblRatio = 0
|
|
|
|
If InStr(1, objVakoCode.GetWert("Produktfamilie"), "Dynamic") > 0 Then
|
|
' Produktfamilie WPV Dynamic => Metrolog sollte eingetragen sein und wird verwendet
|
|
Debug.Print strMetrolog
|
|
Else
|
|
'Debug.Print objVakoCode.GetWert("SGR")
|
|
Debug.Print objVakoCode.GetWert("Qn")
|
|
If Val(objVakoCode.GetWert("Ratio")) > 0 Then
|
|
' mit Metrolog = "MID" aus der Prüfpunkte-Tabelle bestimmen
|
|
strMetrolog = "MID"
|
|
Else
|
|
' Metrolog = "Sensus MID" aus der Prüfpunkte-Tabelle bestimmen
|
|
' festgelegt für Sensus Katalogwerte
|
|
strMetrolog = "Sensus MID"
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If Left(objVakoCode.VakoCode, 3) = "MTW" Then
|
|
'' Sonderregel: 30.10.2012: für VakoCode MTW** sollen die Prüfpunkte nicht errechnet werden.
|
|
dblQn = 0
|
|
dblRatio = 0
|
|
ElseIf Left(objVakoCode.VakoCode, 3) = "PST" Then
|
|
' Sonderbehandlung PST
|
|
If CreateMIDPruefpunkteFromVakoCodeForPST(objVakoCode) Then
|
|
createFromVakoCode = True
|
|
Exit Function
|
|
End If
|
|
Else
|
|
If dblRatio > 0 And dblQn > 0 Then
|
|
' Neu 22.2.2017 Neuer Typ WPD VMT
|
|
' Neu 12.12.2017 Neuer Typ WPF
|
|
If Left(objVakoCode.VakoCode, 3) = "WPD" Or Left(objVakoCode.VakoCode, 3) = "WPF" Then
|
|
If CreateMIDPruefpunkteFromVakoCode_for_WPD_WPF(objVakoCode) Then
|
|
createFromVakoCode = True
|
|
Else
|
|
createFromVakoCode = False
|
|
End If
|
|
Exit Function
|
|
End If
|
|
|
|
If CreateMIDPruefpunkteFromVakoCode(objVakoCode) Then
|
|
createFromVakoCode = True
|
|
Exit Function
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
' Im VAKO_Merkmal Ausfuehrung Land/C_WPD_QAM sollte der Charcode am Anfang des Wertes stehen
|
|
' Todo: in Tabelle VAKO_Merkmal wird der Schlüssel "Ausfuehrung" wird doppelt benutzt,
|
|
' einmal mit QA_M als numerischer Wert am Anfang und als CSD XXXXXX ab Wort Nr 2
|
|
|
|
strAusführungLand = Left(objVakoCode.GetWert("Ausfuehrung"), 2)
|
|
strKurzBez = objVakoCode.GetWert("KurzBez")
|
|
strTyp = objVakoCode.GetWert("Typ")
|
|
strTypzusatz = objVakoCode.GetWert("Typzusatz")
|
|
intNennweite = Val(objVakoCode.GetWert("Nennweite"))
|
|
intTemperatur = Val(objVakoCode.GetWert("Temperatur"))
|
|
intDruck = Val(objVakoCode.GetWert("Druck"))
|
|
intBaulaenge = Val(objVakoCode.GetWert("Baulaenge"))
|
|
|
|
If objVakoCode.GetWert("Metrolog") <> "" And strMetrolog = "" Then
|
|
' Die Metrolog aus der Auftragsposition hat Vorrang
|
|
strMetrolog = objVakoCode.GetWert("Metrolog")
|
|
End If
|
|
|
|
If Left(objVakoCode.VakoCode, 3) = "MTW" And (strMetrolog = "" Or strMetrolog = "MID") Then
|
|
m_sInfo = m_sInfo & "Sonderregel MTW ohne Metrolog: keine Berechnung der Prüfpunkte, sondern passende IdentNr mit Metrolog=MID" & vbCrLf
|
|
' Sonderregel: 30.10.2012: für VakoCode MTW** sollen die Prüfpunkte nicht errechnet werden. Es soll eine passende IdentNr herausgesucht werden und dann die Metrologische Klasse MID verwendet werden.
|
|
strMetrolog = "MID"
|
|
Else
|
|
'strMetrolog = objVakoCode.GetWert("Metrolog") 'eigentlich Problematisch: Was ist, wenn in der Auftragposition die Metrolog geändert wurde? (widerspruch zur Metrolog im VakoCode)
|
|
'strMetrolog = AuftragPosition.getMetrolog
|
|
End If
|
|
|
|
'If strAusführungLand = "01" Then strAusführungLand = ""
|
|
|
|
'If strAusführungLand = "" And strMetrolog <> "" Then
|
|
' Ausführung_land ist leer aber Metrolog ist vorhanden (keine Prüfpunkte nach MID)
|
|
' lade die IdentNr aus einer baugleichen Identnr ohne VakoCode
|
|
' mit identischen Eigenschaften KurzBez, Typ, NW, Temp, Druck, KundenNr
|
|
|
|
|
|
If strMetrolog <> "" Then
|
|
|
|
strSQL = "SELECT * from IdentNr where 1=1"
|
|
If strKurzBez <> "" Then
|
|
'strSQL = strSQL & " AND (KurzBez = '" & strKurzBez & "' or KurzBez is NULL)"
|
|
strSQL = strSQL & " AND (KurzBez = '" & strKurzBez & "')"
|
|
End If
|
|
If strTyp <> "" Then
|
|
|
|
If strTyp = "WPF" Then
|
|
' RH 15.1.2018
|
|
strTyp = "WPD"
|
|
End If
|
|
|
|
'strSQL = strSQL & " AND (Typ = '" & strTyp & "' or Typ is NULL)"
|
|
'strSQL = strSQL & " AND (Typ = '" & strTyp & "')"
|
|
strSQL = strSQL & " AND (Typ like '" & strTyp & "%')"
|
|
End If
|
|
If intNennweite <> 0 Then
|
|
'strSQL = strSQL & " AND (Nennweite = '" & intNennweite & "' or Nennweite is NULL)"
|
|
strSQL = strSQL & " AND (Nennweite = '" & intNennweite & "')"
|
|
End If
|
|
|
|
If intTemperatur <> 0 Then
|
|
' Temperaturen gruppieren
|
|
If intTemperatur = 30 Or intTemperatur = 50 Then
|
|
strSQL = strSQL & " AND (Temperatur = 30 or Temperatur = 50 or Temperatur is NULL)"
|
|
ElseIf intTemperatur = 130 Or intTemperatur = 150 Then
|
|
strSQL = strSQL & " AND (Temperatur = 130 or Temperatur = 150 or Temperatur is NULL)"
|
|
Else
|
|
strSQL = strSQL & " AND (Temperatur = '" & intTemperatur & "' or Temperatur is NULL)"
|
|
End If
|
|
End If
|
|
|
|
If intDruck <> 0 Then
|
|
strSQL = strSQL & " AND (Druck = '" & intDruck & "' or Druck is NULL)"
|
|
End If
|
|
|
|
' AB 11.1.2011: Baulänge ist nicht relevant für PP
|
|
' If intBaulaenge <> 0 Then
|
|
' strSQL = strSQL & " AND (Baulaenge = '" & intBaulaenge & "' or Baulaenge is NULL)"
|
|
' End If
|
|
|
|
|
|
' Fert_Ort nicht Versuch und auch nicht leer
|
|
strSQL = strSQL & " AND (Fert_Ort <> 'VS' or Fert_Ort is NULL) "
|
|
|
|
' ggf. übereinstimmende KundenNr
|
|
strSQL = strSQL & " AND (Kunde = '" & AuftragPosition.getKundenNr & "' or Kunde is NULL) "
|
|
|
|
' aber kein Vako!!
|
|
strSQL = strSQL & " AND (VakoCode = '' or VakoCode is NULL) "
|
|
'strSQL = strSQL & " AND (VakoCode = '' or VakoCode is NULL or VakoCode = '" & objVakoCode.VakoCode & "') "
|
|
|
|
Set rs = New CRecordset
|
|
Debug.Print strSQL
|
|
'Clipboard.SetText strSQL
|
|
|
|
rs.openRS strSQL, False
|
|
|
|
|
|
If Not rs.EOF Then
|
|
Dim lngIdentNr As Long
|
|
lngIdentNr = rs.getLongValue("IdentNr")
|
|
If load(lngIdentNr, strMetrolog) Then
|
|
'MsgBox "Vako Stufe 1: PP werden aus Identnr " & lngIdentNr & " und Metrolog '" & strMetrolog & "' bestimmt."
|
|
createFromVakoCode = True
|
|
m_sInfo = m_sInfo & " (Ähnliche IdentNr für " & strKurzBez & " " & strTyp & " DN" & intNennweite & " " & intTemperatur & "°C PN" & intDruck & " " & intBaulaenge & "mm" & vbCrLf
|
|
m_sInfo = m_sInfo & "Prüfpunkte aus IdentNr= " & lngIdentNr & ", Metrolog='" & strMetrolog & "')" & vbCrLf
|
|
m_sPruefklasseKZ = strMetrolog
|
|
m_lIdentNr = lngIdentNr
|
|
'Exit Function
|
|
Else
|
|
'BenachrichtigeDatenpflege "Vako (Stufe 1): Prüfpunkte konnten nicht aus Identnr " & lngIdentNr & " & Metrolog '" & strMetrolog & "' bestimmt werden." & vbCrLf & strSQL & vbCrLf & "Auftrag " & AuftragPosition.getAuftragNr & "/" & AuftragPosition.getNr & ",FA " & AuftragPosition.GetFertigungsauftragNr
|
|
createFromVakoCode = False
|
|
End If
|
|
Else
|
|
' BenachrichtigeDatenpflege "Vako (Stufe 1): Es wurde keine passende Identnr gefunden: " & strSQL & vbCrLf & "Auftrag " & AuftragPosition.getAuftragNr & "/" & AuftragPosition.getNr & ",FA " & AuftragPosition.GetFertigungsauftragNr
|
|
createFromVakoCode = False
|
|
End If
|
|
End If
|
|
|
|
Dim strAMTNr As String
|
|
strAMTNr = GetWertFromLangtext(AuftragPosition, "AMT Nr. ")
|
|
If mstr_Kundenmaterialnr <> "" Then
|
|
strAMTNr = mstr_Kundenmaterialnr
|
|
End If
|
|
|
|
strSQL = "SELECT * from Spezifikationen WHERE 1=1 "
|
|
If strKurzBez <> "" Then
|
|
strSQL = strSQL & " AND (KurzBez = '" & strKurzBez & "' or KurzBez is NULL)"
|
|
End If
|
|
|
|
strSQL = strSQL & " AND (Ausfuehrung_Land = '" & strAusführungLand & "') " ''''''or Ausfuehrung_Land is NULL)"
|
|
|
|
' neu RH 7.5.2012
|
|
strSQL = strSQL & " AND (KundenNr = '" & AuftragPosition.getKundenNr & "' or Kunde is NULL) "
|
|
|
|
If strTyp <> "" Then
|
|
strSQL = strSQL & " AND (Typ = '" & strTyp & "' or Typ is NULL)"
|
|
End If
|
|
|
|
'''' später:
|
|
''''' strSQL = strSQL & " and (Typzusatz = '" & strTypzusatz & "' or Typzusatz like ';" & strTypzusatz & ";' or Typzusatz like '%;*;%' or Typzusatz is NULL)"
|
|
|
|
If intNennweite <> 0 Then
|
|
strSQL = strSQL & " AND (Nennweite = '" & intNennweite & "' or Nennweite is NULL)"
|
|
End If
|
|
|
|
If intTemperatur <> 0 Then
|
|
If intTemperatur = 30 Or intTemperatur = 50 Then
|
|
strSQL = strSQL & " AND (Temperatur = 30 or Temperatur = 50 or Temperatur is NULL)"
|
|
ElseIf intTemperatur = 130 Or intTemperatur = 150 Then
|
|
strSQL = strSQL & " AND (Temperatur = 130 or Temperatur = 150 or Temperatur is NULL)"
|
|
Else
|
|
strSQL = strSQL & " AND (Temperatur = '" & intTemperatur & "' or Temperatur is NULL)"
|
|
End If
|
|
End If
|
|
If intDruck <> 0 Then
|
|
strSQL = strSQL & " AND (Druck = '" & intDruck & "' or Druck is NULL)"
|
|
End If
|
|
|
|
' If intBaulaenge <> 0 Then
|
|
' strSQL = strSQL & " AND (Baulaenge = '" & intBaulaenge & "' or Baulaenge is NULL)"
|
|
' End If
|
|
|
|
If strMetrolog <> "" Then
|
|
strSQL = strSQL & " AND (Metrolog = '" & strMetrolog & "' or Metrolog is NULL)"
|
|
End If
|
|
|
|
If AuftragPosition.getIdentNrObj.GetVakoCodeNZ <> "" Then
|
|
Dim objVako As CVakoCode
|
|
Dim strMetrologNz As String
|
|
|
|
Set objVako = New CVakoCode
|
|
If objVako.load(AuftragPosition.getIdentNrObj.GetVakoCodeNZ) Then
|
|
strMetrologNz = objVako.GetWert("Metrolog")
|
|
If strMetrologNz <> "" Then
|
|
strSQL = strSQL & " AND Metrolog_NZ = '" & strMetrologNz & "'"
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
If dblQn > 0 Then
|
|
strSQL = strSQL & " AND (Qn= '" & dblQn & "' or Qn is NULL)"
|
|
End If
|
|
|
|
' RH 27.5.2013 wieder rausgenommen
|
|
' ' todo Filtern nach AMT Nr.
|
|
' If strAMTNr <> "" Then
|
|
' strSQL = strSQL & " AND AM_Art_Nr = '" & strAMTNr & "' "
|
|
' End If
|
|
|
|
' todo Filtern nach Qn, mit_Reed, mit_Opto ?
|
|
' filtern nach Spezifikationen mit eingetragenen Prüfpunkten (notwendig z.B. f. FANr 320710)
|
|
strSQL = strSQL & " AND (Q1 is not NULL)"
|
|
|
|
'erst mal nach Anlagezeitpunkt sortiert
|
|
strSQL = strSQL & " ORDER BY Sortorder"
|
|
|
|
|
|
Set rs = New CRecordset
|
|
Debug.Print strSQL
|
|
|
|
|
|
rs.openRS strSQL, False
|
|
If Not rs.EOF Then
|
|
If rs.RecordCount = 1 Then
|
|
' genau einen Fund
|
|
'Debug.Assert False
|
|
WriteToLog "Vako Stufe 2: Prüfpunkte kommen aus Tabelle Spezifikation mit ID= " & rs.getLongValue("id")
|
|
m_sInfo = m_sInfo & "Vako Stufe 2: Prüfpunkte kommen aus Tabelle Spezifikation mit ID= " & rs.getLongValue("id")
|
|
|
|
ElseIf rs.RecordCount > 1 Then
|
|
BenachrichtigeDatenpflege "Vako Stufe 2: Es wurden " & rs.RecordCount & " Datensaetze in 'Spezifikationen' gefunden:" & vbCrLf & strSQL & vbCrLf & "Prüfpunkte kommen aus Tabelle Spezifikation mit ID= " & rs.getLongValue("id") & vbCrLf & "Auftrag " & AuftragPosition.getAuftragNr & "/" & AuftragPosition.getNr & ",FA " & AuftragPosition.GetFertigungsauftragNr
|
|
' zuviel gefunden
|
|
End If
|
|
|
|
m_lngSpezifikationID = rs.getLongValue("ID")
|
|
|
|
Set m_colPP = New CPruefpunktCol
|
|
For PPNr = 1 To 10
|
|
If Not rs.isFieldNull("Q" & PPNr) Then
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ rs.getDoubleValue("Q" & PPNr)
|
|
Pruefpunkt.setFGo rs.getDoubleValue("FGo" & PPNr)
|
|
Pruefpunkt.setFGu rs.getDoubleValue("FGu" & PPNr)
|
|
Pruefpunkt.SetTime rs.getDoubleValue("P" & PPNr & "SollPruefZeit")
|
|
m_colPP.Add Pruefpunkt
|
|
Else
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
If Me.getPruefpunkteCount = 0 And strMetrolog <> "" Then
|
|
' noch ein Fallback, wenn keine Prüfpunkte in Spezifikationen definiert sind, RH 7.5.2012
|
|
If load(AuftragPosition.getIdentNr, strMetrolog) Then
|
|
WriteToLog "Prüfpunkte aus IdentNr=" & AuftragPosition.getIdentNr & " und Metrolog=" & strMetrolog
|
|
Else
|
|
WriteToLog "Es gibt auch keine Prüfpunkte aus IdentNr=" & AuftragPosition.getIdentNr & " und Metrolog=" & strMetrolog
|
|
End If
|
|
End If
|
|
|
|
m_Regulierdaten.setSPSSollwertRegulierung rs.getDoubleValue("SPS_Sollwert_Regulierung")
|
|
createFromVakoCode = True
|
|
Else
|
|
'Debug.Assert False
|
|
' nichts gefunden
|
|
'BenachrichtigeDatenpflege "Vako Stufe 2: Es wurden keine Datensaetze in 'Spezifikationen' gefunden:" & vbCrLf & strSQL & vbCrLf & vbCrLf & "Auftrag " & AuftragPosition.getAuftragNr & "/" & AuftragPosition.getNr & ",FA " & AuftragPosition.GetFertigungsauftragNr
|
|
|
|
|
|
End If
|
|
|
|
If getPruefpunkte.Count = 0 Then
|
|
' nichts gefunden
|
|
createFromVakoCode = False
|
|
End If
|
|
|
|
m_Regulierdaten.setSteigung 1, 0.7
|
|
m_Regulierdaten.setDaempfung 1, 3
|
|
|
|
m_Regulierdaten.setSteigung 2, 0.1
|
|
m_Regulierdaten.setDaempfung 2, 5
|
|
|
|
m_Regulierdaten.setSteigung 3, 0.05
|
|
m_Regulierdaten.setDaempfung 3, 7
|
|
|
|
End Function
|
|
|
|
Public Function GetWertFromLangtext(AuftragPosition As CAuftragPosition, strName As String) As String
|
|
Dim varZeile As Variant
|
|
|
|
For Each varZeile In Split(AuftragPosition.getZusatztext, vbCrLf)
|
|
Debug.Print "Zeile: " & varZeile
|
|
If Left(varZeile, Len(strName)) = strName Then
|
|
GetWertFromLangtext = Right(varZeile, Len(varZeile) - Len(strName))
|
|
Exit Function
|
|
End If
|
|
Next
|
|
End Function
|
|
|
|
|
|
Public Function GetFehlergrenzenOeffnenSchliessen(ByRef FGoOeff As Double, ByRef FGuOeff As Double, ByRef FGoSchl As Double, ByRef FGuSchl As Double) As Boolean
|
|
Dim strTyp As String
|
|
Dim strMetrolog As String
|
|
Dim strNennweite As String
|
|
Dim strSQL As String
|
|
Dim rs As CRecordset
|
|
|
|
Dim objIndentNr As CIdentNr
|
|
Set objIndentNr = New CIdentNr
|
|
If objIndentNr.load(m_lIdentNr) Then
|
|
strTyp = objIndentNr.getTyp
|
|
strNennweite = CStr(objIndentNr.getNennweite)
|
|
strMetrolog = m_sPruefklasseKZ
|
|
|
|
'ID
|
|
'TypBereich
|
|
'MetrologBereich
|
|
'NennweiteBereich
|
|
'TemperaturBereich
|
|
'FgoOeffnen
|
|
'FguOeffnen
|
|
'FgoSchliessen
|
|
'FGuSchliessen
|
|
'Reihenfolge
|
|
'Bemerkung
|
|
|
|
strSQL = "SELECT * FROM FehlergrenzenVerbundzaehler "
|
|
strSQL = strSQL & " WHERE (TypBereich like '%;" & objIndentNr.getTyp & ";%' or TypBereich like '%;*;%') "
|
|
strSQL = strSQL & " AND (NennweiteBereich like '%;" & CStr(objIndentNr.getNennweite) & ";%' or NennweiteBereich like '%;*;%') "
|
|
strSQL = strSQL & " AND (MetrologBereich like '%;" & m_sPruefklasseKZ & ";%' or MetrologBereich like '%;*;%') "
|
|
strSQL = strSQL & " AND (TemperaturBereich like '%;" & objIndentNr.GetTemperatur & ";%' or TemperaturBereich like '%;*;%') "
|
|
strSQL = strSQL & " ORDER BY Reihenfolge "
|
|
|
|
Debug.Print strSQL
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
If Not rs.EOF Then
|
|
FGoOeff = rs.getDoubleValue("FgoOeffnen")
|
|
FGuOeff = rs.getDoubleValue("FguOeffnen")
|
|
FGoSchl = rs.getDoubleValue("FgoSchliessen")
|
|
FGuSchl = rs.getDoubleValue("FGuSchliessen")
|
|
GetFehlergrenzenOeffnenSchliessen = True
|
|
Else
|
|
Debug.Print "keine passenden FehlergrenzenVerbundzaehler : " & strSQL
|
|
End If
|
|
Else
|
|
Debug.Print "IdentNr " & m_lIdentNr & " konnte nicht geladen wewrden."
|
|
End If
|
|
End Function
|
|
|
|
Public Function CreatePruefpunkteFromSpezifikationen(Bestellcode As CBestellcode, Auftrag As CAuftrag) As Boolean
|
|
Dim rs As CRecordset
|
|
Dim strSQL As String
|
|
Dim strNennweite As String
|
|
Dim strTyp As String
|
|
Dim strTypzusatz As String
|
|
Dim strCSD As String
|
|
|
|
CreatePruefpunkteFromSpezifikationen = False
|
|
|
|
strTyp = Bestellcode.GetWert("Typ")
|
|
strTypzusatz = Bestellcode.GetWert("Typzusatz")
|
|
strCSD = Trim(Bestellcode.GetWert("CSD"))
|
|
If strCSD = "" Then
|
|
Exit Function
|
|
End If
|
|
|
|
strNennweite = Bestellcode.GetWert("Nennweite")
|
|
|
|
'1(5): Produktbezeichnung=Meistream
|
|
'1(5): Typ=MS
|
|
'2(1): KurzBez=WZ
|
|
'2(1): MS_Hochgenauigkeit=Plus, Komplettzähler
|
|
'2(1): Typzusatz=Plus
|
|
'3(M): Eichkennzeichnung=International (Sensuswerte)
|
|
'4(19): CSD=CSD 38134-3-SA
|
|
'4(19): Logo=Sabesp CSD 38134-3-SA
|
|
'6(B): Nennweite=50
|
|
'9(1): Druck=16
|
|
'10(F): Baulaenge=270
|
|
'11(8): Bohrung=NBR 7669/1982 PN16
|
|
'12(1): Temperatur=30
|
|
'12(1): Temperaturstufe=kalt
|
|
'13(A): Zählwerk=D-Werk mech.
|
|
'14(1): Anzeige=m³
|
|
'15(X): Modultyp=kein MODULME
|
|
|
|
strSQL = "SELECT * from Spezifikationen where (Typ = '" & strTyp & "' or Typ like '%;" & strTyp & ";%' or Typ like ';*;') "
|
|
strSQL = strSQL & " and (Typzusatz = '" & strTypzusatz & "' or Typzusatz like ';" & strTypzusatz & ";' or Typzusatz like '%;*;%' or Typzusatz is NULL)"
|
|
|
|
If strNennweite <> "" Then
|
|
strSQL = strSQL & " and (Nennweite = '" & strNennweite & "' or Nennweite like ';*;%' or Nennweite is null) "
|
|
End If
|
|
|
|
'If strCSD <> "" Then ' CSD darf nicht leer sein
|
|
strSQL = strSQL & " and (CSD = '" & strCSD & "' or CSD like '%;" & strCSD & ";%' or CSD like ';*;') "
|
|
'End If
|
|
|
|
If Auftrag.getKundenNr <> 0 Then
|
|
strSQL = strSQL & " and (KundenNr = " & Auftrag.getKundenNr & " or KundenNr is null) "
|
|
End If
|
|
|
|
strSQL = strSQL & " and Q1 > 0 "
|
|
|
|
Set rs = New CRecordset
|
|
rs.openRS strSQL, True
|
|
Debug.Print strSQL
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
If Not rs.EOF Then
|
|
Set m_colPP = New CPruefpunktCol
|
|
|
|
If rs.RecordCount > 1 Then
|
|
BenachrichtigeDatenpflege "CreatePruefpunkteFromSpezifikationen(): Es ist mehr als einen (=" & rs.RecordCount & ") Datensatz in der Tabelle Spezifikationen vorhanden. Bitte Daten pflegen!" & vbCrLf & strSQL & vbCrLf & "Auftrag " & Auftrag.getNr
|
|
End If
|
|
|
|
Dim sNummer As Integer
|
|
For sNummer = 1 To 10
|
|
If rs.isFieldNull("Q" & sNummer) Then
|
|
Debug.Print "kein Prüfpunkt Q" & sNummer & " in Tabelle Spezifikation, Datensatz mit ID=" & rs.getLongValue("id")
|
|
Exit For
|
|
Else
|
|
CreatePruefpunkteFromSpezifikationen = True
|
|
m_lngSpezifikationID = rs.getLongValue("ID")
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Call Pruefpunkt.setMember( _
|
|
rs.getDoubleValue("Q" & sNummer), _
|
|
rs.getDoubleValue("FGo" & sNummer), _
|
|
rs.getDoubleValue("FGu" & sNummer), , rs.getDoubleValue("P" & sNummer & "SollPruefZeit"))
|
|
m_colPP.Add Pruefpunkt
|
|
End If
|
|
Next
|
|
|
|
CreatePruefpunkteFromSpezifikationen = True
|
|
'MsgBox "Es werden die Prüfpunkte aus der Spezifikation " & m_lngSpezifikationID & " verwendet."
|
|
End If
|
|
Exit Function
|
|
Errorhandler:
|
|
LogIntoDB "Fehler " & Err.Number & " in CreatePruefpunkteFromSpezifikationen(): " & Err.Description, "Softwarefehler"
|
|
Exit Function
|
|
Resume
|
|
End Function
|
|
|
|
|
|
Public Function CreateMIDPruefpunkteFromVakoCode_for_WPD_WPF(objVakoCode As CVakoCode) As Boolean
|
|
Dim dblNenndurchfluss As Double
|
|
Dim dblVerhaeltnisQiQp As Double
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
' nach allgemeinen Zählerprüfpunkten Sensus-1-796 WPD FS - Heisswasser
|
|
|
|
m_dblRatio = Val(Replace(objVakoCode.GetWert("Ratio"), ",", "."))
|
|
dblNenndurchfluss = Val(Replace(objVakoCode.GetWert("Qn"), ",", "."))
|
|
|
|
' VMT ist veraltet!
|
|
|
|
If InStr(1, objVakoCode.GetWert("Produktfamilie"), "VMT") > 0 Or InStr(objVakoCode.GetWert("Produktfamilie"), "FlowSensor") > 0 Or InStr(objVakoCode.GetWert("Typzusatz"), "Flow-Sensor") Then
|
|
' Heisswasser
|
|
dblVerhaeltnisQiQp = 0.6
|
|
m_bPruefung_nach_MID = True
|
|
Else
|
|
' alle anderen WPD kaltwasser ??
|
|
CreateMIDPruefpunkteFromVakoCode_for_WPD_WPF = False
|
|
Exit Function
|
|
End If
|
|
|
|
|
|
Set m_colPP = New CPruefpunktCol
|
|
|
|
' 1. Prüfpunkt ist Qp = Nenndurchfluss
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ dblNenndurchfluss
|
|
If Val(objVakoCode.GetWert("Nennweite")) < 200 Then
|
|
Pruefpunkt.setFGo 2
|
|
Pruefpunkt.setFGu -2
|
|
Else
|
|
Pruefpunkt.setFGo 1.5
|
|
Pruefpunkt.setFGu -1.5
|
|
End If
|
|
Pruefpunkt.SetTime 60
|
|
m_colPP.Add Pruefpunkt
|
|
Set m_Qp = Pruefpunkt
|
|
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' 2. Prüfpunkt ist Qp / Ratio
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ dblNenndurchfluss / m_dblRatio
|
|
If Val(objVakoCode.GetWert("Nennweite")) < 200 Then
|
|
Pruefpunkt.setFGo 2.2
|
|
Pruefpunkt.setFGu -2.2
|
|
Else
|
|
Select Case m_dblRatio
|
|
Case 10
|
|
Pruefpunkt.setFGo 4
|
|
Pruefpunkt.setFGu -3
|
|
Case 25
|
|
Pruefpunkt.setFGo 2
|
|
Pruefpunkt.setFGu -1.5
|
|
End Select
|
|
End If
|
|
Pruefpunkt.SetTime 120
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Select Case m_dblRatio
|
|
Case 25
|
|
' 3. Prüfpunkt ist Qi= Qp / Ratio / 2.5
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setQ dblNenndurchfluss / m_dblRatio / 2.5
|
|
If Val(objVakoCode.GetWert("Nennweite")) < 200 Then
|
|
Pruefpunkt.setFGo 2.5
|
|
Pruefpunkt.setFGu -2.5
|
|
Else
|
|
Pruefpunkt.setFGo 4
|
|
Pruefpunkt.setFGu -3
|
|
End If
|
|
Pruefpunkt.SetTime 120
|
|
m_colPP.Add Pruefpunkt
|
|
Case 10
|
|
' kein 3. Prüfpunkt
|
|
Case Else
|
|
|
|
End Select
|
|
Set m_Qi = Pruefpunkt
|
|
|
|
CreateMIDPruefpunkteFromVakoCode_for_WPD_WPF = True
|
|
End Function
|
|
|
|
|
|
Public Function CreateMIDPruefpunkteFromVakoCode(objVakoCode As CVakoCode) As Boolean
|
|
Dim dblNenndurchfluss As Double
|
|
Dim dblDurchflussQ As Double
|
|
Dim strPruefklasse As String
|
|
Dim dblVerhaeltnisQ3Q1 As Double
|
|
Dim strWert As String
|
|
|
|
strWert = objVakoCode.GetWert("Ratio")
|
|
' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
strWert = Replace(strWert, ",", ".")
|
|
|
|
dblVerhaeltnisQ3Q1 = Val(strWert)
|
|
m_dblRatio = dblVerhaeltnisQ3Q1
|
|
|
|
strWert = objVakoCode.GetWert("Qn")
|
|
' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
strWert = Replace(strWert, ",", ".")
|
|
dblNenndurchfluss = Val(strWert)
|
|
|
|
If dblVerhaeltnisQ3Q1 = 0 Or dblNenndurchfluss = 0 Then
|
|
DebugMsg "Die MID Prüfpunkte konnten nicht aus dem VakoCode '" & objVakoCode.VakoCode & "' ermittelt werden."
|
|
CreateMIDPruefpunkteFromVakoCode = False
|
|
Exit Function
|
|
End If
|
|
|
|
m_bPruefung_nach_MID = True
|
|
|
|
' Hier sind Nenndurchfluss und Verhältniss Q3/Q1 über den Bestellcode definiert
|
|
Set m_colPP = New CPruefpunktCol
|
|
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
' Prüfpunkte des Kaltwasserzählers
|
|
'''''''''''''''''''''''''''''
|
|
' wird nach OIML R49-1 (2006) nicht geprüft (nur bei Zulassungsprüfungen)
|
|
' Q4 = 1.25 * QN
|
|
'dblDurchflussQ = dblNennDurchfluss * 1.25
|
|
'Debug.Print "Q4 = " & dblNennDurchfluss & " {Qn} * " & 1.25 & " {Const} = " & dblDurchflussQ
|
|
|
|
'''''''''''''''''''''''''''''
|
|
' Q3
|
|
'
|
|
'''''''''''''''''''''''''''''
|
|
dblDurchflussQ = dblNenndurchfluss
|
|
Debug.Print "Q3 = Qn = " & dblNenndurchfluss
|
|
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
|
|
If objVakoCode.GetWert("Nennweite") = 125 And objVakoCode.GetWert("Typ") = "MS" Then
|
|
'neu 24.4.2012 Sonderregel Fehlergrenzen Prüfpunkte nach MID: Q3, Q2 = ±2 statt ±1.5 wenn Bestellcode.Nennweite=125
|
|
DebugMsg "Sonderregel: FG(Q2)=±2 für NW=125 "
|
|
Pruefpunkt.setFGo 2
|
|
Pruefpunkt.setFGu -2
|
|
Else
|
|
' neu RH 29.9.2011
|
|
Pruefpunkt.setFGo 1.5
|
|
Pruefpunkt.setFGu -1.5
|
|
End If
|
|
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
|
|
|
|
Pruefpunkt.SetTime 60
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
|
|
dblDurchflussQ = 1.6 * dblNenndurchfluss / dblVerhaeltnisQ3Q1
|
|
Debug.Print "Q2 = 1.6 {Const} * " & dblNenndurchfluss & " {Qn} / " & dblVerhaeltnisQ3Q1 & " {Vq3q1} = " & dblDurchflussQ
|
|
' Q2 = Q1 * 1.6
|
|
|
|
'ToDo Checken von Roland
|
|
If (objVakoCode.GetWert("Typzusatz") = "Flow-Sensor") Then
|
|
'Q2 = Qp *0,1
|
|
dblDurchflussQ = 0.1 * dblNenndurchfluss
|
|
Debug.Print "Q2 = 0.1 {Const} * " & dblNenndurchfluss & " {Qn} = " & dblDurchflussQ
|
|
End If
|
|
|
|
|
|
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
|
|
If objVakoCode.GetWert("Nennweite") = 125 And objVakoCode.GetWert("Typ") = "MS" Then
|
|
'neu 24.4.2012 Sonderregel Fehlergrenzen Prüfpunkte nach MID: Q3, Q2 = ±2 statt ±1.5 wenn Bestellcode.Nennweite=125
|
|
DebugMsg "Sonderregel: FG(Q2)=±2 für NW=125 "
|
|
Pruefpunkt.setFGo 2
|
|
Pruefpunkt.setFGu -2
|
|
Else
|
|
' neu RH 29.9.2011
|
|
Pruefpunkt.setFGo 1.5
|
|
Pruefpunkt.setFGu -1.5
|
|
End If
|
|
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
Pruefpunkt.SetTime 60
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
|
|
'''''''''''''''''''''''''''''
|
|
' Q1 = Qn / VQ3Q1
|
|
|
|
dblDurchflussQ = Round(dblNenndurchfluss / dblVerhaeltnisQ3Q1, 3)
|
|
|
|
Debug.Print "Q1 = " & dblNenndurchfluss & " {Qn} / " & dblVerhaeltnisQ3Q1 & " {Vq3Q1} = " & dblDurchflussQ
|
|
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
' Pruefpunkt.setFGo 5
|
|
' Pruefpunkt.setFGu -5
|
|
' neu RH 29.9.2011
|
|
Pruefpunkt.setFGo 4
|
|
Pruefpunkt.setFGu -4
|
|
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
Pruefpunkt.SetTime 120
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
''''''''''''''''''''''''''''''''''''''''''
|
|
'Sonderlocke für eRegister MS Nennweite 40 (lassen sich nicht mit LWL prüfen) lt. eMail vom 6.12.2016 von Andreas Pfeiffer
|
|
''''''''''''
|
|
'Hallo Reinhard,
|
|
'Bitte behandele diese Prüfung, so dass für egal welches Ratio oder sonstige Sondereinstellungen dieser Zähler immer mit den unten genannte Prüfzeiten bei Q1, Q2 und Q3 geprüft wird, danke. Mit dieser Maßnahme ist erst einmal Druck aus dieser Prüfsituation herausgenommen worden, wissend das die Prüfzeiten sehr hoch sind, aber bei der sehr geringen Stückzahl ist das auf absehbare Zeit zu verkraften.
|
|
'Als spätere Änderung dient dann die Optimierung der Auslesung der Werte 4 mal je Sekunde aller eingebauten Zähler, was dir wohl schon von Thomas Q, bzw. Peter B. mitgeteilt worden ist.
|
|
'Mit freundlichen Grüßen / Best regards Andreas Pfeiffer
|
|
If objVakoCode.GetWert("Zählwerk") = "eRegister" And objVakoCode.GetWert("Typ") = "MS" Then
|
|
If objVakoCode.GetWert("Nennweite") = 40 Then
|
|
m_colPP.Item(1).SetTime 60
|
|
m_colPP.Item(2).SetTime 900
|
|
m_colPP.Item(3).SetTime 1440
|
|
End If
|
|
End If
|
|
''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
CreateMIDPruefpunkteFromVakoCode = True
|
|
g_bln_Pruefung_nach_MID = True
|
|
End Function
|
|
|
|
Public Function CreateMIDPruefpunkteFromVakoCodeForPST(objVakoCode As CVakoCode) As Boolean
|
|
Dim dblNenndurchfluss As Double
|
|
Dim dblDurchflussQ As Double
|
|
Dim strPruefklasse As String
|
|
Dim dblVerhaeltnisQ3Q1 As Double
|
|
Dim strWert As String
|
|
Dim intPruefklasse As Integer
|
|
|
|
If Val(objVakoCode.GetWert("Trompetenklasse")) > 0 Then
|
|
intPruefklasse = Val(objVakoCode.GetWert("Trompetenklasse"))
|
|
End If
|
|
|
|
strWert = objVakoCode.GetWert("Ratio")
|
|
' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
strWert = Replace(strWert, ",", ".")
|
|
|
|
dblVerhaeltnisQ3Q1 = Val(strWert)
|
|
m_dblRatio = dblVerhaeltnisQ3Q1
|
|
|
|
strWert = objVakoCode.GetWert("Qn")
|
|
' aus dem Bestellcode kommt dieser Wert mit einem Komma -> in . umwandeln
|
|
strWert = Replace(strWert, ",", ".")
|
|
dblNenndurchfluss = Val(strWert)
|
|
|
|
If dblVerhaeltnisQ3Q1 = 0 Or dblNenndurchfluss = 0 Then
|
|
DebugMsg "Die MID Prüfpunkte konnten nicht aus dem VakoCode '" & objVakoCode.VakoCode & "' ermittelt werden."
|
|
CreateMIDPruefpunkteFromVakoCodeForPST = False
|
|
Exit Function
|
|
End If
|
|
|
|
m_bPruefung_nach_MID = True
|
|
|
|
' Hier sind Nenndurchfluss und Verhältniss Q3/Q1 über den Bestellcode definiert
|
|
Set m_colPP = New CPruefpunktCol
|
|
|
|
Dim Pruefpunkt As CPruefpunkt
|
|
|
|
' Prüfpunkte des Kaltwasserzählers
|
|
'''''''''''''''''''''''''''''
|
|
' wird nach OIML R49-1 (2006) nicht geprüft (nur bei Zulassungsprüfungen)
|
|
' Q4 = 1.25 * QN
|
|
'dblDurchflussQ = dblNennDurchfluss * 1.25
|
|
'Debug.Print "Q4 = " & dblNennDurchfluss & " {Qn} * " & 1.25 & " {Const} = " & dblDurchflussQ
|
|
|
|
'''''''''''''''''''''''''''''
|
|
' Q3
|
|
'
|
|
'''''''''''''''''''''''''''''
|
|
dblDurchflussQ = dblNenndurchfluss
|
|
Debug.Print "Q3 = Qn = " & dblNenndurchfluss
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setFGo FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNenndurchfluss)
|
|
Pruefpunkt.setFGu -FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNenndurchfluss)
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
Pruefpunkt.SetTime getTimeForPP(dblNenndurchfluss, dblDurchflussQ)
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
Set m_Qp = Pruefpunkt
|
|
|
|
|
|
' Q2 = Q1 / 10
|
|
dblDurchflussQ = dblNenndurchfluss / 10
|
|
Debug.Print "Q2 = " & dblNenndurchfluss & " {Qp} / 10 = " & dblDurchflussQ
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setFGo FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNenndurchfluss)
|
|
Pruefpunkt.setFGu -FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNenndurchfluss)
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
Pruefpunkt.SetTime getTimeForPP(dblNenndurchfluss, dblDurchflussQ)
|
|
m_colPP.Add Pruefpunkt
|
|
|
|
|
|
'''''''''''''''''''''''''''''
|
|
' Q1 = Qn / VQ3Q1
|
|
dblDurchflussQ = Round(dblNenndurchfluss / dblVerhaeltnisQ3Q1, 3)
|
|
Debug.Print "Q1 = " & dblNenndurchfluss & " {Qp} / " & dblVerhaeltnisQ3Q1 & " {Ratio} = " & dblDurchflussQ
|
|
Set Pruefpunkt = New CPruefpunkt
|
|
Pruefpunkt.setFGo FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNenndurchfluss)
|
|
Pruefpunkt.setFGu -FehlerRahmenTrompete(intPruefklasse, dblDurchflussQ, dblNenndurchfluss)
|
|
Pruefpunkt.setQ Round(dblDurchflussQ, 3)
|
|
Pruefpunkt.SetTime getTimeForPP(dblNenndurchfluss, dblDurchflussQ)
|
|
m_colPP.Add Pruefpunkt
|
|
Set m_Qi = Pruefpunkt
|
|
|
|
|
|
Select Case objVakoCode.GetWert("Nennweite")
|
|
Case 50, 65, 100
|
|
m_colPP.getCollection.Item(1).setFGo 1.5
|
|
m_colPP.getCollection.Item(1).setFGu -1.5
|
|
|
|
m_colPP.getCollection.Item(2).setFGo 1.5
|
|
m_colPP.getCollection.Item(2).setFGu -1.5
|
|
|
|
m_colPP.getCollection.Item(3).setFGo 1
|
|
m_colPP.getCollection.Item(3).setFGu -1
|
|
Case 80
|
|
m_colPP.getCollection.Item(1).setFGo 1.5
|
|
m_colPP.getCollection.Item(1).setFGu -1.5
|
|
|
|
m_colPP.getCollection.Item(2).setFGo 1.5
|
|
m_colPP.getCollection.Item(2).setFGu -1.5
|
|
|
|
m_colPP.getCollection.Item(3).setFGo 1.5
|
|
m_colPP.getCollection.Item(3).setFGu -1.5
|
|
Case Else
|
|
|
|
End Select
|
|
|
|
|
|
''''' If objVakoCode.GetWert("Nennweite") = 65 Then
|
|
''''' Auf Wunsch von J.Lippold 06.08.2013: Fehlerrahmen anpassen / Bei DN65 bitte über alle 3 PrüfPunkte auf ±1% einschränken
|
|
''''' m_colPP.getCollection.Item(1).setFGo 1
|
|
''''' m_colPP.getCollection.Item(1).setFGu -1
|
|
''''' m_colPP.getCollection.Item(2).setFGo 1
|
|
''''' m_colPP.getCollection.Item(2).setFGu -1
|
|
''''' m_colPP.getCollection.Item(3).setFGo 1
|
|
''''' m_colPP.getCollection.Item(3).setFGu -1
|
|
''''' End If
|
|
|
|
CreateMIDPruefpunkteFromVakoCodeForPST = True
|
|
g_bln_Pruefung_nach_MID = True
|
|
End Function
|
|
|
|
|
|
|
|
|
|
|
|
Private Function getTimeForPP(Qp As Double, QSoll As Double) As Long ' in sec
|
|
Select Case Qp
|
|
Case 15
|
|
Select Case QSoll
|
|
Case 15
|
|
getTimeForPP = 120
|
|
Case 1.5
|
|
getTimeForPP = 600
|
|
Case 0.15
|
|
getTimeForPP = 920
|
|
End Select
|
|
Case 25
|
|
Select Case QSoll
|
|
Case 25
|
|
getTimeForPP = 120
|
|
Case 2.5
|
|
getTimeForPP = 600
|
|
Case 0.25
|
|
getTimeForPP = 920
|
|
End Select
|
|
Case 40
|
|
Select Case QSoll
|
|
Case 40
|
|
getTimeForPP = 120
|
|
Case 4
|
|
getTimeForPP = 420
|
|
Case 0.4
|
|
getTimeForPP = 720
|
|
End Select
|
|
Case 60
|
|
Select Case QSoll
|
|
Case 60
|
|
getTimeForPP = 80
|
|
Case 6
|
|
getTimeForPP = 420
|
|
Case 0.6
|
|
getTimeForPP = 540
|
|
End Select
|
|
End Select
|
|
|
|
' If getTimeForPP * QSoll / 3.6 > g_dblVolumenGrosserBehaelter Then
|
|
' getTimeForPP = g_dblVolumenGrosserBehaelter * 3.6 / QSoll
|
|
' 'MsgBox "Die Prüfzeit für Qsoll=" & QSoll & " wird auf " & getTimeForPP & "s gesenkt, damit das Prüf-Volumen nicht das Behältervlumen übersteigt."
|
|
' End If
|
|
End Function
|
|
|
|
Public Function GetQp() As CPruefpunkt
|
|
Set GetQp = m_Qp
|
|
End Function
|
|
|
|
Public Function GetQi() As CPruefpunkt
|
|
Set GetQi = m_Qi
|
|
End Function
|
|
|