Re: 3d polygon sichtbare legende

["Jens-Peer Kuska" <kuska@XXXXXXX.de>]

Hallo,

fangen wir mal beim der letzen Eingabe Deines Beispiels an und sagen
gg = Show[Mut, Legende, AxesLabel -> {A, B,
C}, PlotRange -> {{-1.3, 3}, {-1.6, 2.1}, {-2.6,
1.5}}, Axes -> True]

gorig = Graphics[gg];
gg1 = Show[gg /. Text[a_, pos_, arg___] :>

          Point[pos], RenderAll -> False] // Graphics

projTex = Cases[gorig, _Text, Infinity];
fromTextList[pos_] := Select[projTex, #1[[2]] == pos &]


Show[gg1 /.
Point[pos_] /; MemberQ[projTex, pos, Infinity] :> {fromTextList[pos]},
PlotRange -> All]

und fertig ist es.

Gruß
 Jens

----- Original Message ----- 
From: "Nic Hutter" <nic_hutter@XXXXXXX.de>
To: <demug@XXXXXXX.ch>
Sent: Wednesday, February 09, 2005 9:47 AM
Subject: 3d polygon sichtbare legende


> Liebes Forum,
>
> es stellt sich folgendes Problem:
> Ich möchte den unten angegebenen polygon zeichnen, der
> sich aus einer punktwolke ergibt, wobei die einzelnen
> punkte als ländernamen kodiert sind.
>
> problem: bei der 3-dimensionalen darstellung zeigt
> mathematica ALLE ländernamen an, d.h. auch jene, die
> eigentlich durch das polygon verdeckt sein sollte
> (nicht sichtbar sein sollten).
>
> kann man das ändern?
> vielen dank im voraus.
> gruß
> nic hutter
>
>
> Needs["Graphics`Graphics3D`"]
>
> pointlist = Table[{{-0.972, 0.372, -0.348}, {0.012,
> 0.931, -0.118}, {-1.053, \
> -0.479, 0.588}, {0.025, 0.973, 0.711}, {
>          0.525, 2.050, 1.035}, {-0.021, -1.109,
> -0.210}, {2.869, 1.062, \
> 1.411}, {0.545, -0.776, 1.460}, {-0.845, 0.122,
> -0.172}, {-0.514, -0.247, \
> -0.348}, {-0.295, -0.996, -0.427}, {-0.059, -0.741,
> -0.904}, {0.405, 0.836, \
> -0.232}, {0.616, -0.586, 0.115}, {-1.237, -1.413,
> -2.561}}];
>
> pointgraph = ScatterPlot3D[pointlist, AxesLabel -> {A,
> B, C}, PlotStyle -> {
>      RGBColor[1, 0, 0], PointSize[.03]}];
>
> Legende = Legende =
>  Show[Graphics3D[{
>    Text["deu", {-0.972, 0.372, -0.348}, {0, -1}],
> Text["fra", {
>            0.012, 0.931, -0.118}, {0, -1}],
>              Text["gbr", {-1.053, -0.479, 0.588}, {
>          0, -1}], Text["ita", {
>            0.025, 0.973, 0.711}, {0, -1}],
> Text["esp", {0.525, 2.050,
>               1.035}, {
>          0, -1}], Text["nld", {-0.021, -1.109,
> -0.210}, {0, -1}], \
> Text["grc", {2.869, 1.062, 1.411}, {
>          0, -1}], Text["prt", {0.545, -0.776, 1.460},
> {0, -1}], Text["bel", \
> {-0.845, 0.122, -0.172}, {
>          0, -1}],
>            Text["swe", {-0.514, -0.247, -0.348}, {0,
> -1}], Text["aut", \
> {-0.295, -0.996, -0.427}, {0, -1}], Text["dnk
>            ", {-0.059, -0.741, -0.904}, {0, -1}],
> Text["fin", {
>            0.405, 0.836, -0.232}, {0, -1}], Text["irl
>            ", {0.616, -0.586, 0.115}, {0, -1}],
> Text["lux
>            ", {-1.237, -1.413, -2.561}, {0, -1}]},
> Axes -> True, AxesLabel \
> -> {A, B, C}, PlotRange -> {{-1.3, 3}, {-1.6, 2.1},
> {-2.6, 1.5}}]]
>
> Show[pointgraph, Legende]
>
> Mut = Show[Graphics3D[{Polygon[{{0.54500000,
> -0.77600000, 1.46000000}, \
> {0.52500000, 2.05000000, 1.03500000}, {2.86900000,
> 1.06100000, 1.41100000}}], \
> Polygon[{{0.54500000, -0.77600000, 1.46000000},
> {-1.05300000, -0.47900000, \
> 0.58800000}, {0.52500000, 2.05000000, 1.03500000}}],
> Polygon[{{2.86900000,
>         1.06100000, 1.41100000}, {0.40500000,
> 0.83600000, -0.23200000}, \
> {-1.23700000, -1.41300000, -2.56100000}}],
> Polygon[{{0.40500000, 0.83600000, \
> -0.23200000}, {0.52500000, 2.05000000, 1.03500000},
> {-1.23700000, \
> -1.41300000, -2.56100000}}], Polygon[{{0.52500000,
> 2.05000000,
>          1.03500000}, {0.40500000, 0.83600000,
> -0.23200000}, {
>              2.86900000, 1.06100000,
>            1.41100000}}], Polygon[{{-0.02100000,
> -1.10900000, -0.21000000}, \
> {2.86900000,
>            1.06100000, 1.41100000}, {-1.23700000,
> -1.41300000, \
> -2.56100000}}], Polygon[{{-0.02100000, -1.10900000,
> -0.21000000}, \
> {0.54500000, -0.77600000, 1.46000000}, {2.86900000,
> 1.06100000,
>            1.41100000}}], Polygon[{{-1.05300000,
> -0.47900000, 0.58800000}, \
> {-0.02100000, -1.10900000, -0.21000000}, {-1.23700000,
> -1.41300000, \
> -2.56100000}}], Polygon[{{-0.02100000, -1.10900000,
> -0.21000000}, \
> {-1.05300000, -0.47900000,
>               0.58800000}, {0.54500000, -0.77600000,
> 1.46000000}}],
>             Polygon[{{0.52500000, 2.05000000,
> 1.03500000}, {-0.97200000, \
> 0.37200000, -0.34800000}, {-1.23700000, -1.41300000,
> -2.56100000}}],
>              Polygon[{{-0.97200000, 0.37200000,
> -0.34800000}, {-1.05300000, \
> -0.47900000,
>               0.58800000}, {-1.23700000, -1.41300000,
> -2.56100000}}], \
> Polygon[{{-1.05300000, -0.47900000, 0.58800000},
> {-0.97200000, 0.37200000, \
> -0.34800000}, {0.52500000,
>               2.05000000, 1.03500000}}]}, PlotRange
> -> {{-1.3, 3}, {-1.6, \
> 2.1}, {-2.6, 1.5}}, Axes -> True]]
>
> Show[Mut, Legende, AxesLabel -> {A, B,
>   C}, PlotRange -> {{-1.3, 3}, {-1.6, 2.1}, {-2.6,
> 1.5}}, Axes -> True]
>
>
>
>
>
>
>
>
>
>
> ___________________________________________________________
> Gesendet von Yahoo! Mail - Jetzt mit 250MB Speicher kostenlos - Hier 
> anmelden: http://mail.yahoo.de