7
$\begingroup$

What is the easiest way to implement a polygon in a Graphics3D? I want to take a regular polygon, the hexagon for example, and be able to easily rotate it in 3D, as well as set its distance to the origin (relative to its centroid), as sketched below

enter image description here

for some $\alpha$, $\beta$ and $r$. Any ideas?

My attempt: I started by using RegularPolygon as follows

hex = Append[#, 0] & /@ CanonicalizePolygon[RegularPolygon[6]][[1]];
Graphics3D[{Yellow, Polygon@hex}, AxesOrigin -> {0, 0, 0}]

but already I get a problem:

enter image description here

where do I go from here?

$\endgroup$

2 Answers 2

12
$\begingroup$

Look at the TranslationTransform and RotationTransform

With[
    {coord=TranslationTransform[{1,0,0}][Append[0]/@CirclePoints[7]]},
    Animate[
        Graphics3D[
            {
                Blue, Arrow[{{0,0,0},{1,0,0}}],
                Red, 
                Polygon[RotationTransform[a,{1,0,0}][coord]]
            }
            , AxesOrigin -> {0, 0, 0}
            , Axes->True
            , PlotRange->{{-2,2},{-2,2},{-2,2}}
        ]
        ,{a,0,2Pi,Pi/20}
    ]
]

enter image description here

$\endgroup$
1
  • 2
    $\begingroup$ I tend to use PadRight[CirclePoints[7], {Automatic, 3}] instead of Append[0] /@ CirclePoints[7], but this is otherwise how I'd do it. $\endgroup$ Commented Jul 1, 2022 at 15:21
7
$\begingroup$
  • Use SphericalCoordinates

In the affine transform GeometricTransformation[g, {m, v}],we set m=RotationMatrix[{{0, 0, 1}, normal} and v=center.

With[{vector = FromSphericalCoordinates[{r, θ, φ}]}, 
 Manipulate[
  Graphics3D[{{Opacity[.5], FaceForm[Yellow], 
     EdgeForm[{Blue, AbsoluteThickness[2]}], 
     GeometricTransformation[
      RegionProduct[RegularPolygon[{1,0},6], 
       Point[{0}]], {RotationMatrix[{{0, 0, 1}, vector}], 
       vector}]}, {Red, Sphere[vector, .05]}, 
    Arrow[{{{0, 0, 0}, {3, 0, 0}}, {{0, 0, 0}, {0, 3, 0}}, {{0, 0, 
        0}, {0, 0, 3}}}], Red, Arrow[{{0, 0, 0}, vector}]}, 
   Boxed -> False, ViewPoint -> {1, 1, 1}, PlotRange -> 3.5], {{r, 2}, 
   1, 3}, {{θ, π/6}, 0, π-.1}, {{φ, π/3}, 0,
    2 π}]]

Or

With[{vector = FromSphericalCoordinates[{r, θ, φ}]},
 Manipulate[
  Graphics3D[{{Opacity[.5], FaceForm[Yellow], 
     EdgeForm[{Blue, AbsoluteThickness[2]}], 
     Polygon[TranslationTransform[
        vector]@(CirclePoints[{1.2, 0}, 6] . 
         Most@Orthogonalize@Normal@HodgeDual@vector)]}, {Red, 
     Sphere[vector, .03]}, {Arrow[{{{0, 0, 0}, {3, 0, 0}}, {{0, 0, 
         0}, {0, 3, 0}}, {{0, 0, 0}, {0, 0, 3}}}], Red, 
     Arrow[{{0, 0, 0}, vector}]}}, Boxed -> False, 
   ViewPoint -> {1, 1, 1}, PlotRange -> 3.5], {{r, 2}, 1, 
   3}, {{θ, π/6}, 0, π - .1}, {{φ, π/3}, 
   0, 2 π}]]

enter image description here

Edit-2

normal = {1, 2, 3};
center = {-2.5, .2, 2.5};
Graphics3D[{{Opacity[.5], FaceForm[Yellow], 
   EdgeForm[{Blue, AbsoluteThickness[2]}], 
   Polygon[TranslationTransform[
      center]@(CirclePoints[{1.2, 0}, 6] . 
       Most@Orthogonalize@Normal@HodgeDual@normal)]}, {Red, 
   Sphere[center, .03]}, {Arrow[{{{0, 0, 0}, {3, 0, 0}}, {{0, 0, 
       0}, {0, 3, 0}}, {{0, 0, 0}, {0, 0, 3}}}], Red, 
   Arrow[{{0, 0, 0}, center}]}}, Boxed -> False, 
 ViewPoint -> {1, 1, 1}]

Or

normal = {1, 2, 3};
center = {-2.5, .2, 2.5}; 
Graphics3D[{{Opacity[.5], FaceForm[Yellow], 
   EdgeForm[{Blue, AbsoluteThickness[2]}], 
   GeometricTransformation[
    RegionProduct[RegularPolygon[6], 
     Point[{0}]], {RotationMatrix[{{0, 0, 1}, normal}], 
     center}]}, {Red, Sphere[center, .05]}, 
  Arrow[{{{0, 0, 0}, {3, 0, 0}}, {{0, 0, 0}, {0, 3, 0}}, {{0, 0, 
      0}, {0, 0, 3}}}], Red, Arrow[{{0, 0, 0}, center}]}, 
 Boxed -> False, ViewPoint -> {1, 1, 1}]

enter image description here

Edit-1

CirclePoints[6] . Most@Orthogonalize@Normal@HodgeDual@{1, 1, 1} // 
  Polygon // Graphics3D

enter image description here

Or

RegionProduct[RegularPolygon[6], Point[{0}]] // Graphics3D

enter image description here

$\endgroup$
5
  • $\begingroup$ Is it possible to incorporate this in a 3D grid (with axes) so that I can include other polygons with different positions and angles? $\endgroup$
    – sam wolfe
    Commented Jul 1, 2022 at 13:03
  • $\begingroup$ @samwolfe normal = {1, 1, 1}; Graphics3D[{GeometricTransformation[ RegionProduct[RegularPolygon[6], Point[{0}]], RotationMatrix[{{0, 0, 1}, normal}]], Point[{0, 0, 0}], Arrow[{{{0, 0, 0}, {1, 0, 0}}, {{0, 0, 0}, {0, 1, 0}}, {{0, 0, 0}, {0, 0, 1}}}]}, Axes -> True]? $\endgroup$
    – cvgmt
    Commented Jul 1, 2022 at 13:17
  • $\begingroup$ @cvgmt is this the PostScript you're talking about? en.wikipedia.org/wiki/PostScript $\endgroup$
    – hana
    Commented Jul 1, 2022 at 15:05
  • $\begingroup$ @hana Yes. But we are not easy to directly use PostScript for Clip and UnFill. I do this by use another drawing language which based on PostScript name asy asymptote.sourceforge.io $\endgroup$
    – cvgmt
    Commented Jul 1, 2022 at 15:32
  • $\begingroup$ @cvgmt thanks, then I probably have to try photoshop instead. $\endgroup$
    – hana
    Commented Jul 1, 2022 at 16:22

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.