Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Smooth Line on XY chart

170 views
Skip to first unread message

Lori Miller

unread,
Jan 14, 2009, 6:01:00 PM1/14/09
to
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

0 new messages