3d import : *.ase
Soyez le premier à donner votre avis sur cette source.
Vue 6 149 fois - Téléchargée 542 fois
Description
Voila un p'tit code qui sert a importer le type de format *.ASE, le format ascii complet de 3D Studio Max, le rendu se fait en opengl est n'est pas optimisé a fond, mais permet au neophyte (sous la condition de la curiosité) d'apprendre quelques petites bases OpenGL. Le code d'importation est tres petit comme vous pourrais le voir. Le format ASE est tres complet, il integre de nombreux parametres interressant tels que les coords de textures, l'animation des mesh, les materiaux... Utilisation : Pour faire tourner plus ou moins vite l'objet : fleche gauche ou droite, pour s'approcher ou s'éloigner du centre: fleche haut et bas, zoom paramétrable, 3D plein, 3D Fil de fer, activer/desactier la grille et la rotation automatique. Pour apprécier le rendu, j'ai intégré une petite lumiére symbolisée par la boule, vous pouvez paramétrer dans le code DrawGL cette lumiére. 10 fichiers ASE sont fournis. Vous pouvez retrouver l'esemble des formats que j'ai importé dans le code "3D Import : Tout : *.ASC, *.ASE, *.OBJ, *.OFF, *.RAW.
Voila le code du module d'importation ASE, je l'optimise en ce moment meme, car il est vrai que j'aurais pu faire plus simple! Tout est dans le zip
Source / Exemple :
Global NmbAseObjet As Integer
Global NmbAseMaterial As Integer
Global F As String
Private Type CoordV
VChar As Variant
X As Integer
Y As Integer
Z As Integer
End Type
Private Type FaceV
FChar As Variant
Mat As Integer
A As Integer
B As Integer
C As Integer
AB As Boolean
BC As Boolean
CA As Boolean
End Type
Private Type ASEObjetV
Ochar As Variant
NmbVertex As Integer
NmbFace As Integer
Vertex() As CoordV
Face() As FaceV
ScaleX As Single
ScaleY As Single
ScaleZ As Single
Nom As String
CenterX As Single
CenterY As Single
CenterZ As Single
R As Single
G As Single
B As Single
End Type
Private Type MaterialV
MChar As Variant
Nom As String
Amb(3) As GLfloat
Dif(3) As GLfloat
Spec(3) As GLfloat
Trans As GLfloat
Shine As GLfloat
End Type
Global ASEObjet() As ASEObjetV
Global ASEMaterial() As MaterialV
Private Sub GetColor(M As Integer, Fin As Variant)
S = "*WIREFRAME_COLOR"
With ASEObjet(M)
I = InStr(.Ochar, F, S, vbBinaryCompare)
L = I + Len(S) + 1
J = InStr(L, F, "}", vbBinaryCompare)
V = Split(Mid(F, L, J - L), vbTab)
.R = Val(V(0)): .G = Val(V(1)): .B = Mid(Val(V(2)), 1, Len(V(2)) - 2)
End With
End Sub
Private Sub GetFace(M As Integer, Fin As Variant)
With ASEObjet(M)
Debut = .Ochar
V = Split(Mid(F, Debut, CVar(Fin - Debut)), "*MESH_FACE ")
For I = 1 To UBound(V)
Suite4:
If I > UBound(V) Then Exit Sub
W = W + 1: ReDim Preserve .Face(W - 1): .NmbFace = (W - 1)
U = Split(V(I), " ")
With .Face(W - 1)
For J = 1 To UBound(U)
If U(J) = "A:" Or U(J) = "B:" Or U(J) = "C:" Or U(J) = "AB:" Or U(J) = "BC:" Or U(J) = "CA:" Then
For K = CInt(J + 1) To UBound(U)
If U(K) <> "" Then Exit For
Next
Select Case U(J)
Case "A:":
.A = U(K)
Case "B:":
.B = U(K)
Case "C:":
.C = U(K)
Case "AB:":
.AB = U(K)
Case "BC:":
.BC = U(K)
Case "CA:":
.CA = U(K)
GoTo Suite3
End Select
J = K
End If
Next
Suite3:
U = Split(V(I), "*MESH_MTLID ")
.Mat = Val(Mid(U(1), 1, Len(U(1)) - 5)) + 2
End With
Next
End With
End Sub
Private Sub GetMat()
StrCmp = "*MATERIAL_AMBIENT"
For I = 1 To NmbAseMaterial
With ASEMaterial(I)
If NmbAseMaterial <= 1 Or I = NmbAseMaterial Then
Fin = Len(F)
Else
Fin = ASEMaterial(I + 1).MChar
End If
S = Mid(F, .MChar, Fin)
Boucle:
U = Split(S, StrCmp)
V = Split(U(1), vbTab)
For J = 0 To 2
Select Case StrCmp
Case "*MATERIAL_AMBIENT":
.Amb(J) = Val(V(J))
If J = 2 Then StrCmp = "*MATERIAL_DIFFUSE": GoTo Boucle
Case "*MATERIAL_DIFFUSE":
.Dif(J) = Val(V(J))
If J = 2 Then StrCmp = "*MATERIAL_SPECULAR": GoTo Boucle
Case "*MATERIAL_SPECULAR":
.Spec(J) = Val(V(J))
If J = 2 Then StrCmp = "*MATERIAL_AMBIENT"
End Select
Next
U = Split(S, "*MATERIAL_SHINE")
V = Split(U(1), " ")
.Shine = Val(V(1))
U = Split(S, "*MATERIAL_TRANSPARENCY")
V = Split(U(1), " ")
.Trans = Val(V(1))
.Amb(3) = 1
.Dif(3) = 1
.Spec(3) = 1
End With
Next
End Sub
Private Sub GetStr(StrCmp As String, Debut As Variant, Fin As Variant, Element As Variant, Nmb As Integer)
L = Len(StrCmp)
I = InStr(Debut, F, StrCmp, vbTextCompare)
J = InStr(I + L, F, "*", vbTextCompare)
S = Mid(F, I + L, J - I - L)
U = CVar(Split(S, vbTab))
T = 4
With ASEObjet(Nmb)
Select Case Element
Case 0:
.ScaleX = (1 / Val(U(0))) * T
.ScaleY = (1 / Val(U(1))) * T
.ScaleZ = (1 / Val(Left(U(2), Len(U(2)) - 2))) * T
Case 1:
.Nom = CVar(Mid(U(0), 3, Len(U(0)) - 5))
Case 2:
.CenterX = Val(U(0)) * T
.CenterY = Val(U(1)) * T
.CenterZ = Val(Left(U(2), Len(U(2)) - 2)) * T
End Select
End With
End Sub
Private Sub GetVertex(M As Integer, Fin As Variant)
With ASEObjet(M)
Debut = .Ochar
V = Split(Mid(F, Debut, CVar(Fin - Debut)), vbTab & vbTab & vbTab)
For I = 1 To UBound(V)
U = Split(V(I), vbTab)
If Left(U(0), 12) <> "*MESH_VERTEX" Then Exit Sub
ReDim Preserve .Vertex(I - 1)
.Vertex(I - 1).X = Val(U(1)) * .ScaleX
.Vertex(I - 1).Y = Val(U(2)) * .ScaleY
.Vertex(I - 1).Z = -Val(Mid(U(3), 1, Len(U(3)) - 2)) * .ScaleZ ' Afin d'eviter le vbtab & vbtab final! Negation a cause du format qui l'impose
Next
End With
End Sub
Sub LoadASE(Fichier As String)
'Loading "CHARGEMENT DE " & Fichier
Open Fichier For Input As 1
F = CStr(Input$(LOF(1), #1))
Close
'Loading "OBJET GEOMETRIQUE"
NmbAseObjet = 0: NmbAseMaterial = 0
StrSrch "*GEOMOBJECT", 1, Len(F), 0
'Loading "MATERIAUX"
StrSrch "MATERIAL ", 1, Len(F), 1
GetMat
For I = 1 To NmbAseObjet
With ASEObjet(I)
If NmbAseObjet <= 1 Or I = NmbAseObjet Then
Fin = Len(F)
Else
Fin = ASEObjet(I + 1).Ochar
End If
' Loading "OBJET " & I & " : NOM"
GetStr "*NODE_NAME", .Ochar, Fin, 1, CInt(I)
' Loading "OBJET " & I & " : ECHELLES"
GetStr "*TM_SCALE", .Ochar, Fin, 0, CInt(I)
' Loading "OBJET " & I & " : POSITION"
GetStr "*TM_POS", .Ochar, Fin, 2, CInt(I)
' Loading "OBJET " & I & " : EMPLACEMENT DES VERTICES"
StrSrch "*MESH_NUMVERTEX", .Ochar, Fin, 2, CInt(I)
' Loading "OBJET " & I & " : EMPLACEMENT DES FACES"
StrSrch "*MESH_NUMFACES", .Ochar, Fin, 3, CInt(I)
' Loading "OBJET " & I & " : STOCKAGE DES VERTICES"
GetVertex CInt(I), Fin
' Loading "OBJET " & I & " : STOCKAGE DES FACES"
GetFace CInt(I), Fin
' Loading "OBJET " & I & " : COULEURS"
GetColor CInt(I), Fin
End With
Next
'Loading "FIN", False
'PUTAIN CA MARCHE!!!!!!!!!!!!!!!!!!!!!
End Sub
Private Sub StrSrch(StrCmp As String, Debut As Variant, Fin As Variant, Element As Variant, Optional Nmb As Integer)
S = Mid(F, Debut, Fin - Debut)
U = Split(S, StrCmp)
n = UBound(U)
For I = 1 To n
J = InStr(1, F, U(I), vbBinaryCompare)
Select Case Element
Case 0:
NmbAseObjet = n
ReDim Preserve ASEObjet(NmbAseObjet)
ASEObjet(I).Ochar = J
Case 1:
NmbAseMaterial = n
ReDim Preserve ASEMaterial(NmbAseMaterial)
ASEMaterial(I).MChar = J
Case 2:
ReDim Preserve ASEObjet(Nmb).Vertex(n)
ASEObjet(Nmb).Vertex(I).VChar = J
Case 3:
ReDim Preserve ASEObjet(Nmb).Face(n)
ASEObjet(Nmb).Face(I).FChar = J
End Select
Next
End Sub
Conclusion :
Voila le code du module d'importation ASE, je l'optimise en ce moment meme, car il est vrai que j'aurais pu faire plus simple! Tout est dans le zip
Codes Sources
A voir également
- .ase
- Import ase - Meilleures réponses
- Importase - Meilleures réponses
- Visual Basic / VB.NET : 3d import : tout : *.asc, *.ase, *.obj, *.off, *.raw, bientot *.3ds, *.md2, - Guide
- 3d import : *.asc - Codes sources - Visual Basic / VB.NET (OpenGL)
- Visual Basic / VB.NET : 3d import : *.obj - CodeS SourceS - Guide
- 3d import : *.off - Codes sources - Visual Basic / VB.NET (OpenGL)
- 3d import : *.raw (bientot *.3ds) - Codes sources - Visual Basic / VB.NET (OpenGL)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.