求两条直线的交点

Sub ll()
  Dim Ent As AcadEntity
  Dim objLine(1) As AcadLine
  Dim Pp, Pp1, Pt1, Pt2
  With ThisDrawing
    ii = 0
    For Each Ent In .ModelSpace
      Set objLine(ii) = Ent
      With objLine(ii)
        For jj = 0 To 2
          Select Case ii
            Case 0
              Pt1 = .StartPoint
              Kk1 = .Delta(1) / .Delta(0)
              .color = 1
              yy = Kk1 * (.EndPoint(0) - .StartPoint(0)) + .StartPoint(1)
              
              'Debug.Print "yy", yy, .EndPoint(1)
            Case 1
              Pt2 = .StartPoint
              Kk2 = .Delta(1) / .Delta(0)
              .color = 2
          End Select
        Next jj
      End With
      ii = ii + 1
    Next Ent
    Pp = objLine(0).IntersectWith(objLine(1), acExtendBoth)
    Debug.Print Pp(0), Pp(1)
    Pp1 = TowLinesIntersect(Pt1, Kk1, Pt2, Kk2)
    Debug.Print Pp1(0), Pp1(1)
  End With
End Sub
Function TowLinesIntersect(Pt1, Kk1, Pt2, Kk2) As Variant
  Dim Pp(2) As Double
  Pp(0) = (Kk1 * Pt1(0) - Pt1(1) - Kk2 * Pt2(0) + Pt2(1)) / (Kk1 - Kk2)
  Pp(1) = (Pp(0) - Pt1(0)) * Kk1 + Pt1(1)
  TowLinesIntersect = Pp
End Function