Extruding along a path

Question

I'm trying to render a 3D image of a path by extruding a circular cross-section along the path, creating a "snake-like" path.

Here is an image I found to illustrate:

I can't seem to figure out if there is a way to do this?

I just found the Tube command; now I need to find a way to turn a set of points into a Curve. Basically, I need to find the necessary control points for a BezierCurve or a BSpline to fit a set of {x,y} coordinates.

Can the Interpolation with the Spline method be used to generate a spline from a set of points?

Answer 1

In Mathematica 7 or 8, you can just use Tube. Please see the docs for many, many examples.

Example:

Show[ParametricPlot3D[{Cos[x], Sin[x], x/5}, {x, 0, 15}] /. 
  Line -> (Tube[#, 0.2] &), PlotRange -> All]

Answer 2

I see you mentioned splines in your question. Your picture is 3D, but you used 2D {x,y} coordinates in the question. This little example uses a random set of control points and emphasizes the 3D nature of the Tube and {x,y,z} coordinates:

points = RandomReal[1, {20, 3}]; 
Export["tube.gif",
   Table[
      Graphics3D[
         {Orange, Specularity[White, 100], Tube[BSplineCurve[points], .03]},
         Boxed -> False, SphericalRegion -> True,
         ViewAngle -> .25, 
         ViewPoint -> RotationTransform[a, {0, 0, 1}][{3, 0, 3}]], 
      {a, 0, 2 Pi, .1}
   ]]

Answer 3

The disadvantage of using BSplineCurve is that generally speaking, the curve doesn't go through the control points. If you want the curve to be both smooth and go through the test points, you could Interpolation with Method -> "Spline" instead. For example

pts = RandomReal[1, {30, 3}];
interp = Interpolation[MapIndexed[{#2[[1]], #1} &, pts], Method -> "Spline"]

You could then use Szabolcs's method to plot interp and replace the line with a tube:

pl = ParametricPlot3D[interp[x], {x, 1, Length[pts]}, 
  PlotPoints -> 2 Length[pts],
  PlotStyle -> Green, PlotRange -> All] /. {Line[a_] :> Tube[a, .05]}

To show that the control points actually lie on the curve:

Show[pl, Graphics3D[{White, Sphere[#, .08] & /@ pts}]]

With BSplineCurve you would get

Graphics3D[{{Darker[Blue], Tube[BSplineCurve[pts], .05]}, {White, 
   Sphere[#, .08] & /@ pts}}]

Answer 4

This question has been nicely addressed by the previous answers, so I'll just write about a method you can use if you want your tube to have custom cross-sections; or, like in this question, you need to have the tube as a bunch of Polygon[]s.

orthogonalDirections[{p1_?VectorQ, p2_?VectorQ, p3_?VectorQ}] := 
 With[{d = If[Abs[#1.#2] == 1, If[Abs[#1[[3]]] < 1,
         {-#1[[2]], #1[[1]], 0}, {0, #1[[3]], -#1[[2]]}], (#1 + #2)/2]}, 
      Normalize /@ {d, Cross[#1, d]}] &[Normalize[p3 - p2], Normalize[p1 - p2]]

orthogonalDirections[{p1_?VectorQ, p2_?VectorQ}] := Module[{no, ta, v1, v2, yk, zk},
  ta = Normalize[p1 - p2]; v1 = ta - p2;
  {yk, zk} = Rest[Range[3][[Ordering[Abs[v1]]]]];
  v2 = ReplacePart[{0, 0, 0}, {yk -> v1[[zk]], zk -> -v1[[yk]]}];
  v1 = p2 + Cross[v1, v2]; no = Normalize[v1 - (v1.ta) ta];
  {no, Cross[no, ta]}]

extend[p_, q_, d_, {x_, y_}] := p + d First[LinearSolve[Transpose[{d, -x, -y}], q - p]]

(* for custom cross-sections *)
crossSection[pointList_?MatrixQ, r_, csList_?MatrixQ] := Module[{bi, no, p1, p2},
   {p1, p2} = Take[pointList, 2]; {no, bi} = orthogonalDirections[{p2, p1}];
   (p1 + r #.{no, bi}) & /@ csList] /; 
  Last[Dimensions[pointList]] == 3 && Last[Dimensions[csList]] == 2

(* for circular cross-sections *)
crossSection[pointList_?MatrixQ, r_, n_Integer] := 
 crossSection[pointList, r, Composition[Through, {Cos, Sin}] /@ Range[0, 2 Pi, 2 Pi/n]]

(* approximate vertex normals, for a smooth appearance *)
vertNormals[vl_List] := Module[{mdu, mdv, msh},
   msh = Composition[
             Join[{{3, -3, 1}.Take[#, 3]}, #, {{1, -3, 3}.Take[#, -3]}] &, 
             Join[Transpose[{Take[#, All, 3].{3, -3, 1}}], #,
                  Transpose[{Take[#, All, -3].{1, -3, 3}}], 2] &] /@ 
         Transpose[vl, {2, 3, 1}];
   mdu = ListCorrelate[{{1, 0, -1}}/2, #, {{-2, 1}, {2, -1}}, 0] & /@ msh;
   mdv = ListCorrelate[{{-1}, {0}, {1}}/2, #, {{1, -2}, {-1, 2}}, 0] & /@ msh;
   MapThread[Composition[Normalize, Cross],
             Transpose[#, {3, 1, 2}] & /@ {mdu, mdv}, 2]] /; ArrayDepth[vl] == 3

MakePolygons[vl_List, OptionsPattern[{"Normals" -> True}]] :=
 Module[{dims = Most[Dimensions[vl]], gc}, 
   gc = GraphicsComplex[Apply[Join, vl], 
     Polygon[Flatten[Apply[Join[Reverse[#1], #2] &, 
        Transpose /@ Partition[Partition[#, 2, 1] & /@ 
           Partition[Range[Times @@ dims], Last[dims]], 2, 1], {2}], 
       1]]];
   If[TrueQ[OptionValue["Normals"]], 
      Append[gc, VertexNormals -> Apply[Join, vertNormals[vl]]], gc]] /;
   ArrayDepth[vl] == 3

Options[TubePolygons] = {"Normals" -> True, "Scale" -> 1.};

TubePolygons[path_?MatrixQ, cs : (_Integer | _?MatrixQ), OptionsPattern[]] := 
 MakePolygons[FoldList[
      Function[{p, t}, With[{o = orthogonalDirections[t]},
               extend[#, t[[2]], t[[2]] - t[[1]], o] & /@ p]], 
      crossSection[path, OptionValue["Scale"], cs], 
      Partition[path, 3, 1, {1, 2}, {}]], "Normals" -> OptionValue["Normals"]]

Try it out:

path = First@Cases[ParametricPlot3D[BSplineFunction[
       {{0, 0, 0}, {1, 1, 1}, {2, -1, -1}, {3, 0, 1}, {4, 1, -1}}][u] // Evaluate,
     {u, 0, 1}, MaxRecursion -> 1], Line[l_] :> l, Infinity];

cs = First@Cases[ParametricPlot[
     BSplineFunction[{{0., 0.}, {0.25, 0.}, {0.5, 0.125}, {0.25, 0.25}, {0., 0.25}},
                     SplineClosed -> True][u] // Evaluate,
                 {u, 0, 1}, MaxRecursion -> 1], Line[l_] :> l, Infinity];

Graphics3D[{EdgeForm[], TubePolygons[path, cs]}, Boxed -> False]

Of course, you can elect to have a circular cross section, as is usual:

Graphics3D[{EdgeForm[], TubePolygons[path, 20, "Scale" -> .2]}, Boxed -> False]

Answer 5

Tube is the right thing to use here. Increase n to smoothly interpolate your curve, and r to control the thickness of your circle.

n = 280;
r = .15;
data = Table[{Cos[u] Sin[u^.3], Sin[u] Cos[u^.2], u/10}, {u, 0, 45,45/(n - 1)}];
Graphics3D[{CapForm[None], 
Tube[BSplineCurve[data], Table[r, {i, Length@data}]]},
Boxed -> False, Axes -> False]

If you want a function:

Extrude[{x_, y_, z_}, {t_, Start_, End_}, Discretization_, Radius_] := 
Module[{data3d},
       data3d =Table[{x, y, z}, {t, Start,End, (End - Start)/(Discretization - 1)}];
       Graphics3D[{CapForm[None],Tube[BSplineCurve[data3d],
       Table[Radius, {i, Length@data3d}]]}, Boxed -> False, Axes -> False]
      ];

The following will generate the same extrusion as the graphics:

Extrude[{Cos[u] Sin[u^.3], Sin[u] Cos[u^.2], u/10}, {u, 0, 45}, 280, .1]