Azionamento desmo con attrito
Dinamica con attrito: da notare la programmazione e la varietà delle possibili configurazioni

SetDirectory[NotebookDirectory[]]

desmo = Import["desmo.jpg"]

desmo=

col1=Hue[0.67`,0.6`,0.6`];

col2=Hue[0.9060679774997897`,0.6`,0.6`];

col3=Hue[0.14213595499957954`,0.6`,0.6`];

b = 3/10;
e=2/10;
r=e+1/10;
a=6/10;
(*ω=10;*)
(*m=5.;*)
(*f=20/100;*)
g=981./100;

θ = 0 corrisponde a s = - e

s[ω_,t_]= -e Cos[ω t ]

x[ω_,t_]= e +s[ω,t]

xp[ω_,t_]=D[x[ω,t],t]

x2p[ω_,t_]=D[xp[ω,t],t]

Manipulate[(

Manipulate[Module[{eee,TA,TB,FA,FB,TD,FD,NA,NB},(
ω=2Pi*freq;

soltab=Table[Solve[{FD - Sign[xp[ω,tt]]*TA -Sign[xp[ω,tt]]* TB - m x2p[ω,tt]==0,
NA + NB - m *gravity - TD == 0,
FD e Sin[ω tt]+ NB (a/2 + s[ω,tt]) - NA (a/2- s[ω,tt]) - TD(b + a/2- s[ω,tt])+Sign[xp[ω,tt]]*fo NA b + Sign[xp[ω,tt]]*fo NB b ==0,
TD - fv FD == 0,
TA -Abs[fo NA]==0,
TB - Abs[fo NB]==0},
{FD,NA,NB,TD,TA,TB}],{tt,0,2Pi/ω,2Pi/ω/5}];



eqnf={FD - Sign[xp[ω,t]]*TA -Sign[xp[ω,t]]* TB - m x2p[ω,t]==0,
NA + NB - m *gravity - TD == 0,
FD e Sin[ω t]+ NB (a/2 + s[ω,t]) - NA (a/2- s[ω,t]) - TD(b + a/2- s[ω,t])+Sign[xp[ω,t]]*fo NA b + Sign[xp[ω,t]]*fo NB b ==0,
TD - fv FD == 0,
TA -Abs[fo NA]==0,
TB - Abs[fo NB]==0};

solf=Solve[eqnf,{FD,NA,NB,TD,TA,TB}];

FDf=FD/.solf[[1]];
NAf=NA/.solf[[1]];
NBf=NB/.solf[[1]];
TDf=TD/.solf[[1]];
TAf=TA/.solf[[1]];
TBf=TB/.solf[[1]];

θ= t ω/Degree;
angolo=(θ-90) Degree;

Column[{
Show[
Graphics[{EdgeForm[Thick],PointSize[0.012],
Opacity[0.35],
Green,
Rotate[Disk[{-(a/2+b+r),e},r],angolo,{-(a/2+b+r),0}],
Gray,
Rotate[Point[{-(a/2+b+r),e}],angolo,{-(a/2+b+r),0}],
Rotate[Line[{{-(a/2+b+r),e},{-(a/2+b+r),0}}],angolo,{-(a/2+b+r),0}],

Lighter[Orange],Translate[Rectangle[{-(a/2+b),-b},{(a/2+b),b}],{-e Sin[angolo],0}],
Gray,
Rotate[Disk[{(a/2+b+r),e},r],angolo,{(a/2+b+r),0}],
Rotate[Point[{(a/2+b+r),e}],angolo,{(a/2+b+r),0}],
Rotate[Line[{{(a/2+b+r),e},{(a/2+b+r),0}}],angolo,{(a/2+b+r),0}],

(*Opacity[0.1],
Rotate[Disk[{(a/2+b+r),e},r],-angolo+Pi,{(a/2+b+r),0}],*)

Opacity[1],

PointSize[0.0316],
Black,
Point[{-(a/2+b+r),0}],
Point[{(a/2+b+r),0}],

PointSize[0.016],
Black,
Point[{-a/2,-b*1.1}],
Point[{+a/2,-b*1.1}],
Point[{+a/2,+b*1.1}],
Point[{-a/2,+b*1.1}],

Red,
Point[{0,0}+{-e Sin[angolo],0}],

PointSize[0.0012],
col1,
Point[{-(a/2+b+r),0}+{e Cos[θ Degree]+r,e Sin[θ Degree]}],
Point[{+(a/2+b+r),0}+{e Cos[θ Degree]-r,e Sin[θ Degree]}],
Thick,

Arrowheads[.031],

If[FDf<=0,


{Arrow[{{-(a/2+b+r),0}+{e Cos[θ Degree]+r,e Sin[θ Degree]},
{-(a/2+b+r),0}+{e Cos[θ Degree]+r,e Sin[θ Degree]}+ 1/(120){-FDf,0}
}],
Arrow[{{-(a/2+b+r),0}+{e Cos[θ Degree]+r,e Sin[θ Degree]},
{-(a/2+b+r),0}+{e Cos[θ Degree]+r,e Sin[θ Degree]}+ 1/(120)Chop[fv{0,-Re[FDf]}]
}]
},

{
Arrow[{{+(a/2+b+r),0}+{e Cos[θ Degree]-r,e Sin[θ Degree]},
{+(a/2+b+r),0}+{e Cos[θ Degree]-r,e Sin[θ Degree]}+ 1/(120){-Re[FDf],0}
}],

Arrow[{{+(a/2+b+r),0}+{e Cos[θ Degree]-r,e Sin[θ Degree]},
{+(a/2+b+r),0}+{e Cos[θ Degree]-r,e Sin[θ Degree]}+ 1/(120)Chop[fv{0,-Re[FDf]}]
}]
},

{Point[{0,0}]}
],

Black,
Arrow[{{0,0}+{-e Sin[angolo],0},{0,0}+{-e Sin[angolo],0}- {0,1/(120) m *gravity}}],
Arrow[{{0,0}+{-e Sin[angolo],0},{0,0}+{-e Sin[angolo],0}- {-1/(120) m*x2p[ω,t],0}}],

col2,
If[NAf> 0,
{Arrow[{{-a/2,-b},{-a/2,-b}+{0,1/(120)(NAf)}}],
Arrow[{{-a/2,-b},{-a/2,-b}+{1/(120)(Sign[xp[ω,t]]*TAf),0}}]},
{Arrow[{{-a/2,+b},{-a/2,+b}+{0,1/(120)(Re[NAf])}}],
Arrow[{{-a/2,+b},{-a/2,+b}+{1/(120)(Sign[xp[ω,t]]*Re[TAf]),0}}]},

Point[{0,0}]
],


col3,
If[NBf> 0,
{Arrow[{{+a/2,-b},{+a/2,-b}+{0,1/(120)NBf}}],
Arrow[{{+a/2,-b},{+a/2,-b}+{1/(120)*(Sign[xp[ω,t]]*TBf),0}}]},
{Arrow[{{+a/2,+b},{+a/2,+b}+{0,1/(120)Re[NBf]}}],
Arrow[{{+a/2,+b},{+a/2,+b}+{1/(120)*(Sign[xp[ω,t]]*Re[TBf]),0}}]},

Point[{0,0}]
]
}],
PlotRange->{{-1.52,1.52},{-0.6,1}},
Axes->None,
ImageSize->800],

(*Row[{

Plot[{FDfun[tt],NAfun[tt],NBfun[tt]},{tt,0,2Pi/ω},
ImageSize->350,
PlotRange->{-300,300},
PlotStyle->Thick,
Epilog->{PointSize[Large],Point[{θ,0}]}]
,

Plot[{TDfun[tt],TAfun[tt],TBfun[tt]},{tt,0,2Pi/ω},
ImageSize->350,
PlotRange->{-150,150},
PlotStyle->Thick]

}]*)

Show[desmo]


}]
)],

{t,0,4Pi/ω,Appearance->"Open",
AnimationRate->rate},ControlPlacement->Top]),
{{freq,0.25, "freq. rotaz. (Hz)"},0.1,2,0.1,Appearance->"Labeled"},
{{fo,0.5,"f appoggi"},0,1,Appearance->"Labeled"},
{{fv,0.5, "f eccentrici"},0,1,Appearance->"Labeled"},
{{gravity,9.81, "acc. gravità"},0,20,Appearance->"Labeled"},
{{m,5,"massa (kg)"},0,20,Appearance->"Labeled"},
Delimiter,
{{rate,1,"animation rate"},0.01,2,0.05,Appearance->"Labeled"},
Delimiter,
"Massimo Guiggiani - 2023 - All rights reserved",
ControlPlacement->Right,
SaveDefinitions->True]