Suche Newton Design Programm

Ohne Korrektor:
Function Calc_Illum3( _
  ByVal HSD#, ByVal F#, ByVal FSD#, ByVal DFB#, _
  ByVal RBO#, ByVal TID#, ByVal DFSTO#, ByVal OAZD#, ByVal DFO#) As Double
'HSD = Hauptspiegeldurchmesser
'F = Brennweite
'FSD = Fangspiegeldurchmesser
'DFB = Distanz Brennebene Fangspiegel
'RBO = Radius des Bildortes (Ort für den die Ausleuchtung ermittelt wird)
'TID = Tubus-Innendurchmesser
'DFSTO = Distanz der Fangspiegelmitte zur Tubusöffnung
'OAZD = Okularauszug Durchlass (Nennmaß)
'DFO = Distanz Oukulausug-Lichteintritt bis Brennebene

'Zu Berechnen ist für jede Blende die Schnittfläche zweier sich
'überschneidender Kreise mit den Radien RA (Fangspiegel) und RB
'(Lichtkegel am Ort des Fangspiegels), bei denen durch den Hauptspiegel-
'mittelpunkt verlaufende Strahlen in der Brennebene eine Verschiebung
'von C gegeneinander besitzen.

'Zunächst Berechnung der Winkel zwischen der Verbindungslinie
'der Kreismittelpunkte und den Kreisschnittpunkten unter Anwendung
'des Kosinussatzes
Dim A# 'Radius der Blende (Fangspiegel)
Dim B# 'Radius des Lichtkegels am Ort der Blende (Fangspiegel)
Dim C# 'Verschiebung am Ort der Blende (Fangspiegel)

Dim Alpha# 'Winkel zwischen Linien Mitte Fsp und Mitte Lichtkegel sowie -Mitte FSp und Schnittpunkt der Kreise
Dim Beta#
Dim Fl#
Const PI = 3.1415927

Dim illum#

A = FSD * 0.5  'Blende
B = HSD / F * DFB * 0.5  'Lichtbündel
C = Abs(RBO / F * (F - DFB))

If C > A + B Then
  'Der Lichtkegel trifft den Fangspiegel nicht
  illum = 0
ElseIf C < Abs(A - B) Then
  'Lichtkegel und Fangspiegel überdecken sich maximal
  If A >= B Then
    'Fangspiegeldurchmesser >= Lichtkegeldurchmesser
    illum = 1
  Else
    'Lichtkegel >= Fangspiegeldurchmesser
    illum = (A * A) / (B * B)
  End If
Else
  'Nach Kosinussatz:
  Alpha = WorksheetFunction.Acos((B * B + C * C - A * A) / (2 * B * C))
  Beta = WorksheetFunction.Acos((A * A + C * C - B * B) / (2 * A * C))
  'Debug.Print A, B, C, Alpha + 180 / PI, Beta * 180 / PI, Abs(B * Sin(Alpha))

  'Die Fläche ermittelt sich aus der Summe der von Mittel- und
  'Schnittpunkten aufgespannten Kreissegmentflächen abzüglich
  'des durch die Punkte aufgespannten Vierecks
  Fl = (B * B * Alpha) + (A * A * Beta) - Abs(C * B * Sin(Alpha))
  illum = Fl / (B * B * PI)
End If

Dim illum_OAZ#
'Vignettierung durch das OAZ-Auszugsrohr einbeziehen
'(Der Lichtkegel wird von der gegenüberliegenden Seite beschnitten!
'=> Lichtverluste addieren sich
A = OAZD * 0.5  'Blende
B = HSD / F * DFO * 0.5  'Lichtbündel
C = Abs(RBO / F * (F - DFO))

If C > A + B Then
  'Der vom Hauptspiegel zurückverfolgte Lichtkegel geht komplett an der OAZ-Öffnung vorbei
  illum_OAZ = 0
ElseIf C < Abs(A - B) Then
  'Lichtkegel und OAZ-Öffnung überdecken sich maximal
  If A >= B Then
    'OAZ-Öffnung >= Lichtkegeldurchmesser
    illum_OAZ = 1
  Else
    'Lichtkegel >= Tubusöffnung
    illum_OAZ = (A * A) / (B * B)
  End If
Else
  'Nach Kosinussatz:
  Alpha = WorksheetFunction.Acos((B * B + C * C - A * A) / (2 * B * C))
  Beta = WorksheetFunction.Acos((A * A + C * C - B * B) / (2 * A * C))
  'Debug.Print A, B, C, Alpha + 180 / PI, Beta * 180 / PI, Abs(B * Sin(Alpha))

  'Die Fläche ermittelt sich aus der Summe der von Mittel- und
  'Schnittpunkten aufgespannten Kreissegmentflächen abzüglich
  'des durch die Punkte aufgespannten Vierecks
  Fl = (B * B * Alpha) + (A * A * Beta) - Abs(C * B * Sin(Alpha))
  illum_OAZ = Fl / (B * B * PI)
End If

Dim Illum_TO#
'Vignettierung durch die Tubusöffnung einbeziehen
'(Der Lichtkegel wird von der gegenüberliegenden Seite beschnitten!
'=> Lichtverluste addieren sich
A = TID * 0.5  'Blende
B = HSD * 0.5  'Lichtbündel
C = Abs(RBO / F * (F - DFB + DFSTO))

If C > A + B Then
  'Der vom Hauptspiegel zurückverfolgte Lichtkegel geht komplett an der Tubusöffnung vorbei
  Illum_TO = 0
ElseIf C < Abs(A - B) Then
  'Lichtkegel und Tubusöffnung überdecken sich maximal
  If A >= B Then
    'Tubusöffnung >= Lichtkegeldurchmesser
    Illum_TO = 1
  Else
    'Lichtkegel >= Tubusöffnung
    Illum_TO = (A * A) / (B * B)
  End If
Else
  'Nach Kosinussatz:
  Alpha = WorksheetFunction.Acos((B * B + C * C - A * A) / (2 * B * C))
  Beta = WorksheetFunction.Acos((A * A + C * C - B * B) / (2 * A * C))
  'Debug.Print A, B, C, Alpha + 180 / PI, Beta * 180 / PI, Abs(B * Sin(Alpha))

  'Die Fläche ermittelt sich aus der Summe der von Mittel- und
  'Schnittpunkten aufgespannten Kreissegmentflächen abzüglich
  'des durch die Punkte aufgespannten Vierecks
  Fl = (B * B * Alpha) + (A * A * Beta) - Abs(C * B * Sin(Alpha))
  Illum_TO = Fl / (B * B * PI)
End If

If illum_OAZ > illum Then
  Calc_Illum3 = (illum + Illum_TO - 1) * 100  '%
Else
  Calc_Illum3 = (illum_OAZ + Illum_TO - 1) * 100
End If

End Function


und mit Korrektor

Function Calc_Illum4K( _
  ByVal HSD#, ByVal F#, ByVal FSD#, ByVal DFB#, _
  ByVal RBO#, ByVal TID#, ByVal DFSTO#, ByVal OAZD#, ByVal DFO#, _
  ByVal VF#, ByVal EP#, ByVal EPBF#) As Double
  
'Berechnung der Ausleuchtung mit Einfluss des aktuell ausgewählten Korrektors.
'Die Berechnung erfolgt nach Umrechnung des Bildortes entsprechend den
'Korrektor-Daten für Korrektor Eintrittspupille und Bildebene.
'Der kleinere der ermittelten Werte ist maßgeblich.
  
  Dim illum#
  Dim illumK#
  'Dim VF#, EP#, EPBF#
  
  'Verlängerungsfaktor: VF = Range("KorrVF").Value
  'Eintrittspupille des Korrektors:  EP = Range("KorrEp").Value
  'Lage der Eintrittspupille vor Originalfokus:   EPBF = Range("KorrEpBf").Value
  
  illum = Calc_Illum3(HSD, F, FSD, DFB, RBO / VF, TID, DFSTO, OAZD, DFO)
  If EP > 0.0001 Then
    illumK = Calc_Illum3(HSD, F, EP, EPBF, RBO / VF, TID, DFSTO, OAZD, DFO)
    
    If illum > illumK Then
      Calc_Illum4K = illumK
    Else
      Calc_Illum4K = illum
    End If
  Else
    Calc_Illum4K = illum
  End If
  
End Function