# RegionProduct to extrude a 3d volume with thickness variation

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.

• Have you seen this? mathematica.stackexchange.com/questions/223661/… – flinty Jul 15 '20 at 18:04
• Hi @flinty, I actually haven't seen this post yet. Thanks a lot, it is very useful. I hope to squeeze out a useful answer and post it below soon. – Jeff71 Jul 16 '20 at 9:06

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]