4
$\begingroup$

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]]

green line is the comb

3D curve

$\endgroup$
  • $\begingroup$ 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? $\endgroup$ – Dunlop Nov 2 '16 at 21:16
  • $\begingroup$ 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". $\endgroup$ – BayWilson Nov 3 '16 at 16:43
5
$\begingroup$

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]}}]]

enter image description here

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}]

enter image description here

| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks for your respond. Actually I just need the "comb" line from surface to normal of the surface. No derived surface needed. $\endgroup$ – BayWilson Nov 3 '16 at 16:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.