Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Problem in "block cutting"

  • To: mathgroup at smc.vnet.net
  • Subject: [mg121607] Re: Problem in "block cutting"
  • From: Roger Bagula <roger.bagula at gmail.com>
  • Date: Thu, 22 Sep 2011 07:24:51 -0400 (EDT)
  • Delivered-to: l-mathgroup@mail-archive0.wolfram.com
  • References: <201109201008.GAA00710@smc.vnet.net> <j5cbas$d0c$1@smc.vnet.net>

Stacking the blocks:
( probably look better with a two layer and a one layer
on top of these... )

Clear[x, y, z, g, g1]
g = Module[{x, y, z},
  Show[RegionPlot3D[(((y + 0.075) 1.25 + 3)/2)^2 - (x 1.25 1.2)^2 <=
       1, ##, Boxed -> False, Axes -> True,
      TextureCoordinateFunction -> ({2 #1 + #2, #2 + #3} &),
      Mesh -> None,
      PlotStyle -> Directive[Brown, Specularity[White, 50]
        , Texture[ExampleData[{"ColorTexture", "WhiteMarble"}]]],
      Lighting -> "Neutral",
      AxesLabel -> {"x", "y", "z"}]
     & @@@ {{{x, 0, 1}, {y, -1, 0}, {z, 0, 1}}, {{x, 0, 1}, {y, -1,
       0}, {z, -1, 0}}, {{x, -1, 0}, {y, -1, 0}, {z, 0, 1}}, {{x, -1,
       0}, {y, -1, 0}, {z, -1, 0}}},
   PlotRange -> All, Axes -> False, BoxRatios -> {2, 1, 2}]]
g1 = Module[{x, y, z},
  Show[RegionPlot3D[(((y + 0.075) 1.25 + 3)/
           2)^2 - ((x - 2) 1.25 1.2)^2 <= 1, ##, Boxed -> False,
      Axes -> True,
      TextureCoordinateFunction -> ({2 #1 + #2, #2 + #3} &),
      Mesh -> None,
      PlotStyle -> Directive[Brown, Specularity[White, 50]
        , Texture[ExampleData[{"ColorTexture", "WhiteMarble"}]]],
      Lighting -> "Neutral",
      AxesLabel -> {"x", "y", "z"}]
     & @@@ {{{x, 2, 3}, {y, -1, 0}, {z, 0, 1}}, {{x, 2, 3}, {y, -1,
       0}, {z, -1, 0}}, {{x, 1, 2}, {y, -1, 0}, {z, 0, 1}}, {{x, 1,
       2}, {y, -1, 0}, {z, -1, 0}}},
   PlotRange -> All, Axes -> False, BoxRatios -> {2, 1, 2}]]
g2 = Module[{x, y, z},
  Show[RegionPlot3D[(((y + 0.075) 1.25 + 3)/
           2)^2 - ((x - 4)*1.25 1.2)^2 <= 1, ##, Boxed -> False,
      Axes -> True,
      TextureCoordinateFunction -> ({2 #1 + #2, #2 + #3} &),
      Mesh -> None,
      PlotStyle -> Directive[Brown, Specularity[White, 50]
        , Texture[ExampleData[{"ColorTexture", "WhiteMarble"}]]],
      Lighting -> "Neutral",
      AxesLabel -> {"x", "y", "z"}]
     & @@@ {{{x, 4, 5}, {y, -1, 0}, {z, 0, 1}}, {{x, 4, 5}, {y, -1,
       0}, {z, -1, 0}}, {{x, 3, 4}, {y, -1, 0}, {z, 0, 1}}, {{x, 3,
       4}, {y, -1, 0}, {z, -1, 0}}},
   PlotRange -> All, Axes -> False, BoxRatios -> {2, 1, 2}]]
g3 = Module[{x, y, z},
  Show[RegionPlot3D[((((y - 1) + 0.075) 1.25 + 3)/
           2)^2 - ((x - 1) 1.25 1.2)^2 <= 1, ##, Boxed -> False,
      Axes -> True,
      TextureCoordinateFunction -> ({2 #1 + #2, #2 + #3} &),
      Mesh -> None,
      PlotStyle -> Directive[Brown, Specularity[White, 50]
        , Texture[ExampleData[{"ColorTexture", "WhiteMarble"}]]],
      Lighting -> "Neutral",
      AxesLabel -> {"x", "y", "z"}]
     & @@@ {{{x, 1, 2}, {y, 0, 1}, {z, 0, 1}}, {{x, 1, 2}, {y, 0,
       1}, {z, -1, 0}}, {{x, 0, 1}, {y, 0, 1}, {z, 0, 1}}, {{x, 0,
       1}, {y, 0, 1}, {z, -1, 0}}},
   PlotRange -> All, Axes -> False, BoxRatios -> {2, 1, 2}]]
g4 = Module[{x, y, z},
  Show[RegionPlot3D[((((y - 1) + 0.075) 1.25 + 3)/
           2)^2 - ((x - 3) 1.25 1.2)^2 <= 1, ##, Boxed -> False,
      Axes -> True,
      TextureCoordinateFunction -> ({2 #1 + #2, #2 + #3} &),
      Mesh -> None,
      PlotStyle -> Directive[Brown, Specularity[White, 50]
        , Texture[ExampleData[{"ColorTexture", "WhiteMarble"}]]],
      Lighting -> "Neutral",
      AxesLabel -> {"x", "y", "z"}]
     & @@@ {{{x, 3, 4}, {y, 0, 1}, {z, 0, 1}}, {{x, 3, 4}, {y, 0,
       1}, {z, -1, 0}}, {{x, 2, 3}, {y, 0, 1}, {z, 0, 1}}, {{x, 2,
       3}, {y, 0, 1}, {z, -1, 0}}},
   PlotRange -> All, Axes -> False, BoxRatios -> {2, 1, 2}]]
g6 = Module[{x, y, z},
  Show[RegionPlot3D[((((y - 1) + 0.075) 1.25 + 3)/
           2)^2 - ((x - 5) 1.25 1.2)^2 <= 1, ##, Boxed -> False,
      Axes -> True,
      TextureCoordinateFunction -> ({2 #1 + #2, #2 + #3} &),
      Mesh -> None,
      PlotStyle -> Directive[Brown, Specularity[White, 50]
        , Texture[ExampleData[{"ColorTexture", "WhiteMarble"}]]],
      Lighting -> "Neutral",
      AxesLabel -> {"x", "y", "z"}]
     & @@@ {{{x, 5, 6}, {y, 0, 1}, {z, 0, 1}}, {{x, 5, 6}, {y, 0,
       1}, {z, -1, 0}}, {{x, 4, 5}, {y, 0, 1}, {z, 0, 1}}, {{x, 4,
       5}, {y, 0, 1}, {z, -1, 0}}},
   PlotRange -> All, Axes -> False, BoxRatios -> {2, 1, 2}]]
gw = Show[{g, g1, g2, g3, g4, g5, g6}, PlotRange -> All]
(*Export["ChainArch.3ds",gw]
Export["ChainArch.obj",gw]
Export["ChainArch.stl",gw]*)





  • Prev by Date: Re: Parallel remote kernel: MathLink connection not active
  • Next by Date: Re: Compilation: Avoiding inlining
  • Previous by thread: Re: Problem in "block cutting"
  • Next by thread: Parallel remote kernel: MathLink connection not active