Group Abstract Group Abstract

Message Boards Message Boards

Writing a word with straight lines

Posted 6 years ago
POSTED BY: Anton Antonov
6 Replies

Dear Anton,

Thanks for the very interesting code. When I run the code, I get an error message in "Getting coordinates for the letters". Do you know why?

For your info: version MM 11.3

Clear[LetterAt];
Options[LetterAt] = {FontFamily -> "Times", FontWeight -> Bold, 
   FontSize -> 120};
LetterAt[letter_String, opts : OptionsPattern[]] := 
  Block[{grm, grmr, mcoords, fontFamily, fontWeight, fontSize}, 
   fontFamily = OptionValue[FontFamily];
   fontWeight = OptionValue[FontWeight];
   fontSize = OptionValue[FontSize];
   grm = Graphics[
     Text[Style[letter, FontFamily -> fontFamily, 
       FontWeight -> fontWeight, FontSize -> fontSize], {0, 0}], 
     ImageSize -> {100, 100}];
   grmr = Rasterize[grm];
   mcoords = Reverse /@ Position[grmr[[1, 1]], {0, 0, 0}] // N];

LetterCoordsToLines[coords_, offsetSize_Integer, nsample_Integer] := 
 Function[{pair}, 
   Line[({pair[[1]] - offsetSize*#1, 
        pair[[2]] + offsetSize*#1} &)[(pair[[2]] - pair[[1]])/
      Norm[pair[[2]] - pair[[1]]]]]] /@ 
  Table[RandomSample[coords, 2], {nsample}]

LetterCoordsToLines2[coords_, offsetSizeDummy_Integer, 
  nsample_Integer] := 
 Map[Function[{pair}, 
   Line[{2 pair[[2]] - pair[[1]], 2 pair[[1]] - pair[[2]]}]], 
  Table[RandomSample[coords, 2], {nsample}]]

word = "MUSEUM";
letterCoords = 
 MapThread[(t = 
     LetterAt[#1, FontFamily -> "Helvetica", FontWeight -> "Normal", 
      FontSize -> 100];
    Map[Function[{p}, p + {#2, 0}], t]) &, {Characters[word], 
   Range[0, (StringLength[word] - 1)*100, 100]}]

enter image description here

Thanks and look forward to your reply !

Regards,.....Jos

POSTED BY: Jos Klaps
Posted 6 years ago

Look at Kotaro Okazaki's reply above. A change is needed for version 11.3.

POSTED BY: Rohit Namjoshi

Dear Rohit,

Thanks for your quick response. Yes, I missed the changes in MM11.3.

Best Regards,.....Jos

POSTED BY: Jos Klaps

I am curious if this is similar to the algorithm used here: http://artof01.com/vrellis/works/knit.html

enter image description here

POSTED BY: Vitaliy Kaurov

Dear Anton,

Thank you for a great post. However it cannot work well in my Mathematica v11.3. So I changed it a bit. I changed Position[] to ImageValuePositions[].

LetterAt[letter_String, opts : OptionsPattern[]] := 
  Block[{grm, grmr, mcoords, fontFamily, fontWeight, fontSize}, 
   fontFamily = OptionValue[FontFamily];
   fontWeight = OptionValue[FontWeight];
   fontSize = OptionValue[FontSize];
   grm = Graphics[
     Text[Style[letter, FontFamily -> fontFamily, 
       FontWeight -> fontWeight, FontSize -> fontSize], {0, 0}], 
     ImageSize -> {100, 100}];
   grmr = Rasterize[grm];
   (* mcoords=Reverse/@Position[grmr[[1,1]],{0,0,0}]//N *)
   mcoords = ImageValuePositions[grmr, {0, 0, 0}] // N];

I enjoyed it in Hiragana. enter image description here enter image description here

POSTED BY: Kotaro Okazaki

enter image description here - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming, and consider contributing your work to the The Notebook Archive!

POSTED BY: EDITORIAL BOARD
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard