[pstricks] 3D clipping - again

[MLuque5130 at aol.com]

>Is it possible to make a cut on a paraboloid
>parallel, for  example, to the z axis? 
 
In this example the plan contains axis OZ Its position is defined by the  
Start angle :
 
\documentclass{article}
\usepackage{pst-3d,pst-node}%
\usepackage{pst-xkey}%
\SpecialCoor
\makeatletter
\pst at addfams{pst-paraboloid}
\newif\ifPstParaboloid at Base
\define at key[psset]{pst-paraboloid}{Base}[true]{\@nameuse{PstParaboloid at Base#1}
}
\define at key[psset]{pst-paraboloid}{Start}{\edef\PstParaboloid at Start{#1}}
\psset{Base=false,Start=0}
%
\def\ParaboloidIIID{\pst at object{ParaboloidIIID}}
\def\ParaboloidIIID at i{\@ifnextchar[{\ParaboloidIIID at do}{\ParaboloidIIID at do[]}}
\def\ParaboloidIIID at do[#1]#2#3{{%
\pst at Verb{%
\psk at embedangle
\psk at viewpoint
\psk at viewangle
\tx at SetMatrixThreeD}
\pst at killglue
\psset{#1}%
\def\parameters{%
\psk at embedangle
\psk at viewpoint
\psk at viewangle
\tx at SetMatrixThreeD
% Vecteur  ViewPoint
\psk at viewpoint
/vZ  ED
/vY  ED
/vX  ED}
\begin at SpecialObj
\addto at pscode{%
/Start \PstParaboloid at Start\space  def
/End Start 170 add def
1 setlinejoin
\parameters
% Les  couleurs
/Cyan 0.5 def
/Magenta 0.5 def
/Yellow 1 def
% /K 0.5  def
% les rayons de lumière
/xLight 1 def
/yLight 0.5 def
/zLight 1  def
% précision du tracé
/pas 0.5 def
/pas10 {pas 10 div} bind  def
%
/NormeLight {xLight dup mul yLight dup mul zLight dup mul add  add
sqrt}  bind def
% l'ellipse du plan de coupe : le contour
/PlanCoupe  {
/Z Hauteur store
/V {Z sqrt} bind  def
/TableauxPoints [
Start 1 End {% on décrit le  cercle
/U exch def [
/Xpoint U cos V  mul AR mul \pst at number\psunit mul def
/Ypoint U sin V mul  AR mul \pst at number\psunit mul def
/Zpoint Z  \pst at number\psunit mul def
Xpoint Ypoint  Zpoint
\tx at ProjThreeD ]
}  for
] def
newpath
TableauxPoints 0 get aload  pop moveto
0 1 TableauxPoints length 1 sub {
/compteur  exch def
TableauxPoints compteur get aload  pop
lineto } for
closepath
}  def
%
/facette {
newpath
/Xpoint U cos V mul AR  mul \pst at number\psunit mul def
/Ypoint U sin V mul AR mul  \pst at number\psunit mul def
/Zpoint Z \pst at number\psunit  mul def
Xpoint Ypoint Zpoint  \tx at ProjThreeD
moveto
U 1 U increment add   {%
/U1 exch def
/Xpoint U1 cos V mul  AR mul \pst at number\psunit mul def
/Ypoint U1 sin V mul AR  mul \pst at number\psunit mul def
%    /Zpoint Z  \pst at number\psunit mul def
Xpoint Ypoint Zpoint  \tx at ProjThreeD
lineto
} for
Z  pas10 Z pas add {
/Z1 exch def
/V  {Z1 sqrt} bind def
/Xpoint U1 cos V mul AR mul  \pst at number\psunit mul def
/Ypoint U1 sin V mul AR mul  \pst at number\psunit mul def
/Zpoint Z1 \pst at number\psunit  mul def
Xpoint Ypoint Zpoint  \tx at ProjThreeD
lineto
} for
U  increment add -1 U {%
/U2 exch def
/Xpoint U2 cos V mul AR mul \pst at number\psunit mul def
/Ypoint U2 sin V mul AR mul \pst at number\psunit mul def
/Zpoint Z pas add \pst at number\psunit mul def
Xpoint Ypoint  Zpoint \tx at ProjThreeD
lineto
}  for
Z pas add pas10 neg Z pas10 sub{
/Z2 exch  def
/V {Z2 abs sqrt} bind def
/Xpoint U cos V mul AR mul \pst at number\psunit mul def
/Ypoint U sin V mul AR mul \pst at number\psunit mul def
/Zpoint Z2 \pst at number\psunit mul def
Xpoint Ypoint Zpoint  \tx at ProjThreeD
lineto
} for
closepath}  def
%
/MaillageParaboloid {
0 pas Hauteur pas  sub{%
/Z ED
/V {Z sqrt} bind  def
Start increment End {%
/U exch def
% Centre de  la facette
/Ucentre {U increment 2 div add} bind  def
/Vcentre {Z pas 2 div add sqrt} bind def
% normale  à la facette
/nXfacette {2 Vcentre dup mul mul Ucentre cos  mul} bind def
/nYfacette {2 Vcentre dup mul mul Ucentre  sin mul} bind def
/nZfacette Vcentre  def
/NormeN {nXfacette dup  mul
nYfacette dup  mul
nZfacette dup  mul
add  add sqrt} bind def
NormeN 0 eq {/NormeN 1e-10 def} if
% test de  visibilité
/PSfacette vX nXfacette  mul
vY nYfacette  mul add
vZ  nZfacette mul add
def
condition {
facette
/cosV  {1 xLight nXfacette mul
yLight nYfacette  mul
zLight nZfacette  mul
add  add
NormeLight
NormeN mul div sub} bind  def
% Cyan cosV dup mul mul Magenta cosV dup mul mul Yellow cosV mul K cosV  mul 
setcmykcolor
Cyan cosV mul dup mul Magenta cosV mul Yellow cosV mul 0  setcmykcolor
fill
0 setgray
facette
stroke
} if
} for
}  for
} def
/Hauteur #2 def
/AR #3  def
/increment 10 def
/conditionGE {PSfacette 0 ge}  def
/conditionLE {PSfacette 0 le}  def}%
\ifPstParaboloid at Base{%
\addto at pscode{%
/condition {conditionGE}  def
MaillageParaboloid
vZ 0 ge {%
PlanCoupe 1 0.5  0.5 setrgbcolor fill
PlanCoupe 0 setgray stroke}  if
}}%
\else
{%
\addto at pscode{%
/condition {conditionLE}  def
MaillageParaboloid
/condition {conditionGE}  def
MaillageParaboloid}%
}\fi%
% fin du code  ps
\showpointsfalse
\end at SpecialObj}}
\makeatother
%
\makeatletter
\let\ProjThreeD\tx at ProjThreeD
\def\pnodeThreeD(#1,#2,#3)#4{%
\pst at Verb{%
\psk at embedangle
\psk at viewpoint
\psk at viewangle
\tx at SetMatrixThreeD}
\pnode(!#1 #2 #3  \ProjThreeD){#4}}
\makeatother
\begin{document}
\begin{pspicture}(-5,-8)(5,10)
\psset{viewpoint=1  1  1}
\pnodeThreeD(0,0,0){O}
\pnodeThreeD(0,0,12){Z}
\pnodeThreeD(10,0,0){X}
\pnodeThreeD(0,10,0){Y}
\psline{->}(O)(X)
\psline{->}(O)(Y)
\psline{->}(O)(Z)
\uput[180](Z){$z$}
\uput[0](X){$x$}
\uput[0](Y){$y$}
%  Base=false
\ParaboloidIIID[Start=60]{7}{1.5}% hauteur, coefficient x et  y
\pnodeThreeD(0,0,7){U}
\psdot[dotsize=1mm,linecolor=red](U)
\psline{->}(U)(Z)
\end{pspicture}
 
\begin{pspicture}(-5,-8)(5,10)
\psset{viewpoint=1 1  0.2}%
\ParaboloidIIID[Base=true]{8}{2}% hauteur, coefficient x et  y
\pnodeThreeD(0,0,0){O}
\pnodeThreeD(0,0,12){Z}
\pnodeThreeD(10,0,0){X}
\pnodeThreeD(0,10,0){Y}
\psline{->}(O)(X)
\psline{->}(O)(Y)
\uput[180](Z){$z$}
\uput[0](X){$x$}
\uput[0](Y){$y$}
\pnodeThreeD(0,0,8){U}
\psdot[dotsize=1mm,linecolor=red](U)
\psline{->}(U)(Z)
\end{pspicture}

\end{document}

Manuel
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://tug.org/pipermail/pstricks/attachments/20051103/b33ce458/attachment.html