3d import : *.ase

0/5 (2 avis)

Vue 6 055 fois - Téléchargée 489 fois

Télécharger le projet
Commenter

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.

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
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
Play02man1
Messages postés
14
Date d'inscription
dimanche 17 novembre 2002
Statut
Membre
Dernière intervention
29 juin 2004
 -
marche pas chez moi ya que du noir snif !!
Signaler
chillboy007
Messages postés
47
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
19 juin 2004
 -
Super, j'avais commencé le code, mais ca fonctionnait pas trop.. Merci !
S'inscrire maintenant

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.

Du même auteur (cs_Geff)