Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2001
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2001

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

Search the Archive

Re: 2D Outlines to 3D Surface or Solid

  • To: mathgroup at smc.vnet.net
  • Subject: [mg27322] Re: 2D Outlines to 3D Surface or Solid
  • From: Jens-Peer Kuska <kuska at informatik.uni-leipzig.de>
  • Date: Wed, 21 Feb 2001 03:16:51 -0500 (EST)
  • Organization: Universitaet Leipzig
  • References: <96t8v3$pqp@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

Hi,

the following will work

distance = 
    Compile[{{x1, _Real, 1}, {x2, _Real, 1}}, 
      Module[{delta = x2 - x1}, Sqrt[Dot[delta, delta]]]
      ];

RibbonTiling[{l1 : {{_, _, _} ..}, l2 : {{_, _, _} ..}}] := 
  RibbonTiling[l1, l2]

RibbonTiling[l1 : {{_, _, _} ..}, l2 : {{_, _, _} ..}] :=
  
  Module[{n, m, i = 1, j = 1, k = 1, p1, p2, d1, d2, pp1, pp2, p3,
polyList},
    n = Length[l1];
    m = Length[l2];
    polyList = Table[Null, {2*(Max[n, m] + 2)}];
    p1 = l1[[i]];
    p2 = l2[[j]];
    While[i < n || j < m,
       If[i < n, pp1 = l1[[i + 1]]];
        If[j < m, pp2 = l2[[j + 1]]];
        d1 = distance[p1, pp2];
        d2 = distance[p2, pp1];
        If[d1 < d2,
          j++;
         polyList[[k++]] = Polygon[{pp2, p2, p1}];
          p2 = pp2,
        (* Else *)
          i++;
         polyList[[k++]] = Polygon[{pp1, p2, p1}];
          p1 = pp1
        ];
      If[i > n || j > m, Break[]];
      ];
    While[i < n, polyList[[k++]] = Polygon[{p2, l1[[i]], l1[[i + 1]]}];
i++];
    While[j < m, polyList[[k++]] = Polygon[{l2[[j + 1]], l2[[j]], p1}];
j++];
    Take[polyList , k - 1]
    ]

(* Append the first point to close ther curve *)
sliceoutline = 
    Append[#, First[#]] & /@ {outline05, outline10, outline15,
outline20};

gg = Show[Graphics3D[
        MapIndexed[{SurfaceColor[
                If[EvenQ[First[#2]], RGBColor[1, 0, 0], RGBColor[1, 1,
1]]], 
              RibbonTiling[#1]} &, 
          Drop[Transpose[{sliceoutline, RotateLeft[sliceoutline]}],
-1]], 
        Axes -> True
        ]
      ];

Hope that helps
  Jens

"John C. Erb, Ph.D." wrote:
> 
> Monday, Feb 19, 2001
> 
> Using a series of CT images, I have made outlines of an area (volume) of
> interest
> as imaged on each slice.  I would like to use these 2D outlines to make
> a 3D surface (or solid), so I can view the volume of interest in 3D space.
> 
> In my simplified example below, the outline is given by the x-y coordinates,
> while the z coordinate is the CT slice coordinate.
> 
> I have tried several plotting routines from the ExtendGraphics by Tom
> Wickham-Jones, but I have not gotten satisfactory results.  Any help
> or hints would be appreciated.
> 
> Here is an Mathematica notebook example of my 2D outlines.
> 
> Thanks,
> John C. Erb
> email: John_C_Erb at prodigy.net
> 
> =================================================================
> (* 2D OUTLINES TO 3D SURFACE NOTEBOOK *)
> 
> (* The outlines from 4 CT slices; z = 0.5 for the first slice,
>   z = 1.0 for the 2nd,
>     z = 1.5 for the 3rd, and z = 2.0 for the 4th *)
> 
> (* NOTE : the outlines do not have the same number of points,
>   and are not regularly - spaced;
>   this is as one would get when digitizing the outlines on each CT slice *)
> 
> outline05 = {{1.02259, -.00956469, .5}, {1.09041, .419046, .5}, {.822027,
>     .687822, .5}, {.367525, .619458, .5}, {.132308, .831539, .5}, {-.191121,
>     1.1554, .5}, {-.446603, .725824, .5}, {-.647789, .576269, .5},
>     {-1.09434, .365993, .5}, {-.973041, -.017658, .5}, {-.945262, -.350991,
> .5},
>     {-.964632, -.807709, .5}, {-.59685, -1.05634, .5}, {-.169448, -.905903,
> .5},
>     {.16231, -1.0699, .5}, {.410886, -.688971, .5}, {.64615, -.564, .5},
>     {1.16262, -.403277, .5}};
> 
> outline10 = {{1.74412, -.0604528, 1}, {1.34186, .662489, 1}, {1.08653,
> 1.22486, 1},
> {.536761, 1.83872, 1}, {-.353659, 1.79741, 1}, {-1.03225,1.56513, 1},
> {-1.61105, .919901, 1}, {-1.80524, .170477,1}, {-1.58627, -.535454, 1},
> {-1.41569, -1.33271, 1}, {-.654148, -1.73365, 1}, {.183023, -1.91315,1},
>    {.844769, -1.37113, 1}, {1.52438, -1.02213, 1}};
> 
> outline15 = {{2.246, .0740504, 1.5}, {1.8566, .790883, 1.5}, {1.56557,
>         1.57265, 1.5}, {.965046, 2.09787, 1.5}, {.0319292, 2.39405,1.5},
>  {-.744443, 1.95951, 1.5}, {-1.33884, 1.4973,1.5},
> {-1.69596, .796889, 1.5}, {-1.80942, .0758934,1.5},
> {-2.10507, -.751449, 1.5}, {-1.60214, -1.4175,1.5},
>  {-1.06342, -2.01603, 1.5}, {-.200747, -1.91514, 1.5},
>  {.445451, -1.75928, 1.5}, {1.11485, -1.49995, 1.5},
>  {1.6223, -.898397, 1.5}};
> 
> outline20 = {{1.28354, -.017042, 2}, {.958306, .319781, 2}, {1.17057,
> .946501, 2},
>  {.632935, 1.104, 2}, {.185354, 1.20054, 2}, {-.223106, 1.53972,2},
>  {-.626283, 1.16136, 2}, {-.938092, .755577, 2},
>  {-.994709, .397014, 2}, {-1.2296, -.0169814, 2},
>  {-1.35325, -.48035, 2}, {-.871178, -.777721, 2},
>  {-.536557, -.868083, 2}, {-.263207, -1.33135, 2},
>  {.198485, -1.38556, 2}, {.700171, -1.15322, 2},
>  {1.03564, -.925754, 2}, {1.30896, -.478603, 2}};
> 
> (* Merge the outlines into one list *)
> newnewkontours = {outline05, outline10, outline15, outline20}
> 
> (* Load the Graphics3D package *)
> Needs["Graphics`Graphics3D`"];
> 
> (* Do a 3D Scatter Plot of the first outline only *)
> ScatterPlot3D[newnewkontours[[1]], PlotJoined -> True];
> 
> (* Do a 3D Scatter Plot of all 4 outlines *)
> g = Table[0, {i, Length[newnewkontours]}];
> Do[
>     g[[i]] =
>         ScatterPlot3D[newnewkontours[[i]], PlotJoined -> True,
>           DisplayFunction -> Identity];,
>     {i, Length[g]}];
> Show[g, DisplayFunction -> $DisplayFunction];
> (* Display of 2D Outlines in 3D Space using polygons *)
> Show[Graphics3D[Map[Polygon[#] &, newnewkontours]]];
> 
> (* Now make a 3D surface, or solid, of the outlines *)
> 
> ========================================================================


  • Prev by Date: Re: avoiding neg values in NDSolve
  • Next by Date: Re: Q: How to plot field lines?
  • Previous by thread: 2D Outlines to 3D Surface or Solid
  • Next by thread: Re: Two Y-Axes