# Plot curvature comb

Does anyone here knows how to create a curvature comb as in the picture but for a 3D curve?

For example if I use the 3D curve as below:

   pts = {{{0, 0, 0}, {0, 1, 0}, {0, 2, 0}, {0, 3, 0}}, {{1, 0, 0}, {1,
1, 1}, {1, 2, 1}, {1, 3, 0}},
{{2, 0, 0}, {2, 1, 1}, {2, 2, 1}, {2, 3, 0}},
{{3, 0, 0}, {3, 1, 0}, {3, 2, 0}, {3, 3, 0}}};
f = BezierFunction[pts]
Show[Graphics3D[{PointSize[Medium], Red, Map[Point, pts]}],
Graphics3D[{Gray, Line[pts], Line[Transpose[pts]]}],
ParametricPlot3D[f[u, v], {u, 0, 1}, {v, 0, 1}, Mesh -> None]]


• Check this link here for an example of how this is done in 2D. Are you asking for a Frenet–Serret frame at each point on your curve? In which case perhaps FrenetSerretSystemmight help? – Dunlop Nov 2 '16 at 21:16
• Yeah, to be exact, I used Frenet-Frame before evaluating the curvature and plot the "comb". I am stuck on how to plot the "comb". – BayWilson Nov 3 '16 at 16:43

## 1 Answer

This is not a "comb" (perhaps "brush") a plot of surface above index surface at normal distance ofcurvature. Using Bezier function f:

r[u_, v_] := f[u, v];
ru[a_, b_] := D[r[u, v], u] /. {u -> a, v -> b}
rv[a_, b_] := D[r[u, v], v] /. {u -> a, v -> b}
n[a_, b_] := With[{un = Cross[ru[a, b], rv[a, b]]}, un/Norm[un]]
ruu[a_, b_] := D[r[u, v], {u, 2}] /. {u -> a, v -> b}
rvv[a_, b_] := D[r[u, v], {v, 2}] /. {u -> a, v -> b}
ruv[a_, b_] := D[r[u, v], u, v] /. {u -> a, v -> b}
ff[a_, b_] := (ru[a, b].ru[a, b]) (
rv[a, b].rv[a, b]) - (ru[a, b].rv[a, b])^2
sf[a_, b_] := (ruu[a, b].n[a, b]) (
rvv[a, b].n[a, b]) - (ruv[a, b].n[a, b])^2
k[a_, b_] := sf[a, b]/ff[a, b]
sur[a_, b_] := r[a, b] + k[a, b] n[a, b]


So,

Show[Graphics3D[{PointSize[0.02], Point[Join @@ pts], Line[pts],
Line[Transpose@pts]}],
ParametricPlot3D[{r[u, v], Evaluate[sur[u, v]]}, {u, 0, 1}, {v, 0,
1}, MeshFunctions -> {#3 &, k[#4, #5] &}, Mesh -> {{0.}},
MeshStyle -> {{Thick, Red}, {Blue, Thick}},
PlotStyle -> {{Yellow, Opacity[0.5]}, {Blue, Opacity[0.2]}}]]


The light blue is the derived surface. The blue mesh line is the line of zero curvature.

The "brush":

brush = Line[{r[#1, #2], sur[#1, #2]}] & @@@
Tuples[Range[0, 1, 0.01], 2];
Show[ParametricPlot3D[r[u, v], {u, 0, 1}, {v, 0, 1}, Mesh -> None],
Graphics3D[brush], PlotRange -> {-1, 1}]


• Thanks for your respond. Actually I just need the "comb" line from surface to normal of the surface. No derived surface needed. – BayWilson Nov 3 '16 at 16:42