Statics of Rigid Systems Using Manipulate

Daniel G. Martinez

Science Applications International Corporation

Three Static Systems In Equilibrium Are Explored

Horizontal Beam Bearing Cargo

A level variable-mass beam, in equilibrium with variable-position and variable-mass cargo, exerts forces on its base supports at its ends.

Ladder Bearing A Climber

A hinge-based ladder in equilibrium, with variable mass and variable center of gravity bearing a climber of variable position and mass, exerts force on a vertical wall.

Two Cables Bearing Cargo

Two versions: 1) cargo in equilibrium supported by two flexible cables, with variable cable and cargo positions and variable cargo mass, exerts forces on both cables; 2) the foregoing arrangement presented with a linear track solution.

Horizontal Beam Bearing Cargo

Needs["BarCharts`"]
Manipulate[Row[{Framed[Show[ListPlot[{{0,0}},PlotRange->{{-0.1,2.1},{-0.1,1}},PlotStyle->White,Axes->{True,False},Frame->{{False,False},{True,False}},FrameLabel->{"Cargo COG Location Scale",None}],Graphics[{Red,Polygon[{{x-0.1,0.38+(0.03/50) mb},{x,0.28+(0.03/50) mb},{x+0.1,0.38+(0.03/50) mb}}]}],Graphics[{Red,Rectangle[{x-0.1,0.379+(0.03/50) mb},{x+0.1,0.379+(0.03/50) mb+0.001 mc}]}],Graphics[Text[Style["▲",Blue,24],{0,0.24}]],Graphics[Text["F1",{0,0.17}]],Graphics[Text[Style["▲",Green,24],{2.01,0.24}]],Graphics[Text["F2",{2,0.17}]],Graphics[{Gray,Rectangle[{-0.005,0.27},{2,0.01+0.27+(0.03/50) mb}]}],Graphics[Text["COG -> Center of Gravity",{1,0.8}]],ImageSize->350],FrameMargins->{{30,30},{5,5}}],Item["     "],Framed[Column[{Row[{"   Cargo COG: ",SetPrecision[x,3]}],Row[{"  Cargo Mass: ",mc}],Row[{"   Beam Mass: ",mb}],Row[{"          F1: ",SetPrecision[mc-((mc x)/2)+(mb/2),3]}],Row[{"          F2: ",SetPrecision[((mc x)/2)+(mb/2),3]}],Row[{" ----------------------"}],BarChart[{mc-((mc x)/2)+(mb/2),((mc x)/2)+(mb/2)}, BarSpacing->0.5, BarStyle->{Blue,Green},ImageSize->200,BarLabels->{"F1","F2"}]}],FrameMargins->{{30,30},{33,33}}]}],{{x,1,"Cargo Location"},0,2,Appearance->Tiny,AppearanceElements->None},{{mc,50,"Cargo Mass"},1,100,Appearance->Tiny,AppearanceElements->None},{{mb,50,"Beam Mass"},1,100,Appearance->Tiny,AppearanceElements->None},AppearanceElements->None]

Ladder Bearing A Climber

κ[Θ_]:=(90+360 UnitStep[Θ-90]-Θ) °  (*  geometric to geodetic angle ( ° ) conversion  *)

λad[α_]:={Blue,Line[{{0,0},{Re[0.95 Exp[I κ[α]]],Im[0.95 Exp[I κ[α]]]}}],Red,Line[{{Re[0.95 Exp[I κ[α]]],0},{Re[0.95 Exp[I κ[α]]],1}}]}  (*  blue "ladder" at geodetic angle α and red vertical line at its tip  *)

Manipulate[Row[{Show[ListPlot[{{0,0}},AspectRatio->Automatic,ImageSize->150,PlotRange->{{-0.03,1.1},{-0.2,1.2}},Axes->False],Graphics[λad[α]],Graphics[Line[{{0,0},{1,0}}]],Graphics[Text["←",{Re[0.95 Exp[I κ[α]]+0.05],Im[0.95 Exp[I κ[α]]]-0.02}]],Graphics[Text["•",{Re[λcg Exp[I κ[α]]],Im[λcg Exp[I κ[α]]]}]],Graphics[Text["(Overscript[▯, (Overscript[\[RightDoubleBracketingBar], (Overscript[\[RightDoubleBracketingBar], (Overscript[▮, •])])])])",{Re[cp Exp[I κ[α]]],Im[cp Exp[I κ[α]]]}]]],Item["       "],Column[{Row[{" base bottom angle ( ° ):  " ,90-α}],Row[{"                F←:  ",SetPrecision[(Subscript[Solve[Cos[α °] t-(λcg Sin[α °] λwt)-(cp Sin[α °] cwt)==0], [[1,1,2]]]),3]}]}]}],{{α,37,"base top angle ° "},5,85,Appearance->{"Labeled",Tiny},AppearanceElements->None},{{λcg,0.4,"ladder COG ( • )"},0.3,0.6,Appearance->{"Labeled",Tiny},AppearanceElements->None},{{cp,0.8,"climber position ( (Overscript[\[RightDoubleBracketingBar], (Overscript[▮, •])]) )"},0,0.9,Appearance->{"Labeled",Tiny},AppearanceElements->None},{{λwt,100,"ladder mass "},25,200,Appearance->{"Labeled",Tiny},AppearanceElements->None},{{cwt,150,"climber mass "},100,200,Appearance->{"Labeled",Tiny},AppearanceElements->None},AppearanceElements->None]

Two Cables Bearing Cargo, Version 1

κ[Θ_]:=(90+360 UnitStep[Θ-90]-Θ) °  (*  geometric to geodetic angle ( ° ) conversion, Rob Knapp's version  *)
λ[Θ_,c_]:=With[{u=1.95 Exp[I κ[Θ]]},Graphics[{c,Arrowheads[0.06],Thickness[0.01],Arrow[{{0.6 Re[u],0.6 Im[u]},{Re[u],Im[u]}}]}]]  (*  arrow from origin to dial's edge at angle Θ ° in color c, adapted from Rob Knapp's version  *)
λt[Θ_,tic_]:=With[{u=Exp[I κ[Θ]]},Graphics[{Blue,Line[{{tic Re[u],tic Im[u]},{Re[u],Im[u]}}]}]]  (*  blue tick of relative length 'tic' from dial's edge at angle Θ °, adapted from Rob Knapp's version   *)
cι[x_]:=Graphics[{Lighter[Blue,0.7],Circle[{0,0},x]}]   (*  circle whose radius is 'x'  *)
t[x_,c_,r_,Θ_]:=With[{u=r Exp[I κ[Θ]]},Graphics[{c,Text[Style[x,Plain,FontSize->10],{Re[u],Im[u]},Background->GrayLevel[0.99]]}]]   (*  plot text 'x' in color 'c' at radius 'r' and angle 'Θ' from circle's center, adapted from Rob Knapp's version  *)
τm=Table[λt[j,0.95],{j,200,520,3.2}];  (* 1-minute tick marks  *)
τq=Table[λt[j,0.9],{j,200,520,3.2×5}];  (* 5-minute tick marks  *)
dat={{0,200},{500,360},{1000,520}};  (*  tension and its related dial angle  *)
λdat={{0,200},{1,280},{10,360},{100,440},{1000,520}};  (*  (Subscript[log, 10]) tension and its related dial angle  *)
f[j_]:=Interpolation[dat,InterpolationOrder->1][j]  (*  time series interpolation  *)
λf[j_]:=Interpolation[λdat,InterpolationOrder->1][j]  (*  (Subscript[log, 10]) time series interpolation  *)
sp[x_]:=SetPrecision[x,3]


ck[p1_,p_,p2_,m_]:=(Subscript[NSolve[(t1/(Sqrt[1+((((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))))^2)]))==(t2/(Sqrt[1+((((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))))^2)]))&&t1 ((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))/(Sqrt[1+((((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))))^2)]))+t2 ((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))/(Sqrt[1+((((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))))^2)]))==m,{t1,t2}], [[1,All,2]]])/;(Subscript[p, [[2]]])<(Subscript[p1, [[2]]])&&(Subscript[p, [[2]]])<(Subscript[p2, [[2]]])
ck[p1_,p_,p2_,m_]:=(Subscript[NSolve[(t1/(Sqrt[1+((((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))))^2)]))==(t2/(Sqrt[1+((((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))))^2)]))&&-t1 ((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))/(Sqrt[1+((((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))))^2)]))+m==t2 ((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))/(Sqrt[1+((((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))))^2)])),{t1,t2}], [[1,All,2]]])/;(Subscript[p1, [[2]]])<(Subscript[p, [[2]]])&&(Subscript[p1, [[2]]])<(Subscript[p2, [[2]]])
ck[p1_,p_,p2_,m_]:= (Subscript[NSolve[(t1/(Sqrt[1+((((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))))^2)]))==(t2/(Sqrt[1+((((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))))^2)]))&&t1 ((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))/(Sqrt[1+((((((Subscript[p1, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p, [[1]]])-(Subscript[p1, [[1]]])))))^2)]))==-t2 ((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))/(Sqrt[1+((((((Subscript[p2, [[2]]])-(Subscript[p, [[2]]]))/((Subscript[p2, [[1]]])-(Subscript[p, [[1]]])))))^2)]))+m,{t1,t2}], [[1,All,2]]])/;(Subscript[p2, [[2]]])<(Subscript[p1, [[2]]])&&(Subscript[p2, [[2]]])<(Subscript[p, [[2]]])
Manipulate[DynamicModule[{p1={10,70},p={50,50},p2={90,70}},Row[{Item[" "],Dynamic[Graphics[{Red,Line[{p,p1}],Green,Line[{p,p2}],Locator[Dynamic[p1],"P1"],Black,Locator[Dynamic[p],"●"],Locator[Dynamic[p2],"P2"]},PlotRange->{{0,100},{0,100}},Axes->False,Frame->True,ImageSize->275]],Item["   "],Dynamic[Framed[Grid[{{"      p1:",Map[sp,p1]},{"   cargo:",Map[sp,p]},{"      p2:",Map[sp,p2]},{"    mass:",Map[sp,m]},{" Length—:",Round[EuclideanDistance[p1,p],0.01]},{" Length—:",Round[EuclideanDistance[p,p2],0.01]},{"  Slope—:",If[(Subscript[p, [[1]]])==(Subscript[p1, [[1]]]),0,sp[((Apply[Divide,(p-p1)])^(-1))]]},{"  Slope—:",If[(Subscript[p, [[1]]])==(Subscript[p2, [[1]]]),0,sp[((Apply[Divide,(p2-p)])^(-1))]]},{"Tension—:",sp[(Subscript[ck[p1,p,p2,m], [[1]]])]},{"Tension—:",sp[(Subscript[ck[p1,p,p2,m], [[2]]])]}}],FrameMargins->{{30,30},{30,28}}]],Item["   "],Switch[sc,lin,Switch[ds,bc,Dynamic[Framed[BarChart[{(Subscript[ck[p1,p,p2,m], [[1]]]),(Subscript[ck[p1,p,p2,m], [[2]]])}, BarSpacing->0.5, BarStyle->{Red,Green},ImageSize->260,AspectRatio->0.9,BarLabels->None],FrameMargins->{{20,20},{20,20}}]],df,Dynamic[Framed[Show[cι[2],cι[1.2],λ[f@(Subscript[ck[p1,p,p2,m], [[1]]]),Red],λ[f@(Subscript[ck[p1,p,p2,m], [[2]]]),Green],t["Tension",Black,0.8,0],t["( linear scale )",Black,0.2,0],t[0,Blue,2.15,200],t[30,Blue,2.15,209.6],t[100,Blue,2.15,232],t[200,Blue,2.15,264],t[500,Blue,2.15,360],t[750,Blue,2.15,440],t[1000,Blue,2.15,160],ImageSize->200]],FrameMargins->{{20,20},{20,20}}]],λog,Switch[ds,bc,Dynamic[Framed[BarChart[{Log[10,(Subscript[ck[p1,p,p2,m], [[1]]])],Log[10,(Subscript[ck[p1,p,p2,m], [[2]]])]}, BarSpacing->0.5, BarStyle->{Red,Green},ImageSize->230,AspectRatio->0.9,BarLabels->None,Ticks->{None,{{0.1,0.1},{1,10},{2,100},{3,1000}}}],FrameMargins->{{20,20},{20,20}}]],df,Dynamic[Framed[Show[cι[2],cι[1.2],λ[λf@(Subscript[ck[p1,p,p2,m], [[1]]]),Red],λ[λf@(Subscript[ck[p1,p,p2,m], [[2]]]),Green],t["Tension",Black,0.8,0],t["( (Subscript[log, 10])  )",Black,0.2,0],t[0.1,Blue,2.15,200],t[1,Blue,2.15,280],t[10,Blue,2.15,360],t[100,Blue,2.15,440],t[1000,Blue,2.15,160]]]]]]}]],{{m,50,""},1,100,ControlType->VerticalSlider,ControlPlacement->Left,Appearance->Tiny,Background->LightBlue,ImageMargins->15},{{ds,bc,"display style: "},{bc->"Bar Chart",df->"Dial Face"}},{{sc,lin,"scale type: "},{lin->"Linear",λog->"Logarithmic"}},Delimiter,Item["     "Dynamic[m]],AppearanceElements->None]

Two Cables Bearing Cargo, Version 2

Manipulate[DynamicModule[{λs={2.3,16},λe={17.7,8},ap1={2,18},ap2={18,12},λ={10,5}},LocatorPane[Dynamic[{λs,λe,ap1,ap2,λ}],
Row[{Dynamic[Show[Plot[((λs[[2]]-λe[[2]])/(λs[[1]]-λe[[1]])) (j-λs[[1]])+λs[[2]],{j,λs[[1]],λe[[1]]},Axes->False,Frame->True,PlotStyle->Lighter[Blue,hi],PlotRange->{{-1,21},{-1,21}},PlotLabel->"System Configuration",FrameLabel->{"Lateral Cargo Position","Cargo    Attachment    Height"},ImageSize->450],Graphics[{Lighter[Black],Dotted,Line[{λ,{λ[[1]],yv=((λs[[2]]-λe[[2]])/(λs[[1]]-λe[[1]])) (λ[[1]]-λs[[1]])+λs[[2]]}}]}],Graphics[{Lighter[Red,hi],Line[{ap1,{λ[[1]],yv}}]}],Graphics[{Lighter[Green,hi],Line[{{λ[[1]],yv},ap2}]}]]],Dynamic[Plot[{Tooltip[(Subscript[ck[ap1,{j,((λs[[2]]-λe[[2]])/(λs[[1]]-λe[[1]])) (j-λs[[1]])+λs[[2]]},ap2,m], [[1]]]),"Tension 1"],Tooltip[(Subscript[ck[ap1,{j,((λs[[2]]-λe[[2]])/(λs[[1]]-λe[[1]])) (j-λs[[1]])+λs[[2]]},ap2,m], [[2]]]),"Tension 2"]},{j,λs[[1]],λe[[1]]},Axes->False,Frame->True,PlotLabel->"Cable Tension",FrameLabel->{"Lateral Cargo Position","Cable   Tension"},ImageSize->450,PlotRange->{{0.9 λs[[1]],1.02λe[[1]]},{-1,pr}},PlotStyle->{Lighter[Red,hi],Lighter[Green,hi]},Epilog->Dynamic[{Lighter[Blue,hi],Line[{{λ[[1]],-1},{λ[[1]],pr}}]}]]]},Spacer[35]],
Appearance->{"◇","◇","P1","P2","▲"}]],{{m,5.3,"cargo mass "},1,100,Appearance->"Labeled",AppearanceElements->None},{pr,10,500,ControlType->VerticalSlider,ControlPlacement->Right,Appearance->Tiny,AppearanceElements->None},{{hi,0.1,"hue intensity "},0.1,1,Appearance->"Labeled",ControlPlacement->Bottom,AppearanceElements->None},AppearanceElements->None]