\def\fileversion{0.2}%
\def\filedate{2002/11/11}%
\message{`PST-NEW3D v\fileversion, \filedate\space (Manuel LUQUE)}%
\csname PSTNewThreeDLoaded\endcsname
\let\PSTNewThreeDLoaded\endinput
% Require PSTricks and pst-node packages
\ifx\PSTricksLoaded\endinput\else\input pstricks.tex\fi
\ifx\PSTnodesLoaded\endinput\else\input pst-node.tex\fi
% DPC interface to the `keyval' package (until keyval based version of PSTricks)
\input pst-key.tex
%
\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax
\SpecialCoor

\pstheader{3D4.pro}
%
\definecolor{Beige} {rgb}{0.96,0.96,0.86}
\definecolor{GrisClair} {rgb}{0.8,0.8,0.8}
\definecolor{GrisTresClair} {rgb}{0.9,0.9,0.9}
\definecolor{OrangeTresPale}{cmyk}{0,0.1,0.3,0}
\definecolor{OrangePale}{cmyk}{0,0.2,0.4,0}
\definecolor{BleuClair}{cmyk}{0.2,0,0,0}
\definecolor{LightBlue}{rgb}{.68,.85,.9}
\definecolor{DarkGreen}{rgb}{0,.85,0}
\definecolor{Copper}{cmyk}{0,0.9,0.9,0.2}
%%%%
\SpecialCoor
\makeatletter
\define@key{psset}{scale}{\edef\psk@TroisD@scale{#1}} % echelle
\define@key{psset}{RotX}{\edef\psk@TroisD@RotX{#1}} % rotation autour de Ox en degrés
\define@key{psset}{RotY}{\edef\psk@TroisD@RotY{#1}} % rotation autour de Oy en degrés
\define@key{psset}{RotZ}{\edef\psk@TroisD@RotZ{#1}} % rotation autour de OZ en degrés
\define@key{psset}{A}{\edef\psk@TroisD@A{#1}} % double  d'une arête du parallèlépipède
\define@key{psset}{B}{\edef\psk@TroisD@B{#1}} % double  d'une arête du parallèlépipède
\define@key{psset}{C}{\edef\psk@TroisD@C{#1}} % double  de l'arête du parallèlépipède
\define@key{psset}{CX}{\edef\psk@TroisD@Xc{#1}} % abscisse du centre du paarallèlépipède
\define@key{psset}{CY}{\edef\psk@TroisD@Yc{#1}} % ordonnée centre du cube
\define@key{psset}{CZ}{\edef\psk@TroisD@Zc{#1}} % cote centre du cube
\define@key{psset}{Rtetraedre}{\edef\psk@TroisD@Rtetraedre{#1}} % Rayon du cercle tétraèdre
\define@key{psset}{ColorFaceA}{\edef\psk@TroisD@TetraedreColorFaceA{#1}} % couleur de la face A du tétraèdre
\define@key{psset}{ColorFaceB}{\edef\psk@TroisD@TetraedreColorFaceB{#1}} % couleur de la face B du tétraèdre
\define@key{psset}{ColorFaceC}{\edef\psk@TroisD@TetraedreColorFaceC{#1}} % couleur de la face C du tétraèdre
\define@key{psset}{ColorFaceD}{\edef\psk@TroisD@TetraedreColorFaceD{#1}} % couleur de la face D du tétraèdre
\define@key{psset}{ColorFaceE}{\edef\psk@TroisD@TetraedreColorFaceE{#1}} % couleur de la face D du tétraèdre
\define@key{psset}{fracHcone}{\edef\psk@TroisD@fracHcone{#1}} % fraction de la hauteur du cone
\define@key{psset}{Hpyramide}{\edef\psk@TroisD@Hpyramide{#1}} % hauteur pyramide
%
\define@key{psset}{normaleLongitude}{\edef\psk@TroisD@normaleLongitude{#1}} % coordonnées angulaires de la normale
\define@key{psset}{normaleLatitude}{\edef\psk@TroisD@normaleLatitude{#1}} % coordonnées angulaires de la normale
\define@key{psset}{Xorigine}{\edef\psk@TroisD@Xorigine{#1}} % coordonnées de la nouvelle origine
\define@key{psset}{Yorigine}{\edef\psk@TroisD@Yorigine{#1}} % coordonnées de la nouvelle origine
\define@key{psset}{Zorigine}{\edef\psk@TroisD@Zorigine{#1}} % coordonnées de la nouvelle origine
\define@key{psset}{Xmax}{\edef\psk@TroisD@Xmax{#1}} % en cm
\define@key{psset}{Xmin}{\edef\psk@TroisD@Xmin{#1}} % en cm
\define@key{psset}{Ymax}{\edef\psk@TroisD@Ymax{#1}} % en cm
\define@key{psset}{Ymin}{\edef\psk@TroisD@Ymin{#1}} % en cm
\define@key{psset}{pas}{\edef\psk@TroisD@pas{#1}} % en cm résolution du tracé
\define@key{psset}{grille}{\edef\psk@TroisD@grille{#1}} % Pas de la grille en cm
%
\define@key{psset}{THETA}{\edef\psk@TroisD@Theta{#1}}
\define@key{psset}{PHI}{\edef\psk@TroisD@Phi{#1}}
\define@key{psset}{PhiCercle}{\edef\psk@TroisD@PhiCercle{#1}}
\define@key{psset}{ThetaMeridien}{\edef\psk@TroisD@ThetaMeridien{#1}}
\define@key{psset}{Dobs}{\edef\psk@TroisD@Dobs{#1}}
\define@key{psset}{Decran}{\edef\psk@TroisD@Ecran{#1}}
\setkeys{psset}{THETA=30,PHI=10,Dobs=100,Decran=10}
%
\setkeys{psset}{normaleLongitude=45,%
                normaleLatitude=45,%
                PhiCercle=0,%
                ThetaMeridien=0,%
                Xorigine=0,%
                Yorigine=0,%
                Zorigine=0,%
                Xmax=50,%
                Ymax=50,%
                Xmin=-50,%
                Ymin=-50,%
                pas=1,%
                grille=10,%
                normaleLongitude=45,%
                normaleLatitude=45,%
                scale=1,%
                RotX=0,RotY=0,RotZ=0,%
                A=10,B=10,C=10,%
                CX=0,CY=0,CZ=0,%
                Rtetraedre=5,%
                ColorFaceD=cyan,ColorFaceA=magenta,ColorFaceB=red,ColorFaceC=blue,ColorFaceE=yellow,%
                fracHcone=1,Hpyramide=5}
%
\newif\ifPst@meridien
\define@key{psset}{meridien}[true]{\@nameuse{Pst@meridien#1}}
\setkeys{psset}{meridien=true}
%
\def\variablesTroisD{%
 0 0 translate
    /reduction \psk@TroisD@scale\space def
    /RotX \psk@TroisD@RotX\space def
    /RotY \psk@TroisD@RotY\space def
    /RotZ \psk@TroisD@RotZ\space def
    /CX \psk@TroisD@Xc\space def
    /CY \psk@TroisD@Yc\space def
    /CZ \psk@TroisD@Zc\space def
    /A \psk@TroisD@A\space def
    /B \psk@TroisD@B\space def
    /C \psk@TroisD@C\space def
    /RayonBaseTetraedre \psk@TroisD@Rtetraedre\space def
    /Hpyramide \psk@TroisD@Hpyramide\space def
    /Rpoint A 4 div def
    /nTheta \psk@TroisD@normaleLongitude\space def
    /nPhi \psk@TroisD@normaleLatitude\space def
    /S1 \psk@TroisD@normaleLongitude\space sin def
    /C1 \psk@TroisD@normaleLongitude\space cos def
    /S2 \psk@TroisD@normaleLatitude\space sin def
    /C2 \psk@TroisD@normaleLatitude\space cos def
    /THETA \psk@TroisD@Theta\space def
    /PHI \psk@TroisD@Phi\space def
    /PhiCercle \psk@TroisD@PhiCercle\space def
    /ThetaMeridien \psk@TroisD@ThetaMeridien\space def
    /Dobs \psk@TroisD@Dobs\space def
    /DScreen \psk@TroisD@Ecran\space def
    /Sin1 THETA sin def
    /Sin2 PHI sin def
    /Cos1 THETA cos def
    /Cos2 PHI cos def
    /Cos1Sin2 Cos1 Sin2 mul def
    /Sin1Sin2 Sin1 Sin2 mul def
    /Cos1Cos2 Cos1 Cos2 mul def
    /Sin1Cos2 Sin1 Cos2 mul def
    /XpointVue Dobs Cos1Cos2 mul def
    /YpointVue Dobs Sin1Cos2 mul def
    /ZpointVue Dobs Sin2 mul def
    /M11 RotZ cos RotY cos mul def
    /M12 RotZ cos RotY sin mul RotX sin mul
         RotZ sin RotX cos mul sub def
    /M13 RotZ cos RotY sin mul RotX cos mul
         RotZ sin RotX sin mul add def
    /M21 RotZ sin RotY cos mul def
    /M22 RotZ sin RotY sin RotX sin mul mul
         RotZ cos RotX cos mul add def
    /M23 RotZ sin RotY sin mul RotX cos mul
         RotZ cos RotX sin mul sub def
    /M31 RotY sin neg def
    /M32 RotX sin RotY cos mul def
    /M33 RotX cos RotY cos mul def
 }%

\def\Cube{\pst@object{Cube}}
\def\Cube@i{\@ifnextchar[{\Cube@do}{\Cube@do[]}}
\def\Cube@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
tx@3DDict begin
Cube
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\Die{
\Cube
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
tx@3DDict begin
Cube
PointsDie
end
}% fin du code ps
\end@ClosedObj
}
%
\def\SphereThreeD{\pst@object{SphereThreeD}}
\def\SphereThreeD@i{\@ifnextchar[{\SphereThreeD@do}{\SphereThreeD@do[]}}
\def\SphereThreeD@do[#1]#2{{%
% (#2,#3,#4) coordonnées du centre
% #5 rayon
%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
reduction reduction scale
    /Rsphere #2 def
    /increment 10 def
tx@3DDict begin
/condition {PSfacette 0 le} def
/departPhi -90 def
MaillageSphere
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
%
\def\SphereCercle{\pst@object{SphereCercle}}
\def\SphereCercle@i{\@ifnextchar[{\SphereCercle@do}{\SphereCercle@do[]}}
\def\SphereCercle@do[#1]#2{{%
% (#2,#3,#4) coordonnées du centre
% #5 rayon
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
reduction reduction scale
    /Rsphere #2 def
tx@3DDict begin
0 2 360 {
    /ThetaEquateur exch def
    /Xpoint Rsphere ThetaEquateur cos mul PhiCercle cos mul def
    /Ypoint Rsphere ThetaEquateur sin mul PhiCercle cos mul def
    /Zpoint Rsphere PhiCercle sin mul def
CalculsPointsAfterTransformations
% rayon de las sphère (normale)
    /nXfacette Xabscisse CX sub def
    /nYfacette Yordonnee CY sub def
    /nZfacette Zcote CZ sub def
% rayon vers point de vue
    /RXvue Xabscisse XpointVue sub def
    /RYvue Yordonnee YpointVue sub def
    /RZvue Zcote ZpointVue sub def
% test de visibilité
    /PSPoint RXvue nXfacette mul
    RYvue nYfacette mul add
    RZvue nZfacette mul add
    def
PSPoint 0 le{
newpath
    CalcCoordinates
0.5 0 360 arc
closepath
fill
} if
%lineto
} for
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
}}
%
%
\def\SphereMeridien{\pst@object{SphereMeridien}}
\def\SphereMeridien@i{\@ifnextchar[{\SphereMeridien@do}{\SphereMeridien@do[]}}
\def\SphereMeridien@do[#1]#2{{%
% (#2,#3,#4) coordonnées du centre
% #5 rayon
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
reduction reduction scale
    /Rsphere #2 def
tx@3DDict begin
0 2 360 {
    /PhiCercle exch def
    /Xpoint Rsphere ThetaMeridien cos mul PhiCercle cos mul def
    /Ypoint Rsphere ThetaMeridien sin mul PhiCercle cos mul def
    /Zpoint Rsphere PhiCercle sin mul def
CalculsPointsAfterTransformations
% rayon de las sphère (normale)
    /nXfacette Xabscisse CX sub def
    /nYfacette Yordonnee CY sub def
    /nZfacette Zcote CZ sub def
% rayon vers point de vue
    /RXvue Xabscisse XpointVue sub def
    /RYvue Yordonnee YpointVue sub def
    /RZvue Zcote ZpointVue sub def
% test de visibilité
    /PSPoint RXvue nXfacette mul
    RYvue nYfacette mul add
    RZvue nZfacette mul add
    def
PSPoint 0 le{
newpath
    CalcCoordinates
0.5 0 360 arc
closepath
fill
} if
%lineto
} for
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
}}
%
\def\CylindreThreeD{\pst@object{CylindreThreeD}}
\def\CylindreThreeD@i{\@ifnextchar[{\CylindreThreeD@do}{\CylindreThreeD@do[]}}
\def\CylindreThreeD@do[#1]#2#3{{%
% Le centre de la base sera placé avec
% les paramètres CX,CY et CZ
% #2 rayon
% #3 hauteur
% on peut ensuite faire tourner le cylindre
% avec RotX, RotY et RotZ
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
reduction reduction scale
    /Rcylindre #2 def
    /Hcylindre #3 def
    /incrementANGLE 10 def
    /incrementHAUTEUR Hcylindre 5 div def
tx@3DDict begin
0 incrementANGLE 360 {%
    /theta exch def
 0 incrementHAUTEUR Hcylindre incrementHAUTEUR sub {%
    /H exch def
% newpath
    /X1 Rcylindre theta cos mul def
    /Y1 Rcylindre theta sin mul def
    /Z1 H def
    /Xpoint X1 def
    /Ypoint Y1 def
    /Zpoint Z1 def
CalculsPointsAfterTransformations
    /Xfacette Xabscisse  def
    /Yfacette Yordonnee  def
    /Zfacette Zcote def
    CalcCoordinates
     moveto
% coordonnées du centre de la facette
    /Xpoint Rcylindre theta incrementANGLE 2 div add cos mul def
    /Ypoint Rcylindre theta incrementANGLE 2 div add sin mul def
    /Zpoint H incrementHAUTEUR 2 div add def
CalculsPointsAfterTransformations
% Point sur l'axe du cylindre
% à la même hauteur que M1
    /Zpoint Z1 def
    /Xpoint 0 def
    /Ypoint 0 def
CalculsPointsAfterTransformations
% normale à la facette
    /nXfacette Xfacette Xabscisse sub def
    /nYfacette Yfacette Yordonnee sub def
    /nZfacette Zfacette Zcote sub def
% rayon vers point de vue
    /RXvue Xfacette XpointVue sub def
    /RYvue Yfacette YpointVue sub def
    /RZvue Zfacette ZpointVue sub def
% test de visibilité
    /PSfacette nXfacette RXvue mul
    nYfacette RYvue mul add
    nZfacette RZvue mul add
    def
PSfacette 0 le {
theta 1 theta incrementANGLE add {%
    /theta1 exch def
    /Xpoint Rcylindre theta1 cos mul def
    /Ypoint Rcylindre theta1 sin mul def
    /Zpoint H def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
H 1 H incrementHAUTEUR add {
    /H1 exch def
    /Xpoint Rcylindre  theta incrementANGLE add cos mul def
    /Ypoint Rcylindre theta incrementANGLE add sin mul def
    /Zpoint H1 def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
theta incrementANGLE add -1 theta {%
    /theta1 exch def
    /Xpoint Rcylindre theta1 cos mul def
    /Ypoint Rcylindre theta1 sin mul def
    /Zpoint H incrementHAUTEUR add def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
H incrementHAUTEUR add -1 H {
    /H1 exch def
    /Xpoint Rcylindre theta cos mul def
    /Ypoint Rcylindre theta sin mul def
    /Zpoint H1 def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
} if
} for
} for
% Face supérieure
% centre de la face supérieure
    /Xpoint 0 def
    /Zpoint Hcylindre def
    /Ypoint 0 def
CalculsPointsAfterTransformations
    /CxFaceSup Xabscisse def
    /CyFaceSup Yordonnee def
    /CzFaceSup Zcote def
% centre de la face inférieure
    /CxFaceInf CX def
    /CyFaceInf CY def
    /CzFaceInf CZ def
% Normale à la face supérieure
    /nXFaceSup CxFaceSup CxFaceInf sub def
    /nYFaceSup CyFaceSup CyFaceInf sub def
    /nZFaceSup CzFaceSup CzFaceInf sub def
% rayon vers point de vue verd la face inférieure
    /RXvueInf CxFaceInf XpointVue sub def
    /RYvueInf CyFaceInf YpointVue sub def
    /RZvueInf CzFaceInf ZpointVue sub def
% rayon vers point de vue verd la face supérieure
    /RXvueSup CxFaceSup XpointVue sub def
    /RYvueSup CyFaceSup YpointVue sub def
    /RZvueSup CzFaceSup ZpointVue sub def
% Visibilité face supérieure
    /PSfaceSup RXvueSup nXFaceSup mul
               RYvueSup nYFaceSup mul add
               RZvueSup nZFaceSup mul add def
% Visibilité face inférieure
    /PSfaceInf RXvueInf nXFaceSup neg mul
               RYvueInf nYFaceSup mul sub
               RZvueInf nZFaceSup mul sub def
PSfaceSup 0 le {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /Xpoint Rcylindre theta cos mul def
    /Ypoint Rcylindre theta sin mul def
    /Zpoint Hcylindre def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
% face inférieure
PSfaceInf 0 le {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /Xpoint Rcylindre theta cos mul def
    /Ypoint Rcylindre theta sin mul def
    /Zpoint 0 def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
 0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
%
\def\FrameThreeD{\pst@object{FrameThreeD}}
\def\FrameThreeD@i{\@ifnextchar[{\FrameThreeD@do}{\FrameThreeD@do[]}}
\def\FrameThreeD@do[#1](#2,#3)(#4,#5){{%
% (#2,#3) d'un sommet
% (#4,#5) du sommet opposé
% rectangle ABCD
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
/XA #2 def
/YA #3 def
/XC #4 def
/YC #5 def
% on en déduit les autres sommets
/XB XC def
/YB YA def
/XD XA def
/YD YC def
\variablesTroisD
/XO' \psk@TroisD@Xorigine\space def
/YO' \psk@TroisD@Yorigine\space def
/ZO' \psk@TroisD@Zorigine\space def
tx@3DDict begin
reduction reduction scale
    /Xframe XA def
    /Yframe YA def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
     moveto
0 0.01 1 { % k
    /K exch def
    /Xframe K XB mul 1 K sub XA mul add def
    /Yframe K YB mul 1 K sub YA mul add def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Xframe K XC mul 1 K sub XB mul add def
    /Yframe K YC mul 1 K sub YB mul add def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Xframe K XD mul 1 K sub XC mul add def
    /Yframe K YD mul 1 K sub YC mul add def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    } for
0 0.01 1 { % k
    /K exch def
    /Xframe K XA mul 1 K sub XD mul add def
    /Yframe K YA mul 1 K sub YD mul add def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    } for
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
%
\def\LineThreeD{\pst@object{LineThreeD}}
\def\LineThreeD@i{\@ifnextchar[{\LineThreeD@do}{\LineThreeD@do[]}}
\def\LineThreeD@do[#1](#2,#3,#4)(#5,#6,#7){{%
% (#2,#3,#4) coordonnées du point1
% (#5,#6,#7) coordonnées du point2
\pst@killglue
\setkeys{psset}{#1}%
\begin@OpenObj
\addto@pscode{%
\variablesTroisD
reduction reduction scale
/X1 #2 def
/Y1 #3 def
/Z1 #4 def
/X2 #5 def
/Y2 #6 def
/Z2 #7 def
tx@3DDict begin
/TableauxPoints [
0 0.01 1.01 { % k
    /K exch def
    [
    /Zcote K Z2 mul 1 K sub Z1 mul add def
    /Xabscisse K X2 mul 1 K sub X1 mul add def
    /Yordonnee K Y2 mul 1 K sub Y1 mul add def
    CalcCoordinates ]
    } for
 ] def
 TableauxPoints 0 get aload pop moveto
 0 1 100 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
% fin du tracé de la ligne
end
 }% fin du code ps
 \end@OpenObj
 }}% % fin de la commande PSTricks
%
%
%
% transformation d'un point
\def\PointThreeD{\@ifnextchar[{\pst@PointThreeD}{\pst@PointThreeD[]}}
%
\def\pst@PointThreeD[#1](#2,#3,#4)#5{{%
%(#2,#3,#4) coordonnées
% #5 nom attribué au point
\pst@killglue
\setkeys{psset}{#1}%
\pnode(!
\variablesTroisD
 /Zcote #4 def
 /Xabscisse #2 def
 /Yordonnee #3 def
tx@3DDict begin
formulesTroisD
 Xi reduction mul Yi reduction mul
 end){#5}
}}
%
% transformation d'un point
\def\PointLongitudeLatitude{\@ifnextchar[{\pst@PointLongitudeLatitude}{\pst@PointLongitudeLatitude[]}}
%
\def\pst@PointLongitudeLatitude[#1]#2#3#4#5{{%
% #2 radius
% #3 longitude
% #4 latitude
% #5 nom attribué au point
\pst@killglue
\setkeys{psset}{#1}%
\pnode(!
\variablesTroisD
/Radius #2 def
/longitude #3 def
/latitude #4 def
 /Zcote Radius latitude sin mul def
 /Xabscisse Radius longitude cos mul latitude cos mul def
 /Yordonnee Radius longitude sin mul latitude cos mul def
tx@3DDict begin
formulesTroisD
 Xi reduction mul Yi reduction mul
 end){#5}
}}
%
\def\Tetraedre{\pst@object{Tetraedre}}
\def\Tetraedre@i{\@ifnextchar[{\Tetraedre@do}{\Tetraedre@do[]}}
\def\Tetraedre@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
tx@3DDict begin
Tetraedre
end
}% fin du code ps
\end@ClosedObj
}}
%
%
% pyramide
%
\def\FaceSAB{\pst@object{FaceSAB}}
\def\FaceSAB@i{\@ifnextchar[{\FaceSABC@do}{\FaceSAB@do[]}}
\def\FaceSAB@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
tx@3DDict begin
SommetsPyramide
 PSAB 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
     moveto
    /Xabscisse XA def
    /Yordonnee YA def
    /Zcote ZA def
    CalcCoordinates
    lineto
    /Xabscisse XB def
    /Yordonnee YB def
    /Zcote ZB def
    CalcCoordinates
    lineto
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
    lineto
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\FaceSBC{\pst@object{FaceSBC}}
\def\FaceSBC@i{\@ifnextchar[{\FaceSBC@do}{\FaceSBC@do[]}}
\def\FaceSBC@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
tx@3DDict begin
SommetsPyramide
 PSBC 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
     moveto
    /Xabscisse XB def
    /Yordonnee YB def
    /Zcote ZB def
    CalcCoordinates
    lineto
     /Xabscisse XC def
    /Yordonnee YC def
    /Zcote ZC def
    CalcCoordinates
    lineto
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
    lineto
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
%
\def\FaceSCD{\pst@object{FaceSCD}}
\def\FaceSCD@i{\@ifnextchar[{\FaceSCD@do}{\FaceSCD@do[]}}
\def\FaceSCD@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
tx@3DDict begin
SommetsPyramide
PSCD 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
     moveto
    /Xabscisse XC def
    /Yordonnee YC def
    /Zcote ZC def
    CalcCoordinates
    lineto
    /Xabscisse XD def
    /Yordonnee YD def
    /Zcote ZD def
    CalcCoordinates
    lineto
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
    lineto
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\FaceSDA{\pst@object{FaceSDA}}
\def\FaceSDA@i{\@ifnextchar[{\FaceSDA@do}{\FaceSDA@do[]}}
\def\FaceSDA@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
tx@3DDict begin
SommetsPyramide
 PSDA 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
     moveto
    /Xabscisse XD def
    /Yordonnee YD def
    /Zcote ZD def
    CalcCoordinates
    lineto
    /Xabscisse XA def
    /Yordonnee YA def
    /Zcote ZA def
    CalcCoordinates
    lineto
    /Xabscisse XS def
    /Yordonnee YS def
    /Zcote ZS def
    CalcCoordinates
    lineto
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\FaceABCD{\pst@object{FaceABCD}}
\def\FaceABCD@i{\@ifnextchar[{\FaceABCD@do}{\FaceABCD@do[]}}
\def\FaceABCD@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
tx@3DDict begin
SommetsPyramide
 PSABCD 0 le { %
reduction reduction scale
1 setlinejoin
    /Xabscisse XA def
    /Yordonnee YA def
    /Zcote ZA def
    CalcCoordinates
     moveto
    /Xabscisse XB def
    /Yordonnee YB def
    /Zcote ZB def
    CalcCoordinates
    lineto
    /Xabscisse XC def
    /Yordonnee YC def
    /Zcote ZC def
    CalcCoordinates
    lineto
    /Xabscisse XD def
    /Yordonnee YD def
    /Zcote ZD def
    CalcCoordinates
    lineto
    /Xabscisse XA def
    /Yordonnee YA def
    /Zcote ZA def
    CalcCoordinates
    lineto
} if
end
}% fin du code ps
\end@ClosedObj
}}
%
\def\Pyramide{\pst@object{Pyramide}}
\def\Pyramide@i{\@ifnextchar[{\Pyramide@do}{\Pyramide@do[]}}
\def\Pyramide@do[#1]{{%
\FaceSAB[fillcolor=\psk@TroisD@TetraedreColorFaceA]%
\FaceSBC[fillcolor=\psk@TroisD@TetraedreColorFaceB]%
\FaceSCD[fillcolor=\psk@TroisD@TetraedreColorFaceC]%
\FaceSDA[fillcolor=\psk@TroisD@TetraedreColorFaceD]%
\FaceABCD[fillcolor=\psk@TroisD@TetraedreColorFaceE]%
}}
%
%
\def\ConeThreeD{\pst@object{ConeThreeD}}
\def\ConeThreeD@i{\@ifnextchar[{\ConeThreeD@do}{\ConeThreeD@do[]}}
\def\ConeThreeD@do[#1]#2#3{{%
% Le centre de la base sera placé avec
% les paramètres CX,CY et CZ
% #2 rayon
% #3 hauteur
% on peut ensuite faire tourner le cylindre
% avec RotX, RotY et RotZ
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
    /fracHcone \psk@TroisD@fracHcone\space def
% fraction de la hauteur du cone 0<fracHcone<1
reduction reduction scale
    /Rcone #2 def
    /Hcone #3 def
    /AngleCone Rcone Hcone atan def
    /TanAngleCone AngleCone dup sin exch cos div def
    /incrementANGLE 10 def
    /incrementHAUTEUR Hcone fracHcone mul  5 div def
tx@3DDict begin
newpath
0 incrementANGLE 360 {%
    /theta exch def
 0 incrementHAUTEUR Hcone fracHcone mul incrementHAUTEUR sub {%
    /H exch def
 % normale à la facette
    /nXfacette Hcone AngleCone dup sin exch cos mul theta incrementANGLE 2 div add cos mul
    mul def
    /nYfacette Hcone AngleCone dup sin exch cos mul theta incrementANGLE 2 div add sin mul
    mul def
    /nZfacette Hcone AngleCone sin dup mul mul def
    /Xpoint nXfacette def
    /Ypoint nYfacette def
    /Zpoint nZfacette def
CalculsPointsAfterTransformations
    /nXfacette Xabscisse CX sub def
    /nYfacette Yordonnee CY sub def
    /nZfacette Zcote CZ sub def
%
    /OK Hcone H sub TanAngleCone mul def
    /Xpoint OK theta cos mul def
    /Ypoint OK theta sin mul def
    /Zpoint H def
CalculsPointsAfterTransformations
    /Xfacette Xabscisse  def
    /Yfacette Yordonnee  def
    /Zfacette Zcote def
    CalcCoordinates
     moveto
% coordonnées du centre de la facette
    /OK Hcone H incrementHAUTEUR 2 div add sub TanAngleCone mul def
    /Xpoint OK theta incrementANGLE 2 div add cos mul def
    /Ypoint OK theta incrementANGLE 2 div add sin mul def
    /Zpoint H incrementHAUTEUR 2 div add def
CalculsPointsAfterTransformations
    /XcentreFacette Xabscisse  def
    /YcentreFacette Yordonnee  def
    /ZcentreFacette Zcote def
% rayon vers point de vue
    /RXvue XcentreFacette XpointVue sub def
    /RYvue YcentreFacette YpointVue sub def
    /RZvue ZcentreFacette ZpointVue sub def
% test de visibilité
    /PSfacette nXfacette RXvue mul
    nYfacette RYvue mul add
    nZfacette RZvue mul add
    def
PSfacette 0 le {
theta 1 theta incrementANGLE add {%
    /theta1 exch def
    /OK Hcone H sub TanAngleCone mul def
    /Xpoint OK theta1 cos mul def
    /Ypoint OK theta1 sin mul def
    /Zpoint H def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
H 1 H incrementHAUTEUR add {
    /H1 exch def
    /OK Hcone H1 sub TanAngleCone mul def
    /Xpoint OK theta incrementANGLE add cos mul def
    /Ypoint OK theta incrementANGLE add sin mul def
    /Zpoint H1 def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
theta incrementANGLE add -1 theta {%
    /theta1 exch def
    /OK Hcone H incrementHAUTEUR add sub TanAngleCone mul def
    /Xpoint OK theta1 cos mul def
    /Ypoint OK theta1 sin mul def
    /Zpoint H incrementHAUTEUR add def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
H incrementHAUTEUR add -1 H {
    /H1 exch def
    /OK Hcone H1 sub TanAngleCone mul def
    /Xpoint OK theta cos mul def
    /Ypoint OK theta sin mul def
    /Zpoint H1 def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
} if
} for
} for
% centre de la base inférieure après transformations
    /CxFaceInf CX def
    /CyFaceInf CY def
    /CzFaceInf CZ def
    /Xpoint CxFaceInf def
    /Ypoint CyFaceInf def
    /Zpoint CzFaceInf def
CalculsPointsAfterTransformations
    /CxBaseInf Xabscisse def
    /CyBaseInf Yordonnee def
    /CzBaseInf Zcote def
% centre de la base supérieure avant transformations
    /CxFaceSup 0 def
    /CyFaceSup 0 def
    /CzFaceSup Hcone fracHcone mul def
% Sommet du cone
    /Xpoint 0 def
    /Ypoint 0 def
    /Zpoint Hcone def
CalculsPointsAfterTransformations
    /XsommetCone Xabscisse def
    /YsommetCone Yordonnee def
    /ZsommetCone Zcote def
% Normale extérieure à la base inférieure
    /nXBaseInf CxFaceInf XsommetCone sub def
    /nYBaseInf CyFaceInf YsommetCone sub def
    /nZBaseInf CzFaceInf ZsommetCone sub def
% centre de la base supérieure
    /Xpoint CxFaceSup def
    /Ypoint CyFaceSup def
    /Zpoint CzFaceSup def
CalculsPointsAfterTransformations
    /CxBaseSup Xabscisse def
    /CyBaseSup Yordonnee def
    /CzBaseSup Zcote def
% Normale extérieure à la base supérieure
    /nXBaseSup XsommetCone CxFaceSup sub def
    /nYBaseSup YsommetCone CyFaceSup sub def
    /nZBaseSup ZsommetCone CzFaceSup sub def
% rayon vers point de vue
    /RXvueSup CxBaseSup XpointVue sub def
    /RYvueSup CyBaseSup YpointVue sub def
    /RZvueSup CzBaseSup ZpointVue sub def
    /RXvueInf CxBaseInf XpointVue sub def
    /RYvueInf CyBaseInf YpointVue sub def
    /RZvueInf CzBaseInf ZpointVue sub def
% Visibilité de la base inférieure
    /PSbaseInfCone nXBaseInf RXvueInf mul
                nYBaseInf RYvueInf mul add
                nZBaseInf RZvueInf mul add def
% Visibilité de la base supérieure
    /PSbaseSupCone nXBaseSup RXvueSup mul
                nYBaseSup RYvueSup mul add
                nZBaseSup RZvueSup mul add def
PSbaseInfCone 0 le {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /Xpoint Rcone theta cos mul def
    /Ypoint Rcone theta sin mul def
    /Zpoint 0 def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
PSbaseSupCone 0 le {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /OK Hcone 1 fracHcone sub mul TanAngleCone mul def
    /Xpoint OK theta cos mul def
    /Ypoint OK theta sin mul def
    /Zpoint Hcone fracHcone mul def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}%
%
\def\CircleThreeD{\pst@object{CircleThreeD}}
\def\CircleThreeD@i{\@ifnextchar[{\CircleThreeD@do}{\CircleThreeD@do[]}}
\def\CircleThreeD@do[#1]#2{{%
% #2 rayon du cercle
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
/Rcercle #2 def
\variablesTroisD
/XO' \psk@TroisD@Xorigine\space def
/YO' \psk@TroisD@Yorigine\space def
/ZO' \psk@TroisD@Zorigine\space def
tx@3DDict begin
reduction reduction scale
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /Angle exch def [
    /Xcercle Rcercle Angle cos mul def
    /Ycercle Rcercle Angle sin mul def
    /Xabscisse Xcercle S1 mul Ycercle S2 C1 mul mul add XO' add
    def
    /Yordonnee Xcercle C1 mul neg Ycercle S2 S1 mul mul add YO' add
    def
    /Zcote Ycercle C2 mul neg ZO' add def
    CalcCoordinates ]
    } for
    ] def
 TableauxPoints 0 get aload pop moveto
 0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
 end
}% fin du code ps
\showpointsfalse
\end@ClosedObj
}}
%
%
\def\FrameThreeD{\pst@object{FrameThreeD}}
\def\FrameThreeD@i{\@ifnextchar[{\FrameThreeD@do}{\FrameThreeD@do[]}}
\def\FrameThreeD@do[#1](#2,#3)(#4,#5){{%
% (#2,#3) d'un sommet
% (#4,#5) du sommet opposé
% rectangle ABCD
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
/XA #2 def
/YA #3 def
/XC #4 def
/YC #5 def
% on en déduit les autres sommets
/XB XC def
/YB YA def
/XD XA def
/YD YC def
\variablesTroisD
/XO' \psk@TroisD@Xorigine\space def
/YO' \psk@TroisD@Yorigine\space def
/ZO' \psk@TroisD@Zorigine\space def
tx@3DDict begin
reduction reduction scale
    /Xframe XA def
    /Yframe YA def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
     moveto
    /Xframe XB def
    /Yframe YB def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    /Xframe XC def
    /Yframe YC def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    /Xframe XD def
    /Yframe YD def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
    /Xframe XA def
    /Yframe YA def
    /Xabscisse Xframe S1 mul Yframe S2 C1 mul mul add XO' add
    def
    /Yordonnee Xframe C1 mul neg Yframe S2 S1 mul mul add YO' add
    def
    /Zcote Yframe C2 mul neg ZO' add def
    CalcCoordinates
    lineto
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
%
\def\QuadrillageThreeD{\pst@object{QuadrillageThreeD}}
\def\QuadrillageThreeD@i{\@ifnextchar[{\QuadrillageThreeD@do}{\QuadrillageThreeD@do[]}}
\def\QuadrillageThreeD@do[#1]{{%
\pst@killglue
\setkeys{psset}{#1}%
\begin@OpenObj
\addto@pscode{%
\variablesTroisD
/XO' \psk@TroisD@Xorigine\space def
/YO' \psk@TroisD@Yorigine\space def
/ZO' \psk@TroisD@Zorigine\space def
/Xmax \psk@TroisD@Xmax\space def
/Ymax \psk@TroisD@Ymax\space def
/Xmin \psk@TroisD@Xmin\space def
/Ymin \psk@TroisD@Ymin\space def
/pas \psk@TroisD@pas\space def
/grille \psk@TroisD@grille\space def
tx@3DDict begin
reduction reduction scale
Ymin grille Ymax {% balayage suivant Oy
    /Ygrille exch def
/TableauxPoints [
    Xmin pas Xmax { % balayage suivant Ox
    /Xgrille exch def
    /Xabscisse Xgrille S1 mul Ygrille S2 C1 mul mul add XO' add
    def
    /Yordonnee Xgrille C1 mul neg Ygrille S2 S1 mul mul add YO' add
    def
    /Zcote Ygrille C2 mul neg ZO' add def
    formulesTroisD
        [
         Xi 28.45 mul Yi 28.45 mul %
        ]
        } for
    ] def
 TableauxPoints 0 get aload pop moveto
 0 1 Xmax Xmin sub pas div {
    /compteur exch def
    TableauxPoints compteur get aload pop
   lineto } for
% stroke
    } for
%
Xmin grille Xmax {% balayage suivant Ox
    /Xgrille exch def
/TableauxPoints [
    Ymin pas Ymax { % balayage suivant Ox
    /Ygrille exch def
    /Xabscisse Xgrille S1 mul Ygrille S2 C1 mul mul add XO' add
    def
    /Yordonnee Xgrille C1 mul neg Ygrille S2 S1 mul mul add YO' add
    def
    /Zcote Ygrille C2 mul neg ZO' add def
    formulesTroisD
        [
         Xi 28.45 mul Yi 28.45 mul %
        ]
        } for
    ] def
 TableauxPoints 0 get aload pop moveto
  0 1 Ymax Ymin sub pas div {
    /compteur exch def
    TableauxPoints compteur get aload pop
   lineto } for
  \pst@number\pslinewidth SLW
  \pst@usecolor\pslinecolor
  \@nameuse{psls@\pslinestyle}
% stroke
    } for
% fin du tracé
end
 }% fin du code ps
 \end@OpenObj
 }}% % fin de la commande PSTricks
%
%
% 11 novembre
\def\DemiSphereThreeD{\pst@object{DemiSphereThreeD}}
\def\DemiSphereThreeD@i{\@ifnextchar[{\DemiSphereThreeD@do}{\DemiSphereThreeD@do[]}}
\def\DemiSphereThreeD@do[#1]#2{{%
% (#2,#3,#4) coordonnées du centre
% #5 rayon
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
reduction reduction scale
    /Rsphere #2 def
    /increment 10 def
tx@3DDict begin
/condition {PSfacette 0 le} def
/departPhi 0 def
MaillageSphere
% centre de la base inférieure après transformations
    /CxFaceInf CX def
    /CyFaceInf CY def
    /CzFaceInf CZ def
    /Xpoint CxFaceInf def
    /Ypoint CyFaceInf def
    /Zpoint CzFaceInf def
CalculsPointsAfterTransformations
    /CxBaseInf Xabscisse def
    /CyBaseInf Yordonnee def
    /CzBaseInf Zcote def
    /RXvueInf CxBaseInf XpointVue sub def
    /RYvueInf CyBaseInf YpointVue sub def
    /RZvueInf CzBaseInf ZpointVue sub def
% Sommet de la sphère
    /Xpoint 0 def
    /Ypoint 0 def
    /Zpoint Rsphere def
CalculsPointsAfterTransformations
    /XsommetSphere Xabscisse def
    /YsommetSphere Yordonnee def
    /ZsommetSphere Zcote def
% Normale extérieure à la base inférieure
    /nXBaseInf CxFaceInf XsommetSphere sub def
    /nYBaseInf CyFaceInf YsommetSphere sub def
    /nZBaseInf CzFaceInf ZsommetSphere sub def
% Visibilité de la base inférieure
    /PSbaseSphere nXBaseInf RXvueInf mul
                  nYBaseInf RYvueInf mul add
                  nZBaseInf RZvueInf mul add def
PSbaseSphere 0 le {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /Xpoint Rsphere theta cos mul def
    /Ypoint Rsphere theta sin mul def
    /Zpoint 0 def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
gsave
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
fill
grestore
 } if
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
%
\def\SphereCreuse{\pst@object{SphereCreuse}}
\def\SphereCreuse@i{\@ifnextchar[{\SphereCreuse@do}{\SphereCreuse@do[]}}
\def\SphereCreuse@do[#1]#2{{%
% (#2,#3,#4) coordonnées du centre
% #5 rayon
\pst@killglue
\setkeys{psset}{#1}%
\begin@ClosedObj
\addto@pscode{%
\variablesTroisD
reduction reduction scale
    /Rsphere #2 def
    /increment 10 def
tx@3DDict begin
/SphereInside {
/condition {PSfacette 0 ge} def
/departPhi 0 def
MaillageSphere
} def
%
% centre de la base inférieure après transformations
    /CxFaceInf CX def
    /CyFaceInf CY def
    /CzFaceInf CZ def
    /Xpoint CxFaceInf def
    /Ypoint CyFaceInf def
    /Zpoint CzFaceInf def
CalculsPointsAfterTransformations
    /CxBaseInf Xabscisse def
    /CyBaseInf Yordonnee def
    /CzBaseInf Zcote def
    /RXvueInf CxBaseInf XpointVue sub def
    /RYvueInf CyBaseInf YpointVue sub def
    /RZvueInf CzBaseInf ZpointVue sub def
% Sommet de la sphère
    /Xpoint 0 def
    /Ypoint 0 def
    /Zpoint Rsphere def
CalculsPointsAfterTransformations
    /XsommetSphere Xabscisse def
    /YsommetSphere Yordonnee def
    /ZsommetSphere Zcote def
% Normale extérieure à la base inférieure
    /nXBaseInf CxFaceInf XsommetSphere sub def
    /nYBaseInf CyFaceInf YsommetSphere sub def
    /nZBaseInf CzFaceInf ZsommetSphere sub def
% Visibilité de la base inférieure
    /PSbaseSphere nXBaseInf RXvueInf mul
                  nYBaseInf RYvueInf mul add
                  nZBaseInf RZvueInf mul add def
/base {
/TableauxPoints [
0 1 359 {% on décrit le cercle
    /theta exch def [
    /Xpoint Rsphere theta cos mul def
    /Ypoint Rsphere theta sin mul def
    /Zpoint 0 def
CalculsPointsAfterTransformations
    CalcCoordinates ]
    } for
    ] def
% gsave
newpath
 TableauxPoints 0 get aload pop moveto
0 1 359 {
    /compteur exch def
    TableauxPoints compteur get aload pop
    lineto } for
0.7 setgray
closepath
% stroke
%grestore
} def
PSbaseSphere 0 le {
base
clip
SphereInside
 } { 0 0 0.01 0 360 arc } ifelse
end
 }% fin du code ps
\showpointsfalse
\end@ClosedObj
 }}% % fin de la commande PSTricks
%
%% END: pst-3DNew.tex
