4
$\begingroup$

I'm researching some computational geometry and am trying to find a method of determining the {x,y} intersection of a circle and BSplineCurve for further processing.

basisPoints = {{0, 0}, {3000, 7000}, {4000, -7000}, {5000, 
    7000}, {8000, 0}};
f = BSplineFunction[basisPoints];
p = ParametricPlot[f[t], {t, 0, 1}, MeshFunctions -> {"ArcLength"}, 
   Mesh -> {10}, MeshStyle -> {PointSize[0.01], Red}];
points = Cases[Normal[p], _Point, Infinity];
ptsPlus = Point /@ {f[0], f[1]};
points = SortBy[points~Join~ptsPlus, First];

Show[
 ParametricPlot[f[t], {t, 0, 1}],
 Graphics[Circle[#, 1400]] & /@ points[[All, 1]],
 Graphics[{AbsolutePointSize[9], Red, points}],
 PlotRange -> All
 ]

enter image description here

Most potential solutions I've come across online so far have the curve in a different form. However, for the project we really want to try to use BSplineCurves because of their ease of input by other users, making the final curve somewhat arbitrary. Mathematica is great for offering BSplineFunction in this regard. Before I go through of all the trouble of translating this curve into a more conventional form, is there a straightforward way to find where this Circle and BSplineFunction intersect?

enter image description here

cir = Circle[#, 1400] & /@ (Cases[points, Point[x_] :> x, Infinity]);
RegionPlot[{
  cir[[1]] // DiscretizeGraphics ,
  spline // DiscretizeGraphics},
 Frame -> False
 ]
$\endgroup$
2
  • $\begingroup$ p and coords are not defined. Looks like p = ParametricPlot[f[t], {t, 0, 1}, MeshFunctions -> {"ArcLength"}, Mesh -> 10] and coords = points[[All, 1]];? $\endgroup$ – kglr Aug 15 '20 at 2:21
  • $\begingroup$ I've updated the code. The evaluation should run in a fresh notebook now. $\endgroup$ – BBirdsell Aug 15 '20 at 15:37
2
$\begingroup$
p = ParametricPlot[f[t], {t, 0, 1}, MeshFunctions -> {"ArcLength"}, Mesh -> 10];
points = Cases[Normal[p], _Point, Infinity];
ptsPlus = Point /@ {f[0], f[1]};
points = SortBy[points~Join~ptsPlus, First];
coords = points[[All, 1]];

circles = Graphics[Circle[#, 1400]] & /@ coords;

intersections = Union @@ (Graphics`Mesh`FindIntersections[Show[p, #], 
      Graphics`Mesh`AllPoints -> False] & /@ circles);

Show[p, circles, Graphics[{AbsolutePointSize[5], Red, Point @ intersections}], 
  PlotRange -> All, ImageSize -> 800]

enter image description here

Show[p, circles[[1]], 
 Graphics[{AbsolutePointSize[9], Red, 
   Point@Graphics`Mesh`FindIntersections[Show[p, circles[[1]]], 
     Graphics`Mesh`AllPoints -> False]}],
 PlotRange -> All, ImageSize -> 800, Axes -> False]

enter image description here

$\endgroup$
1
  • $\begingroup$ Hmm.. Looking over the post, this is not as straightforward as I thought. I'm at the limits of my knowledge of computational geometry here. 😀 Please bare with me as I run through this code. $\endgroup$ – BBirdsell Aug 15 '20 at 15:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.