I have this code that I found a while ago, but I can't find the source anymore. Here it is:
findRange[lst_?MatrixQ]:=Table[Through[{Min,Max}@lst[[All,i]]],{i,Length@First@lst}]
selfIntersectingQ[lns___Line]:=Module[{pts,lines},
pts=Cases[{lns},{_?NumericQ,_?NumericQ},All];
lines=Flatten[{lns}/.Line[{pt1_,ps___,pt2_}/;Not[pt1===pt2]]:>Line[{pt1,ps,pt2,pt1}]/.{x_?NumericQ,y_?NumericQ}:>Position[pts,{x,y}][[1,1]]];
Quiet[Check[BoundaryMeshRegion[pts,Sequence@@lines];False,True,{BoundaryMeshRegion::binsect}],{BoundaryMeshRegion::binsect}]
]
conjoinOverlappingLines[ln1_Line,ln2_Line]:=Module[{dist1,dist2,breakup1,breakup2,externalPieces1,externalPieces2,gap,connectEndPoints,purgeDuplicates,minimal},
dist1=SignedRegionDistance[ln1/.Line->Polygon];
dist2=SignedRegionDistance[ln2/.Line->Polygon];
breakup1=Split[ln1[[1]],Sign[dist2[#1]]===Sign[dist2[#2]]&];
If[Sign[dist2[breakup1[[1,1]]]]==Sign[dist2[breakup1[[-1,1]]]],breakup1=Replace[RotateLeft[breakup1],{pts1___,pts2_List,pts3_}:>{pts1,Join[pts2,pts3]}]];
breakup2=Split[ln2[[1]],Sign[dist1[#1]]===Sign[dist1[#2]]&];
If[Sign[dist1[breakup2[[1,1]]]]==Sign[dist1[breakup2[[-1,1]]]],breakup2=Replace[RotateLeft[breakup2],{pts1___,pts2_List,pts3_}:>{pts1,Join[pts2,pts3]}]];
externalPieces1=Line/@Select[breakup1,dist2[First[#]]>0&];
externalPieces2=Line/@Select[breakup2,dist1[First[#]]>0&];
gap[lin1_Line,lin2_Line]:=EuclideanDistance[lin1[[1,-1]],lin2[[1,1]]];
connectEndPoints=(Line[{pt1_,pts___,pt2_}/;Not[SameQ[pt1,pt2]]]:>Line[{pt1,pts,pt2,pt1}]);
purgeDuplicates=(Line[{pts1___,pt1_,pt1_,pts2___}]:>Line[{pts1,pt1,pts2}]);
First[Join[externalPieces1,externalPieces2]//.({Line[pts1_],lins2__Line}:>Join@{{Line@Join[pts1,minimal=MinimalBy[{lins2},gap[Line@pts1,#]&];minimal[[1,1]]]},DeleteCases[{lins2},minimal[[1]]]})/.connectEndPoints//.purgeDuplicates]
]
gatherLinesByRectangles[lns___Line]:=Module[{rect,startRectangles,overlappingQ,gatherCouple,gathered},
startRectangles=Map[rect[findRange[#[[1]]],#]&,{lns}];
overlappingQ[rect[{{x1_,x2_},{y1_,y2_}},lines1___],rect[{{x3_,x4_},{y3_,y4_}},lines2___]]:=
Nor[x2<x3,x4<x1,y2<y3,y4<y1];
gatherCouple[rect[{{x1_,x2_},{y1_,y2_}},lines1___],rect[{{x3_,x4_},{y3_,y4_}},lines2___]]:=rect[{{Min[x1,x3],Max[x2,x4]},{Min[y1,y3],Max[y2,y4]}},lines1,lines2];
gathered=startRectangles//.({rs1___,r1_rect,rs2___,r2_rect,rs3___}/;overlappingQ[r1,r2]):>{rs1,gatherCouple[r1,r2],rs2,rs3};
gathered/.rect[rg_List,lines___Line]:>{lines}
];
conjoinMultipleLines[lns__Line]:=Module[{ord,conjoinRepeated},
ord=gatherLinesByRectangles[lns];
conjoinRepeated:=({lns1___,ln1_Line,lns2___,ln2_Line,lns3___}/;selfIntersectingQ[ln1,ln2]):>Flatten[{lns1,conjoinOverlappingLines[ln1,ln2],lns2,lns3}];
Quiet[LaunchKernels[],{LaunchKernels::nodef}];
DistributeDefinitions[conjoinOverlappingLines,conjoinRepeated];
Flatten[ParallelMap[#//.conjoinRepeated&,ord]]
]
filledCurveSegmentToLine[lengthList_?MatrixQ,pts_?MatrixQ,opts___Rule]:=Module[{lst,bezierFunctionList,extrema,l,f,x,lines,allPoints,allX,allY,diameter,degenerateLine,argument,argument2},
lst=Partition[Prepend[Accumulate[lengthList[[All,2]]],1],2,1];
bezierFunctionList=Table[BezierCurveFunction[Take[pts,extrema],argument],{extrema,lst}];
l=Length[bezierFunctionList];f=Function@@{{x},List@Piecewise@MapIndexed[(i=First[#2];{#1[Rescale[x,{(i-1)/l,i/l},{0,1}]],(i-1)/l<=x<=i/l})&,bezierFunctionList]}/.x->argument2;
lines=Cases[ParametricPlot[f[x],{x,0,1},Evaluate[Sequence@@FilterRules[{Mesh->None,opts},Options@ParametricPlot]],Exclusions->None,PlotPoints->4l+1,MaxRecursion->1],_Line,{1,Infinity}];
allPoints=Cases[lines,{_?NumericQ,_?NumericQ},{1,Infinity}];
{allX,allY}=Transpose[allPoints];
diameter=Norm[{Max[allX]-Min[allX],Max[allY]-Min[allY]}];
degenerateLine[pt__/;MatrixQ[{pt}]]:=Norm@Flatten@Minors[Map[#-{pt}[[1]]&,Rest[{pt}]],2]<10^-8;
lines/.Line[{pt__/;degenerateLine[pt]}]:>Sequence@@{}
];
filledCurveToLines[FilledCurve[lengthSpec_List/;Precision[lengthSpec]===Infinity,ptCoord_List],opts___Rule]:=Module[{f},Flatten[Thread[f[lengthSpec,ptCoord]]/.f->(filledCurveSegmentToLine[#1,#2,opts]&)]
];
filledCurveToPolygons[FilledCurve[lengthSpec_List/;Precision[lengthSpec]===Infinity,ptCoord_List],opts___Rule]:=Module[{startingLines,rng,rngMemberQ,circuitation,containedPolygonQ,closestCouple,joinTwoContainedPolygon,ruleForJoiningContainedPolygons},
startingLines=filledCurveToLines[FilledCurve[lengthSpec,ptCoord],opts];
rng[pts_?MatrixQ]:=(Interval[{Min[#1],Max[#1]}]&)/@Transpose[pts];rngMemberQ[pts1_?MatrixQ,pts2_?MatrixQ]:=Module[{intX1,intY1,intX2,intY2},{intX1,intY1}=rng[pts1];{intX2,intY2}=rng[pts2];IntervalMemberQ[intX1,intX2]&&IntervalMemberQ[intY1,intY2]];containedPolygonQ[pts1_?MatrixQ,pts2_?MatrixQ]/;!rngMemberQ[pts1,pts2]:=False;
circuitation[pts_?MatrixQ,pt0_List]:=Table[1/(z-Complex@@pt0),{z,Apply[Complex,Most@pts,{1}]}].Differences[Apply[Complex,pts,{1}]];
(*NIntegrate[1/(z-Complex@@pt0),Evaluate[Join[{z},Apply[Complex,pts,{1}]]]]*);containedPolygonQ[pts1_?MatrixQ,pts2_?MatrixQ]/;rngMemberQ[pts1,pts2]:=Abs[circuitation[pts1,pts2[[1]]]]>\[Pi]/2;closestCouple[pts1_?MatrixQ,pts2_?MatrixQ]:=Module[{tpls,couplePos,pos1,pos2},tpls=Tuples[{pts1,pts2}];couplePos=Ordering[tpls,1,EuclideanDistance@@#1<=EuclideanDistance@@#2&][[1]];pos1=Quotient[couplePos,Length[pts2]]+1;pos2=Mod[couplePos-1,Length[pts2]]+1;{pos1,pos2}];
joinTwoContainedPolygon[pts1_?MatrixQ,pts2_?MatrixQ]:=Module[{pos1,pos2},
{pos1,pos2}=closestCouple[pts1,pts2];Polygon[Join[RotateLeft[pts1,pos1-1],{pts1[[pos1]]},RotateLeft[pts2,pos2-1],{pts2[[pos2]]}]]];
ruleForJoiningContainedPolygons={{a___,Polygon[pts1_],Polygon[pts2_],b___}/;containedPolygonQ[pts1,pts2]:>{a,joinTwoContainedPolygon[pts1,pts2],b},{a___,Polygon[pts2_],Polygon[pts1_],b___}/;containedPolygonQ[pts1,pts2]:>{a,joinTwoContainedPolygon[pts1,pts2],b}};
startingLines/.Line->Polygon//.ruleForJoiningContainedPolygons
]
BSplineCurveFunction[pts_?MatrixQ]:=Module[{knots,deg},knots=Rationalize@BSplineFunction[pts][[6,1]];deg=BSplineFunction[pts][[3,1]];
Apply[Function,List@Sum[pts[[i+1]]BSplineBasis[{deg,knots},i,#],{i,0,Length[pts]-1}]]
];
BezierSymbolicFunction[pts_?MatrixQ]:=Apply[Function,List@Sum[pts[[i+1]]BernsteinBasis[Length[pts]-1,i,#],{i,0,Length[pts]-1}]];BezierCurveFunction[pts_?MatrixQ/;Length[pts]<=4]:=BezierSymbolicFunction[pts];
BezierCurveFunction[pts_?MatrixQ/;Length[pts]>4]:=Module[{x,sgmts,lngth},
sgmts=Partition[pts,4,3,{1,1},{}];
lngth=Length[sgmts];
Apply[Function,{Piecewise@MapIndexed[{BezierCurveFunction[#1][Rescale[x,{First@#2-1,First@#2}/lngth]],0<=lngth*x-First@#2+1<=1}&,sgmts]}/.x->#]
];
BezierSymbolicFunction[pts_?MatrixQ,argument_Symbol]:=Apply[Function,{{argument},List@Sum[pts[[i+1]]BernsteinBasis[Length[pts]-1,i,argument],{i,0,Length[pts]-1}]}];BezierCurveFunction[pts_?MatrixQ/;Length[pts]<=4,argument_Symbol]:=BezierSymbolicFunction[pts,argument];
BezierCurveFunction[pts_?MatrixQ/;Length[pts]>4,argument_Symbol]:=Module[{x,sgmts,lngth},
sgmts=Partition[pts,4,3,{1,1},{}];
lngth=Length[sgmts];
Apply[Function,{{argument},,Piecewise@MapIndexed[{BezierCurveFunction[#1][Rescale[x,{First@#2-1,First@#2}/lngth]],0<=lngth*x-First@#2+1<=1}&,sgmts]}/.x->argument]
];
TextToGraphics[str_,opts___Rule]:=Module[{txtRange,fromPDFExport,optTransf,mag,ovrlapQ,flng,fillingQ,x0,x1,y0,y1,startingPolygons,xmin,xmax,ymin,ymax,lowerLeftCorner,originalCenter,finalCenter,centeredInTheOrigin,tallerQ,transf,finalTransf,fldCvs},
{txtRange,optTransf,mag,ovrlapQ}={TextRange,GeometricTransformation,Magnification,ResolveFontOverlapping}/.{opts}/.Options[TextToGraphics];
If[Not@MatchQ[txtRange,{{_?NumericQ,_?NumericQ},{_?NumericQ,_?NumericQ}}|Automatic],txtRange={{0,1},{0,1}}];
flng=Filling/.{opts}/.Options[TextToGraphics];
fillingQ=TrueQ[flng];
fromPDFExport=ImportString[ExportString[str,"PDF"],"PDF"];
If[$VersionNumber<8,startingPolygons=Cases[fromPDFExport,_Polygon|_Line,{1,Infinity}]];
If[$VersionNumber>=8,
fldCvs=Cases[fromPDFExport,fc_FilledCurve,{1,Infinity}];
Quiet[LaunchKernels[],{LaunchKernels::nodef}];
DistributeDefinitions[filledCurveToPolygons,filledCurveToLines,fldCvs,BezierCurveFunction,BezierSymbolicFunction];startingPolygons=Flatten[If[TrueQ@fillingQ,
ParallelMap[filledCurveToPolygons[#,opts]&,fldCvs,Method->"CoarsestGrained"],
ParallelMap[filledCurveToLines[#,opts]&,fldCvs,Method->"CoarsestGrained"]]]];
If[Not@TrueQ@fillingQ&&TrueQ[ovrlapQ],startingPolygons=conjoinMultipleLines@@startingPolygons];
startingPolygons=startingPolygons/.{Polygon[pts_]:>Polygon[mag*pts],Line[pts_]:>Line[mag*pts]};
{{xmin,xmax},{ymin,ymax}}=findRange[Cases[startingPolygons,{_?NumericQ,_?NumericQ},{1,Infinity}]];
lowerLeftCorner={xmin,ymin};
If[txtRange===Automatic,txtRange={{0,xmax-xmin},{0,ymax-ymin}}];
{{x0,x1},{y0,y1}}=Map[Sort,txtRange];
If[txtRange===Automatic,Return[startingPolygons/.{x_?NumericQ,y_?NumericQ}:>Composition[optTransf,TranslationTransform[-lowerLeftCorner]][{x,y}]]];
originalCenter=Map[Mean,{{xmin,xmax},{ymin,ymax}}];
finalCenter=Map[Mean,txtRange];
centeredInTheOrigin=startingPolygons/.{x_?NumericQ,y_?NumericQ}:>TranslationTransform[-originalCenter][{x,y}];
tallerQ=(ymax-ymin)/(xmax-xmin)>=(y1-y0)/(x1-x0);
transf/;tallerQ:=AffineTransform[(y1-y0)/(ymax-ymin)IdentityMatrix[2]];
transf/;Not@tallerQ:=AffineTransform[(x1-x0)/(xmax-xmin)IdentityMatrix[2]];
finalTransf=Composition[TranslationTransform[finalCenter],optTransf,ScalingTransform[mag{1,1}],transf];
centeredInTheOrigin/.{x_?NumericQ,y_?NumericQ}:>finalTransf[{x,y}]
]
Options[TextToGraphics]={TextRange->Automatic,GeometricTransformation->Identity,Magnification->1,Filling->True,ResolveFontOverlapping->False}
Options[TextToGraphics3D]={PlotStyle->Directive[Black,EdgeForm[]],GeometricTransformation->Identity,Magnification->1,TextRange->Automatic,Filling->True,ResolveFontOverlapping->False};
TextToGraphics3D[str_,lowerLeftCorner:{_?NumericQ,_,_},lowerRightCorner:{_?NumericQ,_?NumericQ,_?NumericQ},upperEdgePoint:{_?NumericQ,_?NumericQ,_?NumericQ},opts___]:=
Module[{flng,txtRange,pltStyle,fillingQ,width,height,graphicsBase,graphics3DBase,mat},
{flng,txtRange,pltStyle}={Filling,TextRange,PlotStyle}/.{opts}/.Options[TextToGraphics3D];
fillingQ=TrueQ[flng];
width=EuclideanDistance[lowerLeftCorner,lowerRightCorner];
height=Sqrt[EuclideanDistance[lowerLeftCorner,upperEdgePoint]^2-((upperEdgePoint-lowerLeftCorner).Normalize[lowerRightCorner-lowerLeftCorner])^2];
If[txtRange===Default,txtRange={{0,width},{0,height}}];
graphicsBase=TextToGraphics[str,TextRange->txtRange,opts];
graphics3DBase={Sequence@@Flatten[{pltStyle}],graphicsBase/.{(hd:(Polygon|Line))[{pts__}]:>hd[{pts}/.{x_Real,y_}:>{x,y,0}]}};
mat=With[{u=lowerRightCorner-lowerLeftCorner,v=upperEdgePoint-lowerLeftCorner},Orthogonalize[{u,v,Cross[u,v]}]];
GeometricTransformation[graphics3DBase,AffineTransform[{Transpose[mat],lowerLeftCorner}]]];
TextToGraphics3D[str_,opts___Rule]:=TextToGraphics3D[str,{0,0,0},{1,0,0},{0,0,1},opts];
TextToGraphics3DLines[smthng__]:=TextToGraphics3D[smthng,Filling->False];
out=TextToGraphics[Style["test",FontFamily->"Times"]];
Graphics[out]
Graphics3D[out/.{(hd:(Polygon|Line))[{pts__}]:>hd[{pts}/.{x_Real,y_}:>{x,y,0}]}]
That should work on version 9.
