RegionProduct to extrude a 3d volume with thickness variation

Question

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:

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

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.

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

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]

RegionProduct to extrude a 3d volume with thickness variation

One Answer

Add your own answers!

Ask a Question