How to extrude a tapered shape (starting from a previous answer)

Question

I have a shape given by

triangleTransform[θ_] := 
 {2*Cos[θ] + Cos[2*θ], 2*Sin[θ] - Sin[2*θ]}; 
triangle = 
 ParametricPlot[
  triangleTransform[θ],
  {θ, 0, 2*Pi}, PlotRange -> All, Axes -> None] /. L_Line :> GeometricTransformation[L, ScalingTransform[{2, 1}]] /. Line[l_List] :> {{LightGray, Polygon[l]}, {LightGray, Line[l]}}

I want to 'extrude' this shape along the path given by

path[u_] :=
 {(5/6)*u*Sin[u], (5/6)*u*Cos[u], (5/18)*u}; 
{uStart, uEnd} = {0, 3*Pi}; 
gPath =
 ParametricPlot3D[path[u], {u, uStart - 0.2, uEnd + 0.2}];

I want the extrusion to taper from 0 at the origin (i.e., the tightest part of the spiral) to some given scalar s at the end of the line, with the sharpest vertex of the triangle pointing inwards at all times.

This page (link) offers a great starting-point. And I can build a new path easily enough, but I can't change the extruded shape to my triangle. The original code, plus the poster's explanations, is

(*Create a path*)

path[u_] := {Sin[u], Cos[u], u/2};
{uStart, uEnd} = {0, 3*Pi}; 
gPath = ParametricPlot3D[path[u], {u, uStart - 0.2, uEnd + 0.2}];

(*Build a straight-sided polygon.*)

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


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

(*Number of extrusion points*)

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

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

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

This produces an extrusion of nlist along the path gPath:

I can successfully change gPath to my desired path by simple substitution of the first 3 lines of code:

(*Create a path*)

path[u_] :=
 {(5/6)*u*Sin[u], (5/6)*u*Cos[u], (5/18)*u}; 
{uStart, uEnd} = {0, 3*Pi}; 
gPath =
 ParametricPlot3D[path[u], {u, uStart - 0.2, uEnd + 0.2}];

But if I use substitution to replace the original nlist with my code to generate the cycloid triangle...

(*Build a polygon.*)
triangleTransform[θ_] := {2 Cos[θ] + Cos[2 θ], 
 2 Sin[θ] - Sin[2 θ]};
triangle = 
 ParametricPlot[triangleTransform[θ], {θ, 0, 2 π}, 
 PlotRange -> All, Axes -> None] /. 
 L_Line :> GeometricTransformation[L, ScalingTransform[{2, 1}]] /. 
 Line[l_List] :> {{LightGray, Polygon[l]}, {LightGray, Line[l]}}
(nlist = (triangle)) // 
  Graphics[{Black, Polygon[#]}, Axes -> True, 
  AxesOrigin -> {0, 0}] &;

...I just get errors. I realise this is because triangle is not a set of coordinates, but until @b3m2a1's helpful comments, below, I didn't know how to make the conversion. However, my second question remains:

How do I replace the 2D shape with triangle?
How to I create the taper from size 0 to s?

UPDATE:

I have tried adapting @b3m2a1's code as per his / her recommendations. But I can't apply the taper effect by chaining ScalingTransform with TranslationTransform. I change

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

to

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

As I understand it, ScalingTransform[3, path[u]] should apply a scaling along the vector given by path[u] - but clearly I'm doing something wrong.

Also, I'm not sure how to scale something from 0 to a given s.

I assume from the use of “extrude” that this is related to 3-D modeling. Have you considered doing the extrusion in a 3-D modeling software instead, where the process is trivial, including the tapering, instead of trying to do it in Mathematica? Perhaps the only thing you could do is export the extrusion path from Mathematica to that software. — MarcoB, Jun 09 '20 at 14:07
Hi @MarcoB. I guess 3D modelling software is simpler if you happen to already know the basics, but the learning curve is incredibly steep, and it seems silly to to learn a whole new package for a single task. As you can see from the above, the extrusion is already being handled in Mathematica; It's changing the shape and adding the taper that I need help with - so I'm hoping I don't have to spend months learning a new graphics package! Fingers crossed that someone has an answer... — Richard Burke-Ward, Jun 09 '20 at 14:18
It would have been kind of you to not just dump the whole code block and leave an (* I CAN'T FIGURE OUT THIS STEP *) comment, but rather to include the code and then show explicitly how you tried and failed to modify it. I didn't realize until I read the entirety of the linked question that you had actually tried to modify the code. In general, assume the reader is going to apply the minimal effort reading your question. You'll get much better responses if you do so. — b3m2a1, Jun 09 '20 at 18:15

b3m2a1 · Accepted Answer · 2020-06-10T23:04:53.947

The main issue seems to be that you didn't bother to read the OG code. nlist is a list of points that define the polygon. So just turn your shape into a list of points

triangleTransform[θ_] := {2*Cos[θ] + Cos[2*θ], 2*Sin[θ] - Sin[2*θ]};
triangle = ParametricPlot[.5*triangleTransform[θ], {θ, 0, 2*Pi}, PlotRange -> All, Axes -> None] /. L_Line :> GeometricTransformation[L, ScalingTransform[{2, 1}]] /. Line[l_List] :> {{LightGray, Polygon[l]}, {LightGray, Line[l]}};
nlist = triangle // FirstCase[#, _Polygon, None, Infinity][[1]] &;

Now you can build the extrusion path

path[u_] := {(5/6)*u*Sin[u], (5/6)*u*Cos[u], (5/18)*u};
{uStart, uEnd} = {0, 3*Pi};
gPath = ParametricPlot3D[path[u], {u, uStart - 0.2, uEnd + 0.2}];

And get the transformed coordinates

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

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

And finally visualize

(*You can attempt to draw directly the surface passing through all the "extruded" points with the function BSplineSurface:*)
Graphics3D[{FaceForm[GrayLevel[0.8]], EdgeForm[None], Polygon[({First[#1], Last[#1]} &)[allpoints]], (BSplineSurface[#1, SplineDegree -> 1] &) /@ Partition[Transpose[Join[allpoints, List /@ allpoints[[All, 1]], 2]], 2, 1]}, Lighting -> "Neutral"]

To introduce a taper add a ScalingTransform to the Composition. Because we're chaining transformations, i.e. composing them as functions

tapering = .9;(*percent to taper over the range*)
transform[u_] :=
 Composition[
  TranslationTransform[path[u]], 
  ScalingTransform[ConstantArray[Rescale[u, {uStart, uEnd}, {1 - tapering, 1}], 3]],
  FindGeometricTransform[frenet[u], {{0, 0, 1}, {1, 0, 0}, {0, 1, 0}}][[2]]
  ]

Obviously, it doesn't need to be a homogenous taper, which you'd get by changing the elements of the ScalingTransform

Hi @b3m2a1. Thank you for this; I did realise it was a list of points, but was unsure how to convert - much appreciated. What about my second question, the tapering issue? — Richard Burke-Ward, Jun 09 '20 at 18:43
@RichardBurke-Ward Chain a ScalingTransform on the TranslationTransform — b3m2a1, Jun 09 '20 at 18:51
Hi @b3m2a1 (and everyone). Please see my update to the OP for problems still outstanding. I'm very grateful for your help and insight. — Richard Burke-Ward, Jun 10 '20 at 10:06
@RichardBurke-Ward functions are chained using Composition, but I added an example for you — b3m2a1, Jun 10 '20 at 23:05
Many thanks @b3m2a1. Marked as answered, and up-ticked. I'm very grateful. — Richard Burke-Ward, Jun 11 '20 at 11:04

How to extrude a tapered shape (starting from a previous answer)

1 Answers1

Linked