3
$\begingroup$

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

enter image description here

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

enter image description here

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:

enter image description here

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

enter image description here

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:

  1. How do I replace the 2D shape with triangle?
  2. 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]]]

enter image description here

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.

$\endgroup$
4
  • $\begingroup$ 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. $\endgroup$ – MarcoB Jun 9 '20 at 14:07
  • $\begingroup$ 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... $\endgroup$ – Richard Burke-Ward Jun 9 '20 at 14:18
  • $\begingroup$ 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. $\endgroup$ – b3m2a1 Jun 9 '20 at 18:15
  • $\begingroup$ My apologies. I'll note this for the future. $\endgroup$ – Richard Burke-Ward Jun 9 '20 at 18:44
8
$\begingroup$

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

enter image description here

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

enter image description here

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

$\endgroup$
5
  • $\begingroup$ 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? $\endgroup$ – Richard Burke-Ward Jun 9 '20 at 18:43
  • $\begingroup$ @RichardBurke-Ward Chain a ScalingTransform on the TranslationTransform $\endgroup$ – b3m2a1 Jun 9 '20 at 18:51
  • $\begingroup$ Hi @b3m2a1 (and everyone). Please see my update to the OP for problems still outstanding. I'm very grateful for your help and insight. $\endgroup$ – Richard Burke-Ward Jun 10 '20 at 10:06
  • $\begingroup$ @RichardBurke-Ward functions are chained using Composition, but I added an example for you $\endgroup$ – b3m2a1 Jun 10 '20 at 23:05
  • $\begingroup$ Many thanks @b3m2a1. Marked as answered, and up-ticked. I'm very grateful. $\endgroup$ – Richard Burke-Ward Jun 11 '20 at 11:04

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.