(*********************************************************************** This file was generated automatically by the Mathematica front end. It contains Initialization cells from a Notebook file, which typically will have the same name as this file except ending in ".nb" instead of ".m". This file is intended to be loaded into the Mathematica kernel using the package loading commands Get or Needs. Doing so is equivalent to using the Evaluate Initialiation Cells menu command in the front end. DO NOT EDIT THIS FILE. This entire file is regenerated automatically each time the parent Notebook file is saved in the Mathematica front end. Any changes you make to this file will be overwritten. ***********************************************************************) (*:Version: Mathematica 3.0 *) (*:Name: MechanicsExplorers`Beam` *) (*:Title: Beam *) (*:Author: Stephan Kaufmann *) (*:Date: April 10, 1997 *) (*:Package Version: 1.0 *) (*:Mathematica Version: 3.0 *) (*:Copyright: \[Copyright] 1997 by Stephan Kaufmann *) (*:Keywords: beam, bending, mechanics *) (*:Requirements: Mathematica 3.0 or higher *) (*:Warnings: The code in this file is in no way meant to be human readable. Please see the source file BeamExplorer.nb. *) (*:Source: None. *) (*:Limitations: None. *) (*:Discussion: The new features of Mathematica Version 3.0 make it easy to program user- friendly interfaces to Mathematica packages. Palettes make it possible to hide or automate the interaction with the Mathematica language. Such programs open new possibilities in education. This package allows for the visualization of the bending of a beam. Beams are 'constructed' by defining supports (simple, fixed), hinges, and loads (discrete or distributed forces, moments). The shearing force, the bending moment, the deflection, and its slope, as well as the resulting forces and moments in the supports are calculated symbolically. After the calculation, the results can be visualized graphically or displayed as formulas. There are three different levels of simplicity for the interaction of the user with the package. - Simple: Everything is evaluated automatically after clicking at the corresponding buttons of a palette. Numerical input is typed into Input[] dialogs or into templates. - Medium: The buttons paste the corresponding Mathematica expression into a notebook. The user fills out the placeholders and evaluates the expressions. - Advanced: Experienced users of Mathematica will want to use the versions of the functions which operate in the traditional way. *) (*:Code Description: See the source file Beam.nb. *) BeginPackage["MechanicsExplorers`Beam`","Calculus`DiracDelta`", "Graphics`Arrow`"]; Off[General::"spell1"] Beam::"usage"= "Beam[{leftEnd,rightEnd,bendingStiffnessFunction},{supportsAndLoads}] \ represents a beam with the given left and right end points, the bending \ stiffness (given as a pure function) and the list of supports (Simple[...], \ Fixed[...], and Hinge[...] objects) and loads (Force[...] and Moment[...] \ objects)."; Simple::"usage"= "Simple[position] represents a simple support (no deflection) at the given \ position in a Beam[...] object."; Fixed::"usage"= "Fixed[position] represents a fixed support (no deflection and horizontal \ slope) at the given position in a Beam[...] object."; Hinge::"usage"= "Hinge[position] represents a hinge (no bending moment) at the given \ position in a Beam[...] object."; Force::"usage"= "Force[position,value] represents a discrete force at the given position \ with the given value in a Beam[...] object. Force[{left,right},function] \ defines a distributed force in the interval [left,right], given by a pure \ function. The positive force direction is downwards."; Moment::"usage"= "Moment[position,value] represents a moment at the given position with the \ given value in a Beam[...] object. The positive moment direction points into \ the screen."; NewWorkBeam::"usage"= "NewWorkBeam[] initializes the work beam with end points {0,1}, constant \ bending stiffness, and no supports or loads. If necessary, a new work \ notebook is opened."; NewBeam::"usage"= "NewBeam[] returns a default Beam object (with end points {0,1}, constant \ bending stiffness, and no supports or loads).\nNewBeam[beam] defines the \ variable beam as a default Beam object."; DefineEndPoints::"usage"= "DefineEndPoints[beam,{left,right}] defines the left and right end points \ of the given beam.\nDefineEndPoints[{left,right}] acts on the work beam.\n\ DefineEndPoints[] asks for input and acts on the work beam."; DefineBendingStiffness::"usage"= "DefineBendingStiffness[beam,function] defines the bending stiffness of the \ given beam. The stiffnes function should either be given as a pure function \ (e.g., (1+#)&), or as a list containing an expression and the variable (e.g., \ {1+x,x}). Discontinuities of the bending stiffness should be expressed in \ term of (linear combinations of) UnitStep functions (e.g., 1+3 \ UnitStep[#-.5]&).\nDefineBendingStiffness[position] acts on the work beam.\n\ DefineBendingStiffness[] asks for input and acts on the work beam."; AddSimpleSupport::"usage"= "AddSimpleSupport[beam,position] adds a simple support at the given \ position to the given beam.\nAddSimpleSupport[position] acts on the work \ beam.\nAddSimpleSupport[] asks for input and acts on the work beam."; AddFixedSupport::"usage"= "AddFixedSupport[beam,position] adds a fixed support at the given position \ to the given beam.\nAddFixedSupport[position] acts on the work beam.\n\ AddFixedSupport[] asks for input and acts on the work beam."; AddHinge::"usage"= "AddHinge[beam,position] adds a hinge at the given position to the given \ beam.\nAddHinge[position] acts on the work beam.\nAddHinge[] asks for input \ and acts on the work beam."; AddForce::"usage"= "AddForce[beam,position,value] adds a discrete force of the given value at \ the given position to the given beam. AddForce[beam,{left,right},function] \ adds a distributed force, starting at position 'left' and ending at position \ 'right'. The function must either be a pure function (e.g., #^2&) or a list \ containing an expression and a variable (e.g., {x,x^2}. Positive forces are \ in direction of the y-axis, i.e., vertically downwards.\n\ AddForce[position,value] and AddForce[{left,right},function]act on the work \ beam.\nAddForce[] asks for input and acts on the work beam."; AddDistributedForce::"usage"= "AddDistributedForce[] asks for input and defines a distributed force for \ the work beam. It is similar to AddForce[]."; AddMoment::"usage"= "AddMoment[beam,position,value] adds a discrete moment of the given value \ at the given position to the given beam. Positive moments are in direction of \ the z-axis, i.e., pointing into the screen.\nAddMoment[position,value] acts \ on the work beam.\nAddMoment[] asks for input and acts on the work beam."; RemoveLastElement::"usage"= "RemoveLastElementElement[] removes the support or load which has been \ defined last. Multiple removals are possible."; RemoveElement::"usage"= "RemoveElement[beam,element] removes a support or load element from the \ beam. Patterns can be used in the specification of the element(s)."; SolveBeam::"usage"= "SolveBeam[beam] returns a list containing a list of 4 pure functions (the \ shearing force, the bending moment, the slope of the deflection, and the \ deflection), and a Beam object, containing the elements of the unsolved beam \ and the forces and moments at the supports. The positive direction of the \ deflection and the slope is in y-direction, i.e., downwards.\nSolveBeam[] \ solves the work beam and assigns the solution to the work solution."; PlotShearingForce::"usage"= "PlotShearingForce[result] takes a result of SolveBeam and plots the \ shearing force.\nPlotShearingForce[beam] solves the beam and plots the \ shearing force.\nPlotShearingForce[] calculates the work solution, if \ necessary, and plots the shearing force."; PlotBendingMoment::"usage"= "PlotBendingMoment[result] takes the result of SolveBeam and plots the \ bending moment.\nPlotBendingMoment[beam] solves the beam and plots the \ bending moment.\nPlotBendingMoment[] calculates the work solution, if \ necessary, and plots the bending moment."; PlotSlope::"usage"= "PlotShearingForce[result] takes the result of SolveBeam and plots the \ slope of the deflection. Positive values are in the y-direction, i.e., \ downwards.\nPlotSlope[beam] solves the beam and plots the shearing force.\n\ PlotSlope[] calculates the work solution, if necessary, and plots the slope."; PlotDeflection::"usage"= "PlotDeflection[result] takes the result of SolveBeam and plots the the \ deflection. Positive values are in the y-direction, i.e., downwards.\n\ PlotDeflection[beam] solves the beam and plots the deflection.\n\ PlotDeflection[] calculates the work solution, if necessary, and plots the \ deflection."; PlotBendingStiffness::"usage"= "PlotBendingStiffness[beam] plots the bending stiffness.\n\ PlotBendingStiffness[] plots the bending stiffness of the work beam.\n\ PlotBendingStiffness[result] plots the bending stiffness of a result of \ SolveBeam."; PrintShearingForce::"usage"= "PrintShearingForce[solution] prints the shearing force of the solution as \ an expression in the variable 'x'. To avoid conflicts, 'x' is a string. \ Therefore, the printed result cannot be used for further calculations.\n\ PrintShearingForce[] prints the shearing force of the work solution."; ShearingForce::"usage"= "ShearingForce[solution] returns the shearing force of the solution as a \ pure function suitable for further calculations.\nShearingForce[] returns the \ shearing force of the work solution."; PrintBendingMoment::"usage"= "PrintBendingMoment[solution] prints the bending moment of the solution as \ an expression in the variable 'x'. To avoid conflicts, 'x' is a string. \ Therefore, the printed result cannot be used for further calculations.\n\ PrintBendingMoment[] prints the bending moment of the work solution."; BendingMoment::"usage"= "BendingMoment[solution] returns the bending moment of the solution as a \ pure function suitable for further calculations.\nBendingMoment[] returns the \ bending moment of the work solution."; PrintSlope::"usage"= "PrintSlope[solution] prints the slope of the solution as an expression in \ the variable 'x'. The positive slope direction is downwards. To avoid \ conflicts, 'x' is a string. Therefore, the printed result cannot be used for \ further calculations.\nPrintSlope[] prints the slope of the work solution."; Slope::"usage"= "Slope[solution] returns the slope of the solution as a pure function \ suitable for further calculations. The positive slope direction is downwards.\ \nSlope[] returns the slope of the work solution."; PrintDeflection::"usage"= "PrintDeflection[solution] prints the deflection function of the solution \ as an expression in the variable 'x'. The positive deflection direction is \ downwards. To avoid conflicts, 'x' is a string. Therefore, the printed result \ cannot be used for further calculations.\nPrintDeflection[] prints the \ deflection of the work solution."; Deflection::"usage"= "Deflection[solution] returns the bending deflection of the solution as a \ pure function suitable for further calculations. The positive deflection \ direction is downwards.\nDeflection[] returns the deflection of the work \ solution."; PrintBendingStiffness::"usage"= "PrintBendingStiffness[beam] prints the bending stiffness function of a \ beam (or a solution) as an expression in the variable 'x'. To avoid \ conflicts, 'x' is a string. Therefore, the printed result cannot be used for \ further calculations.\nPrintBendingStiffness[] prints the bending stiffness \ of the work beam."; BendingStiffness::"usage"= "BendingStiffness[bem] returns the bending stiffness of the beam as a pure \ function suitable for further calculations.\nBendingStiffness[] returns the \ bending stiffness of the work beam."; DrawBeam::"usage"= "DrawBeam[beam] draws a sketch of the beam.DrawBeam[] draws a sketch of the \ work beam."; DrawSolution::"usage"= "DrawSolution[solution] draws a sketch of the solution.\nDrawSolution[] \ draws a sketch of the work solution.\nDrawSolution[beam] solved the beam and \ draws the solution. With this version, the solution is lost and has to be \ recalculated for further drawings."; DrawAll::"usage"= "DrawAlll[beam,solution] draws the original beam and the solved beam and \ plots the bending stiffness, the shearing force, the bending moment, the \ slope, and the deflection.\nDrawAll[] uses the work beam and the work \ solution.\nDrawAll[beam] solved the beam and draws everything (the solution \ is lost)."; SetInputDialogs::"usage"= "SetInputDialogs[value] expects the value True or False. If set True, \ numerical input is given by Input[] dialogs. If set False, numerical input is \ given by inserting values into templates and evaluating the expressions."; SetDrawEach::"usage"= "SetDrawEach[value] expects the value True or False. If set True, all \ changes of the work beam are sketched automatically."; SetWorkBeam::"usage"= "SetWorkBeam[beam] sets the work beam to the given beam."; GetWorkBeam::"usage"="GetWorkBeam[] returns the work beam."; SetWorkSolution::"usage"= "SetWorkSolution[solution] sets the work solution to the given solution."; GetWorkSolution::"usage"="GetWorkSolution[] returns the work beam."; BeamPasteEvaluate::"usage"= "BeamPasteEvaluate[functions] pastes the function into the work notebook \ and evaluates it."; Beam::"undef"= "Your beam seems to be kinematically undefinded. Consider adding more \ supports."; Beam::"nosol"="Your beam could not be solved."; Beam::"badends"= "Warning: Your beam contains elements outside of its end points. The end \ points have been automatically adjusted to contain all elements."; Beam::"nobeam"="This function only works for Beam objects."; Beam::"multelem"= "The beam contained multiple copies of elements. Only one of each is kept."; Beam::"illdef"="Your beam is ill-defined."; Beam::"symbends"= "Warning: Your beam contains symbolic end points. All supports and loads \ are assumed to be between the end points. You will not be able to plot the \ results without defining numerical end points."; Beam::"numends"= "The draw and plot functions can only work for numerical end points."; Beam::"fixedhinge"= "A fixed support and a hinge at the same position are equivalent to a \ simple support and a hinge. They have been replaced accordingly."; Beam::"simplefixed"= "It does not make much sense to have a fixed support and a fixed support at \ the same position. The supports have been replaced by a single fixed \ support."; Beam::"unitstep"= "Warning: Equations containing UnitStep functions have to be solved. This \ might take quite long. If no result is returned within reasonable time, \ consider using numerical values for the positions. Results containing \ UnitStep functions in the denominator can not be trusted."; Beam::"badstiffness"= "The bending stiffness is ill-defined. Either use a constant function \ (e.g., '1&'), or a function containing UnitSteps(e.g., '1+3 \ UnitStep[#-.5]&'), or a list containing an expression and the variable (e.g., \ '{1,x}' or '{1+3 UnitStep[x-.5],x}')."; Beam::"baddistforce"= "The distributed force is ill-defined. Either give a pure function (e.g., \ '#^2&'), or a list containing an expression and the variable (e.g., \ '{x^2,x}'."; Beam::"nolast"= "The last element cannot be removed. It is only possible to remove the last \ definition of a support or a load."; Begin["`Private`"]; $WorkBeam=Beam[{0,1,1&},{Fixed[0],Force[1,1]}]; \!\(\($WorkSolution = {{1&, 1 - #1&, \(-\(1\/2\)\)\ \((\(-2\) + #1)\)\ #1&, \(-\(1\/6\)\)\ \((\(-3\) + #1)\)\ #1\^2&}, Beam[{0, 1, 1&}, {Fixed[0], Force[0, \(-1\)], Moment[0, \(-1\)], Force[1, 1]}]}; \)\) $LastElements={}; $Calculated=True; $DrawEach=True; $InputDialogs=True; MakePure[expr_,x_]:=Evaluate[expr/.x\[Rule]#1]& MakeExpr[fct_]:=fct["x"] Neg[fct_Function]:=Module[{x},MakePure[-fct[x],x]] SetAttributes[InvertNumber,Listable] InvertNumber[x_]:=If[NumberQ[x],-x,x] InsertUnknowns[beam_Beam]:= Beam[beam\[LeftDoubleBracket]1\[RightDoubleBracket], Flatten[beam\[LeftDoubleBracket]2\[RightDoubleBracket]/.{ Fixed[x_]\[Rule]{Fixed[x],Force[x],Moment[x]}, Simple[x_]\[Rule]{Simple[x],Force[x]}}]] \!\(InvertBeta[expr_, x_] := Module[{e = Collect[expr, UnitStep[_]], free, us, ic, in}, free = e /. UnitStep[_] \[Rule] 0; \n\t\t us = Sort[ Cases[e, UnitStep[_], \[Infinity]], #1\[LeftDoubleBracket]1, 1\[RightDoubleBracket] > #2 \[LeftDoubleBracket]1, 1\[RightDoubleBracket]&]; \n\t\t ic = 1\/FoldList[Plus, free, \((Coefficient[e, #1]&)\)/@us]; in = RotateRight[ReplacePart[ic, 0, \(-1\)]]; us = Prepend[us, 1]; Simplify[Plus@@\((\((ic - in)\)\ us)\)]]\) CheckBeam[beam_Beam]:= Module[{ep=Flatten[beam\[LeftDoubleBracket]1\[RightDoubleBracket]], sl=Flatten[beam\[LeftDoubleBracket]2\[RightDoubleBracket]],mima}, Which[MatchQ[ep,{_?AtomQ,_?AtomQ,_Function}],Null, MatchQ[ep,{_?AtomQ,_?AtomQ}],AppendTo[ep,1&],True, Message[Beam::"illdef"];Throw[Null,"error"]]; If[Length[sl]=!=Length[sl=Union[sl]],Message[Beam::"multelem"]]; If[Length[sl]=!=Length[Union[First/@sl]], If[sl=!=(sl= Union[sl//.{a___,Fixed[x_],b___,Hinge[x_],c___}\[Rule]{a,b,c, Hinge[x],Simple[x]}]),Message[Beam::"fixedhinge"]]; If[sl=!=(sl= Union[sl//.{a___,Fixed[x_],b___,Simple[x_],c___}\[Rule]{a,b,c, Fixed[x]}]),Message[Beam::"simplefixed"]]]; sl=DeleteCases[sl, Hinge[ep\[LeftDoubleBracket]1\[RightDoubleBracket]]| Hinge[ep\[LeftDoubleBracket]2\[RightDoubleBracket]]]; If[\[InvisibleSpace]!(And@@NumberQ/@Drop[ep,-1]), Message[Beam::"symbends"]]; If[\[InvisibleSpace]!(Or@@NumberQ/@ep),Return[Beam[ep,sl]]]; mima=Through[{Min,Max}[Select[Flatten[{First/@sl,ep}],NumberQ]]]; If[\[InvisibleSpace]!( ep\[LeftDoubleBracket]1\[RightDoubleBracket]\[LessEqual]mima \[LeftDoubleBracket]1\[RightDoubleBracket]), Message[Beam::"badends"]; ep\[LeftDoubleBracket]1\[RightDoubleBracket]= mima\[LeftDoubleBracket]1\[RightDoubleBracket]]; If[\[InvisibleSpace]!( ep\[LeftDoubleBracket]2\[RightDoubleBracket]\[GreaterEqual]mima \[LeftDoubleBracket]2\[RightDoubleBracket]), Message[Beam::"badends"]; ep\[LeftDoubleBracket]2\[RightDoubleBracket]= mima\[LeftDoubleBracket]2\[RightDoubleBracket]]; sl=DeleteCases[sl, Hinge[ep\[LeftDoubleBracket]1\[RightDoubleBracket]]| Hinge[ep\[LeftDoubleBracket]2\[RightDoubleBracket]]];Beam[ep,sl]] GetInput[dialogStrings_List,notebookString_String,template_String]:= Module[{values}, CheckNotebooks[]; If[$InputDialogs,values=ToString[#,InputForm]&/@Input/@dialogStrings; NotebookWrite[$WorkNotebook,template, Placeholder];(NotebookWrite[$WorkNotebook,#1,Placeholder]&)/@values; SelectionMove[$WorkNotebook,All,Cell]; SelectionEvaluateCreateCell[$WorkNotebook], NotebookWrite[$WorkNotebook,Cell[notebookString,"Text"]]; NotebookWrite[$WorkNotebook,template,Placeholder]]] SetAttributes[AddElement,HoldFirst] AddElement[beam_,element_]:= Module[{res},If[Head[beam]=!=Beam,Message[Beam::"nobeam"];Return[]]; res=If[MatchQ[beam,Beam[_List,_List]], Beam[beam\[LeftDoubleBracket]1\[RightDoubleBracket], Union[Append[beam\[LeftDoubleBracket]2\[RightDoubleBracket], element]]],Beam[{},element]]; If[ValueQ[beam]&&FreeQ[Hold[beam],Out],beam=res,res]] AddToWorkBeam[fct_,params___]:=(fct[$WorkBeam,params]; $Calculated=False; AppendTo[$LastElements, Switch[fct, AddSimpleSupport,Simple[params], AddFixedSupport,Fixed[params], AddHinge,Hinge[params], AddForce,If[FreeQ[{params},List],Force[params], Force[{params}\[LeftDoubleBracket]1\[RightDoubleBracket], If[MatchQ[{params}\[LeftDoubleBracket]2 \[RightDoubleBracket],{_,_?AtomQ}], MakePure@@{params}\[LeftDoubleBracket]2\[RightDoubleBracket],{ params}\[LeftDoubleBracket]2\[RightDoubleBracket]]]], AddMoment,Moment[params]]]; If[$DrawEach,DrawBeam[]]) SolveFirst[beam_Beam,fct_,opts___]:= Module[{s},InitCalculationWindow[];s=Catch[DoSolveBeam[beam],"error"]; CloseCalculationWindow[];If[s=!=Null,fct[s,opts]]] SolveAndPlot[fct_,opts___]:=(If[\[InvisibleSpace]!$Calculated,DoSolveBeam[]]; If[$WorkSolution=!=Null,fct[$WorkSolution,opts]]) SolveAndEvaluate[resultType_]:=( If[\[InvisibleSpace]!$Calculated,DoSolveBeam[]]; If[$WorkSolution=!=Null,resultType[$WorkSolution]]) UnitStepToLists[fct_Function,x_,l_,r_]:=Module[{us,e},e=fct[x]; us=Sort[ Union[Cases[e,UnitStep[_?(!FreeQ[#,x]&)], \[Infinity]]],#1\[LeftDoubleBracket]1,1\[RightDoubleBracket]>#2 \[LeftDoubleBracket]1,1\[RightDoubleBracket]&]; Transpose[{ FoldList[Plus, e/.UnitStep[_?(!FreeQ[#,x]&)]\[Rule]0,(Coefficient[e,#1]&)/@ us]//Expand//Chop//Simplify, Partition[ Join[{l}, us/.UnitStep[a__?(!FreeQ[#,x]&)]\[RuleDelayed](-a/.x\[Rule]0),{ r}],2,1]}]] PrintResult[fct_,name_String,l_,r_]:= Module[{x}, If[FreeQ[fct,UnitStep[_]], CellPrint[ Cell[BoxData[ GridBox[{{name,"=",ToBoxes[fct["x"]],",",l,"<","x","<",r}}]], "StandardForm"]], CellPrint[ Cell[BoxData[ RowBox[{name,"=","\[LeftBracketingBar]", GridBox[({ToBoxes[#1\[LeftDoubleBracket]1 \[RightDoubleBracket]/.x\[Rule]"x"],",", ToBoxes[#1\[LeftDoubleBracket]2,1 \[RightDoubleBracket]],"<","x","<", ToBoxes[#1\[LeftDoubleBracket]2,2 \[RightDoubleBracket]]}&)/@ UnitStepToLists[fct,x,l,r]]}]],"StandardForm"]]]] CheckNotebooks[]:=( If[\[InvisibleSpace]!(MemberQ[Notebooks[],InputNotebook[]]),$WorkNotebook= NotebookCreate[WindowTitle\[Rule]"Work Beam"],$WorkNotebook= InputNotebook[]];) InitCalculationWindow[]:=($CalculationNotebook= NotebookCreate[WindowMargins\[Rule]{{0,Automatic},{Automatic,0}}, WindowSize\[Rule]{300,100},WindowTitle\[Rule]"Calculating..."]; NotebookWrite[$CalculationNotebook, Cell["Solving the beam. Please hold on...","Text"]];) CloseCalculationWindow[]:=NotebookClose[$CalculationNotebook]; SetInputDialogs[value_?(MemberQ[{True,False},#1]&)]:=$InputDialogs=value; SetDrawEach[value_?(MemberQ[{True,False},#1]&)]:=$DrawEach=value; SetWorkBeam[beam_Beam]:=($Calculated=False;$WorkBeam=beam) GetWorkBeam[]:=$WorkBeam SetWorkSolution[x:{{_,_,_,_},_Beam}]:=$WorkSolution=x GetWorkSolution[]:=$WorkSolution SetAttributes[{NewBeam,DefineEndPoints,DefineBendingStiffness, AddSimpleSupport,AddFixedSupport,AddHinge,AddForce,AddMoment, RemoveElement},{HoldFirst}] BeamPasteEvaluate[fct_String]:=(CheckNotebooks[]; NotebookWrite[$WorkNotebook,fct,All]; SelectionEvaluateCreateCell[$WorkNotebook]) NewBeam[]:=Beam[{0,1,1&},{}] NewBeam[beam_]:= If[(ValueQ[beam]||AtomQ[beam])&&FreeQ[Hold[beam],Out], beam=Beam[{0,1,1&},{}],Beam[{0,1,1&},{}]] NewWorkBeam[]:=($WorkBeam=Beam[{0,1,1&},{}];$Calculated= False;$LastElements={};) DefineEndPoints[beam_,{left_,right_}]:= Module[{res},If[Head[beam]=!=Beam,Message[Beam::"nobeam"];Return[]]; res=If[MatchQ[beam,Beam[{_,_,_},_List]], ReplacePart[ beam,{left,right,beam\[LeftDoubleBracket]1,3\[RightDoubleBracket]}, 1],Beam[{left,right,1&}, beam\[LeftDoubleBracket]2\[RightDoubleBracket]]]; If[ValueQ[beam]&&\[InvisibleSpace]!(MemberQ[Attributes[beam],Protected]), beam=res,res]] DefineEndPoints[{left_,right_}]:=( DefineEndPoints[$WorkBeam,{left,right}];$Calculated=False;) DefineEndPoints[]:= GetInput[{"Enter the position of the left end of the beam", "Enter the position of the right end of the beam"}, "Replace the placeholders in the following input cell by the positions of \ the left and the right end points of the beam. Then evaluate the cell.", "DefineEndPoints[{\[Placeholder],\[Placeholder]}]"] DefineBendingStiffness[beam_,sf_]:= Module[{fct,res},If[Head[beam]=!=Beam,Message[Beam::"nobeam"];Return[]]; If[MatchQ[sf,{_,_?AtomQ}],fct=MakePure@@sf,fct=sf]; If[Head[fct]=!=Function,Message[Beam::"badstiffness"];Return[b]]; res=If[MatchQ[beam,Beam[{_,_,_},_List]],ReplacePart[beam,fct,{1,3}], Beam[{0,1,fct},beam\[LeftDoubleBracket]2\[RightDoubleBracket]]]; If[ValueQ[beam]&&\[InvisibleSpace]!(MemberQ[Attributes[beam],Protected]), beam=res,res]] DefineBendingStiffness[sf_]:=( DefineBendingStiffness[$WorkBeam,sf];$Calculated=False;) DefineBendingStiffness[]:= GetInput[{ "Enter a pure function defining the bending stiffness (e.g., \ (1+.2UnitStep[#-.5])&) or a list containing an expression defining the \ bending stiffness and the variable (e.g., {1+.2UnitStep[x-.5], x})"}, "Replace the placeholder in the following input cell either by a pure \ function defining the bending stiffness (e.g., (1+.2UnitStep[#-.5])&), or by \ a list containing an expressing defining the bending stiffness and the \ variable (e.g., {1+.2UnitStep[x-.5], x}). Then evaluate the cell.", "DefineBendingStiffness[\[Placeholder]]"] AddSimpleSupport[beam_,pos_]:=AddElement[beam,Simple[pos]] AddSimpleSupport[pos_]:=AddToWorkBeam[AddSimpleSupport,pos] AddSimpleSupport[]:= GetInput[{"Enter the position of the simple support"}, "Replace the placeholder in the following input cell by the position of \ the simple support. Then evaluate the cell.", "AddSimpleSupport[\[Placeholder]]"] AddFixedSupport[beam_,pos_]:=AddElement[beam,Fixed[pos]] AddFixedSupport[pos_]:=AddToWorkBeam[AddFixedSupport,pos] AddFixedSupport[]:= GetInput[{"Enter the position of the fixed support"}, "Replace the placeholder in the following input cell by the position of \ the fixed support. Then evaluate the cell.","AddFixedSupport[\[Placeholder]]"] AddHinge[beam_,pos_]:=AddElement[beam,Hinge[pos]] AddHinge[pos_]:=AddToWorkBeam[AddHinge,pos] AddHinge[]:= GetInput[{"Enter the position of the hinge"}, "Replace the placeholder in the following input cell by the position of \ the hinge. Then evaluate the cell.","AddHinge[\[Placeholder]]"] AddForce[beam_,{l_,r_},fct_]:= Module[{f},If[MatchQ[fct,{_,_?AtomQ}],f=MakePure@@fct,f=fct]; If[Head[f]=!=Function,Message[Beam::"baddistforce"];Return[beam]]; AddElement[beam,Force[{l,r},f]]] AddForce[{l_,r_},fct_]:=AddToWorkBeam[AddForce,{l,r},fct] AddDistributedForce[]:= GetInput[{"Enter the the left end of the distributed force", "Enter the right end of the distributed force", "Enter the function defining the force. Either use a pure function \ (e.g., #^2& or Function[x,x^2] for a quadratic force distribution), or use a \ list with an expression and the variable (e.g., {x^2,x}); forces pointing \ downwards are positive"}, "Replace the first two placehoders by the left and the right end of the \ distributed force. The third placeholder should either contain a pure \ function defining the force (e.g., #^2& or Function[x,x^2] for a quadratic \ distribution), or a list containing an expression and the variable (e.g., \ {x^2,x}). Forces pointing downwards are positive. Then evaluate the cell.", "AddForce[{\[Placeholder],\[Placeholder]},\[Placeholder]]"] AddForce[beam_,pos_,value_]:=AddElement[beam,Force[pos,value]] AddForce[pos_,value_]:=AddToWorkBeam[AddForce,pos,value] AddForce[]:= GetInput[{"Enter the position of the force", "Enter the value of the force (the positive force direction is \ downwards)"}, "Replace the placeholders in the following input cell by the position and \ the value of the force. Forces pointing downwards are positive. Then evaluate \ the cell.","AddForce[\[Placeholder],\[Placeholder]]"] AddMoment[beam_,pos_,value_]:=AddElement[beam,Moment[pos,value]] AddMoment[pos_,value_]:=AddToWorkBeam[AddMoment,pos,value] AddMoment[]:= GetInput[{"Please enter the position of the moment", "Enter the value of the moment (moment vectors pointing into the screen \ are positive)"}, "Replace the placeholders in the following input cell by the position and \ the value of the moment. Moment vectors pointing into the screen are \ positive. Then evaluate the cell.","AddMoment[\[Placeholder],\[Placeholder]]"] RemoveLastElement[]:= If[$LastElements==={},Message[Beam::"nolast"], $WorkBeam= DeleteCases[$WorkBeam,$LastElements \[LeftDoubleBracket]-1\[RightDoubleBracket], \[Infinity]];$LastElements=Drop[$LastElements,-1]; $Calculated=False; If[$DrawEach,DrawBeam[]]] RemoveElement[beam_,element_]:= Module[{res},If[Head[beam]=!=Beam,Message[Beam::"nobeam"];Return[]]; res=Beam@@DeleteCases[beam/.Beam\[Rule]List,element,\[Infinity]]; If[ValueQ[beam]&&\[InvisibleSpace]!(MemberQ[Attributes[beam],Protected]), beam=res,res]] \!\(DoSolveBeam[beam_Beam] := Module[{b, S, M, d, s, x, l, r, ef, if, betaInverse, c, unknownFM, newUnknownFM, equations, sol, res, cleanRule}, b = InsertUnknowns[CheckBeam[beam]]; \n\t\t l = b\[LeftDoubleBracket]1, 1\[RightDoubleBracket]; r = b\[LeftDoubleBracket]1, 2\[RightDoubleBracket]; \n\t\t ef = Cases[b\[LeftDoubleBracket]2\[RightDoubleBracket], Force[l, ___] | Force[r, ___] | Moment[l, ___] | Moment[r, ___]]; if = Complement[b\[LeftDoubleBracket]2\[RightDoubleBracket], ef]; cleanRule = {UnitStep[a_?Positive] \[Rule] 1, UnitStep[b_?Negative] \[Rule] 0, UnitStep[a_?Positive\ b_?Negative] \[Rule] 0, DiracDelta[_?\((FreeQ[#1, x]&)\)] \[Rule] 0}; betaInverse = If[FreeQ[b\[LeftDoubleBracket]1, 3\[RightDoubleBracket], UnitStep[_]], 1\/\(b\[LeftDoubleBracket]1, 3\[RightDoubleBracket]\)[x], InvertBeta[\(b\[LeftDoubleBracket]1, 3\[RightDoubleBracket]\)[x], x]]; S = \(-Plus@@Cases[ef, Force[l, v_: Force[l]] \[Rule] v]\) - \[Integral]Plus@@ \((Cases[if, Force[{_, _}, _]] /. { Force[{p1_, r}, f_] \[Rule] UnitStep[x - p1]\ f[x], Force[{p1_, p2_}, f_] \[Rule] UnitStep[x - p1]\ f[x] - UnitStep[x - p2]\ f[x]})\) \[DifferentialD]x - Plus@@Join[Cases[if, Force[a_] \[Rule] Force[a]\ UnitStep[x - a]], Cases[if, Force[a_?\((\(\[InvisibleSpace]\(! \((ListQ[#1])\)\)\)&)\), v_] \[Rule] v\ UnitStep[x - a]]]; equations = { \((S /. x \[Rule] r)\) - Plus@@Cases[ef, Force[r, v_: Force[r]] \[Rule] v] == 0}; M = \(-Plus@@Cases[ef, Moment[l, v_: Moment[l]] \[Rule] v]\) - \[Integral]S \[DifferentialD]x - Plus@@Join[ Cases[if, Moment[a_] \[Rule] Moment[a]\ UnitStep[x - a]], Cases[if, Moment[a_, v_] \[Rule] v\ UnitStep[x - a]]]; AppendTo[equations, \((M /. x \[Rule] r)\) - Plus@@Cases[ef, Moment[r, v_: Moment[r]] \[Rule] v] == 0]; s = \[Integral]\(M\ betaInverse\) \[DifferentialD]x + c[1] + Plus@@Cases[if, Hinge[a_] \[Rule] c[a, a]\ UnitStep[x - a]]; d = \[Integral]s \[DifferentialD]x + c[2]; equations = Join[equations, Flatten[Cases[if, Simple[_] | Fixed[_] | Hinge[_]] /. { Simple[a_] \[Rule] \((d /. x \[Rule] a)\) == 0, Fixed[a_] \[Rule] Thread[\(( NestList[\[PartialD]\_x #1&, d, 1] /. x \[Rule] a) \) == 0], Hinge[a_] \[Rule] \((M /. x \[Rule] a)\) == 0}]] /. cleanRule; If[\(\[InvisibleSpace]\(! \((FreeQ[equations, UnitStep])\)\)\), Message[Beam::"\"]]; sol = Solve[equations, Union[Flatten[{Cases[d, c[__], \[Infinity]], Cases[b\[LeftDoubleBracket]2\[RightDoubleBracket], Force[_] | Moment[_], \[Infinity]]}]]]; If[sol == {}, Message[Beam::"\"]; Throw[Null, "\"]]; unknownFM = Cases[b\[LeftDoubleBracket]2\[RightDoubleBracket], Force[_] | Moment[_]]; newUnknownFM = \(unknownFM /. {Force[a_] \[Rule] Force[a, Force[a]], Moment[a_] \[Rule] Moment[a, Moment[a]]}\) /. Chop[sol\[LeftDoubleBracket]1\[RightDoubleBracket]]; res = Simplify[ Chop[Expand[{S, M, s, d} /. sol\[LeftDoubleBracket]1\[RightDoubleBracket]]]]; If[\(\[InvisibleSpace]\(! \((FreeQ[res, c[__]])\)\)\), Message[Beam::"\"]; Throw[Null, "\"]]; \n \t\t{\((MakePure[#1, x]&)\)/@res, b /. Thread[unknownFM \[Rule] newUnknownFM]}]\) DoSolveBeam[]:=( InitCalculationWindow[];$WorkSolution= Catch[DoSolveBeam[$WorkBeam],"error"]; If[$WorkSolution=!=Null,$Calculated=True];CloseCalculationWindow[];) SolveBeam[beam_Beam]:=Catch[DoSolveBeam[beam],"error"] SolveBeam[]:=(DoSolveBeam[];If[$WorkSolution=!=Null,$WorkSolution]) PlotSolution[solution_,l_,r_,xLabel_String,title_String,opts___]:= Module[{options,fs}, If[\[InvisibleSpace]!(NumberQ[l]&&NumberQ[r]),Message[Beam::"numends"]; Return[Null]]; fs=(DefaultFont/.Flatten[{opts}]/.DefaultFont\[Rule]$DefaultFont) \[LeftDoubleBracket]2\[RightDoubleBracket]+2; options=Flatten[{opts, PlotLabel \[Rule]StyleForm[xLabel,FontFamily\[Rule]"Times", FontSize\[Rule]fs,FontWeight\[Rule]Bold], FrameLabel \[Rule]{"","","", StyleForm[title,FontFamily\[Rule]"Times",FontSlant\[Rule]Italic, FontSize\[Rule]fs]},Frame\[Rule]True, RotateLabel\[Rule]False, PlotRange\[Rule]All}];Plot[solution[x],{x,l,r},Evaluate[options]]] PlotShearingForce[{{S_,_,_,_},Beam[{l_,r_,_},_]},opts___]:= PlotSolution[S,l,r,"Shearing Force","\!\(S\_y\)",opts] PlotShearingForce[beam_Beam,opts___]:=SolveFirst[beam,PlotShearingForce,opts] PlotShearingForce[opts___]:=SolveAndPlot[PlotShearingForce,opts] PlotBendingMoment[{{_,M_,_,_},Beam[{l_,r_,_},_]},opts___]:= PlotSolution[M,l,r,"Bending Moment","\!\(M\_z\)",opts] PlotBendingMoment[beam_Beam,opts___]:=SolveFirst[beam,PlotBendingMoment,opts] PlotBendingMoment[opts___]:=SolveAndPlot[PlotBendingMoment,opts] PlotSlope[{{_,_,s_,_},Beam[{l_,r_,_},_]},opts___]:= PlotSolution[Neg[$WorkSolution],l,r,"Slope","-d'",opts] PlotSlope[{{_,_,s_,_},Beam[{l_,r_,_},_]},opts___]:= Module[{p,t,df}, df=DisplayFunction/.Flatten[{opts}]/.DisplayFunction \[Rule]$DisplayFunction; p=PlotSolution[Neg[s],l,r,"Slope","\!\(d'\)", Flatten[{opts,DisplayFunction\[Rule]Identity}]]; t=FrameTicks/.FullOptions[p]; Show[p,FrameTicks \[Rule]ReplacePart[t, Transpose[ MapAt[InvertNumber, Transpose[t\[LeftDoubleBracket]2\[RightDoubleBracket]],2]],2], DisplayFunction\[Rule]df]] PlotSlope[beam_Beam,opts___]:=SolveFirst[beam,PlotSlope,opts] PlotSlope[opts___]:=SolveAndPlot[PlotSlope,opts] PlotDeflection[{{_,_,_,d_},Beam[{l_,r_,_},_]},opts___]:= Module[{p,t,df}, df=DisplayFunction/.Flatten[{opts}]/.DisplayFunction \[Rule]$DisplayFunction; p=PlotSolution[Neg[d],l,r,"Deflection","d", Flatten[{opts,DisplayFunction\[Rule]Identity}]]; t=FrameTicks/.FullOptions[p]; t=FrameTicks/.FullOptions[p]; Show[p,FrameTicks \[Rule]ReplacePart[t, Transpose[ MapAt[InvertNumber, Transpose[t\[LeftDoubleBracket]2\[RightDoubleBracket]],2]],2], DisplayFunction\[Rule]df]] PlotDeflection[beam_Beam,opts___]:=SolveFirst[beam,PlotDeflection,opts] PlotDeflection[opts___]:=(If[\[InvisibleSpace]!$Calculated,DoSolveBeam[]]; PlotDeflection[$WorkSolution,opts]) PlotBendingStiffness[Beam[{l_,r_,sf_},_],opts___]:= PlotSolution[sf,l,r,"Bending Stiffness","\!\(E I\_z\)",opts] PlotBendingStiffness[{{_,_,_,_},beam_},opts___]:= PlotBendingStiffness[beam,opts] PlotBendingStiffness[opts___]:=PlotBendingStiffness[$WorkBeam,opts] PrintShearingForce[{{S_,_,_,_},Beam[{l_,r_,_},_]}]:= PrintResult[S,"\!\(S\_y\)",l,r] PrintShearingForce[beam_Beam]:=SolveFirst[beam,PrintShearingForce] PrintShearingForce[]:=SolveAndEvaluate[PrintShearingForce] ShearingForce[{{S_,_,_,_},Beam[{_,_,_},_]}]:=S ShearingForce[beam_Beam]:=SolveFirst[beam,ShearingForce] ShearingForce[]:=SolveAndEvaluate[ShearingForce] PrintBendingMoment[{{_,M_,_,_},Beam[{l_,r_,_},_]}]:= PrintResult[M,"\!\(M\_z\)",l,r] PrintBendingMoment[beam_Beam]:=SolveFirst[beam,PrintBendingMoment] PrintBendingMoment[]:=SolveAndEvaluate[PrintBendingMoment] BendingMoment[{{_,M_,_,_},Beam[{_,_,_},_]}]:=M BendingMoment[bean_Beam]:=SolveFirst[beam,BendingMoment] BendingMoment[]:=SolveAndEvaluate[BendingMoment] PrintSlope[{{_,_,s_,_},Beam[{l_,r_,_},_]}]:=PrintResult[s,"d'",l,r] PrintSlope[beam_Beam]:=SolveFirst[beam,PrintSlope] PrintSlope[]:=SolveAndEvaluate[PrintSlope] Slope[{{_,_,s_,_},Beam[{_,_,_},_]}]:=s Slope[beam_Beam]:=SolveFirst[beam,Slope] Slope[]:=SolveAndEvaluate[Slope] PrintDeflection[{{_,_,_,d_},Beam[{l_,r_,_},_]}]:=PrintResult[d,"d",l,r] PrintDeflection[beam_Beam]:=SolveFirst[beam,PrintDeflection] PrintDeflection[]:=SolveAndEvaluate[PrintDeflection] Deflection[{{_,_,_,d_},Beam[{_,_,_},_]}]:=d Deflection[beam_Beam]:=SolveFirst[beam,Deflection] Deflection[]:=SolveAndEvaluate[Deflection] PrintBendingStiffness[Beam[{l_,r_,bs_},_]]:=PrintResult[bs,"E\!\(I\_z\)",l,r] PrintBendingStiffness[{{_,_,_,_},Beam[{l_,r_,bs_},_]}]:= PrintResult[bs,"E\!\(I\_z\)",l,r] PrintBendingStiffness[]:=PrintBendingStiffness[$WorkBeam] BendingStiffness[Beam[{_,_,bs_},_]]:=bs BendingStiffness[{{_,_,_,_},Beam[{_,_,bs_},_]}]:=bs BendingStiffness[]:=BendingStiffness[$WorkBeam] MakeFixed[pos_?NumberQ,as_]:={GrayLevel[.5], Rectangle[{pos-as,-2 as},{pos+as,2 as}]} MakeFixed[pos_,as_]:={Text[Fixed[pos],Scaled[{.5,.1}]]} MakeSimple[pos_?NumberQ,as_]:={Line[{{pos-2 as,-2 as},{pos+2 as,2 as}}], Line[{{pos-2 as,2 as},{pos+2 as,-2 as}}],{GrayLevel[.5], Rectangle[{pos-2 as,-4 as},{pos+2 as,-2 as}], Rectangle[{pos-2 as,4 as},{pos+2 as,2 as}]}} MakeSimple[pos_,as_]:={Text[Simple[pos],Scaled[{.5,.2}]]} MakeHinge[pos_?NumberQ,as_,dpos_:0]:={{GrayLevel[1],Disk[{pos,dpos},as]}, Circle[{pos,dpos},as]} MakeHinge[pos_,as_,dpos_:0]:={Text[Hinge[pos],Scaled[{.5,.3}]]} MakeForce[pos_?NumberQ,value_,as_,fs_,dpos_:0]:= Module[{v}, v=If[NumberQ[value],value,1];{ Arrow[{pos,dpos+fs v},{pos,dpos},HeadScaling\[Rule]Relative], Text[value,{pos,dpos+fs v+2 Sign[v] as}]}] MakeForce[pos_,value_,as_,fs_,dpos_:0]:={ Text[Force[pos,value],Scaled[{.5,.9}]]} \!\(MakeDistributedForce[{l_?NumberQ, r_?NumberQ}, ffct_?\((NumberQ[#[1]]&)\), as_, fs_, dfct_: \((0&)\)] := Module[{x, p = \(l + r\)\/2, fp}, fp = ffct[p]; {Line[{{l, dfct[l] + fs\ ffct[l]}, {l, dfct[l]}}], Line[{{r, dfct[r] + fs\ ffct[r]}, {r, dfct[r]}}], \(Plot[fs\ ffct[x] + dfct[x], {x, l, r}, DisplayFunction \[Rule] Identity]\)\[LeftDoubleBracket]1, 1 \[RightDoubleBracket], Text[TraditionalForm[ffct[x] /. x \[Rule] "\"], {p, dfct[p] + fs\ fp + 3\ as\ Sign[fp]}]}]\) MakeDistributedForce[{l_,r_},ffct_,as_,fs_,dfct_:(0&)]:={ Text[Force[{l,r},ffct],Scaled[{.5,.8}]]} MakeMoment[pos_?NumberQ,value_,as_,dpos_:0]:={Circle[{pos,dpos},as], If[\[InvisibleSpace]!(NumberQ[value])||value>0,{ Line[{{pos-0.7 as,dpos-0.7 as},{pos+0.7 as,dpos+0.7 as}}], Line[{{pos-0.7 as,dpos+0.7 as},{pos+0.7 as,dpos-0.7 as}}]}, Disk[{pos,dpos},.3 as]],Text[value,{pos+1.8 as,dpos+1.8 as}]} MakeMoment[pos_,value_,as_,dpos_:0]:={Text[Moment[pos,value],Scaled[{.5,.7}]]} BeamGraphics[Beam[{l_,r_,_:(1&)},obj_],opts___]:=Module[{as,fs,options}, If[!(NumberQ[l]&&NumberQ[r]),Message[Beam::"numends"];Return[Null]]; options=Flatten[{opts,Axes\[Rule]None,AspectRatio\[Rule]Automatic, PlotRange\[Rule]All}];as=.02 Abs[r-l]; fs=(10 as)/ Max[Flatten[{ Cases[obj,Force[__]]/.{ Force[x_?NumberQ,v_?NumberQ]\[Rule]Abs[v], Force[x_?NumberQ,_]\[Rule]1, Force[{left_?NumberQ,right_?NumberQ},fct_?(NumberQ[#[1]]&)] \[Rule]Abs[{fct[left],fct[right]}], Force[___]\[Rule]0},.0001}]]; Graphics[{{AbsoluteThickness[3],Line[{{l,0},{r,0}}]}, obj/.{Fixed[x_]\[RuleDelayed]MakeFixed[x,as], Simple[x_]\[RuleDelayed]MakeSimple[x,as], Hinge[x_]\[RuleDelayed]MakeHinge[x,as], Force[ends_List,fct_]\[RuleDelayed]MakeDistributedForce[ends,fct, as,fs],Force[x_,v_]\[RuleDelayed]MakeForce[x,v,as,fs], Moment[x_,v_]\[RuleDelayed]MakeMoment[x,v,as]}},options]] DrawBeam[beam_Beam,opts___]:= Module[{res=Catch[BeamGraphics[CheckBeam[beam],opts],"error"]}, If[res=!=Null,Show[res],Null]] DrawBeam[{{_,_,_,_},beam_Beam},opts___]:=DrawBeam[N[beam],opts] DrawBeam[]:= Module[{res=Catch[BeamGraphics[$WorkBeam=CheckBeam[$WorkBeam]],"error"]}, If[res=!=Null,Show[res],Null]] \!\(DrawSolution[{{_, _, _, d_}, Beam[{l_, r_, _ : \((1&)\)}, obj_]}, opts___] := Module[{ar, as, fs, p, options, max, scaledD}, If[\(\[InvisibleSpace]\(! \((NumberQ[l] && NumberQ[r])\)\)\), Message[Beam::"\"]; Return[Null]]; options = Flatten[{opts, Axes \[Rule] None, AspectRatio \[Rule] Automatic, PlotRange \[Rule] All, DisplayFunction \[Rule] $DisplayFunction}]; as = .02\ Abs[r - l]; fs = \((10\ as)\)/ Max[Flatten[{ Cases[obj, Force[__]] /. { Force[x_?NumberQ, v_?NumberQ] \[RuleDelayed] Abs[v], Force[x_?NumberQ, _] \[Rule] 1, Force[{left_?NumberQ, right_?NumberQ}, fct_?\((NumberQ[#[1]]&)\)] \[RuleDelayed] Abs[{fct[left], fct[right]}], Force[___] \[Rule] 0}, .0001}]]; ar = \((.3\ \((r - l)\))\)/ Plus@@Through[{Max, \(-Min[#1]\)&}[ Append[Table[d[x], {x, l, r, \(r - l\)\/20}], .000001]]]; scaledD = Function[x, \(-.3\)\ ar\ Evaluate[d[x]]]; p = Plot[Evaluate[scaledD[x]], {x, l, r}, Evaluate[ Flatten[{PlotStyle \[Rule] AbsoluteThickness[3], DisplayFunction \[Rule] Identity, options}]]]; Show[{p, Graphics[{ Cases[obj, Force[__] | Moment[__] | Hinge[__], \[Infinity]] /. { Hinge[x_] \[RuleDelayed] MakeHinge[x, as, scaledD[x]], Force[ends_List, fct_] \[RuleDelayed] MakeDistributedForce[ends, fct, as, fs, scaledD], Force[x_, v_] \[RuleDelayed] MakeForce[x, N[v, Max[2, N[Log[10, Abs[v]]] + 1]], as, fs, scaledD[x]], Moment[x_, v_] \[RuleDelayed] MakeMoment[x, N[v, Max[2, N[Log[10, Abs[v]]] + 1]], as, scaledD[x]]}}]}, options]]\) DrawSolution[beam_Beam]:=SolveFirst[beam,DrawSolution] DrawSolution[]:=SolveAndEvaluate[DrawSolution] DrawAll[beam_Beam,sol:{{_,_,_,_},_Beam}]:= Module[{df={$DefaultFont\[LeftDoubleBracket]1 \[RightDoubleBracket],$DefaultFont\[LeftDoubleBracket]2 \[RightDoubleBracket]-1}}, If[\[InvisibleSpace]!( NumberQ[beam\[LeftDoubleBracket]1,1\[RightDoubleBracket]]&& NumberQ[beam\[LeftDoubleBracket]1,2\[RightDoubleBracket]]), Message[Beam::"numends"];Return[Null]];Show[GraphicsArray[{ {DrawBeam[beam,DisplayFunction\[Rule]Identity,DefaultFont\[Rule]df], PlotShearingForce[sol,DisplayFunction\[Rule]Identity, AspectRatio\[Rule].5,DefaultFont\[Rule]df]},{ DrawSolution[sol,DisplayFunction\[Rule]Identity, DefaultFont\[Rule]df], PlotBendingMoment[sol,DisplayFunction\[Rule]Identity, AspectRatio\[Rule].5,DefaultFont\[Rule]df]},{ PlotBendingStiffness[beam,DisplayFunction\[Rule]Identity, AspectRatio\[Rule].5,DefaultFont\[Rule]df], PlotSlope[sol,DisplayFunction\[Rule]Identity,AspectRatio\[Rule].5, DefaultFont\[Rule]df]}}],DisplayFunction\[Rule]$DisplayFunction, AspectRatio\[Rule]1]] DrawAll[beam_Beam]:=SolveFirst[beam,DrawAll[beam,#1]&] DrawAll[]:=(If[\[InvisibleSpace]!$Calculated,DoSolveBeam[]]; If[$WorkSolution=!=Null,DrawAll[$WorkBeam,$WorkSolution]]) End[]; On[General::"spell1"] EndPackage[];