L
Lori Miller
For anyone that's interested i've got a simple function that returns values
along a "smoothed line" on an XY chart. In tests this agrees to the nearest
pixel at all scales. This fixes several issues with and simplifies a
procedure by Brian Murphy.
eg =ChartCurve(1.5)
ctrl+shift+entered in two cells returns coordinates between the first two
points of the first series of the first chart on the sheet. Recalculate after
a change.
Since the curve is easy to plot, this should be useful for estimation. You
can use goal seek to find a y value given an x value but maybe someone could
add a procedure to automate this?
____________________
Function ChartCurve(Position As Double, Optional Series, Optional ChartObj)
'Returns x,y values at a given position along a smoothed chart line
Dim Chrt As Chart, ChrtS As Series, A As Variant, i As Integer, _
s As Double, t As Double, l(1) As Double, p(1, 3) As Double, _
d(1, 2) As Double, u(2) As Double, q(1) As Double, z As Double
Application.Volatile
Set Chrt = Application.Caller.Worksheet _
.ChartObjects(IIf(IsMissing(ChartObj), 1, ChartObj)).Chart
Set ChrtS = Chrt.SeriesCollection(IIf(IsMissing(Series), 1, Series))
l(0) = (Chrt.Axes(xlCategory).MaximumScale - _
Chrt.Axes(xlCategory).MinimumScale) / Chrt.PlotArea.InsideWidth
l(1) = (Chrt.Axes(xlValue).MaximumScale - _
Chrt.Axes(xlValue).MinimumScale) / Chrt.PlotArea.InsideHeight
A = Array(ChrtS.XValues, ChrtS.Values)
n = UBound(A(0)) - 2
s = Int(Position) + (Position = n + 1)
t = Position - s
For i = 0 To 1
p(i, 1) = A(i)(s + 1)
p(i, 2) = A(i)(s + 2)
p(i, 0) = A(i)(s - (s = 0)) - (s = 0) * (p(i, 1) - p(i, 2))
p(i, 3) = A(i)(s + 3 + (s = n)) + (s = n) * (p(i, 1) - p(i, 2))
d(i, 0) = (p(i, 2) - p(i, 1)) / l(i)
d(i, 1) = (p(i, 2) - p(i, 0)) / l(i) / 3
d(i, 2) = (p(i, 3) - p(i, 1)) / l(i) / 3
Next i
For i = 0 To 2
u(i) = d(0, i) ^ 2 + d(1, i) ^ 2
Next i
z = (u(0) / WorksheetFunction.Max(u)) ^ 0.5 / 2
For i = 0 To 1
q(i) = t ^ 2 * (3 - 2 * t) * p(i, 2) + _
(1 - t) ^ 2 * (1 + 2 * t) * p(i, 1) + _
z * t * (1 - t) * (t * (p(i, 1) - p(i, 3)) + _
(1 - t) * (p(i, 2) - p(i, 0)))
Next i
ChartCurve = q
End Function
along a "smoothed line" on an XY chart. In tests this agrees to the nearest
pixel at all scales. This fixes several issues with and simplifies a
procedure by Brian Murphy.
eg =ChartCurve(1.5)
ctrl+shift+entered in two cells returns coordinates between the first two
points of the first series of the first chart on the sheet. Recalculate after
a change.
Since the curve is easy to plot, this should be useful for estimation. You
can use goal seek to find a y value given an x value but maybe someone could
add a procedure to automate this?
____________________
Function ChartCurve(Position As Double, Optional Series, Optional ChartObj)
'Returns x,y values at a given position along a smoothed chart line
Dim Chrt As Chart, ChrtS As Series, A As Variant, i As Integer, _
s As Double, t As Double, l(1) As Double, p(1, 3) As Double, _
d(1, 2) As Double, u(2) As Double, q(1) As Double, z As Double
Application.Volatile
Set Chrt = Application.Caller.Worksheet _
.ChartObjects(IIf(IsMissing(ChartObj), 1, ChartObj)).Chart
Set ChrtS = Chrt.SeriesCollection(IIf(IsMissing(Series), 1, Series))
l(0) = (Chrt.Axes(xlCategory).MaximumScale - _
Chrt.Axes(xlCategory).MinimumScale) / Chrt.PlotArea.InsideWidth
l(1) = (Chrt.Axes(xlValue).MaximumScale - _
Chrt.Axes(xlValue).MinimumScale) / Chrt.PlotArea.InsideHeight
A = Array(ChrtS.XValues, ChrtS.Values)
n = UBound(A(0)) - 2
s = Int(Position) + (Position = n + 1)
t = Position - s
For i = 0 To 1
p(i, 1) = A(i)(s + 1)
p(i, 2) = A(i)(s + 2)
p(i, 0) = A(i)(s - (s = 0)) - (s = 0) * (p(i, 1) - p(i, 2))
p(i, 3) = A(i)(s + 3 + (s = n)) + (s = n) * (p(i, 1) - p(i, 2))
d(i, 0) = (p(i, 2) - p(i, 1)) / l(i)
d(i, 1) = (p(i, 2) - p(i, 0)) / l(i) / 3
d(i, 2) = (p(i, 3) - p(i, 1)) / l(i) / 3
Next i
For i = 0 To 2
u(i) = d(0, i) ^ 2 + d(1, i) ^ 2
Next i
z = (u(0) / WorksheetFunction.Max(u)) ^ 0.5 / 2
For i = 0 To 1
q(i) = t ^ 2 * (3 - 2 * t) * p(i, 2) + _
(1 - t) ^ 2 * (1 + 2 * t) * p(i, 1) + _
z * t * (1 - t) * (t * (p(i, 1) - p(i, 3)) + _
(1 - t) * (p(i, 2) - p(i, 0)))
Next i
ChartCurve = q
End Function