facet normal 0.000000e+000 0.000000e+000 -1.000000e+000
outer loop
vertex 7.460438e+002 1.019743e+002 3.140000e+002
vertex 7.233645e+002 1.246536e+002 3.140000e+002
vertex 7.049680e+002 1.509265e+002 3.140000e+002
endloop
endfacet
facet normal 0.000000e+000 0.000000e+000 -1.000000e+000
outer loop
vertex 7.049680e+002 1.509265e+002 3.140000e+002
vertex 1.023665e+003 3.349265e+002 3.140000e+002
vertex 1.037220e+003 3.058582e+002 3.140000e+002
endloop
endfacet
facet normal 0.000000e+000 0.000000e+000 -1.000000e+000
outer loop
vertex 8.013850e+002 4.158300e+002 3.140000e+002
vertex 7.049680e+002 1.509265e+002 3.140000e+002
vertex 6.914133e+002 1.799948e+002 3.140000e+002
endloop
endfacet
在一个data.txt文本中读取vertex 之后的三个数据，分别保存到x(),y(),z()数组中去要如何实现啊，各位大神求指导！相邻的三个vertex是一个三角形面饼。是由stl文件保存的asc码
这只是txt文本中的一小段，一共有24798个vertex
11 个解决方案
#1
s="vertex 8.013850e+002 4.158300e+002 3.140000e+002"
dim B() as string
b=split(s," ")
for i=0 to ubound(b)
if isnumeric(b(i)) then
msgbox "B(" & cstr(i) & ")是一个数值"
end if
next
dim B() as string
b=split(s," ")
for i=0 to ubound(b)
if isnumeric(b(i)) then
msgbox "B(" & cstr(i) & ")是一个数值"
end if
next
#2
我的意思是：当程序读到“vertex 7.460438e+002 1.019743e+002 3.140000e+002”时，能够运行你发给我的那个命令，那个命令我自己已经编完了，现在的问题就是，用什么样的语句判别关键词"vertex”， 求指导啊，最好详细一些，菜鸟级别求详解。不用输出msgbox，只需要把数值点保存到相应的数组中去就可以了
#3
本帖最后由 bcrun 于 2012-03-30 21:28:28 编辑
定义一个类模块vertex，它只包含三个数据成员,使用类保存顶点，可以动态的创建对象
public x as single
public y as single
public z as sing
窗口模块中：
假设你已经将solid data读入到一个字符串sData中
dim s() as string
dim x as vertex
dim C as new collection '将所有的顶点使用集合收集
dim d() as string
s=split(sData,vbcrlf) '把每行数据装入到s数组中，每个单元对应于一行
for i=0 to ubound(s)
if instr(1,s(i),"vertex")>0 then '如果行包含关键字vertex
d=split(s(i)," ")
set x=new vertex
if isnumeric(d(1)) then x.x=val(d(1))
if isnumeric(d(2)) then x.y=val(d(2))
if isnumeric(d(3)) then x.z=val(d(3))
c.add x
end if
next
#4
擦……你是要方法还是要人家直接给你代码啊，去威客去简单直接
#5
肯定是要方法啊，那句话的意识是他理解错我的意思了，我只是把我的想法告诉他，这没问题吧，PS：为了减少像你一样的不必要的乱喷，附上我的程序主要代码。
#6
Public Sub Init()
Dim pfd As PIXELFORMATDESCRIPTOR '描述像素格式
pfd.nSize = Len(pfd) '结构大小
pfd.nVersion = 1 '版本号
pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_DRAW_TO_WINDOW Or PFD_DOUBLEBUFFER Or PFD_TYPE_RGBA 'RGBA颜色模式
pfd.iPixelType = PFD_TYPE_RGBA '像素格式类型
pfd.cColorBits = 16 '所需的颜色索引位数
pfd.cDepthBits = 16 '所需的深度缓冲区位数
pfd.iLayerType = PFD_MAIN_PLANE '主层类型
' 为设备描述表得到最匹配的像素格式，确定pfd结构是否存在
PixelFormat = ChoosePixelFormat(hDC, pfd)
If PixelFormat = 0 Then
MsgBox "设备描述表支持的像素格式" & vbCrLf & vbCrLf & _
"与给定像素格式不匹配！", vbCritical, "错误"
End
End If
'设置设备描述表的像素格式，把指定的像素格式赋给指定的设备
spf = SetPixelFormat(hDC, PixelFormat, pfd)
If spf = False Then
MsgBox "设置设备描述表像素格式失败！", vbInformation, "失败"
End
End If
'do pre-gl initialization here
End Sub
Public Sub InitGL()
hGLRC = wglCreateContext(hDC)
wglMakeCurrent hDC, hGLRC
'允许深度比较
glEnable GL_DEPTH_TEST
'顶点逆时针方向定义的多边形为前面
glFrontFace GL_CCW
'设置绘图背景色
glClearColor 0, 0, 0, 1
'打开光照，放置一个光源，定义光照模型
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glLightModelf GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE
'设置光源位置
Dim LightPos(3) As GLfloat
LightPos(0) = 0#: LightPos(1) = 0#: LightPos(2) = -1: LightPos(3) = 1
glLightfv GL_LIGHT0, GL_POSITION, LightPos(0)
'设置环境光
Dim Light_Ambient(3) As GLfloat
Light_Ambient(0) = 0.7: Light_Ambient(1) = 0.7
Light_Ambient(2) = 0.7: Light_Ambient(3) = 1
glLightfv GL_LIGHT0, GL_AMBIENT, Light_Ambient(0)
'设置漫射光
Dim Light_Diffuse(3) As GLfloat
Light_Diffuse(0) = 0.6: Light_Diffuse(1) = 0.6
Light_Diffuse(2) = 0.6: Light_Diffuse(3) = 1
glLightfv GL_LIGHT0, GL_DIFFUSE, Light_Diffuse(0)
'设置镜面光
Dim Light_Specular(3) As GLfloat
Light_Specular(0) = 1: Light_Specular(1) = 1
Light_Specular(2) = 1: Light_Specular(3) = 1
glLightfv GL_LIGHT0, GL_SPECULAR, Light_Specular(0)
'设置材质属性
'设置模型镜面光反射率属性
Dim SpecRef(3) As GLfloat
SpecRef(0) = 0.1: SpecRef(1) = 0.1
SpecRef(2) = 0.1: SpecRef(3) = 1
glMaterialfv GL_FRONT_AND_BACK, GL_SPECULAR, SpecRef(0)
'设置材质镜面指数，它确定镜面光斑的大小和聚焦程度。取值1-128，该值越大，表面光泽越明显
glMateriali GL_FRONT_AND_BACK, GL_SHININESS, 128
'使用颜色跟踪法，设置模型前后面环境反射率和漫射反射率属性
glEnable GL_COLOR_MATERIAL
glColorMaterial GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE
glViewport 0, 0, w, h '定义视见区
glMatrixMode GL_PROJECTION '定义矩阵为投影矩阵
glLoadIdentity '用于在进行矩阵处理之前"复位"坐标系
'告诉OpenGL将来的所有变换都会影响模型
glMatrixMode GL_MODELVIEW '定义矩阵为模型变换矩阵
glLoadIdentity
End Sub
'do gl initialization here
Public Function Reshape(width&, height&) As Long
def = True
End Function
Private Sub InitColorTable()
'初始化颜色表
For i = 0 To 255
With ColorTable(i)
.R = 255 - i: .G = i: .b = 0
End With
Next i
For i = 256 To 510
With ColorTable(i)
.R = 0: .G = 255 - (i - 255): .b = i - 255
End With
Next i
Private Sub form_click()
Open "d:\tem\modelasc.txt" For Input As #1
End Sub
Public Sub command1_click()
Dim Keywords As String
Dim sData As String
n = 0
Do While Not EOF(1)
Line Input #1, sData
If sData = " endloop" Then
n = n + 1
End If
Loop
Close #1
a = n * 3
End Sub
Private Sub Form_Load()
Dim s() As String
Dim Top As Vertex
Dim C As New Collection '将所有的顶点使用集合收集
Dim d() As String
s = Split(sData, vbCrLf) '把每行数据装入到s数组中，每个单元对应于一行
For i = 0 To UBound(s)
If InStr(1, s(i), "vertex") > 0 Then '如果行包含关键字vertex
d = Split(s(i), " ")
Set Top = New Vertex
If IsNumeric(d(1)) Then Top.X() = Val(d(1)) '把读到的数值赋给Top.X(),Top.Y(),Top.Z()
If IsNumeric(d(2)) Then Top.Y() = Val(d(2))
If IsNumeric(d(3)) Then Top.Z() = Val(d(3))
C.Add Top
End If
Next
End Sub
Public Sub draw()
glClearColor 0#, 0#, 1#, 0# '清空颜色缓存的RGBA颜色值
glClear clrColorBufferBit '为绘下帧曲面清除缓冲区
glColor3f 0.8, 0.3, 0.5 '设置显示的字体颜色
glPushMatrix '依据当前模式（模式-视图矩阵）使矩阵入栈
glBegin GL_Trrangles '开始绘图，绘制三角形面片
For j = 1 To a Step 3
glVertex3f Top.X(j), Top.Y(j), Top.Z(j) '3个顶点
glVertex3f Top.X(j + 1), Top.Y(j + 1), Top.Z(j + 1)
glVertex3f Top.X(j + 2), Top.Y(j + 2), Top.Z(j + 2)
glEnd
glPopMatrix
'draw things here
End Sub
Dim pfd As PIXELFORMATDESCRIPTOR '描述像素格式
pfd.nSize = Len(pfd) '结构大小
pfd.nVersion = 1 '版本号
pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_DRAW_TO_WINDOW Or PFD_DOUBLEBUFFER Or PFD_TYPE_RGBA 'RGBA颜色模式
pfd.iPixelType = PFD_TYPE_RGBA '像素格式类型
pfd.cColorBits = 16 '所需的颜色索引位数
pfd.cDepthBits = 16 '所需的深度缓冲区位数
pfd.iLayerType = PFD_MAIN_PLANE '主层类型
' 为设备描述表得到最匹配的像素格式，确定pfd结构是否存在
PixelFormat = ChoosePixelFormat(hDC, pfd)
If PixelFormat = 0 Then
MsgBox "设备描述表支持的像素格式" & vbCrLf & vbCrLf & _
"与给定像素格式不匹配！", vbCritical, "错误"
End
End If
'设置设备描述表的像素格式，把指定的像素格式赋给指定的设备
spf = SetPixelFormat(hDC, PixelFormat, pfd)
If spf = False Then
MsgBox "设置设备描述表像素格式失败！", vbInformation, "失败"
End
End If
'do pre-gl initialization here
End Sub
Public Sub InitGL()
hGLRC = wglCreateContext(hDC)
wglMakeCurrent hDC, hGLRC
'允许深度比较
glEnable GL_DEPTH_TEST
'顶点逆时针方向定义的多边形为前面
glFrontFace GL_CCW
'设置绘图背景色
glClearColor 0, 0, 0, 1
'打开光照，放置一个光源，定义光照模型
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glLightModelf GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE
'设置光源位置
Dim LightPos(3) As GLfloat
LightPos(0) = 0#: LightPos(1) = 0#: LightPos(2) = -1: LightPos(3) = 1
glLightfv GL_LIGHT0, GL_POSITION, LightPos(0)
'设置环境光
Dim Light_Ambient(3) As GLfloat
Light_Ambient(0) = 0.7: Light_Ambient(1) = 0.7
Light_Ambient(2) = 0.7: Light_Ambient(3) = 1
glLightfv GL_LIGHT0, GL_AMBIENT, Light_Ambient(0)
'设置漫射光
Dim Light_Diffuse(3) As GLfloat
Light_Diffuse(0) = 0.6: Light_Diffuse(1) = 0.6
Light_Diffuse(2) = 0.6: Light_Diffuse(3) = 1
glLightfv GL_LIGHT0, GL_DIFFUSE, Light_Diffuse(0)
'设置镜面光
Dim Light_Specular(3) As GLfloat
Light_Specular(0) = 1: Light_Specular(1) = 1
Light_Specular(2) = 1: Light_Specular(3) = 1
glLightfv GL_LIGHT0, GL_SPECULAR, Light_Specular(0)
'设置材质属性
'设置模型镜面光反射率属性
Dim SpecRef(3) As GLfloat
SpecRef(0) = 0.1: SpecRef(1) = 0.1
SpecRef(2) = 0.1: SpecRef(3) = 1
glMaterialfv GL_FRONT_AND_BACK, GL_SPECULAR, SpecRef(0)
'设置材质镜面指数，它确定镜面光斑的大小和聚焦程度。取值1-128，该值越大，表面光泽越明显
glMateriali GL_FRONT_AND_BACK, GL_SHININESS, 128
'使用颜色跟踪法，设置模型前后面环境反射率和漫射反射率属性
glEnable GL_COLOR_MATERIAL
glColorMaterial GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE
glViewport 0, 0, w, h '定义视见区
glMatrixMode GL_PROJECTION '定义矩阵为投影矩阵
glLoadIdentity '用于在进行矩阵处理之前"复位"坐标系
'告诉OpenGL将来的所有变换都会影响模型
glMatrixMode GL_MODELVIEW '定义矩阵为模型变换矩阵
glLoadIdentity
End Sub
'do gl initialization here
Public Function Reshape(width&, height&) As Long
def = True
End Function
Private Sub InitColorTable()
'初始化颜色表
For i = 0 To 255
With ColorTable(i)
.R = 255 - i: .G = i: .b = 0
End With
Next i
For i = 256 To 510
With ColorTable(i)
.R = 0: .G = 255 - (i - 255): .b = i - 255
End With
Next i
Private Sub form_click()
Open "d:\tem\modelasc.txt" For Input As #1
End Sub
Public Sub command1_click()
Dim Keywords As String
Dim sData As String
n = 0
Do While Not EOF(1)
Line Input #1, sData
If sData = " endloop" Then
n = n + 1
End If
Loop
Close #1
a = n * 3
End Sub
Private Sub Form_Load()
Dim s() As String
Dim Top As Vertex
Dim C As New Collection '将所有的顶点使用集合收集
Dim d() As String
s = Split(sData, vbCrLf) '把每行数据装入到s数组中，每个单元对应于一行
For i = 0 To UBound(s)
If InStr(1, s(i), "vertex") > 0 Then '如果行包含关键字vertex
d = Split(s(i), " ")
Set Top = New Vertex
If IsNumeric(d(1)) Then Top.X() = Val(d(1)) '把读到的数值赋给Top.X(),Top.Y(),Top.Z()
If IsNumeric(d(2)) Then Top.Y() = Val(d(2))
If IsNumeric(d(3)) Then Top.Z() = Val(d(3))
C.Add Top
End If
Next
End Sub
Public Sub draw()
glClearColor 0#, 0#, 1#, 0# '清空颜色缓存的RGBA颜色值
glClear clrColorBufferBit '为绘下帧曲面清除缓冲区
glColor3f 0.8, 0.3, 0.5 '设置显示的字体颜色
glPushMatrix '依据当前模式（模式-视图矩阵）使矩阵入栈
glBegin GL_Trrangles '开始绘图，绘制三角形面片
For j = 1 To a Step 3
glVertex3f Top.X(j), Top.Y(j), Top.Z(j) '3个顶点
glVertex3f Top.X(j + 1), Top.Y(j + 1), Top.Z(j + 1)
glVertex3f Top.X(j + 2), Top.Y(j + 2), Top.Z(j + 2)
glEnd
glPopMatrix
'draw things here
End Sub
#7
额，好像triangles那行代码我敲错了
#8
童鞋们和谐啊，新手就该多照顾照顾啊~~~~~
#9
咳,这把神剑弄的够郁闷了.
新手看别人回复,思路方法都给了,还说不够不够,不喷,那干什么?
新手看别人回复,思路方法都给了,还说不够不够,不喷,那干什么?
#10
按照你给的方法我自己编了下：
Private Sub Form_Load()
Dim s() As String
Dim Top As Vertex
Dim C As New Collection '将所有的顶点使用集合收集
Dim d() As String
s = Split(sData, vbCrLf) '把每行数据装入到s数组中，每个单元对应于一行
For i = 0 To UBound(s)
If InStr(1, s(i), "vertex") > 0 Then '如果行包含关键字vertex
d = Split(s(i), " ")
Set Top = New Vertex
If IsNumeric(d(1)) Then Top.X()= Val(d(1)) '把读到的数值赋给Top.X,Top.Y,Top.Z
If IsNumeric(d(2)) Then Top.Y()= Val(d(2))
If IsNumeric(d(3)) Then Top.Z() = Val(d(3))
C.Add Top
End If
Next
End Sub
之前我已经在类模块中定义了
Private X() As Single
Private Y() As Single
Private Z() As Single
（定义成public提示我有问题）
现在 的出现的问题是
If IsNumeric(d(1)) Then Top.X()= Val(d(1)) '把读到的数值赋给Top.X,Top.Y,Top.Z
If IsNumeric(d(2)) Then Top.Y()= Val(d(2))
If IsNumeric(d(3)) Then Top.Z() = Val(d(3))
提示我未找到方法或者数据成员，不知道为什么
我调试了一下，发现Ubound（s(i))返回的是-1，不知道为什么啊
#11
我给你的代码是完整的代码，你完整使用就可以了。你将成员定义的public数组是不可以的，不能将数组作为公共的成员，定义为Private是不能访问的，我给你的代码的xyz后面没有括号！
#1
s="vertex 8.013850e+002 4.158300e+002 3.140000e+002"
dim B() as string
b=split(s," ")
for i=0 to ubound(b)
if isnumeric(b(i)) then
msgbox "B(" & cstr(i) & ")是一个数值"
end if
next
dim B() as string
b=split(s," ")
for i=0 to ubound(b)
if isnumeric(b(i)) then
msgbox "B(" & cstr(i) & ")是一个数值"
end if
next
#2
我的意思是：当程序读到“vertex 7.460438e+002 1.019743e+002 3.140000e+002”时，能够运行你发给我的那个命令，那个命令我自己已经编完了，现在的问题就是，用什么样的语句判别关键词"vertex”， 求指导啊，最好详细一些，菜鸟级别求详解。不用输出msgbox，只需要把数值点保存到相应的数组中去就可以了
#3
本帖最后由 bcrun 于 2012-03-30 21:28:28 编辑
定义一个类模块vertex，它只包含三个数据成员,使用类保存顶点，可以动态的创建对象
public x as single
public y as single
public z as sing
窗口模块中：
假设你已经将solid data读入到一个字符串sData中
dim s() as string
dim x as vertex
dim C as new collection '将所有的顶点使用集合收集
dim d() as string
s=split(sData,vbcrlf) '把每行数据装入到s数组中，每个单元对应于一行
for i=0 to ubound(s)
if instr(1,s(i),"vertex")>0 then '如果行包含关键字vertex
d=split(s(i)," ")
set x=new vertex
if isnumeric(d(1)) then x.x=val(d(1))
if isnumeric(d(2)) then x.y=val(d(2))
if isnumeric(d(3)) then x.z=val(d(3))
c.add x
end if
next
#4
擦……你是要方法还是要人家直接给你代码啊，去威客去简单直接
#5
肯定是要方法啊，那句话的意识是他理解错我的意思了，我只是把我的想法告诉他，这没问题吧，PS：为了减少像你一样的不必要的乱喷，附上我的程序主要代码。
#6
Public Sub Init()
Dim pfd As PIXELFORMATDESCRIPTOR '描述像素格式
pfd.nSize = Len(pfd) '结构大小
pfd.nVersion = 1 '版本号
pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_DRAW_TO_WINDOW Or PFD_DOUBLEBUFFER Or PFD_TYPE_RGBA 'RGBA颜色模式
pfd.iPixelType = PFD_TYPE_RGBA '像素格式类型
pfd.cColorBits = 16 '所需的颜色索引位数
pfd.cDepthBits = 16 '所需的深度缓冲区位数
pfd.iLayerType = PFD_MAIN_PLANE '主层类型
' 为设备描述表得到最匹配的像素格式，确定pfd结构是否存在
PixelFormat = ChoosePixelFormat(hDC, pfd)
If PixelFormat = 0 Then
MsgBox "设备描述表支持的像素格式" & vbCrLf & vbCrLf & _
"与给定像素格式不匹配！", vbCritical, "错误"
End
End If
'设置设备描述表的像素格式，把指定的像素格式赋给指定的设备
spf = SetPixelFormat(hDC, PixelFormat, pfd)
If spf = False Then
MsgBox "设置设备描述表像素格式失败！", vbInformation, "失败"
End
End If
'do pre-gl initialization here
End Sub
Public Sub InitGL()
hGLRC = wglCreateContext(hDC)
wglMakeCurrent hDC, hGLRC
'允许深度比较
glEnable GL_DEPTH_TEST
'顶点逆时针方向定义的多边形为前面
glFrontFace GL_CCW
'设置绘图背景色
glClearColor 0, 0, 0, 1
'打开光照，放置一个光源，定义光照模型
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glLightModelf GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE
'设置光源位置
Dim LightPos(3) As GLfloat
LightPos(0) = 0#: LightPos(1) = 0#: LightPos(2) = -1: LightPos(3) = 1
glLightfv GL_LIGHT0, GL_POSITION, LightPos(0)
'设置环境光
Dim Light_Ambient(3) As GLfloat
Light_Ambient(0) = 0.7: Light_Ambient(1) = 0.7
Light_Ambient(2) = 0.7: Light_Ambient(3) = 1
glLightfv GL_LIGHT0, GL_AMBIENT, Light_Ambient(0)
'设置漫射光
Dim Light_Diffuse(3) As GLfloat
Light_Diffuse(0) = 0.6: Light_Diffuse(1) = 0.6
Light_Diffuse(2) = 0.6: Light_Diffuse(3) = 1
glLightfv GL_LIGHT0, GL_DIFFUSE, Light_Diffuse(0)
'设置镜面光
Dim Light_Specular(3) As GLfloat
Light_Specular(0) = 1: Light_Specular(1) = 1
Light_Specular(2) = 1: Light_Specular(3) = 1
glLightfv GL_LIGHT0, GL_SPECULAR, Light_Specular(0)
'设置材质属性
'设置模型镜面光反射率属性
Dim SpecRef(3) As GLfloat
SpecRef(0) = 0.1: SpecRef(1) = 0.1
SpecRef(2) = 0.1: SpecRef(3) = 1
glMaterialfv GL_FRONT_AND_BACK, GL_SPECULAR, SpecRef(0)
'设置材质镜面指数，它确定镜面光斑的大小和聚焦程度。取值1-128，该值越大，表面光泽越明显
glMateriali GL_FRONT_AND_BACK, GL_SHININESS, 128
'使用颜色跟踪法，设置模型前后面环境反射率和漫射反射率属性
glEnable GL_COLOR_MATERIAL
glColorMaterial GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE
glViewport 0, 0, w, h '定义视见区
glMatrixMode GL_PROJECTION '定义矩阵为投影矩阵
glLoadIdentity '用于在进行矩阵处理之前"复位"坐标系
'告诉OpenGL将来的所有变换都会影响模型
glMatrixMode GL_MODELVIEW '定义矩阵为模型变换矩阵
glLoadIdentity
End Sub
'do gl initialization here
Public Function Reshape(width&, height&) As Long
def = True
End Function
Private Sub InitColorTable()
'初始化颜色表
For i = 0 To 255
With ColorTable(i)
.R = 255 - i: .G = i: .b = 0
End With
Next i
For i = 256 To 510
With ColorTable(i)
.R = 0: .G = 255 - (i - 255): .b = i - 255
End With
Next i
Private Sub form_click()
Open "d:\tem\modelasc.txt" For Input As #1
End Sub
Public Sub command1_click()
Dim Keywords As String
Dim sData As String
n = 0
Do While Not EOF(1)
Line Input #1, sData
If sData = " endloop" Then
n = n + 1
End If
Loop
Close #1
a = n * 3
End Sub
Private Sub Form_Load()
Dim s() As String
Dim Top As Vertex
Dim C As New Collection '将所有的顶点使用集合收集
Dim d() As String
s = Split(sData, vbCrLf) '把每行数据装入到s数组中，每个单元对应于一行
For i = 0 To UBound(s)
If InStr(1, s(i), "vertex") > 0 Then '如果行包含关键字vertex
d = Split(s(i), " ")
Set Top = New Vertex
If IsNumeric(d(1)) Then Top.X() = Val(d(1)) '把读到的数值赋给Top.X(),Top.Y(),Top.Z()
If IsNumeric(d(2)) Then Top.Y() = Val(d(2))
If IsNumeric(d(3)) Then Top.Z() = Val(d(3))
C.Add Top
End If
Next
End Sub
Public Sub draw()
glClearColor 0#, 0#, 1#, 0# '清空颜色缓存的RGBA颜色值
glClear clrColorBufferBit '为绘下帧曲面清除缓冲区
glColor3f 0.8, 0.3, 0.5 '设置显示的字体颜色
glPushMatrix '依据当前模式（模式-视图矩阵）使矩阵入栈
glBegin GL_Trrangles '开始绘图，绘制三角形面片
For j = 1 To a Step 3
glVertex3f Top.X(j), Top.Y(j), Top.Z(j) '3个顶点
glVertex3f Top.X(j + 1), Top.Y(j + 1), Top.Z(j + 1)
glVertex3f Top.X(j + 2), Top.Y(j + 2), Top.Z(j + 2)
glEnd
glPopMatrix
'draw things here
End Sub
Dim pfd As PIXELFORMATDESCRIPTOR '描述像素格式
pfd.nSize = Len(pfd) '结构大小
pfd.nVersion = 1 '版本号
pfd.dwFlags = PFD_SUPPORT_OPENGL Or PFD_DRAW_TO_WINDOW Or PFD_DOUBLEBUFFER Or PFD_TYPE_RGBA 'RGBA颜色模式
pfd.iPixelType = PFD_TYPE_RGBA '像素格式类型
pfd.cColorBits = 16 '所需的颜色索引位数
pfd.cDepthBits = 16 '所需的深度缓冲区位数
pfd.iLayerType = PFD_MAIN_PLANE '主层类型
' 为设备描述表得到最匹配的像素格式，确定pfd结构是否存在
PixelFormat = ChoosePixelFormat(hDC, pfd)
If PixelFormat = 0 Then
MsgBox "设备描述表支持的像素格式" & vbCrLf & vbCrLf & _
"与给定像素格式不匹配！", vbCritical, "错误"
End
End If
'设置设备描述表的像素格式，把指定的像素格式赋给指定的设备
spf = SetPixelFormat(hDC, PixelFormat, pfd)
If spf = False Then
MsgBox "设置设备描述表像素格式失败！", vbInformation, "失败"
End
End If
'do pre-gl initialization here
End Sub
Public Sub InitGL()
hGLRC = wglCreateContext(hDC)
wglMakeCurrent hDC, hGLRC
'允许深度比较
glEnable GL_DEPTH_TEST
'顶点逆时针方向定义的多边形为前面
glFrontFace GL_CCW
'设置绘图背景色
glClearColor 0, 0, 0, 1
'打开光照，放置一个光源，定义光照模型
glEnable GL_LIGHTING
glEnable GL_LIGHT0
glLightModelf GL_LIGHT_MODEL_TWO_SIDE, GL_TRUE
'设置光源位置
Dim LightPos(3) As GLfloat
LightPos(0) = 0#: LightPos(1) = 0#: LightPos(2) = -1: LightPos(3) = 1
glLightfv GL_LIGHT0, GL_POSITION, LightPos(0)
'设置环境光
Dim Light_Ambient(3) As GLfloat
Light_Ambient(0) = 0.7: Light_Ambient(1) = 0.7
Light_Ambient(2) = 0.7: Light_Ambient(3) = 1
glLightfv GL_LIGHT0, GL_AMBIENT, Light_Ambient(0)
'设置漫射光
Dim Light_Diffuse(3) As GLfloat
Light_Diffuse(0) = 0.6: Light_Diffuse(1) = 0.6
Light_Diffuse(2) = 0.6: Light_Diffuse(3) = 1
glLightfv GL_LIGHT0, GL_DIFFUSE, Light_Diffuse(0)
'设置镜面光
Dim Light_Specular(3) As GLfloat
Light_Specular(0) = 1: Light_Specular(1) = 1
Light_Specular(2) = 1: Light_Specular(3) = 1
glLightfv GL_LIGHT0, GL_SPECULAR, Light_Specular(0)
'设置材质属性
'设置模型镜面光反射率属性
Dim SpecRef(3) As GLfloat
SpecRef(0) = 0.1: SpecRef(1) = 0.1
SpecRef(2) = 0.1: SpecRef(3) = 1
glMaterialfv GL_FRONT_AND_BACK, GL_SPECULAR, SpecRef(0)
'设置材质镜面指数，它确定镜面光斑的大小和聚焦程度。取值1-128，该值越大，表面光泽越明显
glMateriali GL_FRONT_AND_BACK, GL_SHININESS, 128
'使用颜色跟踪法，设置模型前后面环境反射率和漫射反射率属性
glEnable GL_COLOR_MATERIAL
glColorMaterial GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE
glViewport 0, 0, w, h '定义视见区
glMatrixMode GL_PROJECTION '定义矩阵为投影矩阵
glLoadIdentity '用于在进行矩阵处理之前"复位"坐标系
'告诉OpenGL将来的所有变换都会影响模型
glMatrixMode GL_MODELVIEW '定义矩阵为模型变换矩阵
glLoadIdentity
End Sub
'do gl initialization here
Public Function Reshape(width&, height&) As Long
def = True
End Function
Private Sub InitColorTable()
'初始化颜色表
For i = 0 To 255
With ColorTable(i)
.R = 255 - i: .G = i: .b = 0
End With
Next i
For i = 256 To 510
With ColorTable(i)
.R = 0: .G = 255 - (i - 255): .b = i - 255
End With
Next i
Private Sub form_click()
Open "d:\tem\modelasc.txt" For Input As #1
End Sub
Public Sub command1_click()
Dim Keywords As String
Dim sData As String
n = 0
Do While Not EOF(1)
Line Input #1, sData
If sData = " endloop" Then
n = n + 1
End If
Loop
Close #1
a = n * 3
End Sub
Private Sub Form_Load()
Dim s() As String
Dim Top As Vertex
Dim C As New Collection '将所有的顶点使用集合收集
Dim d() As String
s = Split(sData, vbCrLf) '把每行数据装入到s数组中，每个单元对应于一行
For i = 0 To UBound(s)
If InStr(1, s(i), "vertex") > 0 Then '如果行包含关键字vertex
d = Split(s(i), " ")
Set Top = New Vertex
If IsNumeric(d(1)) Then Top.X() = Val(d(1)) '把读到的数值赋给Top.X(),Top.Y(),Top.Z()
If IsNumeric(d(2)) Then Top.Y() = Val(d(2))
If IsNumeric(d(3)) Then Top.Z() = Val(d(3))
C.Add Top
End If
Next
End Sub
Public Sub draw()
glClearColor 0#, 0#, 1#, 0# '清空颜色缓存的RGBA颜色值
glClear clrColorBufferBit '为绘下帧曲面清除缓冲区
glColor3f 0.8, 0.3, 0.5 '设置显示的字体颜色
glPushMatrix '依据当前模式（模式-视图矩阵）使矩阵入栈
glBegin GL_Trrangles '开始绘图，绘制三角形面片
For j = 1 To a Step 3
glVertex3f Top.X(j), Top.Y(j), Top.Z(j) '3个顶点
glVertex3f Top.X(j + 1), Top.Y(j + 1), Top.Z(j + 1)
glVertex3f Top.X(j + 2), Top.Y(j + 2), Top.Z(j + 2)
glEnd
glPopMatrix
'draw things here
End Sub
#7
额，好像triangles那行代码我敲错了
#8
童鞋们和谐啊，新手就该多照顾照顾啊~~~~~
#9
咳,这把神剑弄的够郁闷了.
新手看别人回复,思路方法都给了,还说不够不够,不喷,那干什么?
新手看别人回复,思路方法都给了,还说不够不够,不喷,那干什么?
#10
按照你给的方法我自己编了下：
Private Sub Form_Load()
Dim s() As String
Dim Top As Vertex
Dim C As New Collection '将所有的顶点使用集合收集
Dim d() As String
s = Split(sData, vbCrLf) '把每行数据装入到s数组中，每个单元对应于一行
For i = 0 To UBound(s)
If InStr(1, s(i), "vertex") > 0 Then '如果行包含关键字vertex
d = Split(s(i), " ")
Set Top = New Vertex
If IsNumeric(d(1)) Then Top.X()= Val(d(1)) '把读到的数值赋给Top.X,Top.Y,Top.Z
If IsNumeric(d(2)) Then Top.Y()= Val(d(2))
If IsNumeric(d(3)) Then Top.Z() = Val(d(3))
C.Add Top
End If
Next
End Sub
之前我已经在类模块中定义了
Private X() As Single
Private Y() As Single
Private Z() As Single
（定义成public提示我有问题）
现在 的出现的问题是
If IsNumeric(d(1)) Then Top.X()= Val(d(1)) '把读到的数值赋给Top.X,Top.Y,Top.Z
If IsNumeric(d(2)) Then Top.Y()= Val(d(2))
If IsNumeric(d(3)) Then Top.Z() = Val(d(3))
提示我未找到方法或者数据成员，不知道为什么
我调试了一下，发现Ubound（s(i))返回的是-1，不知道为什么啊
#11
我给你的代码是完整的代码，你完整使用就可以了。你将成员定义的public数组是不可以的，不能将数组作为公共的成员，定义为Private是不能访问的，我给你的代码的xyz后面没有括号！