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 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 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 at 23:47
  • $\begingroup$ Thank you, I will! $\endgroup$ – Paul Apr 3 at 13:53
9
$\begingroup$

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

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]
$\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 at 13:58

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.