4
$\begingroup$

enter image description here

I want to drawing with Vector Plot a deflection and slope of a linearly varying cantilever. And with Contour Plot it works but with Vector Plot it didn't. Here is the code:

M = EI D[y[x], {x, 2}];
q = -1;
M1 = M /. x -> 0;
M2 = M /. x -> L;
y1 = y[x] /. x -> 0;
y2 = y[x] /. x -> L;
s = DSolve[{EI y''''[x] == q, M1 == 0, y1 == 0, M2 == 0, y2 == 0}, y,  x];
displacement = y[x] /. s[[1]];
Eb = 20000000;
b = 0.25;
t0 = 0.5;
L = 5;
t[x_] := (t0 (L + x))/L;
Ib = (b t[x]^3)/12
EI = Eb Ib
u = {-x2 D[displacement, x], displacement}
VectorPlot[u, {x, 0, L}, {x2, -t[x]/2, t[x]/2}, 
PlotLabel -> "vektoros", AspectRatio -> Automatic]

The result with constant cross section and the same code for constant cross section:

M = EI D[y[x], {x, 2}];
q = -10;
M1 = M /. x -> 0;
M2 = M /. x -> L;
y1 = y[x] /. x -> 0;
y2 = y[x] /. x -> L;
s = DSolve[{EI y''''[x] == q, M1 == 0, y1 == 0, M2 == 0, y2 == 0}, y, 
x]
displacement = y[x] /. s[[1]]
Eb = 20000000;
b = 0.25;
t = 0.5;
L = 5;
Ib = (b t^3)/12;
EI = Eb Ib;
u = {-x2 D[displacement, x], displacement}
VectorPlot[u, {x, 0, L}, {x2, -t/2, t/2}, PlotLabel -> "vektoros", 
AspectRatio -> Automatic, VectorStyle -> Black]

enter image description here

searched a similar result

enter image description here

$\endgroup$
0

2 Answers 2

4
$\begingroup$

It's not exactly what was asked for but it's another way to display the sought-after deformation. I thought I would share it because it's probably not well known how it can be done, and it seems appropriate to the problem at hand.

First the OP's code computed this displacement:

displacement
(*  (0.0001 (-125 x + 10 x^3 - x^4))/(5 + x)^3  *)

Here is an image of the beam. I did not see where the parameters (other than the length L = 5) were specified. So I made some of it up.

Needs["NDSolve`FEM`"];
mesh = ToElementMesh[FullRegion[2], {{0, L}, {-1, 1}/2}];
u = Function[{x, y}, 0];
v = Function[{x, y}, y (x - L)/20];

uif = ElementMeshInterpolation[{mesh}, u @@@ mesh["Coordinates"]];
vif = ElementMeshInterpolation[{mesh}, v @@@ mesh["Coordinates"]];

mesh = ElementMeshDeformation[mesh, {uif, vif}];
mesh["Wireframe"]

Mathematica graphics

Then we can deform the mesh according to displacement using ElementMeshDeformation. I magnified the displacement by 1000 to make the deformation perceptible. The beam can be colored by the magnitude of the displacement at each point.

u = Function[{x, y}, 0];
v = Function @@ {{x, y}, 1000 displacement};

uif = ElementMeshInterpolation[{mesh}, u @@@ mesh["Coordinates"]];
vif = ElementMeshInterpolation[{mesh}, v @@@ mesh["Coordinates"]];

dmesh = ElementMeshDeformation[mesh, {uif, vif}];

deform = (Norm[{0, v @@ #}] & /@ mesh["Coordinates"])
Legended[
 Show[
  Graphics@ElementMeshToGraphicsComplex[dmesh, All, 
    VertexColors -> ColorData["Rainbow"] /@ Rescale[deform]],
  dmesh["Wireframe"]],
 Placed[BarLegend[{"Rainbow", Through[{Min, Max}[deform]]}, 
   LegendLayout -> "Row"], Below]
 ]

Mathematica graphics


If the arrows are standard in the industry/field, then perhaps something like this:

Show[
 BoundaryMeshRegion[mesh],
 Graphics[Table[Arrow@Thread[{x, 5000 displacement {-1, 1}}], {x, 0.5, 4.5, 0.5}]]
 ]

Mathematica graphics

A combination of arrows and coloring. The legend is scaled by 10^6.

u = Function[{x, y}, 0];
v = Function @@ {{x, y}, displacement};
deform = (Norm[{u @@ #, v @@ #}] & /@ mesh["Coordinates"]);
Legended[
 Show[
  Graphics[
   ElementMeshToGraphicsComplex[mesh, All, 
    VertexColors -> (ColorData["Rainbow"] /@ Rescale[deform])]], 
  Graphics[Table[Arrow@Thread[{x, 5000 displacement {-1, 1}}], {x, 0.5, 4.5, 0.5}]]
  ],
 Placed[BarLegend[{"Rainbow", 10^6 Through[{Min, Max}[deform]]}, 
   LegendLayout -> "Row"], Below]
 ]

Mathematica graphics


VectorPlot issue

VectorPlot with a variable domain for x2 just hangs on me for reasons I don't understand (bug, maybe?). You can use RegionFunction instead:

VectorPlot[u, {x, 0, L}, {x2, -t[L]/2, t[L]/2}, 
 PlotLabel -> "vektoros", AspectRatio -> Automatic, 
 RegionFunction -> Function[{x, x2}, -t[x]/2 < x2 < t[x]/2]]

Mathematica graphics

$\endgroup$
6
  • $\begingroup$ Thanks for the answer but I want to solve the problem with finite difference method $\endgroup$
    – wlkyr
    Apr 14, 2015 at 13:31
  • $\begingroup$ @wikyr I used your solution from your quesiton!! I don't know what you mean. $\endgroup$
    – Michael E2
    Apr 14, 2015 at 13:42
  • $\begingroup$ Oops, yes it is, but I would be interested how can I show with vector plot? for example why my code dont work?Because for constant cross section it works fine $\endgroup$
    – wlkyr
    Apr 14, 2015 at 14:02
  • 1
    $\begingroup$ @wlkyr Some problem in VectorPlot, I guess. See my workaround. $\endgroup$
    – Michael E2
    Apr 14, 2015 at 14:09
  • 1
    $\begingroup$ @wlkyr You're welcome. $\endgroup$
    – Michael E2
    Apr 14, 2015 at 14:21
5
$\begingroup$
Eb = 2 10^7;
b = 1/4;
t0 = 1/2;
L = 5;
t[x_] := (t0 (L + x))/L;

s = DSolve[{Eb   (b t[x]^3)/12 y''''[x] == -1, 
            y''[0] == 0,  y''[L] == 0, y[0] == 0, y[L] == 0}, y, x][[1]];
displacement = y[x] /. s[[1]];
u = {-x2 D[displacement, x], displacement};
VectorPlot[u, {x, 0, L}, {x2, -4, 4}]

Mathematica graphics

$\endgroup$
1
  • $\begingroup$ Thanks for the reply, it was very helpful. But still there is a question, that how could be detected/express the deflection with vectorplot on the support with variable cross section? I attach the picture about the support with constant cross section. $\endgroup$
    – wlkyr
    Apr 13, 2015 at 11:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.