The following line of code finds the edge of a character:
pic = Binarize[GradientFilter[Rasterize[Style["\[Euro]", FontFamily -> "Times"],
ImageSize -> 200] // Image, 1]]
The coordinates of the edges can be found as follows:
pdata = Position[ImageData[pic], 1];
Test:
Graphics[Point[pdata]]
However, the points are not sorted in an order usable by Line
or Polygon
:
Graphics[Polygon[pdata]]
This brings me to my question:
- What would be an efficient method to sort the coordinates so that it would plot properly with
Line
orPolygon
?
Additionally,
- How to thin and smooth the set of points?
- How to deal with characters with holes in them, like the ones below?
or
Answer
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
Graphics3D[Table[{Orange, Opacity[.5],Polygon[(#~Join~{10 n})&
/@ lcp[[1, 1, 3, 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}]
Comments
Post a Comment