I think there is a neat solution. We have curios function ListCurvePathPlot:
pic = Thinning@Binarize[GradientFilter[Rasterize[Style["\[Euro]",
FontFamily -> "Times"], ImageSize -> 200] // Image, 1]];
pdata = Position[ImageData[pic], 1];
lcp = ListCurvePathPlot[pdata]
Now this is of course Graphics containing Line with set of points
lcp[[1, 1, 3, 2]]
So of course we can do something like
Graphics[Graphics3D[Table[{Orange, ThickOpacity[.5],Polygon[(#~Join~{10 n})&
/@ lcp[[1, 1, 3, 2]]2, 1]]]}, {n, 10}], Boxed -> False]
I think it works nicely with "8" and Polygon:
pic = Thinning@Binarize[GradientFilter[
Rasterize[Style["8", FontFamily -> "Times"], ImageSize -> 500] //Image, 1]];
pdata = Position[ImageData[pic], 1]; lcp = ListCurvePathPlot[pdata]
And you can do polygons 1-by-1 extraction:
Graphics3D[{{Orange, Thick, Polygon[(#~Join~{0}) & /@ lcp[[1, 1, 3, 2, 1]]]},
{Red, Thick, Polygon[(#~Join~{1}) & /@ lcp[[1, 1, 3, 3, 1]]]},
{Blue, Thick, Polygon[(#~Join~{200}) & /@ lcp[[1, 1, 3, 4, 1]]]}}]
=> To smooth the curve set ImageSize -> "larger number" in your pic = code.
=> To thin the curve to 1 pixel wide use Thinning:
Row@{Thinning[#], Identity[#]} &@Binarize[GradientFilter[
Rasterize[Style["\[Euro]", FontFamily -> "Times"],
ImageSize -> 200] // Image, 1]]
You can do curve extraction more efficiently with Mathematica. A simple example would be
text = First[
First[ImportString[
ExportString[
Style["\[Euro] 9 M-8 ", Italic, FontSize -> 24,
FontFamily -> "Times"], "PDF"], "PDF",
"TextMode" -> "Outlines"]]];
Graphics[{EdgeForm[Black], FaceForm[], text}]
