vb绘图

zyzy577048814 2014-05-16 10:11:04

’有三个圆，aqd数组分别存入的是圆的x横纵和半径 r数值
两根垂直的导轨（xy导轨距离圆心距离均为200）能从圆1移到圆2再到圆3（xy导轨距离圆心均为200）实现动态移动
程序如下，运行时坐标总是对不上。求各位大神看看那边出错了
Private Sub Command4_Click() '加工模拟
Dim a()
Dim q()
Dim d()
Dim n1 As Integer
a = Array(301, 430, 560)
q = Array(320, 430, 500)
d = Array(35, 25, 15)
n1 = 3
For k = 0 To (n1 - 1)
Text1(1).Text = a(k)
Text2(1).Text = q(k)
Text3(1).Text = d(k)
Xc = Val(Text1(1).Text)
Yc = Val(Text2(1).Text)
R = Val(Text3(1).Text)
If k = 0 Then
For c = 0 To Xc - 200 Step 5
Picture3.Cls
Picture3.Circle (Xc, Yc), R, vbRed
Picture3.Line (c, (Yc - 200) / (Xc - 200) * c)-(c, 800), RGB(255, 255, 100)
Picture3.Line (c, (Yc - 200) / (Xc - 200) * c)-(1000, (Yc - 200) / (Xc - 200) * c), RGB(255, 255, 100) '黄色
Sleep 100
DoEvents
Next c
End If
Sleep 1000
If k > 0 Then
For c = 0 To (a(k) - a(k - 1)) Step 5
Picture3.Cls
z = (q(k) - q(k - 1)) / (a(k) - a(k - 1))
Picture3.Line (a(k - 1) + c, q(k - 1) + z * c)-(a(k - 1) + c, 800), RGB(255, 255, 100)
Picture3.Line (a(k - 1) + c, q(k - 1) + z * c)-(1000, q(k - 1) + z * c), RGB(255, 255, 100) '黄色
Sleep 100
DoEvents
Next c
End If
还有一个问题想问一下只看红色部分即可[color=#FF0000][/color]
Dim x(0 To 80000) As Single
Dim y(0 To 80000) As Single
Dim xa As Double
Dim xb As Double
Dim ya As Double
Dim yb As Double
Timer1.Enabled = True
n = 0
Open App.Path & "\" & k & ".tmp" For Input As #2 '从第k个文本中提取（第k个）园的细分点坐标
Open App.Path & "\" & kk & ".tmp" For Output As #5
Open App.Path & "\" & kkk & ".tmp" For Output As #6
i = -1
Do
i = i + 1
Input #2, x(i), y(i) '文件中i从0开始读取
Loop Until EOF(2) '一直等到文件cb读到做末尾一个数字时停止读取
For j = 0 To i 'i+1为读了多少个数
If j = i Then
End If
Picture3.Cls
For z = 0 To k - 1
Picture3.Circle (a(z), q(z)), d(z), vbRed
Next z
' Call Tline
Picture3.Line (Xc - 200, Yc - 200)-(Xc - 200, 800), RGB(255, 255, 100)
Picture3.Line (Xc - 200, Yc - 200)-(1000, Yc - 200), RGB(255, 255, 100) '黄色
For s = 0 To j
Picture3.PSet (x(s), y(s)), vbRed
Next s
If Yc < 300 Then
yb = Sqr(300 ^ 2 - y(j) ^ 2) + x(j)
ya = x(j) - Sqr(300 ^ 2 - y(j) ^ 2) '300为杆固定长
Else
yb = Sqr(300 ^ 2 - (y(j) + 200 - Xc) ^ 2) + x(j)
ya = x(j) - Sqr(300 ^ 2 - (y(j) + 200 - Xc) ^ 2)
End If
Print #5, "导轨1坐标值"; ya
Print #6, "导轨2坐标值"; yb '把值写入文件，方便下次读取
If Yc < 300 Then
Picture3.Line (x(j), y(j))-(yb, 0), RGB(100, 255, 200)
Picture3.Line (x(j), y(j))-(ya, 0), RGB(255, 255, 0) '将两点连接起来用不同颜色表示
Picture3.PSet (x(j), y(j)), vbRed
' Picture3.PSet (ya, 0), RGB(255, 155, 100)
' Picture3.PSet (yb, 0), RGB(155, 105, 100)
Else
Picture3.Line (x(j), y(j))-(yb, Yc - 200), RGB(100, 255, 200)
Picture3.Line (x(j), y(j))-(ya, Yc - 200), RGB(255, 255, 0) '将两点连接起来用不同颜色表示
Picture3.PSet (x(j), y(j)), vbRed
Picture3.PSet (ya, Yc - 200), RGB(255, 155, 100)
Picture3.PSet (yb, Yc - 200), RGB(155, 105, 100)
End If

DoEvents
Next j
Close #2
Close #5
Close #6
上面程序中，56我明明关上了，为什么每次运行都说我文件已打开

...全文