12
$\begingroup$

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

$\endgroup$
  • 2
    $\begingroup$ J. M. answered this question here. mathematica.stackexchange.com/questions/3051/… $\endgroup$ – David G. Stork Dec 29 '14 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 Dec 29 '14 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$ – Rahul Dec 30 '14 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 Jan 1 '15 at 6:13
  • 1
    $\begingroup$ @SquareOne Please see my comments. I think they may be of interest to you. $\endgroup$ – Michael E2 Jan 1 '15 at 6:14
17
$\begingroup$

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:

Graphics3D[{FaceForm[GrayLevel[0.8]], 
  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).

Graphics3D[{FaceForm[GrayLevel[0.8]], 
  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.

$\endgroup$
  • $\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 Jan 2 '15 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$ – Филипп Цветков Jan 2 '15 at 16:19
  • 1
    $\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 Jan 3 '15 at 0:56

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.