ClearAll[graphicsDigitizing]; graphicsDigitizing[image_Image: ImageResize[Image[{{{1,1,1}}},ColorSpace->"RGB"],{600,600}]]:=With[ {im=ImageResize[image,600]}, With[ {imdim=ImageDimensions[im]}, CreateDialog[{ ExpressionCell[ DynamicModule[ {degree,xmin=0,xmax=1,ymin=0,ymax=1,currentFunction,u,unew,udiap,\[Alpha],\[Beta]1,\[Beta]2}, Grid[ { { DefaultButton[ " ", DialogReturn[ With[ {var1=If[ Length[u]<4, None, unew=Drop[u,2]; udiap=Transpose[u[[1;;2]]]; Transpose[ { Rescale[unew[[All,1]],{Min[udiap[[1]]],Max[udiap[[1]]]},{xmin,xmax}], Rescale[unew[[All,2]],{Min[udiap[[2]]],Max[udiap[[2]]]},{ymin,ymax}]} ]/.x_Real:>Round[x,0.01]],var2=degree}, CopyToClipboard[BSplineCurve[var1,SplineDegree->var2]]] ]] }, { TabView[ {""->Grid[ { { Grid[ { { Row[{" :",Slider[Dynamic@\[Alpha],{-Pi/6,Pi/6},ImageSize->Small]}," "] }, { Row[{":",Slider2D[Dynamic[\[Beta]1],{0.2 Max[imdim] {-1,-1},0.2 Max[imdim] {1,1}}],Slider2D[Dynamic[\[Beta]2],{0.2 Max[imdim] {-1,-1},0.2 Max[imdim] {1,1}}]}," "] }, { Row[{" :",SetterBar[Dynamic@degree,{0,1,2,3,4}]}," "] }, { Grid[{{"\!\(\*SubscriptBox[\(x\), \(min\)]\) =", InputField[Dynamic[xmin],FieldSize->{3,1}],"\!\(\*SubscriptBox[\(x\), \(max\)]\) =", InputField[Dynamic[xmax],FieldSize->{3,1}]},{"\!\(\*SubscriptBox[\(y\), \(min\)]\) =", InputField[Dynamic[ymin],FieldSize->{3,1}],"\!\(\*SubscriptBox[\(y\), \(max\)]\) =", InputField[Dynamic[ymax],FieldSize->{3,1}]}}] }}, Alignment->Left, Spacings->{Automatic,1}], LocatorPane[ Dynamic@u, Framed@Dynamic@Graphics[{Inset[im,{0,0},{0,0},imdim,{Cos[\[Alpha]],Sin[\[Alpha]]}], {EdgeForm[Directive[AbsoluteThickness[3],RGBColor[{214,0,0}/255]]], Opacity[0.2,Yellow], Rectangle[u[[1]],u[[2]]]}, {Dashed,Blue,AbsoluteThickness[4], If[Length[u]<4,BSplineCurve[u[[1;;2]],SplineDegree->2],BSplineCurve[Drop[u,2],SplineDegree->degree]] }}, PlotRange->Transpose[{\[Beta]1,imdim+\[Beta]2}],ImageSize->600],LocatorAutoCreate->True] } },Alignment->{Center,Top} ], ""->Dynamic@Graphics[ {Blue,AbsoluteThickness[2], If[Length[u]<4, BSplineCurve[u[[1;;2]],SplineDegree->2], BSplineCurve[unew=Drop[u,2]; udiap=Transpose[u[[1;;2]]]; Transpose[ {Rescale[unew[[All,1]],{Min[udiap[[1]]],Max[udiap[[1]]]},{xmin,xmax}], Rescale[unew[[All,2]],{Min[udiap[[2]]],Max[udiap[[2]]]},{ymin,ymax}]}], SplineDegree->degree]]}, PlotRange->{{xmin,xmax},{ymin,ymax}}, ImageSize->600, Axes->True, AspectRatio->imdim[[2]]/imdim[[1]]] },Alignment->Center] } } ], Initialization:>(u={{0,0},imdim};\[Alpha]=0; degree=3;\[Beta]1=0.1 Max[imdim] {-1,-1};\[Beta]2=0.1 Max[imdim] {1,1})] ]}];]]; graphicsDigitizing[image_String/;FileExistsQ[image]]:=graphicsDigitizing[Import[image]]; graphicsDigitizing[x___]:=(Echo[Inactive[graphicsDigitizing][x]," : "]; Nothing)