4
$\begingroup$

I'm interested in polygonal spirals and after reading Filling Space with Pursuit Polygons, I was curious if I could extend the program to create twisted pyramids as 3D-objects. My goal is something like this picture: twisted 3D pyramid

although I would like to be able to vary parameters like shape of the chords from base to top (straight, concave or convex).

I already tried to draw objects like this in AutoCAD, but the process was rather tedious and I'm not yet knowledgeable enough in programming to do something like that from scratch. Here are some of my attempts:

polygon pyramid sharp 1polygon pyramid sharp 2polygon pyramid straight 1 polygon pyramid straight 2

I would also like to know if my red pyramid model would also be possible to be modelled with a script like that:

polygon pyramid red 3

My approach to this model was different to the other two: instead of just connecting the corners with a point on the edge of the square the next level up to create the 4 lines winding up in a spiral and end up with a wire model, I tried to make a solid model by connecting the point of the next level up with all the adjacent corners below. polygon pyramid red 1 polygon pyramid red 2

Thank you in advance!

Edit: I'm not asking you to write that code for me, I'm interested whether a script to create a polygon spiral can be used to create a 3D object with a simple extension to it.

$\endgroup$
4
  • 1
    $\begingroup$ This is a work-request rather than a question. Have you tried anything in MMA yet? $\endgroup$
    – MarcoB
    Apr 2, 2021 at 14:22
  • $\begingroup$ Hello, I'm sorry if it came off that way and I edited my wording. I don't want you to do the work for me. I just wanted to know if a script like I linked in the question could theoretically be extended to meet my requirements and if the red object I've shown in the three pictures would fall into the same category as the other objects. Unfortunately, I'm recently still only reading into Mathematica, so I couldn't yet try it out myself. If someone could estimate if it's easily programmable or not, I would try to do it myself. $\endgroup$
    – Paul
    Apr 2, 2021 at 15:30
  • 1
    $\begingroup$ Welcome to MMA SE! Mathematica can be used to create 3D meshes, which can then be exported in a variety of formats. You might want to check out MeshRegion or Polyhedron. $\endgroup$
    – thorimur
    Apr 2, 2021 at 23:47
  • $\begingroup$ Thank you, I will! $\endgroup$
    – Paul
    Apr 3, 2021 at 13:53

1 Answer 1

10
$\begingroup$

Original

For two points a and b, we rotation and scale the segment t*a + (1 - t)*b in the plane and then lift it to space,all of the transformation according to the parametric θ.

we do the same thing for all the lines of the polygon,then we construct the desired surface.

pts = CirclePoints[5];
draw[a_, b_] := 
  ParametricPlot3D[
   TranslationTransform[{0, 0, -θ}]@PadRight[#, 3] &@
    ScalingTransform[θ*{1, 1}]@
     RotationTransform[-θ][t*a + (1 - t)*b], {t, 0, 
    1}, {θ, 1, 0}, ColorFunction -> Hue, 
   MeshFunctions -> (#3 &)];
Show[draw @@@ Partition[pts, 2, 1, 1], PlotRange -> All, 
 Boxed -> False, Axes -> False, ViewPoint -> {1.3, -2.4, 2.}]

enter image description here

Test another method.

Table[Region[
    TransformedRegion[
     RegionProduct[RegionBoundary@RegularPolygon[5], Point[{0}]], 
     TranslationTransform[{0, 0, -θ}]@*
      ScalingTransform[θ*{1, 1, 1}]@*
      RotationTransform[-θ, {0, 0, 1}]]] // 
   Evaluate, {θ, 0, 1, .04}] // Show

enter image description here

Edit-1

curve[t_] = Normalize[{Cos[t], Sin[t], 0}, Norm[#, 1] &];
ParametricPlot3D[
 TranslationTransform[{0, 0, -θ}]@
  ScalingTransform[θ*{1, 1, 1}]@
   RotationTransform[-θ, {0, 0, 1}]@curve[t]// Evaluate, {t, 0, 
  2 π}, {θ, 1, 0}, ColorFunction -> Hue, 
 MeshFunctions -> (#3 &)]
n = 5;
pts = Append[#, First[#]] &[PadRight[#, 3] & /@ CirclePoints[n]];
curve = BSplineFunction[pts, SplineDegree -> 1];
(*curve[t_]=Piecewise[Thread[{MapThread[ReplaceAll[#1,Rule[t,#2]]&,{\
Function[{x,y},(1-t)*x+t*y]@@@Partition[pts,2,1,1],Rescale[t,#,{0,1}]&\
/@Partition[Subdivide[0,1,n],2,1]}],#1≤t≤#2&@@@\
Partition[Subdivide[0,1,n],2,1]}]];*)
ParametricPlot3D[
 TranslationTransform[{0, 0, -θ}]@
   ScalingTransform[θ*{1, 1, 1}]@
    RotationTransform[-θ, {0, 0, 1}]@curve[Mod[t, 1]] // 
  Evaluate, {t, 0, 1}, {θ, 1, 0}, ColorFunction -> Hue, 
 MeshFunctions -> (#3 &), PlotPoints -> 80, Boxed -> False, 
 Axes -> False]

Edit-2

Clear["Global`*"];
pts = PadRight[#, 3] & /@ CirclePoints[5];
n = Length@pts;
curve[t_] = 
  Sum[UnitStep[t - i/n, 
     Mod[i + 1, n, 1]/n - 
      t]*{1 - Rescale[t, {i/n, Mod[(i + 1), n, 1]/n}, {0, 1}], 
      Rescale[t, {i/n, Mod[(i + 1), n, 1]/n}, {0, 
        1}]} . {pts[[Mod[i, n, 1]]], pts[[Mod[i + 1, n, 1]]]}, {i, 0, 
    n}];
ParametricPlot3D[
 TranslationTransform[{0, 0, -θ}]@
   ScalingTransform[θ*{1, 1, 1}]@
    RotationTransform[-θ, {0, 0, 1}]@curve[Mod[t, 1]] // 
  Evaluate, {t, 0, 1}, {θ, 1, 0}, ColorFunction -> Hue, 
 MeshFunctions -> (#3 &), PlotPoints -> 80, Boxed -> False, 
 Axes -> False, Exclusions -> None]
$\endgroup$
1
  • $\begingroup$ Thank you so much! I'm thrilled to vary the parameters for different surfaces. I suppose that if one would only rotate from one corner to the top and wouldn't repeat the process for all the other corners, the resulting surface might look similar to the red object I drew with the difference that the chords of the surface would wind up spirally and not straight like in the pictures I uploaded? $\endgroup$
    – Paul
    Apr 3, 2021 at 13:58

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.