mathematica

gistfile1.txt

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





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.25, 0.25}, {0., 0.25}},
         SplineClosed -> True, SplineDegree -> 1][u] // Evaluate, {u, 
      0, 1}, MaxRecursion -> 1], Line[l_] :> l, Infinity];

Graphics3D[{EdgeForm[], TubePolygons[path, cs]}]