MathGroup Archive 2009

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

Search the Archive

Re: Re: Help with Mathematica 7.0

  • To: mathgroup at smc.vnet.net
  • Subject: [mg96687] Re: [mg96656] Re: Help with Mathematica 7.0
  • From: Tim Brophy <timbrophy at mac.com>
  • Date: Fri, 20 Feb 2009 05:48:57 -0500 (EST)
  • References: <gngk0r$jj8$1@smc.vnet.net> <200902190834.DAA18978@smc.vnet.net>

Thanks to everyone who helped me out with this problem.

In my hurry I posted a file with errors in it. Sorry about that but it  
was picked up by so many of you that I am very impressed.

I am really glad to be able to create animated gifs again. They are  
very useful in showing students something quickly.

Once again, thanks to all.

Tim


On 19 Feb 2009, at 08:34, Bob F wrote:

> On Feb 18, 2:22 am, Tim Brophy <timbro... at mac.com> wrote:
>> Hello All,
>>
>> In Mathematica 5.2 and earlier I could create a Notebook like:
>>
>> << Graphics`
>> $FormatType = TraditionalForm;
>> $TextStyle = {FontFamily -> "Times", FontSize -> 12};
>> Strip = {Polygon[{{-0.1, 0, 1}, {
>>         0.1, 0, 1}, {0.1, 0, 0} + s, {-0.1, 0, 0} + s}],
>>             Polygon[{{-0.1, 0, 0} + s, {-0.1,
>>             0, -1}, {0.1, 0, -1}, {0.1, 0, 0} + s}]};
>> Magnet = {Cuboid[{-1, -0.5, -0.1}, {-0.2, 0.5, 0.1}],
>>         Cuboid[{0.2, -0.5, -0.1}, {1, 0.5, 0.1}]}
>> Wire = {Line[{{0, 0, -1}, {0, 0, -1.2}, {-1.4, 0, -1.2}, {-1.4,
>>             0, -0.2}}], Line[{{-1.2, 0, -0.2}, {-1.7, 0, -=
> 0.2}}], \
>> Line[{{-1.3, 0, 0}, {-1.6, 0, 0}}], Line[{{-1.4, 0, 0}, {-1.4, 0, 1},
>> {-0.1,
>>           0, 1}}]};
>> circuit = Table[
>>     Show[Graphics3D[{Magnet,
>>         Strip, Wire}], Epilog -> {Text["N", {.402, .504}], Tex=
> t["S",
>> {.62, \
>> .47}], Red, Arrow[{.53, .71}, {.53, .16}],
>>               Text["Current", {.7, 0.69 - .394t}]}, Boxe=
> d -> False,
>>                PlotRange -> {{-1.8, 1.5}, {-1,
>>             1}, {-1.3, 1.3}}], {t, 0, 1, 0.05}];
>> Export["Conductor.gif", circuit, ConversionOptions -> {"Loop" ->  
>> True}]
>>
>> to create animations as in http://web.me.com/timbrophy/physicsnow/current=
> m.html
>>
>> In versions 6 and 7 the Table command does not produce all the  
>> files I =
>
>> need for the animated gifs. How can I do the same?
>>
>> Manipulate is no good as I simply want gifs to demonstrate different
>> aspects of Physics to my students.
>>
>> Tim Brophy
>
> I think this is one example of yours that works. There were several
> typo's in this example - are you sure this worked in 5.2?? The Table
> increment is t, but you use s as the value to add for the "strip", and
> you need to add the variable to just the "y" component of the vector
> (not the entire vector). And then it seems that the arrow is not
> correct for the N and S locations, ...
>
> BTW animated GIF's are the default according to the GIF document page
> in Mathematica now in V7 (so no need for the "ConversionOptions ->
> {"Loop" -> True}"
>
> Also, if you want to see what it kinda looks like in Mathematica, just
> add a "Show[circuit]" command after the Export[] command. That is how
> I figured out the problem that the variable should be added to just
> the y vector component.
>
> I made the current arrow red, and the field arrow green, but change it
> if you wish.
>
> Anyway here is what I came up with -- the gif file seems to display
> correctly when I view it with Safari on a Mac
>
> $FormatType = TraditionalForm;
> $TextStyle = {FontFamily -> "Times", FontSize -> 12};
> Strip = {Polygon[{{-0.1, 0, 1}, {0.1, 0, 1}, {0.1, 0 + t, 0}, {-0.1,
>      0 + t, 0}}],
>   Polygon[{{-0.1, 0 + t, 0}, {-0.1, 0, -1}, {0.1, 0, -1}, {0.1,
>      0 + t, 0}}]};
> Magnet = {Cuboid[{-1, -0.5, -0.1}, {-0.2, 0.5, 0.1}],
>   Cuboid[{0.2, -0.5, -0.1}, {1, 0.5, 0.1}]};
> Wire = {Line[{{0, 0, -1}, {0, 0, -1.2}, {-1.4, 0, -1.2}, {-1.4,
>      0, -0.2}}], Line[{{-1.2, 0, -0.2}, {-1.7, 0, -0.2}}],
>   Line[{{-1.3, 0, 0}, {-1.6, 0, 0}}],
>   Line[{{-1.4, 0, 0}, {-1.4, 0, 1}, {-0.1, 0, 1}}]};
> arrowacross = {Arrowheads[Large],
>   Arrow[{{0.8, .0, .2}, {-0.8, .0, .2}}]};
> arrowup = {Arrowheads[Large],
>   Arrow[{{0., -0.1, 1.}, {0., -0.1, -1.}}]};
> circuit =
>  Table[Show[
>    Graphics3D[{Magnet, Strip, Wire, Thick, Green, arrowacross, Red,
>      arrowup}],
>    Epilog -> {Text["S", {.402, .504}], Text["N", {.62,  .47}], Red,
>      Text["Current", {.7, 0.69 - .394 t}]}, Boxed -> False,
>    PlotRange -> {{-1.8, 1.5}, {-1, 1}, {-1.3, 1.3}}], {t, 0, 1,
>    0.05}];
> Export["Conductor.gif", circuit];
>
> -Bob
>



  • Prev by Date: Re: pfa2pfb
  • Next by Date: Re: Shortest Path Problem
  • Previous by thread: Re: Help with Mathematica 7.0
  • Next by thread: Re: Help with Mathematica 7.0