AW: Tangenten an Diagramm per vba erstellen
28.11.2013 17:58:37
Bastian
Hallo Daniel,
der nachfolgende Code berechnet Dir die Geradengleichungen der beiden Tangenten. Ich habe die Ergebnisse am Ende über eine MsgBox ausgegeben. Du kannst damit natürlich auch weiterrechnen, oder sie nutzen, um die Tangenten im Diagramm darzustellen.
Gruß, Bastian
Option Explicit
Sub TangentenGleichungen()
Dim rngBiegemoment As Range 'Zellbereich Biegemoment
Dim rngBiegewinkel As Range 'Zellbereich Biegewinkel
Dim varBiege As Variant 'Matrix Biegemomentenverlauf
Dim varDreh As Variant 'Drehmatrix
Dim varBiegeGedr As Variant 'Gedrehte Matrix Biegemomentenverlauf
Dim varC As Variant 'Gedrehte Matrix Biegemomentenverlauf wird mit _
Vektor (1,0) multipliziert, _
um nur die y-Werte (Biegemoment) zu erhalten _
und den Max-Wert ermitteln zu können
Dim dblMax As Double 'max-Werte im Array varBiegeGedr
Dim intPos As Integer 'Position des max-Wertes im Array varBiegeGedr
Dim dblWinkel As Double 'Winkel aus Steigung der 2. Tangente
Dim y As Double, x As Double 'Berührungspunkt Tangente 2
Dim dblMaxBiegemoment As Double 'max. Biegemoment
Dim dblMaxBiegem10 As Double 'max. Biegemoment * 0,1
Dim dblMaxBiegem40 As Double 'max. Biegemoment * 0,4
Dim lngZeileL10 As Long 'Untere Zeile 10% von max. Biegemoment
Dim lngZeileL40 As Long 'Untere Zeile 40% von max. Biegemoment
Dim dblYL1 As Double, dblXL1 As Double 'Y- und X- Werte für die Interpolation des _
Biegewinkels
Dim dblYU1 As Double, dblXU1 As Double
Dim dblYL4 As Double, dblXL4 As Double
Dim dblYU4 As Double, dblXU4 As Double
Dim dblMaxBiegew10 As Double 'Interpolierter Biegewinkel bei max. Biegemoment * _
0,1
Dim dblMaxBiegew40 As Double 'Interpolierter Biegewinkel bei max. Biegemoment * _
0,4
Dim dblSteigung1 As Double, dblAchsenab1 As Double 'Steigung und Achsenabschnitt Tangente _
1
Dim dblSteigung2 As Double, dblAchsenab2 As Double 'Steigung und Achsenabschnitt Tangente _
2
With ThisWorkbook.Worksheets("Tabelle1")
'Zellbereiche für Biegemoment und Biegewinkel zuweisen
Set rngBiegemoment = .Range(Cells(3, 1), Cells(3, 1).End(xlDown))
Set rngBiegewinkel = .Range(Cells(3, 2), Cells(3, 2).End(xlDown))
'Max Biegemoment
dblMaxBiegemoment = WorksheetFunction.max(rngBiegemoment.Value)
dblMaxBiegem10 = 0.1 * dblMaxBiegemoment
dblMaxBiegem40 = 0.4 * dblMaxBiegemoment
lngZeileL10 = WorksheetFunction.Match(dblMaxBiegem10, rngBiegemoment.Value, 1)
lngZeileL40 = WorksheetFunction.Match(dblMaxBiegem40, rngBiegemoment.Value, 1)
'Hilfswerte für die Interpolation des Biegewinkels
dblYL1 = .Cells(lngZeileL10 + 2, 1).Value
dblXL1 = .Cells(lngZeileL10 + 2, 2).Value
dblYU1 = .Cells(lngZeileL10 + 3, 1).Value
dblXU1 = .Cells(lngZeileL10 + 3, 2).Value
dblYL4 = .Cells(lngZeileL40 + 2, 1).Value
dblXL4 = .Cells(lngZeileL40 + 2, 2).Value
dblYU4 = .Cells(lngZeileL40 + 3, 1).Value
dblXU4 = .Cells(lngZeileL40 + 3, 2).Value
'Lineare Interpolation des Biegewinkels
dblMaxBiegew10 = (dblYU1 - dblYL1) / (dblXU1 - dblXL1) _
* (dblMaxBiegem10 - dblYL1) + dblXL1
dblMaxBiegew40 = (dblYU4 - dblYL4) / (dblXU4 - dblXL4) _
* (dblMaxBiegem40 - dblYL4) + dblXL4
'Steigung und Achsenabschnitt der Geradengleichungen der Tangenten
dblSteigung1 = (dblMaxBiegem40 - dblMaxBiegem10) / (dblMaxBiegew40 - dblMaxBiegew10)
dblAchsenab1 = dblMaxBiegem40 - dblSteigung1 * dblMaxBiegew40
dblSteigung2 = dblSteigung1 / 6
dblWinkel = Atn(dblSteigung2)
varBiege = .Range(Cells(3, 1), Cells(3, 2).End(xlDown))
varDreh = Array(Array(Cos(dblWinkel), Sin(dblWinkel)), Array(-Sin(dblWinkel), Cos( _
dblWinkel)))
varBiegeGedr = WorksheetFunction.MMult(varBiege, varDreh)
varC = Array(Array(1), Array(0))
varBiegeGedr = WorksheetFunction.MMult(varBiegeGedr, varC)
dblMax = WorksheetFunction.max(varBiegeGedr)
For intPos = LBound(varBiegeGedr) To UBound(varBiegeGedr)
If varBiegeGedr(intPos, 1) = dblMax Then Exit For
Next
y = varBiege(intPos, 1)
x = varBiege(intPos, 2)
dblAchsenab2 = y - (x * dblSteigung2)
End With
MsgBox "Steigung Tangente1: " & dblSteigung1 & Chr(13) & _
"Achsenabschnitt Tangente1: " & dblAchsenab1 & Chr(13) & Chr(13) & _
"Steigung Tangente2: " & dblSteigung2 & Chr(13) & _
"Achsenabschnitt Tangente2: " & dblAchsenab2
End Sub