AutoCAD_Vba_求样条曲线交点座标

Sub AutoCAD_Vba求样条曲线交点坐标()
    Dim ytqx1 As AcadSpline, ytqx2 As AcadSpline
    Dim r As Object
    Dim leaderObj As AcadLeader
    Dim points(0 To 8) As Double
    Dim xPnt(0 To 2) As Double, I As Integer
    Dim leaderType As Integer
    Dim annotation As AcadObject
    Dim Width As Double
    Dim mtxtStr As String
    Set r = ThisDrawing.Utility
    r.CreateTypedArray a, vbDouble, 0, 0, 0
    r.CreateTypedArray b, vbDouble, 0, 0, 0
    r.CreateTypedArray arr, vbDouble, 489.93, 979.87, 0, 979.87, 61.24, 0, 1469.8, 12.1, 0
    Set ytqx1 = ThisDrawing.ModelSpace.AddSpline(arr, a, b)
    r.CreateTypedArray arr, vbDouble, 489.93, 168.39, 0, 979.87, 99.69, 0, 1469.8, 75.51, 0
    Set ytqx2 = ThisDrawing.ModelSpace.AddSpline(arr, a, b)
    jdzb = ytqx1.IntersectWith(ytqx2, acExtendBoth)
    ThisDrawing.ActiveTextStyle.fontFile = "c:\windows\fonts\simsun.ttc"
    points(0) = jdzb(0): points(1) = jdzb(1): points(2) = jdzb(2)
    For I = 1 To 2
        points(3 * I) = jdzb(0) + I * 100
        points(3 * I + 1) = jdzb(1) + 200
        points(3 * I + 2) = jdzb(2)
    Next
    leaderType = acLineWithArrow
    Set leaderObj = ThisDrawing.ModelSpace.AddLeader(points, annotation, leaderType)
    Width = 640
    mtxtStr = "交点坐标 : " & Format(jdzb(0), "0.00") & "," & Format(jdzb(1), "0.00") & "," & jdzb(2)
    xPnt(0) = points(6) + 3.5
    xPnt(1) = points(7) + 25
    xPnt(2) = points(8)
    Set annotation = ThisDrawing.ModelSpace.AddMText(xPnt, Width, mtxtStr)
    annotation.Height = 30
    leaderObj.ArrowheadSize = 50
    ZoomAll
End Sub