Code archives/3D Graphics - Mesh/SaveMesh3DS function

This code has been declared by its author to be Public Domain code.

Download source code

SaveMesh3DS function by markcw
(Posted 20 years ago)
This function supports saving a mesh to 3ds with uv coords, material settings, and an optional texture filename.

I have now updated this to support multiple meshes/hierarchy (thanks to Beaker's NextChild function) and with correct orientation. Mesh positions are also stored, as well as rotations (thanks to sswift's AddMeshToSurface function). It still does not support multiple textures or animation.

I have updated this again to comform to strict face ordering, such as in wings3d. 
;Save Mesh 3DS, on 26/9/06

Graphics3D 640,480,0,2
AppTitle "Save Mesh 3DS"
SetBuffer BackBuffer()

camera=CreateCamera() ;init world
light=CreateLight()
RotateEntity light,45,45,0

tex=MakeTestTexture(128,128) ;new texture

shape=0 ;type of shape to save
Select shape
 Case 0
  mesh1=CreateCube() : child1=CreateCube(mesh1)
  PositionEntity child1,1,-1,1 : RotateEntity child1,30,-30,30
 Case 1
  mesh1=CreateSphere(8) : child1=CreateSphere(8,mesh1)
  PositionEntity child1,1,1,-1
 Case 2
  mesh1=CreateCylinder(8,True) : child1=CreateCylinder(8,True,mesh1)
  PositionEntity child1,1,1,1 : RotateEntity child1,30,30,-30
 Case 3
  mesh1=CreateCone(8,True) : child1=CreateCone(8,True,mesh1)
  PositionEntity child1,1,-1,-1
 Case 4
  mesh1=LoadMesh("yourname.x")
 Case 5
  mesh1=LoadAnimMesh("yourname.x")
End Select
EntityTexture mesh1,tex ;texture
If child1 Then EntityTexture child1,tex

filename$="test.3ds" ;save to 3ds file
;texfile$="test.bmp" ;optional texture filename
ok=SaveMesh3DS(mesh1,filename$,texfile$)

mesh2=LoadMesh(filename$) ;load new 3ds
If Len(texfile$)=0 Then EntityTexture mesh2,tex ;texture

PositionEntity mesh1,-2,0,5 ;position to left
PositionEntity mesh2,2,0,5 ;position to right

While Not KeyHit(1)
 RenderWorld()

 TurnEntity mesh1,0.3,0.2,0.1
 TurnEntity mesh2,0.3,0.2,0.1

 If KeyHit(17) Then wf=Not wf : WireFrame wf ;W key

 Text 0,0,"ok="+ok+" filename$="+filename$

 Flip
Wend

Function SaveMesh3DS(mesh,filename$,texfile$="",diffuse=$CCCCCC)
 ;Saves a given mesh, or mesh hierarchy, as a 3DS file
 ;From "3dsinfo.txt" by Jochen Wilhelmy
 ;mesh=mesh/mesh hierarchy handle, filename$="name.3ds"
 ;texfile$=optional texture file, diffuse=optional diffuse color

 Local file,piv,matname$,mnlen,tflen,ent,surf,si,mi,objname$,onlen
 Local tssize,tmsize,tfsize,tosize,tcsize,tvsize,otsize
 Local eobjsize,ematsize,editsize,i

 file=WriteFile(filename$)
 If Not file Return False ;fail code
 piv=CreatePivot() ;pivot to tform vertices

 ;calculate chunk sizes and file size
 matname$="Material"
 mnlen=Len(matname$)+1
 tflen=Len(texfile$)+1
 ent=mesh
 While ent
  For si=1 To CountSurfaces(ent)
   surf=GetSurface(ent,si)
   mi=mi+1 : If mi<10 Then objname$="mesh0"+mi Else objname$="mesh"+mi
   onlen=Len(objname$)+1
   tssize=6+(CountTriangles(surf)*4) ;sizeof(Tri_Smooth)
   tmsize=8+mnlen+(CountTriangles(surf)*2) ;sizeof(Tri_Material)
   tfsize=8+(CountTriangles(surf)*4*2)+tmsize+tssize ;sizeof(Tri_FaceList)
   tosize=8+(CountVertices(surf)*2) ;sizeof(Tri_VertexOptions)
   tcsize=8+(CountVertices(surf)*2*4) ;sizeof(Tri_MappingCoords)
   tvsize=8+(CountVertices(surf)*3*4) ;sizeof(Tri_VertexList)
   otsize=6+tvsize+tcsize+tosize+54+tfsize ;sizeof(Object_TriMesh)
   eobjsize=eobjsize+(6+onlen+otsize) ;sizeof(All_Edit_Objects)
  Next
  ent=NextChild(ent)
 Wend
 ematsize=6+(6+mnlen)+(15*3)+(14*6)+10 ;sizeof(Edit_Material)
 If tflen>1 Then ematsize=ematsize+(6+(6+tflen)) ;Mat_TextureMap1
 editsize=6+10+ematsize+10+eobjsize ;sizeof(Edit3DS)

 ;Main3DS Chunk
 WriteShort file,$4D4D ;wChunkID, Main3DS
 WriteInt file,6+10+editsize ;dwChunkSize, filesize
 ;Version3DS Chunk
 WriteShort file,$0002 ;wChunkID, Version3DS
 WriteInt file,10 ;dwChunkSize, sizeof(Version3DS)
 WriteInt file,3 ;ChunkData, dwVersion3DS

 ;Edit3DS Chunk, Main3DS Subchunk
 WriteShort file,$3D3D ;wChunkID, Edit3DS
 WriteInt file,editsize ;dwChunkSize, editsize=6+ematsize+eobjsize
 ;Edit_MeshVersion, Edit3DS Subchunk
 WriteShort file,$3D3E ;wChunkID, Edit_MeshVersion
 WriteInt file,10 ;dwChunkSize, sizeof(Edit_MeshVersion)
 WriteInt file,3 ;ChunkData, dwMeshVersion

 ;Edit_Material Chunk, Edit3DS Subchunk
 WriteShort file,$AFFF ;wChunkID, Edit_Material
 WriteInt file,ematsize ;dwChunkSize, ematsize=6+(6+mnlen)+(15*3)
 ;Mat_Name01 Chunk, Edit_Material Subchunk
 WriteShort file,$A000 ;wChunkID, Mat_Name01
 WriteInt file,6+mnlen ;dwChunkSize, sizeof(Mat_Name01)
 WriteStringAscii(file,matname$) ;ChunkData, material name
 WriteByte file,0 ;ChunkData, Ascii-z null byte
 ;Mat_Ambient Chunk, Edit_Material Subchunk
 WriteShort file,$A010 ;wChunkID, Mat_Ambient
 WriteInt file,15 ;dwChunkSize, sizeof(Mat_Ambient)
 WriteShort file,$0011 ;wChunkID, bRGB
 WriteInt file,9 ;dwChunkSize, sizeof(bRGB)
 WriteRGBColor(file,$666666) ;ChunkData, ambient color
 ;Mat_Diffuse Chunk, Edit_Material Subchunk
 WriteShort file,$A020 ;wChunkID, Mat_Diffuse
 WriteInt file,15 ;dwChunkSize, sizeof(Mat_Diffuse)
 WriteShort file,$0011 ;wChunkID, bRGB
 WriteInt file,9 ;dwChunkSize, sizeof(bRGB)
 WriteRGBColor(file,diffuse) ;ChunkData, diffuse color
 ;Mat_Specular Chunk, Edit_Material Subchunk
 WriteShort file,$A030 ;wChunkID, Mat_Specular
 WriteInt file,15 ;dwChunkSize, sizeof(Mat_Specular)
 WriteShort file,$0011 ;wChunkID, bRGB
 WriteInt file,9 ;dwChunkSize, sizeof(bRGB)
 WriteRGBColor(file,$FFFFFF) ;ChunkData, specular color
 ;Mat_Shininess Chunk, Edit_Material Subchunk
 WriteShort file,$A040 ;wChunkID, Mat_Shininess
 WriteInt file,14 ;dwChunkSize, sizeof(Mat_Shininess)
 WriteShort file,$0030 ;wChunkID, wPercent
 WriteInt file,8 ;dwChunkSize, sizeof(wPercent)
 WriteShort file,75 ;ChunkData, Shininess
 ;Mat_ShininessStrength Chunk, Edit_Material Subchunk
 WriteShort file,$A041 ;wChunkID, Mat_ShininessStrength
 WriteInt file,14 ;dwChunkSize, sizeof(Mat_ShininessStrength)
 WriteShort file,$0030 ;wChunkID, wPercent
 WriteInt file,8 ;dwChunkSize, sizeof(wPercent)
 WriteShort file,20 ;ChunkData, ShininessStrength
 ;Mat_Transparency Chunk, Edit_Material Subchunk
 WriteShort file,$A050 ;wChunkID, Mat_Transparency
 WriteInt file,14 ;dwChunkSize, sizeof(Mat_Transparency)
 WriteShort file,$0030 ;wChunkID, wPercent
 WriteInt file,8 ;dwChunkSize, sizeof(wPercent)
 WriteShort file,0 ;ChunkData, Transparency
 ;Mat_TransparencyFalloff Chunk, Edit_Material Subchunk
 WriteShort file,$A052 ;wChunkID, Mat_TransparencyFalloff
 WriteInt file,14 ;dwChunkSize, sizeof(Mat_TransparencyFalloff)
 WriteShort file,$0030 ;wChunkID, wPercent
 WriteInt file,8 ;dwChunkSize, sizeof(wPercent)
 WriteShort file,0 ;ChunkData, TransparencyFalloff
 ;Mat_ReflectionBlur Chunk, Edit_Material Subchunk
 WriteShort file,$A053 ;wChunkID, Mat_ReflectionBlur
 WriteInt file,14 ;dwChunkSize, sizeof(Mat_ReflectionBlur)
 WriteShort file,$0030 ;wChunkID, wPercent
 WriteInt file,8 ;dwChunkSize, sizeof(wPercent)
 WriteShort file,0 ;ChunkData, ReflectionBlur
 ;Mat_SelfIllumination Chunk, Edit_Material Subchunk
 WriteShort file,$A084 ;wChunkID, Mat_SelfIllumination
 WriteInt file,14 ;dwChunkSize, sizeof(Mat_SelfIllumination)
 WriteShort file,$0030 ;wChunkID, wPercent
 WriteInt file,8 ;dwChunkSize, sizeof(wPercent)
 WriteShort file,0 ;ChunkData, SelfIllumination
 ;Edit_WireThickness Chunk, Edit_Material Subchunk
 WriteShort file,$A087 ;wChunkID, Edit_WireThickness
 WriteInt file,10 ;dwChunkSize, sizeof(Edit_WireThickness)
 WriteFloat file,1 ;fWireThickness
 ;Mat_TextureMap1 Chunk, Edit_Material Subchunk
 If tflen>1
  WriteShort file,$A200 ;wChunkID, Mat_TextureMap1
  WriteInt file,6+(6+tflen) ;dwChunkSize, sizeof(Mat_TextureMap1)
  ;Mat_TextureFilename, Mat_TextureMap1 Subchunk
  WriteShort file,$A300 ;wChunkID, Mat_TextureFilename
  WriteInt file,6+tflen ;dwChunkSize, sizeof(Mat_TextureFilename)
  WriteStringAscii(file,texfile$) ;ChunkData, texture filename
  WriteByte file,0 ;ChunkData, Ascii-z null byte
 EndIf

 ;Edit_OneUnit Chunk, Edit3DS Subchunk
 WriteShort file,$0100 ;wChunkID, Edit_OneUnit
 WriteInt file,10 ;dwChunkSize, sizeof(Edit_OneUnit)
 WriteFloat file,1 ;fOneUnit

 ;calculate each mesh object chunk sizes
 ent=mesh : mi=0
 While ent
  For si=1 To CountSurfaces(ent)
   surf=GetSurface(ent,si)
   mi=mi+1 : If mi<10 Then objname$="mesh0"+mi Else objname$="mesh"+mi
   onlen=Len(objname$)+1
   tssize=6+(CountTriangles(surf)*4) ;sizeof(Tri_Smooth)
   tmsize=8+mnlen+(CountTriangles(surf)*2) ;sizeof(Tri_Material)
   tfsize=8+(CountTriangles(surf)*4*2)+tmsize+tssize ;sizeof(Tri_FaceList)
   tosize=8+(CountVertices(surf)*2) ;sizeof(Tri_VertexOptions)
   tcsize=8+(CountVertices(surf)*2*4) ;sizeof(Tri_MappingCoords)
   tvsize=8+(CountVertices(surf)*3*4) ;sizeof(Tri_VertexList)
   otsize=6+tvsize+tcsize+tosize+54+tfsize ;sizeof(Object_TriMesh)
   eobjsize=6+onlen+otsize ;sizeof(Edit_Object)
   ;position/rotate pivot to tform surface vertices
   PositionEntity piv,EntityX(ent,1),EntityY(ent,1),EntityZ(ent,1),1
   RotateEntity piv,EntityPitch(ent,1),EntityYaw(ent,1),EntityRoll(ent,1),1

   ;Edit_Object Chunk, Edit3DS Subchunk
   WriteShort file,$4000 ;wChunkID, Edit_Object
   WriteInt file,eobjsize ;dwChunkSize, eobjsize=6+onlen+otsize
   WriteStringAscii(file,objname$) ;ChunkData, object name
   WriteByte file,0 ;ChunkData, Ascii-z null byte

   ;Object_TriMesh Chunk, Edit_Object Subchunk
   WriteShort file,$4100 ;wChunkID, Object_TriMesh
   WriteInt file,otsize ;dwChunkSize, otsize=6+tvsize+tcsize+54+tfsize
   ;Tri_VertexList Chunk, Object_TriMesh Subchunk
   WriteShort file,$4110 ;wChunkID, Tri_VertexList
   WriteInt file,tvsize ;dwChunkSize, tvsize=8+(nVerts*3*4)
   WriteShort file,CountVertices(surf) ;ChunkData, wVerticesTotal
   For i=0 To CountVertices(surf)-1 ;switch y and z axis
    TFormPoint VertexX(surf,i),VertexY(surf,i),VertexZ(surf,i),piv,0
    WriteFloat file,TFormedX() ;fVertexX
    WriteFloat file,TFormedZ() ;fVertexY
    WriteFloat file,TFormedY() ;fVertexZ
   Next
   ;Tri_MappingCoords Chunk, Object_TriMesh Subchunk
   WriteShort file,$4140 ;wChunkID, Tri_MappingCoords
   WriteInt file,tcsize ;dwChunkSize, tcsize=8+(nVerts*2*4)
   WriteShort file,CountVertices(surf) ;ChunkData, wVerticesTotal
   For i=0 To CountVertices(surf)-1 ;invert v coord
    WriteFloat file,VertexU(surf,i) ;fVertexU
    WriteFloat file,-VertexV(surf,i) ;fVertexV
   Next
   ;Tri_VertexOptions Chunk, Object_TriMesh Subchunk
   WriteShort file,$4111 ;wChunkID, Tri_VertexOptions
   WriteInt file,tosize ;dwChunkSize, tosize=8+(nVerts*2)
   WriteShort file,CountVertices(surf) ;ChunkData, wVerticesTotal
   For i=0 To CountVertices(surf)-1 ;invert v coord
    WriteShort file,$0700 ;AllVertexOptions
   Next
   ;Tri_Local Chunk, Object_TriMesh Subchunk
   WriteShort file,$4160 ;wChunkID, Tri_Local
   WriteInt file,54 ;dwChunkSize, sizeof(Tri_Local)
   For i=0 To 3 ;X,Y,Z,Origin
    If i=0 Then WriteFloat file,1 Else WriteFloat file,0 ;fLocal1
    If i=1 Then WriteFloat file,1 Else WriteFloat file,0 ;fLocal2
    If i=2 Then WriteFloat file,1 Else WriteFloat file,0 ;fLocal3
   Next
   ;Tri_FaceList Chunk, Object_TriMesh Subchunk
   WriteShort file,$4120 ;wChunkID, Tri_FaceList
   WriteInt file,tfsize ;dwChunkSize, tfsize=8+(nTris*4*2)+tmsize+tssize
   WriteShort file,CountTriangles(surf) ;ChunkData, wTrianglesTotal
   For i=0 To CountTriangles(surf)-1 ;invert face order
    WriteShort file,TriangleVertex(surf,i,2) ;wTriangleVertexA
    WriteShort file,TriangleVertex(surf,i,1) ;wTriangleVertexB
    WriteShort file,TriangleVertex(surf,i,0) ;wTriangleVertexC
    WriteShort file,$0407 ;wFaceFlags
   Next
   ;Tri_Material Chunk, Tri_FaceList Subchunk
   WriteShort file,$4130 ;wChunkID, Tri_Material
   WriteInt file,tmsize ;dwChunkSize, tmsize=8+mnlen+(nTris*2)
   WriteStringAscii(file,matname$) ;ChunkData, material name
   WriteByte file,0 ;ChunkData, Ascii-z null byte
   WriteShort file,CountTriangles(surf) ;ChunkData, wTrianglesAssigned
   For i=0 To CountTriangles(surf)-1
    WriteShort file,i ;wTriangleIndex
   Next
   ;Tri_Smooth Chunk, Tri_FaceList Subchunk
   WriteShort file,$4150 ;wChunkID, Tri_Smooth
   WriteInt file,tssize ;dwChunkSize, tssize=6+(nTris*4)
   For i=0 To CountTriangles(surf)-1
    WriteInt file,1 ;dwTriangleSmoothGroup
   Next

  Next
  ent=NextChild(ent)
 Wend

 FreeEntity piv
 CloseFile file
 Return True ;success code

End Function

Function WriteStringAscii(file,ascii$)
 ;file=file handle, ascii$=ascii string

 Local i,char$
 For i=1 To Len(ascii$)
  char$=Mid(ascii$,i,1)
  WriteByte(file,Asc(char$))
 Next

End Function

Function WriteRGBColor(file,rgb)
 ;file=file handle, rgb=3-byte value

 WriteByte(file,(rgb And $FF0000) Shr 16) ;r
 WriteByte(file,(rgb And $00FF00) Shr 8) ;g
 WriteByte(file,(rgb And $0000FF)) ;b

End Function

Function NextChild(ent)
 ;Returns next child of entity as if it was on the same hierarchy level
 ;"NextChild(entity)", by Beaker

 If CountChildren(ent)>0
  Return GetChild(ent,1)
 EndIf
 Local foundunused=False
 Local foundent=0,parent,sibling
 While foundunused=False And ent<>0
  parent=GetParent(ent)
  If parent<>0
   If CountChildren(parent)>1
    If GetChild(parent,CountChildren(parent))<>ent
     For siblingcnt=1 To CountChildren(parent)
      sibling=GetChild(parent,siblingcnt)
      If sibling=ent
       foundunused=True
       foundent=GetChild(parent,siblingcnt+1)
      EndIf
     Next
    EndIf
   EndIf
  EndIf
  ent=parent
 Wend
 Return foundent

End Function

Function MakeTestTexture(width,height)

 Local texture,x,y,rgb
 texture=CreateTexture(width,height)
 LockBuffer(TextureBuffer(texture))
 For y=0 To TextureHeight(texture)-1
  For x=0 To TextureWidth(texture)-1
   rgb=y+(y*256)+(x*256^2) ;gradient color
   WritePixelFast x,y,rgb,TextureBuffer(texture)
  Next
 Next
 UnlockBuffer(TextureBuffer(texture))
 SetBuffer TextureBuffer(texture)
 Color 255,255,255 : Oval 40,40,30,30
 Color 0,0,0 : Text 50,50,"3DS" : Color 255,255,255
 SetBuffer BackBuffer()
 Return texture

End Function