Here is some code from an engine to load 3DS meshes.
Lol and to think this doesn't even cover texturing and rendering. Your best bet is to probably get a book that tells you how to load 3ds models, or to use an engine. If you use an engine, may I suggest TrueVision 3D for VB, check it out at
Sub Load3DsMesh(Filename As String)
'##BD Load a 3DS file in the mesh. The materials and the texture will be loaded too.
'##PD filename 3Ds filename.
Dim LE As MaterialFactory8
Set LE = New MaterialFactory8
'SetPrimitiveType TV_TRIANGLELIST
'SetVertexType TV_VERTEX
On Error GoTo errs
Dim ErrString As String
ErrString = "3DS: Load3ds"
' AddLog "Load 3ds :" + filename
Dim VbCounter As Long
Dim ColorByte As udColorByte
Dim PercentInt As Integer
Dim cBlock As Byte ' Type of color currently being imported. See colorblock Enum
Dim Materials2() As aMaterial
Dim mCount As Integer ' Number of loaded material
'im MatTexture() As Texture8
Dim Info As tdsHeader ' Header of Chunk
Dim Index As Long ' Index in File -- filepos
Dim MeshName As String ' Current Mesh Name
Dim Done As Boolean
Dim CurrentMat As Integer
Dim NbGroupe As Integer
Dim vcount As Long ' redundant vertex counter
Dim vertices As Integer ' ""
Dim faces As Integer ' Numbder of faces
Dim VertexList() As D3DVECTOR ' #DS file Vertexlist
Dim Facelist() As aFace ' Facelist
Dim vbuf() As Long ' redunant vertexlist for vertex buffer
'Dim MeshVertices() As D3DVERTEX ' Actual constructor for vertex buffer
Dim UVCoords() As UVmap ' #DS file UV coordinates
Dim UVbuf() As UVmap ' Buffer for MeshVertices construction
Dim nBuf() As D3DVECTOR ' Buffer for the temp face Normals
Dim Normals() As D3DVECTOR ' Array to hold temporary face normals
Dim tVector As D3DVECTOR
Dim Char As Byte
Dim Strz As String ' All Generic definitions for reading
Dim Dword As Long ' types stored in #DS file via C typedefs
Dim word As Integer
Dim Real As Single
Dim i As Long
Dim TheScale As Long
Mesh(MeshIndex).Features.PrimType = D3DPT_TRIANGLELIST
TheScale = 1
Dim UVCoordsTrue As Boolean
UVCoordsTrue = False
Dim MinX, MinY, MinZ As Single
Dim MaxX, MaxY, maxZ As Single
Index = 1
TestPAKFile Filename
AddLog "Loading 3DS mesh : " + CStr(Filename) + "..."
Open Filename For Binary As #1
While Not EOF(1)
Get #1, Index, Info
Index = Index + 6
' Debug.Print Hex(Info.Header), Info.Length
Select Case Info.Header
Case &H2: ' 3DS Version Number
ErrString = "3DS Version"
Get #1, Index, Dword
Index = Index + Len(Dword)
Case &H3D3D: ' 3D Editor Header
ErrString = "3D Editor Chunk"
Case &H3D3E: ' Mesh Version
ErrString = "Mesh Version"
Get #1, Index, Dword
Index = Index + Len(Dword)
Case &H4000: ' Object Block -- Includes Name
ErrString = "Object Block"
Done = False
MeshName = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
MeshName = MeshName + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Debug.Print "Name :"; MeshName; ""
Case &H4100: ' Triangular Mesh
ErrString = "Triangular Mesh"
NbGroupe = NbGroupe + 1
SetGroupPointer NbGroupe
Debug.Print NbGroupe
Case &H4110: ' Verticies List
ErrString = "Vertices"
Get #1, Index, vertices
Index = Index + Len(vertices)
Debug.Print "Vertex list "; vertices
ReDim VertexList(vertices)
Get #1, Index, VertexList
Index = Index + Len(VertexList(0)) * CLng(vertices)
MinX = 500000: MinY = MinX: MinZ = MinY
MaxX = -500000: MaxY = MaxX: maxZ = MaxY
For i = 0 To vertices - 1
With VertexList(i)
VertexList(i).x = VertexList(i).x * TheScale
VertexList(i).y = VertexList(i).y * TheScale
VertexList(i).z = VertexList(i).z * TheScale
If .x < MinX Then MinX = .x
If .y < MinY Then MinY = .y
If .z < MinZ Then MinZ = .z
If .x > MaxX Then MaxX = .x
If .y > MaxY Then MaxY = .y
If .z > maxZ Then maxZ = .z
End With
Next i
Case &H4120: ' Face List
ErrString = "Face List"
Get #1, Index, faces
Index = Index + Len(faces)
Debug.Print "Face list "; faces
ReDim Facelist(faces)
Get #1, Index, Facelist
Index = Index + Len(Facelist(0)) * CLng(faces)
vcount = -1
ReDim vbuf(faces * 3)
ReDim UVbuf(faces * 3)
For i = 0 To faces - 1
vcount = vcount + 3
'debug.print vcount
If UVCoordsTrue Then
UVbuf(vcount - 2) = UVCoords(Facelist(i).a)
UVbuf(vcount - 1) = UVCoords(Facelist(i).b)
UVbuf(vcount) = UVCoords(Facelist(i).C)
End If
vbuf(vcount - 2) = Facelist(i).a
vbuf(vcount - 1) = Facelist(i).b
vbuf(vcount) = Facelist(i).C
' Make Face Normal
Dim a As D3DVECTOR, b As D3DVECTOR, C As D3DVECTOR
ReDim Preserve nBuf(vcount)
With DirectX
' Face Normal
D3DXVec3Subtract a, VertexList(vbuf(vcount - 2)), VertexList(vbuf(vcount - 1))
D3DXVec3Subtract b, VertexList(vbuf(vcount - 2)), VertexList(vbuf(vcount))
D3DXVec3Cross C, a, b
D3DXVec3Normalize C, C
nBuf(vcount) = C
nBuf(vcount - 1) = C
nBuf(vcount - 2) = C
End With
Next i
UVCoordsTrue = False
ErrString = "Load3ds: Mesh Add"
Debug.Print "Mesh add " + MeshName
With Mesh(MeshIndex)
For i = 0 To vcount
'AddLog "Addvertex :" + CStr(vbuf(I))
AddVertex VertexList(vbuf(i)).x, VertexList(vbuf(i)).y, VertexList(vbuf(i)).z, D3DColorMake(1, 1, 1, 1), UVbuf(i).U, 1 - UVbuf(i).V, nBuf(i).x, nBuf(i).y, nBuf(i).z
Next i
End With
Case &H4130: ' Face Material List
ErrString = "Face Material"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Dim Q As Integer
For Q = 1 To mCount
If Strz = Materials2(Q).MatName Then
' Store the Material Here
Debug.Print "Selected :"; Strz
Mesh(MeshIndex).Features.Groups(NbGroupe).TextureI = Materials2(Q).MapPercent
Materials(Materials2(Q).MaterialIndex).Mat.Ambient = Materials2(Q).Ambient
Materials(Materials2(Q).MaterialIndex).Mat.Diffuse = DXColor(1, 1, 1, 1)
Materials(Materials2(Q).MaterialIndex).Mat.Specular = Materials2(Q).Specular
Materials(Materials2(Q).MaterialIndex).Mat.emissive = DXColor(0, 0, 0, 0)
'Debug.Print Q, Materials2(Q).Ambient.r, , Materials2(Q).Ambient.g, Materials2(Q).Ambient.B
Mesh(MeshIndex).Features.Groups(NbGroupe).MaterialI = Materials2(Q).MaterialIndex
'SetTexture MatTexture(Q), NbGroupe
Exit For
End If
Next Q
Get #1, Index, word
Index = Index + Len(word)
For i = 1 To word
Get #1, Index, word
Index = Index + Len(word)
Next i
Case &H4140: ' Face Texture Coordinate
Debug.Print "Add texture coordinates"
ErrString = "Face Texture Coordinates"
Get #1, Index, word
Index = Index + Len(word)
ReDim UVCoords(word)
Get #1, Index, UVCoords
Index = Index + Len(UVCoords(0)) * CLng(word)
UVCoordsTrue = True
Case &H4160:
ErrString = "Local Coordinate System"
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
Index = Index + Len(tVector)
Get #1, Index, tVector
'DD.MeshParent(ObjName2).Mesh(MeshName).position
Index = Index + Len(tVector)
Case &HA000: ' Material Name
ErrString = "Material Name"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Materials2(mCount).MatName = Strz
Debug.Print "Material Name :"; Strz
Case &HAFFF: ' Material Editor Chunk
ErrString = "Material Editor Chunk"
mCount = mCount + 1
ReDim Preserve Materials2(mCount) ' Save stored materials
CurrentMat = LE.CreateMaterial
Materials2(mCount).MaterialIndex = CurrentMat
Case &H10: ' Single Color Chunk
ErrString = "Single Color Chunk"
Index = Index + Info.Length - 6
Case &H11: ' Byte Color Chunk
ErrString = "Byte Color Chunk"
Get #1, Index, ColorByte
Index = Index + Len(ColorByte)
Select Case cBlock
Case Ambient:
With Materials2(mCount).Ambient
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Ambient :"; .r; " "; .g; " "; .b
End With
Case Diffuse:
With Materials2(mCount).Diffuse
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Diffuse :"; .r; " "; .g; " "; .b
End With
Case Specular:
With Materials2(mCount).Specular
.a = 1
.r = ColorByte.Red / 255
.g = ColorByte.Green / 255
.b = ColorByte.Blue / 255
Debug.Print " Material Specular :"; .r; " "; .g; " "; .b
End With
End Select
Case &H30: ' Percent Chunk Int format
ErrString = "Percent Chunk INT"
Get #1, Index, PercentInt
Index = Index + Len(PercentInt)
Case &H31: ' Percent Chunk Float format
ErrString = "Percent Chunk Float"
Index = Index + Info.Length - 6
Case &HA010: ' Ambient color
ErrString = "Ambient Color"
cBlock = Ambient
Case &HA020: ' Diffuse Color
ErrString = "Diffuse Color"
cBlock = Diffuse
Case &HA030: ' Specular Color
ErrString = "Specular Color"
cBlock = Specular
Case &HA200: ' Map #1 -- diffuse?
cBlock = Diffuse
Case &HA300: ' Map FileName
ErrString = "Map File Name"
Done = False
Strz = ""
While Not Done
Get #1, Index, Char
If Char <> 0 Then
Strz = Strz + Chr(Char)
Else
Done = True
End If
Index = Index + Len(Char)
Wend
Select Case cBlock
Case Diffuse:
Materials2(mCount).MapName = Strz
End Select
Debug.Print "Material Map Name: " & Strz
'ReDim Preserve MatTexture(mCount)
'For i = 1 To 256
' If TextureName(i) = "" Then Exit For
'Next i
If Exist(Strz) = False Then
Strz = Left$(Filename, InStrRev(Filename, "\"
) + Strz
End If
i = LocTexFactory.LoadTexture(Strz, Strz, , , TV_COLORKEY_BLACK).GetTexIndex
'Set Texture(i) = LoadSimpleTexture(SearchExistPath(Strz, Left$(Filename, InStrRev(Filename, "\"
)), 256, 256)
'TextureName(i) = "3DS Texture " + CStr(i)
Materials2(mCount).MapPercent = i
'Set MatTexture(mCount) = LocalScene.LoadTexture("d:\" + Strz, 256, 256)
Case &HA33A: ' Map #2 -- Ambient?
cBlock = Ambient
Case &HA354
ErrString = "V scaling for Map"
Index = Index + Info.Length - 6
Case &HA356
ErrString = "U scaling for Map"
Index = Index + Info.Length - 6
Case &HA358
ErrString = "U offset for Map"
Index = Index + Info.Length - 6
Case &HA35A
ErrString = "V offset for Map"
Index = Index + Info.Length - 6
Case &HA35C
ErrString = "Rotation Angle for Map"
Index = Index + Info.Length - 6
Case &H100: ' One Unit
ErrString = "One Unit"
Get #1, Index, Real
Index = Index + Len(Real)
Case &H4D4D ' OK the object begins
Case Else ' Unknown Chunk
ErrString = "Unknown Chunk"
Index = Index + Info.Length - 6
End Select
Debug.Print " ## "; Hex$(Info.Header); "("; ErrString; "
"
AddLog " ## " + Hex$(Info.Header) + " (" + CStr(ErrString) + "
"
Wend
Close #1
DeletePAKTemp Filename
AddLog "End of 3DS Loading."
Exit Sub
errs:
Debug.Print "Error :"; ErrString, Err.Number, Err.Description
AddLog "Error in 3Ds loader :" + CStr(Err.Number) + " " + Err.Description + " " + ErrString
Resume Next
End Sub
