%% $Id: pst-gears.tex 1185 2025-12-15 15:43:57Z herbert $ %% %% Package `pst-gears.tex' %% %% Manuel Luque %% Herbert Voss %% %% This program can be redistributed and/or modified under the terms %% of the LaTeX Project Public License Distributed from CTAN archives %% in directory macros/latex/base/lppl.txt. %% %% DESCRIPTION: %% `pst-func' is a PSTricks package to plot special functions \csname PSTGEARSLoaded\endcsname \let\PSTGEARSLoaded\endinput % Requires some packages \ifx\PSTricksLoaded\endinput\else \input pstricks \fi \ifx\PSTXKeyLoaded\endinput\else \input pst-xkey \fi \def\fileversion{0.61} \def\filedate{2025/12/14} \message{`PSTGEARS' v\fileversion, \filedate} \edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax \pst@addfams{pst-gears} \define@key[psset]{pst-gears}{Z1}{\def\psk@ZA{#1 }} \psset[pst-gears]{Z1=20} \define@key[psset]{pst-gears}{Z2}{\def\psk@ZB{#1 }} \psset[pst-gears]{Z2=10} \define@key[psset]{pst-gears}{m}{\def\psk@m{#1 }} \psset[pst-gears]{m=0.5} \define@key[psset]{pst-gears}{ap}{\def\psk@ap{#1 }} \psset[pst-gears]{ap=20} \define@key[psset]{pst-gears}{Rarct}{\def\psk@Rarct{#1 }} \psset[pst-gears]{Rarct=0.1} \define@key[psset]{pst-gears}{wheelrotation}{\def\psk@wheelrotation{#1 }} \psset[pst-gears]{wheelrotation=0} \define@key[psset]{pst-gears}{polarangle}{\def\psk@polarangle{#1 }} \psset[pst-gears]{polarangle=0} \define@key[psset]{pst-gears}{color1}{\pst@getcolor{#1}\pscolora} \psset[pst-gears]{color1={[rgb]{0.625 0.75 1}}} \define@key[psset]{pst-gears}{color2}{\pst@getcolor{#1}\pscolorb} \psset[pst-gears]{color2={[rgb]{0.75 1 0.75}}} \define@key[psset]{pst-gears}{colorcircles}{\pst@getcolor{#1}\pscolorc} \psset[pst-gears]{colorcircles=red} % %% === Option pour ne pas dessiner le type d'engrenage --------------------- \newif\ifPst@gears@int \newif\ifPst@gears@clockwork \newif\ifPst@gears@circles \newif\ifPst@gears@key \define@key[psset]{pst-gears}{int}[true]{\@nameuse{Pst@gears@int#1}} \psset[pst-gears]{int=false} % \define@key[psset]{pst-gears}{drawWheels}{\def\psk@drawWheels{#1 }} \psset[pst-gears]{drawWheels=1 1} % style horlogerie clockwork % 26 avril 2020 \define@key[psset]{pst-gears}{clockwork}[true]{\@nameuse{Pst@gears@clockwork#1}} \psset[pst-gears]{clockwork=false} %% === pour dessiner cercle de base et cercle primitif \define@key[psset]{pst-gears}{circles}[true]{\@nameuse{Pst@gears@circles#1}} \psset[pst-gears]{circles=false} % %% === pour dessiner la clavette \define@key[psset]{pst-gears}{key}[true]{\@nameuse{Pst@gears@key#1}} \psset[pst-gears]{key=true} % \def\pstgears{\def\pst@par{}\pst@object{pstgears}} \def\pstgears@i{\@ifnextchar({\pstgears@do}{\pstgears@do(0,0)}} \def\pstgears@do(#1){% \begin@SpecialObj \pst@@getcoor{#1}% \addto@pscode{% \pst@coor /t@@y ED /t@@x ED /cm {\pst@number\psunit mul } bind def /Z1 \psk@ZA def /m@ \psk@m def /Z2 \psk@ZB def /ap \psk@ap def /facteurRayonRaccord {\psk@Rarct mul} def /polarAngle \psk@polarangle def \psk@drawWheels /drawWheel2 exch def /drawWheel1 exch def /color1 {\pst@usecolor\pscolora } def /color2 {\pst@usecolor\pscolorb } def /colorcircles {\pst@usecolor\pscolorc } def /linecolor {\pst@usecolor\pslinecolor} def /Fill { \psk@opacityalpha .setopacityalpha fill } def % /Pi 3.14159265359 def % /rad2deg { 180 mul Pi div } bind def % /deg2rad { 180 div Pi mul } bind def %/RadtoDeg { 180 mul Pi div } bind def % convert from radian to degrees %/DegtoRad { Pi mul 180 div } bind def % viceversa all from pstricks.pro 1 setlinejoin /Datas1 { /Z@ exch def /m@ exch def /R@ {m@ Z@ mul 2 div } bind def % cercle primitif /Rb {R@ ap cos mul } bind def % cercle de base /Rp {R@ 2 mul 2.5 m@ mul sub 2 div } bind def % cercle de pied /Rt {R@ 2 mul 2 m@ mul add 2 div } bind def % cercle de tête } def /Datas2 { % for internal gearing /Z@ exch def /m@ exch def /R@ {m@ Z@ mul 2 div } bind def % cercle primitif /Rb {R@ ap cos mul } bind def % cercle de base /Rp {R@ 2 mul 2 m@ mul sub 2 div } bind def % cercle de pied /Rt {R@ 2 mul 2.5 m@ mul add 2 div } bind def % cercle de tête } def /Calculs { R@ 1 ge { /rScrew R@ 10 div cm def }{ /rScrew R@ 5 div cm def } ifelse % les valeurs suivantes sont en radians /ThetaP {R@ Rb div dup mul 1 sub sqrt } bind def % intersection avec cercle primitif /ThetaT {Rt Rb div dup mul 1 sub sqrt } bind def % intersection avec cercle de tete % Les valeurs suivantes ont en degrés /ThetaTdeg {Rt Rb div dup mul 1 sub sqrt RadtoDeg } bind def % /ThetaPdeg {R@ Rb div dup mul 1 sub sqrt RadtoDeg } bind def /ThetaPieddeg {Rp Rb div dup mul 1 sub abs sqrt RadtoDeg } bind def /DeltaP {ThetaPdeg sin ThetaP ThetaPdeg cos mul sub ThetaPdeg cos ThetaP ThetaPdeg sin mul add atan } bind def /DeltaT {ThetaTdeg sin ThetaT ThetaTdeg cos mul sub ThetaTdeg cos ThetaT ThetaTdeg sin mul add atan } bind def /DeltaS {Pi 2 div Z@ div } bind def /DeltaSdeg {90 Z@ div } bind def /AngleDent {360 Z@ div} bind def /Alpha {DeltaSdeg DeltaP add DeltaT sub } bind def /2Beta {DeltaSdeg DeltaP add 2 mul } bind def /Beta_ {DeltaSdeg DeltaP add neg} bind def Rp Rb ge {/Rb Rp def} if /ptA {Rp cm 0} bind def /ptB {Rb cm 0} bind def /ptC {Rp cm DeltaSdeg 2 mul neg 2Beta 2 div add cos mul Rp cm DeltaSdeg 2 mul neg 2Beta 2 div add sin mul} bind def /ptA'{Rp cm DeltaP DeltaSdeg add 2 mul cos mul Rp cm DeltaP DeltaSdeg add 2 mul sin mul} bind def /ptB'{Rb cm DeltaP DeltaSdeg add 2 mul cos mul Rb cm DeltaP DeltaSdeg add 2 mul sin mul} bind def /ptC'{Rp cm DeltaSdeg 3 mul DeltaP add cos mul Rp cm DeltaSdeg 3 mul DeltaP add sin mul} bind def /Raxe {Rp 4 div } bind def /A@0 14.5 def % position et largeur de la clavette % rayon de raccordement sur le cercle de pied /Rarct {Rp Pi mul Z@ div 12 div cm} bind def % rayon pour le style horlogerie /Rayon Rp cm 0.8 mul def } def % Le symetrique P' de P par rapport a la l'axe de la dent % Delta(axe de la dent) y=x*tan(Beta) % x'=y*sin(2*Beta)+x*cos(2*Beta) % y'=x*sin(2*Beta)-y*cos(2*Beta) % x y symAxe -> x' y' /symAxe { 2 dict begin /y exch def /x exch def y 2Beta sin mul x 2Beta cos mul add % x' x 2Beta sin mul y 2Beta cos mul sub % y' end } def % % Rotation pour amener l'axe de la dent horizontal % /RotDent { 2 dict begin /y exch def /x exch def i@ cos x mul i@ sin y mul sub i@ sin x mul i@ cos y mul add end } def % % developpante du cercle de base % /devCercle { 1 dict begin /t exch def % en degres Rb t cos t DegtoRad t sin mul add mul cm % x Rb t sin t DegtoRad t cos mul sub mul cm % y end } def % trace des cercles /Circles { gsave [ \psk@dash\space ] 0 setdash newpath 0 0 R@ cm 0 360 arc closepath colorcircles stroke newpath 0 0 Rb cm 0 360 arc closepath newpath 0 0 Rp cm 0 360 arc closepath stroke grestore } def %%%% definition de la roue dentee %%%%%% /Roue { % arc de développante /tabArcDev [ 0 1 ThetaTdeg { /i@ exch def [i@ devCercle] } for ] def % /n@ tabArcDev length def % /tabDent [ % l'arc de developpante initial tabArcDev aload pop % l'arc ce cercle de tete DeltaT 0.1 2Beta DeltaT sub {/i@ exch def [Rt cm i@ cos mul Rt cm i@ sin mul] } for % le symetrique de l'arc de developpante par rapport a l'axe de la dent n@ 1 sub -1 0 { /compteur exch def [tabArcDev compteur get aload pop symAxe] } for ] def % tracé de la dent /n2@ tabDent length def newpath ptC moveto 0 1 Z@ 1 sub {/i@ exch AngleDent mul def \ifPst@gears@int wheel 1 eq { ptA RotDent ptB RotDent Rarct arct ptB RotDent lineto }{ ptA RotDent lineto ptB RotDent lineto} ifelse \else Rp Rb eq { ptA RotDent lineto ptB RotDent lineto }{ ptA RotDent ptB RotDent Rarct arct ptB RotDent lineto } ifelse \fi 0 1 n2@ 1 sub { /compteur exch def tabDent compteur get aload pop RotDent lineto } for \ifPst@gears@int wheel 2 eq { Rp Rb eq { ptA' RotDent lineto ptC' RotDent lineto }{ ptA' RotDent ptC' RotDent Rarct arct ptC' RotDent lineto } ifelse } { ptA' RotDent lineto ptC' RotDent lineto } ifelse \else Rp Rb eq { ptA' RotDent lineto ptC' RotDent lineto }{ ptA' RotDent ptC' RotDent Rarct arct ptC' RotDent lineto } ifelse \fi } for } def %%%% fin de la definition de la roue dentee %%% %%% axe de la roue %%% /AXE { %newpath Raxe 4 div cm A@0 cos Raxe mul cm moveto 0 0 Raxe cm 90 A@0 sub 90 A@0 add arcn Raxe 4 div cm neg A@0 cos Raxe mul cm lineto Raxe 4 div cm neg Raxe A@0 cos 0.2 add mul cm lineto Raxe 4 div cm Raxe A@0 cos 0.2 add mul cm lineto } def % axe sans la rainure /axe { 0 0 Raxe cm 0 360 arc } def %%% clavette %%% /CLAVETTE { newpath Raxe 4 div cm A@0 cos 0.2 sub Raxe mul cm moveto Raxe 4 div cm Raxe A@0 cos 0.2 add mul cm lineto Raxe 4 div cm neg Raxe A@0 cos 0.2 add mul cm lineto Raxe 4 div cm neg A@0 cos 0.2 sub Raxe mul cm lineto closepath } def %=== Style engrenage pour horlogerie === /RayonA { /Alpha 0.1 arcsin def /Beta 90 Alpha sub def /A1 {Rayon Alpha cos mul % x Rayon Alpha sin mul % y } def /A2 {Rayon Alpha sin mul % x Rayon Alpha cos mul % y } def /A3 {Rayon 10 div Rayon 5 div } def /A4 {Rayon 5 div Rayon 10 div } def A1 moveto A4 lineto Rayon 5 div dup Rayon 10 div 270 180 arcn A2 lineto 0 0 Rayon Beta Alpha arcn } def % /RayonB { 90 rotate RayonA } def /RayonC { 180 rotate RayonA } def /RayonD { 270 rotate RayonA } def /styleHorology { gsave Roue R@ 1 ge { RayonA RayonB RayonC RayonD } if closepath \ifx\psk@fillstyle\relax\else color1 Fill \fi grestore \ifx\pslinestyle\@none \else Roue R@ 1 ge { RayonA RayonB RayonC RayonD } if closepath linecolor stroke \fi newpath 0 0 rScrew 0 360 arc closepath \ifx\psk@fillstyle\relax\else color1 Fill \fi newpath 0 0 rScrew 0 360 arc closepath linecolor stroke % la vis rScrew 40 cos mul rScrew 40 sin mul moveto rScrew 50 cos mul neg rScrew 50 sin mul neg lineto stroke rScrew 50 cos mul rScrew 50 sin mul moveto rScrew 40 cos mul neg rScrew 40 sin mul neg lineto stroke } def % /COURONNE { % pour l'engrenage interieur 0 0 Rt 1.1 mul cm 360 0 arcn } def /AngleRotation \psk@wheelrotation def %%% Les dessins de l'engrenage %%%%%% %%%%%%%%%% Roue N°1 %%%%%%%%%%%%%%%%% drawWheel1 1 eq { /wheel 1 def gsave t@@x t@@y translate m@ Z1 \ifPst@gears@int /wheel 2 def Datas2 Calculs Beta_ AngleRotation sub rotate Roue COURONNE closepath \ifx\psk@fillstyle\relax\else color1 Fill \fi \ifx\pslinestyle\@none \else Roue closepath linecolor stroke COURONNE closepath linecolor stroke \fi \ifPst@gears@circles Circles \fi \else Datas1 Calculs Beta_ AngleRotation sub rotate \ifPst@gears@clockwork styleHorology \else % Beta_ AngleRotation sub rotate Roue \ifPst@gears@key AXE \else axe \fi closepath \ifx\psk@fillstyle\relax\else color1 Fill \fi \ifx\pslinestyle\@none \else Roue closepath linecolor stroke \fi \ifPst@gears@key AXE closepath \ifx\psk@fillstyle\relax\else 0.8 setgray Fill \fi AXE closepath linecolor stroke CLAVETTE \ifx\psk@fillstyle\relax\else 0 0.125 0.25 0.25 setcmykcolor Fill \fi CLAVETTE linecolor stroke \else axe \ifx\psk@fillstyle\relax\else 0.8 setgray Fill \fi axe linecolor stroke \fi \fi \fi \ifPst@gears@circles Circles \fi grestore } if %%%%%%%%%% Roue N°2 %%%%%%%%%%%%%%%%% drawWheel2 1 eq { /wheel 2 def gsave m@ Z2 Datas1 Calculs /a@ex m@ Z1 Z2 add mul 2 div cm def % entraxe engrenage exterieur /a@in m@ Z1 Z2 sub mul 2 div cm def % entraxe engrenage interieur \ifPst@gears@int a@in polarAngle cos mul t@@x add a@in polarAngle sin mul t@@y add translate Beta_ Z1 Z2 div AngleRotation mul sub polarAngle Z1 Z2 sub Z2 div mul sub rotate \else a@ex polarAngle cos mul t@@x add a@ex polarAngle sin mul t@@y add translate DeltaSdeg DeltaP add neg 180 Z2 div add 180 add Z1 Z2 div AngleRotation mul add polarAngle Z1 Z2 add Z2 div mul add rotate \fi \ifPst@gears@clockwork %gsave styleHorology %grestore \else Roue \ifPst@gears@key AXE \else axe \fi closepath \ifx\psk@fillstyle\relax\else color2 Fill \fi \ifx\pslinestyle\@none\else Roue closepath linecolor stroke \fi \ifPst@gears@key AXE closepath \ifx\psk@fillstyle\relax\else 0.8 setgray Fill \fi AXE closepath linecolor stroke CLAVETTE \ifx\psk@fillstyle\relax\else 0 0.125 0.25 0.25 setcmykcolor Fill \fi CLAVETTE linecolor stroke \else axe \ifx\psk@fillstyle\relax\else 0 0.125 0.25 0.25 setcmykcolor Fill \fi axe closepath linecolor stroke \fi \fi \ifPst@gears@circles Circles \fi grestore } if }% \end@SpecialObj}% % fin de la commande PSTricks \catcode`\@=\PstAtCode\relax % \endinput