注意看这两行
...
For tana = delta To 0.00001 Step m
u = Sqr(delta ^ 2 - tana ^ 2)
...
第一次执行时tana=delta,当然u=0
....
不知道原理你看没有。文本框内的值不能随意写,圆半径由大至小测试，显然步长为负，而且必须每次更新tana

[ 本帖最后由 lianyicq 于 2015-3-27 12:13 编辑 ]

用直线方程必须考虑斜率无穷大的情况。

在哪里加啊，我那个delta赋值是自己输入，我弄了个文本框，是自己输入数值

Option Explicit
Private Type coordinate
x As Double
y As Double
End Type
Dim A As coordinate, B As coordinate, P As coordinate, T As coordinate
Dim parameter_a As Double
Dim r As Double
Dim s As Double
Private Sub Command1_Click()
Dim parameter_t As Double
Dim t_test As Double
Dim u As Double
Dim k As Double
Dim delta As Double

For parameter_t = r - s To 0 Step -s
  u = Sqr(r ^ 2 - parameter_t ^ 2)
  t_test = 4 * parameter_a * u ^ 3 - 4 * parameter_a * u ^ 2 * A.y - parameter_t ^ 2 + 4 * parameter_a * u * parameter_t ^ 2 + 4 * parameter_a * u * parameter_t * A.x
  If t_test > 0 And t_test < s Then Exit For
Next
P.x = A.x + parameter_t
P.y = A.y - u

T.x = parameter_t / (2 * parameter_a * u)
T.y = parameter_a * T.x ^ 2
k = (P.y - T.y) / (P.x - T.x)
delta = Sqr(k ^ 2 - 4 * parameter_a * (k * A.x - A.y))
B.x = (k + delta) / (2 * parameter_a)
B.y = parameter_a * B.x ^ 2
Form1.Print P.x & "," & P.y
Form1.Print k & "," & 180 * Atn(k) / 3.14 & "度"
Form1.Print T.x & "," & T.y
Form1.Print B.x & "," & B.y
End Sub
Private Sub Text1_Change()
parameter_a = Val(Text1.Text)
End Sub
Private Sub Text2_Change()
r = Val(Text2.Text)
End Sub
Private Sub Text3_Change()
A.x = Val(Text3.Text)
A.y = parameter_a * A.x ^ 2
Text4.Text = A.y
End Sub
Private Sub Text5_Change()
s = Val(Text5.Text)
End Sub

说明一下
text1是y=ax^2的a值比如0.2 text2是圆半径比如0.1 text3是A点横坐标比如2 text4是自动计算A点纵坐标 text5是测试步长比如0.0001

[ 本帖最后由 lianyicq 于 2015-3-30 16:53 编辑 ]