How can I move some polygon

list = {{0, 0}, {0, 15}, {7, 13}, {2, 13}, {2, 5}, {5, 5}, {5, 3}, {2,3}, {2, 0}};
Graphics[{Black, Polygon[list]}]

so it follow some 3D parametric curve

ParametricPlot3D[{Sin[u], 5 Cos[u], u/10}, {u, 0, 20}]

to create 3D shape? The tangent of the curve should be always perpendicular to polygon surface. So I could create, for example, the 3D shape like this enter image description here

  • 2
    $\begingroup$ J. M. answered this question here. mathematica.stackexchange.com/questions/3051/… $\endgroup$ Commented Dec 29, 2014 at 18:53
  • 2
    $\begingroup$ To the closers: not sure if this is a duplicate, since the mentioned question does not explicitly ask for arbitrary cross-section for the loft (although this answer adresses the issue). $\endgroup$
    – Yves Klett
    Commented Dec 29, 2014 at 21:33
  • $\begingroup$ @Yves: Perhaps one could edit the previous question to optionally request an arbitrary cross-section. (That wouldn't invalidate the rest of the existing answers.) $\endgroup$
    – user484
    Commented Dec 30, 2014 at 4:59
  • 1
    $\begingroup$ @Mr.Wizard I agree it's a good policy. Somehow I just thought I should notify you. I'm hoping SquareOne will see my comments and decide where it is best to post an answer. (Not knowing what it is, I can't say for sure what should happen, which is why I haven't voted to close yet.) $\endgroup$
    – Michael E2
    Commented Jan 1, 2015 at 6:13
  • 1
    $\begingroup$ @SquareOne Please see my comments. I think they may be of interest to you. $\endgroup$
    – Michael E2
    Commented Jan 1, 2015 at 6:14

1 Answer 1


My approach is based on the basic Frenet Trihedron formulas (which were implemented in v.10) and also some basic geometric transformations (matrix rotation and translation).

It can be applied to extrude any 2D polygon.

1. Choice of the path

I modified a little bit the OP's path for the sake of keeping the 3D graphics simple to view.

path[u_] := {Sin[u], Cos[u], u/2};

{uStart, uEnd} = {0, 2};

It corresponds to a portion of a helix

gPath = ParametricPlot3D[path[u], {u, uStart - 0.2, uEnd + 0.2}, 
PlotStyle -> Thickness[0.02]]

enter image description here

2. Choice of the Polygon

This is the OP's polygon :

list = {{0, 0}, {0, 15}, {7, 13}, {2, 13}, {2, 5}, {5, 5}, {5, 3}, {2,3}, {2,0}};

which needs to be scaled down in order to fit the overall size of the path. For example :

scale = 0.05;
transxy = {-0.05, -0.25};
(nlist = (Plus[transxy, #] & /@ (scale*list))) // 
 Graphics[{Black, Polygon[#]}, Axes -> True, AxesOrigin -> {0, 0}] &

Notice the arbitrary translation (transxy) which lets you also choose where exactly the path line will pass through the polygon (we defined here the axes origin {0,0} to be always this point). (Of course, one could also add a local rotation of the polygon in the plane if needed).

enter image description here

3. Transformation Definitions (Rotation+Translation)

To extrude the polygon along the path, we need to rotate the 2D polygon in the 3D space such that its (x,y) axes match respectively the (normal, binormal) axes of the frenet trihedron along the curve. The z axis will have to match the tangent of the curve (in order this tangent to be perpendicular to the polygon surface as requested by the OP). We also need to translate the rotated polygon to its corresponding position along the path.

All this can be simply achieved with :

frenet[u_] = FrenetSerretSystem[path[u], u][[2]];

transform[u_] := Composition[TranslationTransform[path[u]], 
 FindGeometricTransform[frenet[u], {{0, 0, 1}, {1, 0, 0}, {0, 1, 0}}][[2]]]

4. Extruding Points

(* Here you choose how many extruded polygons you want along the given path *)
nint = 50;

allpoints = 
 Table[transform[u] /@ (nlist /. {x_, y_} -> {x, y, 0}),
{u, uStart, uEnd, (uEnd - uStart)/nint}];

Let's check :

Graphics3D[{Point /@ allpoints, Polygon@allpoints[[1]]}]

enter image description here

5. Drawing the surface

That's almost it ... We "just" need to draw some surface passing through the "extruded" points.

5.1 The hard way

The idea here is simply to draw polygons through every 4 neighbour points.

pPoly = Join[allpoints, List /@ allpoints[[All, 1]], 2] // 
   Table[Polygon@Extract[#, { {i, j}, {i, j + 1}, {i + 1, j + 1}, {i + 1, j}}],
 {i, 1, Length@# - 1}, {j, 1, Length@#[[1]] - 1}] &;
pPolyEnds = allpoints // {First@#, Last@#} & // Polygon;
pEdges = Line[Transpose@allpoints];
pExtr = {RGBColor[0.8, 0.8, 0.8], {EdgeForm[], 
    pPoly}, {EdgeForm[Black], pPolyEnds}, {Black, pEdges}};

The final result :

gTNB = Graphics3D@Map[Arrow@{path[0.], path[0.] + #} &, frenet[0.]];

Show[{Graphics3D@pExtr, gPath, gTNB}, Lighting -> "Neutral", 
 Axes -> True]

enter image description here

In particular, you can check here that 1/ the path (in blue) pass through the chosen point inside the polygon (see the section Choice of the polygon), and 2/ that the polygon surface is perpendicular to tangent and that the (x,y) axes of the polygon matches the normal and binormal directions.

5.2 The Spline Way

You can attempt to draw directly the surface passing through all the "extruded" points with the function BSplineSurface:

  BSplineSurface[allpoints, SplineDegree -> 1]}, 
 Lighting -> "Neutral"]

enter image description here

However, if you look carefully there is a problem because some edges are not anymore sharp as they should be. If you zoom in :

enter image description here

The workaround is simply to break the whole surface into smaller parts (which solves also the problem to draw solid lines along the edges of the polygon).

  allpoints // {First@#, Last@#} & // Polygon, 
  BSplineSurface[#, SplineDegree -> 1] & /@ 
   Partition[Transpose@Join[allpoints, List /@ allpoints[[All, 1]], 2], 2, 1]},
  Lighting -> "Neutral"]

enter image description here

You can have a much smoother 3D rendering of the surface if you use SplineDegree->2 (it is safe to do so because we have broken the whole surface into smaller smooth parts) :

enter image description here

This last graphic shows that one could optimize nint, the number of extruded points, in order to get the smoothest surface with the less number of these points.

  • $\begingroup$ There are of course few things to improve. 1/I am not satisfied yet with the way transform is defined. 2/The extruded points could be computed as a function of the curvature in order to add more points where needed, like in the Plot* functions. 3/ It would be nice to have a BSplineSurface which simply draws a surface between two given curves (here those curves are known : this is simply the translated path[u] for each point of the polygon) ... $\endgroup$
    – SquareOne
    Commented Jan 2, 2015 at 11:52
  • $\begingroup$ For some paths it does not work properly path[u_] := {20 Sin[u]^0.01, 20 Cos[u]^0.01, 0} $\endgroup$ Commented Jan 2, 2015 at 16:19
  • 2
    $\begingroup$ @ФилиппЦветков The problem does not come from the approach. You have to carefully examine the particular path you've chosen. 1/ Sin[u] and Cos[u] can't return negative numbers otherwise you'll get complex numbers ... 2/ but it seems also that Mathematica has a problem to compute the tangent, normal and binormal at u=0,Pi/2,Pi, ... I could extrude with no problem just defining {uStart, uEnd} = {0.001, Pi/2}; $\endgroup$
    – SquareOne
    Commented Jan 3, 2015 at 0:56

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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