老师 我这里还是有问题,运行到红色一行的时候 错误提示“除数为零”。
我要完成的功能是,1、入txt中的每行数据,txt中每行数据中,分别表示x,y坐标,及一个对应值
2、在picture中绘制出所有对应的坐标点
我后面画图那块好像是有点问题。
我将我这段程序都贴出来,请您指教
xxx As Single
Dim yyy As Single
Dim hhh As Single
Dim xy_max As Single
Dim k As Long
Dim arry_num As Long
Dim strFileName As String '文件名
strFileName = App.Path & "\" & Text1.Text & ".TXT"
List1.AddItem (App.Path & "\" & Text1.Text & ".TXT")
If Dir(App.Path & "\" & Text1.Text & ".TXT") = vbNullString Then
MsgBox "您选择的数据不存在!,请重新选择"
Else
Open strFileName For Input As #1
'读取txt文本
'************测得txt文本行数
Dim s As String
Do Until EOF(1)
' 循环至文件尾
arry_num = arry_num + 1
Input #1, s
Loop
List1.AddItem (arry_num)
Dim xyh_arry() As Single
'如果能查询txt文件有多少行
ReDim xyh_arry(0 To 2, 0 To arry_num - 1) As Single
Do Until EOF(1)
' 循环至文件尾
Line Input #1, TextLine
' 读入一行数据并将其赋予某变量
'xxx = Val(Mid(TextLine, 1, 13))
'按位取x坐标
'yyy = Val(Mid(TextLine, 14, 13))
'按位取y坐标
'hhh = Val(Mid(TextLine, 27, 13))
'按位取厚度值
Dim o As Long
Dim fj()
'接你红色部分
TextLine = Replace(TextLine, vbTab, " ")
'把 TAB 换成 空格
Do
o = Len(TextLine)
TextLine = Replace(TextLine, "
", " ")
'把 双空格 换成 单空格
Loop While o <> Len(TextLine)
fj = Split(TextLine, " ")
'以 单空格 为分隔符
If UBound(fj) >= 2 Then
'存在三个或以上元素,超出问题不使用
xxx = Val(fj(0))
'按位取x坐标
yyy = Val(fj(1))
'按位取y坐标
hhh = Val(fj(2))
'按位取厚度值
'Else
'数据不够,在这里处理,如果你是有几个数,就读几个数,那么这里需要分解开来写
End If
Stop
List1.AddItem xxx
List1.AddItem yyy
List1.AddItem hhh
If xxx >= yyy Then
'计算x,y坐标最大值
If xxx >= xy_max Then
xy_max = xxx
End If
Else
If yyy >= xy_max Then
xy_max = yyy
End If
End If
xyh_arry(0, k) = xxx
xyh_arry(1, k) = yyy
xyh_arry(2, k) = hhh
List1.AddItem (xyh_arry(0, k))
List1.AddItem (xyh_arry(1, k))
List1.AddItem (xyh_arry(2, k))
k = k + 1
Loop
Close #1
'***************绘图初始化********************
Dim surface_width As Integer
Dim surface_height As Integer
Dim surface_count As Integer
If (xxx >= yyy) Then
surface_width = xy_max * 5
surface_height = xy_max * 5
surface_count = xy_max * 5
Else
surface_width = xy_max * 5
surface_height = xy_max * 5
surface_count = xy_max * 5
End If
P.ForeColor = vbRed
P.DrawWidth = 1
P.ScaleMode = 0
P.Scale (0, surface_count)-(surface_count, 0) '设定坐标尺度
If (surface_width >= surface_height) Then
P.Line (0, surface_height)-(surface_width - 1, surface_height), vbBlue '横线
P.Line -(surface_width - 1, 1), vbBlue
P.Line -(0, 1), vbBlue
P.Line -(0, surface_height), vbBlue
Else
P.Line (surface_width, 0)-(surface_width, surface_height), vbBlue
'横线
P.Line -(0, surface_height), vbBlue
P.Line -(0, 1), vbBlue
P.Line -(surface_width, 1), vbBlue
End If
P.CurrentX = surface_width / 30
'设置 原点 O POINT 的位置
P.CurrentY = surface_height / 30
P.Print "0"
P.DrawWidth = 5
For k = 0 To arry_num - 1
P.PSet (xyh_arry(0, k), arry(1, k))
List1.AddItem (arry(0, k) & "," & arry(1, k))
Next k
End If
End Sub