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 *)
>
> ========================================================================