Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

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

Search the Archive

RE: Drawing a HEART in mathematica?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg46279] RE: [mg46268] Drawing a HEART in mathematica?
  • From: "David Park" <djmp at earthlink.net>
  • Date: Fri, 13 Feb 2004 02:28:47 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

For those who have DrawGraphics this is my attempt at a Valentine plot.

Needs["DrawGraphics`DrawingMaster`"]

ptlist = {{0, 0}, {0.149827`, 0.174208`}, {0.324045`, 0.348426`}, {0.45645`,
        0.536581`}, {0.6237`, 0.738673`}, {0.797917`, 0.947735`},
{0.937292`,
        1.14983`}, {0.986072`, 1.4007`}, {0.94426`, 1.58886`}, {0.763074`,
        1.7352`}, {0.651574`, 1.89548`}, {0.5122`, 1.96517`}, {0.331014`,
        1.94426`}, {0.170733`, 1.86064`}, {0, 1.77004`}};

vlineright = SplineToLine[ptlist, Bezier, 40];
vlineleft = vlineright /. {x_, y_} -> {-x, y};

heart = StitchLineSegments[{vlineright, Reverse /@ vlineleft}];
lace = Partition[First@heart, 2, 1];

lacepiece[{pt1_, pt2_}] := Module[{size, center, \[Theta]0},
   center = (pt1 + pt2)/2; size = Sqrt[(pt2 - pt1) . (pt2 - pt1)]/2;
    {White, Disk[center, size], Black, Circle[center, size]}]

Draw2D[
    {lacepiece /@ lace,
      ColorMix[Red, White][0.4], heart /. Line -> Polygon,
      AbsoluteThickness[2], LightPink, heart,
      White,
      Text[
        StyleForm[
          "\[ScriptCapitalB]\[ScriptE] \[ScriptCapitalM]\[ScriptY] \
\[ScriptCapitalV]\[ScriptA]\[ScriptL]\[ScriptE]\[ScriptN]\[ScriptT]\[ScriptI
]\
\[ScriptN]\[ScriptE]", FontSize -> 26], {0.00668153, 1.18497}],
      CadetBlue,
      Text[
        StyleForm[

"\[ScriptCapitalC]\[ScriptH]\[ScriptA]\[ScriptR]\[ScriptL]\[ScriptI]\
\[ScriptE]", FontSize -> 20], {0.242764, 0.877616}]},
    AspectRatio -> Automatic,
    PlotRange -> {{-1, 1}, {-0.1, 2}},
    ImageSize -> 450,
    Background -> OldLace];

David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/


From: Charlie Bishop [mailto:charliebishop at yahoo.com]
To: mathgroup at smc.vnet.net

can anyone suggest some code or a graph (or several graphs) that I could
plot in mathematic to display the image of a heart? trying to make a
homemade valentine for my girl.. and being a Physics/Math major it seems
appropriatte to be a bit geeky about it :)

I can't seem to get it look right though.. so can someone help?

- Charlie



  • Prev by Date: Re: FindRoot in Version 5
  • Next by Date: Re: Drawing a HEART in mathematica?
  • Previous by thread: Re: Drawing a HEART in mathematica?
  • Next by thread: Re: Drawing a HEART in mathematica?