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
 ]
Improve this question
$\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, 2020 at 2:21
  • $\begingroup$ I've updated the code. The evaluation should run in a fresh notebook now. $\endgroup$
    – BBirdsell
    Aug 15, 2020 at 15:37

1 Answer 1

Reset to default
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

Improve this answer
$\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, 2020 at 15:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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