vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Zippen wie die Profis!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
Rubrik: Variablen/Strings · Algorithmen/Mathematik   |   VB-Versionen: VB5, VB622.12.06
E-Normwert nach DIN IEC 60063 bestimmen

Berechnung von Werten passiver Bauelemente nach den E-Normreihen

Autor:   Thomas GollmerBewertung:     [ Jetzt bewerten ]Views:  7.055 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Neue Version! sevEingabe 3.0 (für VB6 und VBA)
Das Eingabe-Control der Superlative! Noch besser und noch leistungsfähiger!
Jetzt zum Einführungspreis       - Aktionspreis nur für kurze Zeit gültig -

Wenn man hin und wieder passive Bauteile, wie Widerstände, Kondensatoren und Spulen berechnet, kommt man meist in Kontakt mit den nach DIN genormten E-Reihen.
Passive Bauteile werden nicht in allen möglichen und unmöglichen Werten und Abstufungen, sondern eben nach diesen Normreihen hergestellt.
Die Normreihen (die da sind E3, E6, E12, E24, E48, E69 und E192) lassen sich anhand einer Formel errechnen.

Mit dem angefügten Modul werden nun diese Normreihen generiert und die Hauptfunktion gibt einen Wert aus dieser Reihe zurück, der dem Übergabewert am nächsten kommt.
Dies ist hilfreich wenn man nach Formeln einen Bauteilwert errechnet und dann den nächstgelegenen Wert wissen will, um den dann tatsächlich einsetzbaren Bauteilwert zu erhalten.... oder ihn in seiner Bastelkiste zu suchen

Fügen Sie folgenden Code in einem Modul:

Option Explicit
 
' Die genormten E-Reihen
Public Enum E_Typen
  E3 = 3
  E6 = 6
  E12 = 12
  E24 = 24
  E48 = 48
  E96 = 96
  E192 = 192
End Enum
 
' Die Grundeinheiten
' Wenn das Ausgabecontrol, auf denen die Werte ausgegeben werden, 
' auf eine Unicode-Schriftart gesetzt ist und Griechisch als Script 
' gewählt wurde, kann auch das Omega angezeigt werden.
' Beim Aufruf der Function "E-Wert_finden" wird je nach Wahl der 
' Einheit das Wort "Ohm" oder das Zeichen Omega zurückgegeben.
Public Enum B_Einheiten
  Farad = 1
  Henry = 2
  Omega = 3
  Ohm = 4
End Enum
 
' Für die Rückgabe der Bauteildaten
Public Type Bauteil
  dblWert As Double
  strWert As String
  eTol As String
End Type
Public Function E_Wert_finden( _
  ByVal Reihe As E_Typen, _
  ByVal WertInGrundeinheit As Double, _
  ByRef Einheit As B_Einheiten) As Bauteil
 
  ' Übergabeparameter
  ' 1. die E-Reihe, in welcher der nächstgelegene Wert gefunden 
  '    werden soll
  ' 2. Der Übergabewert in Ohm, Henry oder Farad
  ' 3. Die Maßeinheit (Ohm, Henry, Farad)
  '
  ' Zurückgegeben wird ein Variablentype mit ...
  ' - dem gefundenen nächstgelegenem E-Normwert in der 
  '   Grundeinheit (Ohm, Henry, Farad)
  ' - dem Rückgabewert als String mit passendem Suffix 
  '   und dem Einheitenzeichen
  ' - die Toleranzklasse der E-Normreihe
 
  Dim E() As Double
  Dim tmp As Integer
  Dim Counter As Integer
  Dim Found1 As Integer
  Dim Found2 As Integer
  Dim Abstand1 As Double
  Dim Abstand2 As Double
  Dim Faktor As Double
  Dim RetVal As Double
  Dim Toleranz As String
  Dim Suffix As String
 
  If WertInGrundeinheit <= 0 Then Exit Function
  On Error GoTo Fehler
 
  ' Wertefeld initialisieren, welches die 
  ' E-Normwerte beinnhaltet
  tmp = Reihe
  ReDim E(0 To tmp)
  E(UBound(E())) = 1000
  For Counter = 0 To tmp - 1
    If tmp >= 48 Then
      E(Counter) = (Round((10 ^ (Counter / tmp)), 2)) * 100
    Else
      E(Counter) = Round(((Round((10 ^ (Counter / tmp)), 2)) * 10), 0) * 10
      ' Nach der Formel errechnete Werte zwischen 260 und 460
      ' entsprechen nicht der DIN-Norm
      If E(Counter) >= 260 And E(Counter) <= 460 Then 
        E(Counter) = E(Counter) + 10
      End If
    End If
  Next
 
  ' Toleranz der E-Reihen:
  Select Case tmp
    Case 3: Toleranz = ">20%"
    Case 6: Toleranz = "20%"
    Case 12: Toleranz = "10%"
    Case 24: Toleranz = "5%"
    Case 48: Toleranz = "2%"
    Case 96: Toleranz = "1%"
    Case 192: Toleranz = "0,5%"
  End Select
 
  ' Eingabewert umformatieren
  Faktor = 1
  If WertInGrundeinheit >= 1000 Then
    Do Until WertInGrundeinheit < 1000
      WertInGrundeinheit = WertInGrundeinheit / 10
      Faktor = Faktor * 10
    Loop
  ElseIf WertInGrundeinheit < 100 Then
    Do Until WertInGrundeinheit >= 100
      WertInGrundeinheit = WertInGrundeinheit * 10
      Faktor = Faktor / 10
    Loop
  End If
 
  ' Variablenfeld absuchen nach den nächstgelegenen 2 Werten
  For Counter = 0 To UBound(E())
    Abstand1 = WertInGrundeinheit - E(Counter)
    If Abstand1 <= 0 Then Found1 = Counter: Exit For
  Next
  If Counter > 0 Then
    Abstand2 = WertInGrundeinheit - E(Counter - 1)
    Found2 = Counter - 1
  End If
 
  ' Auswerten welcher Wert am nächsten ist
  Abstand1 = Abs(Abstand1)
  Abstand2 = Abs(Abstand2)
  If Abstand1 = Abstand2 Or Abstand1 < Abstand2 Then
    RetVal = E(Found1)
  Else
    RetVal = E(Found2)
  End If
 
  ' Wert mit Faktor multiplizieren und in die 
  ' Rückgabewerte auffüllen
  RetVal = RetVal * Faktor
  E_Wert_finden.dblWert = RetVal
  E_Wert_finden.eTol = Toleranz
 
  ' Maßeinheit und Suffix anhängen
  Select Case Einheit
    Case 1: Suffix = "F"
    Case 2: Suffix = "H"
    Case 3: Suffix = ChrW(217)
    Case 4: Suffix = "Ohm"
  End Select
  E_Wert_finden.strWert = FormatEinheit(RetVal) & Suffix
  Exit Function
 
Fehler:
  MsgBox "Fehler Nr: " & Err.Number, vbCritical
End Function
Public Function FormatEinheit(Wert As Double) As String
  ' Hier wird ein Widerstandswert, Spulenwert.. in der 
  ' Grundform übergeben
  ' Zurückgeliefert wird ein Stirng mit dem Suffx und dem 
  ' formatierten Wert
  Dim RetVal As Double
  Dim Suffix As String
 
  RetVal = Wert
  If RetVal >= 10 ^ 12 Then
    RetVal = RetVal / 10 ^ 12
    Suffix = "T"
   ElseIf RetVal >= 10 ^ 9 Then
    RetVal = RetVal / 10 ^ 9
    Suffix = "G"
   ElseIf RetVal >= 10 ^ 6 Then
    RetVal = RetVal / 10 ^ 6
    Suffix = "M"
   ElseIf RetVal >= 10 ^ 3 Then
    RetVal = RetVal / 10 ^ 3
    Suffix = "k"
   ElseIf RetVal < 10 ^ -9 Then
    RetVal = RetVal * 10 ^ 12
    Suffix = "p"
   ElseIf RetVal < 10 ^ -6 Then
    RetVal = RetVal * 10 ^ 9
    Suffix = "n"
   ElseIf RetVal < 10 ^ -3 Then
    RetVal = RetVal * 10 ^ 6
    Suffix = "µ"
   ElseIf RetVal < 1 Then
    RetVal = RetVal * 10 ^ 3
    Suffix = "m"
  End If
  Suffix = Format$(RetVal, "0.00") & " " & Suffix
  FormatEinheit = Suffix
End Function

Nun ein praktischer Anwendungsfall.
Erstellen sie auf einer Form folgende neue Steuerelemente:

  • 2 Listboxen (List1 und List2)
  • 1 Textbox (Text1) mit Multiline = True und Scrollbars = Vertikal
Fügen Sie folgenden Code ein, mit welchem Sie den Vorwiderstand einer LED bei einer bestimmten Versorgungsspannung errechnen können.

Option Explicit
 
Private Sub Form_Load()
  Dim Counter As Integer
 
  ' Steuerelemente initialisieren
  Me.Caption = "LED Vorwiderstand berechnen"
 
  ' Textbox auf Griechisch setzten...
  ' dann können zwar keine Umlaute mehr angezeigt 
  ' werden, aber das Omega
  Text1.Font = "Arial Unicode"
  Text1.Font.Charset = 161
  Text1.FontBold = True
  Text1.FontSize = 12
 
  For Counter = 10 To 50 Step 5
    List1.AddItem "LED = 2,2 Volt - " & CStr(Counter) & " mA"
    List1.AddItem "LED = 3,4 Volt - " & CStr(Counter) & " mA"
  Next
  For Counter = 5 To 20
    List2.AddItem "U-Versorgung = " & CStr(Counter) & " Volt"
  Next
 
  List1.Selected(0) = True
  List2.Selected(0) = True
End Sub
Private Sub List1_Click()
  ' Click auf die Liste = Vorwiderstand berechnen
  r_berechnen
End Sub
Private Sub List2_Click()
  ' Click auf die Liste = Vorwiderstand berechnen
  r_berechnen
End Sub
Private Sub r_berechnen()
  ' Vorwiderstand für LED bei der gewählten 
  ' Veersorgungsspannung berechnen
  Dim E_Count As Integer
  Dim R_genau As Double
  Dim Uled As Double
  Dim Uein As Double
  Dim Iled As Double
  Dim ausStr As String
  Dim einStr As String
  Dim R_EReihe As Bauteil
  Dim Last As Double
 
  If List1.Text = "" Or List2.Text = "" Then Exit Sub
 
  ' Eingabewerte lesen
  einStr = List1.List(List1.ListIndex)
  Uled = CDbl(Mid$(einStr, 7, 3))
  Iled = CDbl(Mid$(einStr, 18, 2))
  einStr = List2.List(List2.ListIndex)
  Uein = CDbl(Mid$(einStr, 16, 2))
 
  ' Vorwiderstand für die LED genau berechnen
  R_genau = (Uein - Uled) / Iled * 1000
  ausStr = "Vorwiderstand genau: " & Format(R_genau, "0.0") & _
    " " & ChrW(217) & vbCrLf & vbCrLf
 
  ' Alle E-Reihen durchlaufen
  E_Count = 3
  Do While E_Count <= 192
    ' Nächstgelegenen Wert finden
    R_EReihe = E_Wert_finden(E_Count, R_genau, Omega)
    ' Tatsächlichen Durchflußstrom für die LED berechnen
    Iled = ((Uein - Uled) / R_EReihe.dblWert) * 1000
    ' Belastung Widerstand berechnen
    Last = (Uein - Uled) * Iled / 10
    ' Ausgabedaten zusammenfassen
    ausStr = ausStr & "Bester Wert der E" & CStr(E_Count) & "-Reihe:" & vbCrLf & _
      R_EReihe.strWert & vbCrLf & "Toleranzklasse Widerstand:" & vbCrLf & _
      R_EReihe.eTol & vbCrLf & "Damit I-LED:" & vbCrLf & Format$(Iled, "0.00") & _
      " mA" & vbCrLf & "Belastung Widerstand" & vbCrLf & Format$(Last, "0.00") & _
      "mW" & vbCrLf & vbCrLf
    E_Count = E_Count * 2
  Loop
  ' Daten ausgeben
  Text1.Text = ausStr
End Sub

Dieser Tipp wurde bereits 7.055 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2017 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel