3
$\begingroup$

I keep seeing a notebook to use of Mathematica as a 3D Printing tool (e.g.: this link). In the notebook on slide 8/11, we find these pictures:

enter image description here enter image description here enter image description here enter image description here enter image description here

I'd like to design it as such that, but I don't know how to create the above examples. Thanks a lot!

$\endgroup$
  • $\begingroup$ Have you tried emailing the author of the notebook? $\endgroup$ – bill s Jan 26 '15 at 13:26
  • $\begingroup$ Interesting question! It will require something along this lines, if you are into relying on bitmap patterns: 1. EdgeDetect for the pattern image 2. Extraction of the contours, possibly using ImageValuePositions and constructing closed paths from that data. 3. Creating a hollowed region (hollow within some boundary you chose). 4. Deforming the region in 3D, using e.g. a 2D-Gaussian. 5. Extruding the deformed region by the target thickness you desire. 6. Constructing something of the shape by translation and rotation, e.g. something like the cube you mentioned. As I said: Interesting! $\endgroup$ – Jinxed Jan 27 '15 at 19:57
  • $\begingroup$ Then again, you could start out with your own regions, e.g. a disk, rectangle, superellipse or whatever, and transform/rotate to follow along a e.g. logarithmic spiral, putting all this into a BoundaryRegion and continue with the steps from my last comment, saving you the hassle of dealing with pixelated input. $\endgroup$ – Jinxed Jan 27 '15 at 20:05
3
$\begingroup$

Using a Graphics3D object from that file (4th object down from the top of slide 8)

enter image description here

(which I'm calling p) we can reconstruct your graphic as follows:

z = Union@
   Cases[p[[1]], {x_Real, y_Real, z_Real} :> {{x, y}, 
      z}, {0, \[Infinity]}];
d2 = DiscretizeGraphics@
   Graphics@
    Replace[p[[1]], {x_Real, y_Real, z_Real} :> {x, 
       y}, {0, \[Infinity]}];
b = BoundaryMesh[
   RegionProduct[d2, MeshRegion[{{0}, {1}}, Line[{1, 2}]]]];
iz = Quiet@Interpolation[z];
len = RegionBounds[b][[1, 2]];
mc = MeshCoordinates[
    b] /. {{x_, y_, 0.} :> {x, y, iz[x, y]}, {x_, y_, 1.} :> {x, y, 
      iz[x, y] + 1}};
mr = MeshRegion[mc, MeshCells[b, 2]];
m2 = Show[mr, 
   TransformedRegion[
    TransformedRegion[mr, RotationTransform[Pi, {1, 0, 0}]], 
    TranslationTransform[{0, 0, len*2}]]];
out = Show[m2, 
  Graphics3D[
   GeometricTransformation[
    GeometricTransformation[
     m2[[1]], {RotationMatrix[90 Degree, {0, 1, 0}]}], 
    TranslationTransform[{-50.8, 0, 50.8}]]], 
  Graphics3D[
   GeometricTransformation[
    GeometricTransformation[
     m2[[1]], {RotationMatrix[90 Degree, {1, 0, 0}]}], 
    TranslationTransform[{0, 50.8, 50.8}]]]]

enter image description here

$\endgroup$
  • $\begingroup$ I really really appreciate your help! $\endgroup$ – Xiang Li Feb 15 '15 at 1:05
  • $\begingroup$ @XiangLi You're welcome :) $\endgroup$ – M.R. Feb 15 '15 at 3:32

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.