Find intersection of pairs of straight lines

p1 = Partition[{{243.8, 77.}, {467.4, 12.}, {291.8, 130.}, {476., 
    210.5}, {103.2, 327.}, {245.2, 110.5}, {47.4, 343.}, {87.4, 
    108.5}, {371., 506.5}, {384.6, 277.}, {264.6, 525.5}, {353.8, 
    294.5}, {113.2, 484.5}, {296., 304.5}, {459.6, 604.5}, {320.2, 
    466.5}, {288.2, 630.5}, {199.6, 446.5}, {138.8, 615.5}, {81.8, 
    410.}, {232.4, 795.}, {461.8, 727.}, {27.4, 671.5}, {206.8, 
    763.5}}, 2];

p2 = Partition[{{356.8, 32.}, {363.2, 120.}, {346., 245.}, {393.8, 
     158.}, {163.8, 211.5}, {230.2, 250.}, {54.6, 225.}, {139.6, 
     220.}, {366., 394.5}, {451.8, 372.}, {241., 398.}, {321., 
     411.5}, {163.2, 347.}, {213.2, 406.5}, {332.4, 596.5}, {402.4, 
     528.5}, {176., 585.5}, {256., 530.5}, {38.2, 553.}, {122.4, 
     507.}, {345.2, 774.5}, {345.2, 688.}, {104.6, 728.}, {161.8, 
     647.}}, 2];

LineIntersectionPoint[{a_, b_}, {c_, d_}] := 
  (Det[{a, b}] (c - d) - Det[{c, d}] (a - b))/Det[{a - b, c - d}]

Graphics[{Line /@ {p1, p2}, Red, [email protected], 
  Point /@ MapThread[LineIntersectionPoint, {p1, p2}]}, Frame -> True]

Mathematica graphics

Ref for finding intersection of 2 lines by determinants

line graph

determinant intersection


Turning my comment into an answer per (now deleted?) comment which requested it.

This is documented to work only in Wolfram Language at this point (specifically Wolfram Programming Cloud). Interestingly enough, it does work also with Mathematica 9.0.1., although documentation has no indication of Line or Solve supporting geometric regions.

p1 = {{243.8, 77.}, {467.4, 12.}, {291.8, 130.}, {476., 
       210.5}, {103.2, 327.}, {245.2, 110.5}, {47.4, 343.}, {87.4, 
       108.5}, {371., 506.5}, {384.6, 277.}, {264.6, 525.5}, {353.8, 
       294.5}, {113.2, 484.5}, {296., 304.5}, {459.6, 604.5}, {320.2, 
       466.5}, {288.2, 630.5}, {199.6, 446.5}, {138.8, 615.5}, {81.8, 
       410.}, {232.4, 795.}, {461.8, 727.}, {27.4, 671.5}, {206.8, 
       763.5}};

p2 = {{356.8, 32.}, {363.2, 120.}, {346., 245.}, {393.8, 
       158.}, {163.8, 211.5}, {230.2, 250.}, {54.6, 225.}, {139.6, 
       220.}, {366., 394.5}, {451.8, 372.}, {241., 398.}, {321., 
       411.5}, {163.2, 347.}, {213.2, 406.5}, {332.4, 596.5}, {402.4, 
       528.5}, {176., 585.5}, {256., 530.5}, {38.2, 553.}, {122.4, 
       507.}, {345.2, 774.5}, {345.2, 688.}, {104.6, 728.}, {161.8, 
       647.}};

(* Convert coordinate-lists to two collections of lines which can be used as
   primitives in both in graphics and new geometric computation. *)
{lines1, lines2} = Line[Partition[#, 2]]& /@ {p1, p2};

(* Create points which belong to both geometric regions
   consisting of line collections, that is any intersections. *)
points = Point[{x, y}] /. Solve[{x, y} \[Element] lines1 &&
                                {x, y} \[Element] lines2, {x, y}];

(* Represent all these as Graphics. *)
Graphics[{Blue, lines1, Red, lines2,
          Black, PointSize[Large], points}, Frame->True]

enter image description here

EDIT:

You can also write above Solvein v10 as:

Solve[{x, y} \[Element] RegionIntersection[lines1, lines2], {x, y}]

This gets interesting when you consider the fact these regions can be much more than lines, for instance circles, filled regions such as disks, implicit and parametric regions, and derived regions. Also in higher dimensions, and symbolically. And they can be discretized, among other things for use of FEM in v10.


Here is a direct vector calculation that verifies the segments (not just the infinite lines) intersect.

 segsegintersection[ lines_ ] := Module[{
    md = Subtract @@ (Plus @@ # & /@ lines),
    sub = Subtract @@ # & /@ lines, det},
        det = -Det[sub];
        If[And @@ (Abs[#] <= 1 & /@ #) ,
             (Plus @@ #[[1]] - Subtract @@ #[[1]] Last@#[[2]])/2 & @
               {First@lines, # }, False] &@
               (Det[{#[[1]], md}]/det & /@ ( {#, Reverse@#}  &@ sub))];

in the example provided they all intersect.. but I thought it useful to included here for completeness. This is way faster than using Solve with constraints. Note @eldo's LineIntersectionPoint is faster than this by a factor of 2 if you do not need the intersection check.

  Graphics[ {Line /@ p1  , Line /@ p2 , Red, PointSize[.025],
      Point@ MapThread[segsegintersection[{ #1 , #2 }] & , {p1, p2} ]}]

same plot as the others..

An example with only some intersections:

 lines = RandomReal[{-1, 1}, {20, 2, 2}];
 Graphics[{Line@lines, Red, PointSize[.02], 
      Point@Select[ segsegintersection[#] & /@ 
              Subsets[lines, {2}] ,  # =!= False &]}]

enter image description here