Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

drawing with Mathematica

  • To: mathgroup at smc.vnet.net
  • Subject: [mg74179] drawing with Mathematica
  • From: "dimitris" <dimmechan at yahoo.com>
  • Date: Tue, 13 Mar 2007 05:10:08 -0500 (EST)

Hello.

Until now for papers drawing, I use two specialized drawing programs.
For a forthcoming publication (alnong with my Supervisor Professor)
I want to use my knowledge in Mathematica (...which I think I have
gained!...)
than hanging around with two programs I must admit I am not very fond
of!

So below are two draws.

The first shows the cleavage stress on a (mathematical) crack.
The second (attempts to) show a (so called) cusp-like (mathematical)
crack.
I would like any comments regarding anything you think can be useful!

(Further, ) I know that this subject has been completely covered (and
actually one of my very first queries was in the same vein), but as
regards the procedure of Copy/Paste to a Word File which procedure
offers the least (if possibly!) declination in the quality of these
graphs?

Lastly, I wanted to draw a bounded region as that encountered in any
elementary text
in Vector Analysis (for example in the proof of the Green-Gauss
Theorem).
I can draw circles, ellipses and the stuff but I really need a
(smooth!) bounded region which shape is not so "canonical" as circle
or ellipse.


FIRST DRAW

<< "Graphics`Arrow`"

lin1 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
0}, {4.5, 0}}]}];
lin2 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
0}, {0, 3}}]}];
ar1 = Graphics[{Arrow[{4.5, 0.0095}, {4.5 + 1/8, 0.0095}]}];
ar2 = Graphics[{Arrow[{-0.01, 3}, {-0.01, 3 + 1/8}]}];
tex1 = Graphics[Text[StyleForm["0", FontSize -> 16, FontWeight ->
"Bold",
FontFamily -> "Times"], {0, -3/8}]];
tex2 = Graphics[Text[StyleForm["x", FontSize -> 16, FontWeight ->
"Bold",
FontFamily -> "Times"], {4.5 + 1/8, -3^(-1)}]];
tex3 = Graphics[Text[StyleForm["cleavage\n  stress", FontSize -> 16,
FontWeight -> "Bold", FontFamily -> "Times"], {3.2, 2.4}]];
cr1 = Graphics[{Thickness[0.009], Line[{{-0, 0.05}, {-3, 0.05}}]}];
cr2 = Graphics[{Thickness[0.009], Line[{{-0, -0.05}, {-3, -0.05}}]}];
lin3 =Graphics[{Thickness[0.009], Line[{{0, -0.05}, {0, 0.05}}]}];
ar3 = Graphics[{Thickness[0.0055], Arrow[{2.7, 2.35}, {1.95, 1.9},
HeadLength -> 0.035]}];
Block[{$DisplayFunction=Identity},g = Plot[5*x*Exp[-x] + x/5, {x,
0.01, 4}, Axes -> False, PlotStyle -> Thickness[0.01]]];

Show[{g, lin1, lin2, lin3, tex1, tex2, tex3, cr1, cr2, ar1, ar3},
PlotRange -> {-1, 2.7},
AspectRatio -> 1/GoldenRatio, ImageSize -> 400];


SECOND DRAW

Clear["Global`*"]

lin1 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
0}, {3.5, 0}}]}];
lin2 = Graphics[{Thickness[0.007], AbsoluteDashing[{4, 6}], Line[{{0,
0}, {0, 2.6}}]}];
ar1 = Graphics[{Arrow[{3.5, 0.0095}, {3.5 + 1/8, 0.0095}]}];
ar2 = Graphics[{Arrow[{-0.005, 2.6}, {-0.005, 2.6 + 1/8}]}];
tex1 = Graphics[Text[StyleForm["0", FontSize -> 16, FontWeight ->
"Bold",
FontFamily -> "Times"], {0, -3/8}]];
tex2 = Graphics[Text[StyleForm["x", FontSize -> 16, FontWeight ->
"Bold",
FontFamily -> "Times"], {3.5 + 1/8, -3^(-1)}]];
tex3 = Graphics[Text[StyleForm["y", FontSize -> 16, FontWeight ->
"Bold",
FontFamily -> "Times"], {-3^(-1), 2.55}]];
cr1 = Graphics[{Thickness[0.009], Line[{{0, 0.07}, {-0.13, 0.07}}]}];
cr2 = Graphics[{Thickness[0.009], Line[{{0, -0.07}, {-0.13,
-0.07}}]}];
lin3 = Graphics[{Thickness[0.009], Line[{{0, -0.07}, {0, 0.07}}]}];
Block[{$DisplayFunction = Identity}, Plot[x^(3/2), {x, 0.18, 1.}, Axes
-> False,
PlotStyle -> Thickness[0.009]]];
g1 = % /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, y};
g2 = %% /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, -y};
Block[{$DisplayFunction = Identity}, Plot[x^(1/2), {x, 1, 2}, Axes ->
False,
PlotStyle -> Thickness[0.009]]];
g3 = % /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, y};
g4 = %% /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, -y};
Block[{$DisplayFunction = Identity}, Plot[x^(1/3) - (2^(1/3) -
Sqrt[2]), {x, 2, 3},
Axes -> False, PlotStyle -> Thickness[0.009]]];
g5 = % /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, y};
g6 = %% /. {(x_)?NumberQ, (y_)?NumberQ} :> {-x, -y};

Show[{g1, g2, g3, g4, g5, g6, lin1, lin2, lin3, tex1, tex2, tex3, cr1,
cr2, ar1, ar2}, AspectRatio -> 1/GoldenRatio, ImageSize -> 400,
PlotRange -> {{-3, 4}, {-2.7, 2.7}}];


Thanks in advance for any replies!

Dimitris



  • Prev by Date: Re: Bug with Limit?
  • Next by Date: Re: Animate command on ListPlot:
  • Previous by thread: Re: draw question
  • Next by thread: Re: drawing with Mathematica