TransWikia.com

RegionProduct to extrude a 3d volume with thickness variation

Mathematica Asked by Jeff71 on August 25, 2021

RegionProduct[] is very useful when one intends to extrude a 2d region into 3d:

s = BoundaryMeshRegion[RandomPolygon[{"Convex", 15}]];
sLinExtrd = RegionProduct[s, MeshRegion[{{0}, {1}}, Line[{1, 2}]]]

Output:
Example output sLinExtrd

However, I run into trouble as soon as I try to combine s with a function instead of a line:

s = BoundaryMeshRegion[RandomPolygon[{"Convex", 15}]];
curve = DiscretizeRegion@Circle[{0, 0}, {1, 3}, {-Pi/2, Pi/2}];
sCurvExtrd = Region[RegionProduct[s, curve]]

Example output sCurvExtrd

Since the dimensionality is now 4, sCurvExtrd cannot be visualised anymore, but from what I understand it can used for further calculations. However, my aim is rather to introduce a thickness variation using the curve, as it can be nicely seen in the extrusion demo:

Extrusion demo

So far, I have seen implementations using ParametricPlot3D[] or ImplicitRegion[]
(example), but I was wondering if the process of extrusion could be done using Regions and RegionProduct[] instead, or what other alternatives exist to tackle this problem. Ideally, visualisation or discretization of the 3d volume should still be possible.

One Answer

As given in the comment by @flinty, the link have a great guidance for a solution.

First,s is defined as above, and centred to the coordinates system origin.

s = BoundaryMeshRegion[RandomPolygon[{"Convex", 15}]];
s = TransformedRegion[s, TranslationTransform[-RegionCentroid[s]]];
Show[s, Graphics[{PointSize[Large], Red, Point[RegionCentroid[s]]}],
  Axes -> True]

s, centred

Subsequently, a 3d extrusion path is defined:

Testpath[z_] := {0, 0, z};
{zStart, zEnd} = {-1, 1};
zPath = ParametricPlot3D[Testpath[z], {z, zStart, zEnd}]

The key takeaway is, that one does not need to transform the BoundaryMeshRegion itself, but merely the MeshCoordinates. For that, a Composition of two transformations is defined:

transform[z_] := 
 Composition[TranslationTransform[Testpath[z]], 
  ScalingTransform[
   ConstantArray[Rescale[z, {zStart, zEnd}, {5*Cos[z], 5*Cos[z]}], 
    3]]]

Note that the thickness gradient will be defined by 5*Cos[z] in this case. Required points are defined by:

nint = 100;
allpoints = 
  Table[transform[
     z] /@ (MeshCoordinates[s] /. {x_, y_} -> {x, y, 0}), {z, zStart,
     zEnd, (zEnd - zStart)/nint}];

And lastly, the extrusion is given by:

sExtr = 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", Axes -> True]

sExtr

Correct answer by Jeff71 on August 25, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP