Code:
'Extract Mesh to Map
'V 0.4 By LordCrush
Const OpenAsASCII = 0
Const OpenAsUnicode = -1
' FileSystemObject.CreateTextFile
Const OverwriteIfExist = -1
Const FailIfExist = 0
' FileSystemObject.OpenTextFile
Const OpenAsDefault = -2
Const CreateIfNotExist = -1
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim oFileSystemObj, sOUT, fOUTFILE, sIN, fINFILE
sMapName="Arena"
sPOVFile=".\" & sMapName & ".pov"
sLineName=sMapName & "Line"
sColor="grey"
bDebug=0
iXMax=0
iYMax=0
iZMax=0
Set oFileSystemObj = CreateObject("Scripting.FileSystemObject")
Set fPOVFile = oFileSystemObj.OpenTextFile(sPOVFile, ForReading)
' WScript.Echo "POVFile " & sPOVFile
iMapNr=1
bVectors=false
Do While fPOVFile.AtEndofStream =False
sBuffer=fPOVFile.ReadLine
' WScript.Echo "Line " & sBuffer
if InStr(sBuffer,"vertex_vectors") > 0 then
sOUT=".\" & sMapName & iMapNr & ".txt"
' WScript.Echo "Line valid, File = " & sOUT
Set fOUTFILE = oFileSystemObj.CreateTextFile(sOUT, ForWriting, OpenAsASCII)
bVectors=true
sBuffer=fPOVFile.ReadLine
End If
if bVectors then
' WScript.Echo "Precheck Line " & sBuffer
if left(sBuffer,1) = "<" then
' WScript.Echo "Line " & sBuffer
fOUTFILE.WriteLine sBuffer
else
fOUTFILE.close
Set fOUTFILE = nothing
' WScript.Echo "File = " & sOUT & " done ..."
iMapNr=iMapNr + 1
bVectors=false
End If
End If
Loop
fPOVFile.close
set fPOVFile=nothing
'Conv mesh start
iMapNr=1
sIN=".\" & sMapName & iMapNr & ".txt"
sOUT=".\" & sMapName & iMapNr & ".map"
' WScript.Echo "Map = " & sIN & ", " & sOUT
Do while oFileSystemObj.FileExists(sIN)
Set fOUTFILE = oFileSystemObj.CreateTextFile(sOUT, ForWriting, OpenAsASCII)
Set fINFILE = oFileSystemObj.OpenTextFile(sIN, ForReading)
fOUTFILE.WriteLine sMapName & "," & sMapName & iMapNr & ",10,10,10"
Do While fINFILE.AtEndofStream =False
sBuffer=fINFILE.ReadLine
iLenSBuffer=Len(sBuffer)
' WScript.Echo "Line " & sBuffer
if left(sBuffer,1) = "<" then
' WScript.Echo "Line valid"
sP=""
iPCount=0
do
' Get Point 1
iPEnd=InStr(sBuffer,">")
iPStart=InStr(sBuffer,"<")
sP1=Mid(sBuffer,iPStart+1,iPEnd-IPStart-1)
'Reduce Buffer
iLenSBuffer=iLenSBuffer-iPEnd
sBuffer=right(sBuffer,(iLenSBuffer))
sPTmp=sP1
ToInt sPTmp
' WScript.Echo "sPTmp= " & SPTmp
GetCoord sPTmp,iCoord
if abs(iCoord) > iXMax then iXMax = abs(iCoord)
iX1=iCoord * (-1) 'Turn 180 Deg
' WScript.echo "X1= " & iX1 & ", iXMax " & iXMax & " sPTmp " & sPTmp
GetCoord sPTmp,iCoord
if abs(iCoord) > iYMax then iYMax=abs(iCoord)
iY1=iCoord
' WScript.echo "Y1= " & iY1 & ", iYMax " & iYMax & " sPTmp " & sPTmp
GetCoord sPTmp,iCoord
if abs(iCoord) > iZMax then iZMax=abs(iCoord)
iZ1=iCoord
' WScript.echo "Z1= " & iZ1 & ", iZMax " & iZMax & " sPTmp " & sPTmp
' Switch y<->z
sP = sP & iX1 & "," & iZ1 & "," & iY1 & ","
iPCount=iPCount+1
' WScript.Echo "P= " & sP
' WScript.Echo "Line " & sBuffer
loop until iLenSBuffer < 14
' WScript.Echo "Line: M,"& sLineName & "," & sColor & "," & iPCount & "," & sP
fOUTFILE.WriteLine "M,"& sLineName & "," & sColor & "," & iPCount & "," & sP
' WScript.Quit(0)
End If
loop
fOUTFILE.Close
Set fOUTFILE = nothing
fINFILE.Close
Set fINFILE = nothing
iMapNr = iMapNr + 1
sIN=".\" & sMapName & iMapNr & ".txt"
sOUT=".\" & sMapName & iMapNr & ".map"
' WScript.Echo "Map = " & sIN & ", " & sOUT
Loop
WScript.Echo (iMapNr-1) & " Maps written"
Function ToInt(sPTmp)
'X
iCoordEnd=InStr(sPTmp,",")
sCoord=Left(sPTmp,iCoordEnd-1) & ","
sPTmp=Right(sPTmp,Len(sPTmp)-iCoordEnd)
iCoordEnd=InStr(sPTmp,",")
sPTmp=Right(sPTmp,Len(sPTmp)-iCoordEnd)
'Y
iCoordEnd=InStr(sPTmp,",")
sCoord=sCoord & Left(sPTmp,iCoordEnd-1) & ","
sPTmp=Right(sPTmp,Len(sPTmp)-iCoordEnd)
iCoordEnd=InStr(sPTmp,",")
sPTmp=Right(sPTmp,Len(sPTmp)-iCoordEnd)
'Z
iCoordEnd=InStr(sPTmp,",")
sCoord=sCoord & Left(sPTmp,iCoordEnd-1)
sPTmp=Right(sPTmp,Len(sPTmp)-iCoordEnd)
sPTmp=sCoord
End Function
Function GetCoord (sPTmp,iCoord)
iCoordEnd=InStr(sPTmp,",")
if iCoordEnd <> 0 then
iCoord=Left(sPTmp,iCoordEnd-1)
sPTmp=Right(sPTmp,Len(sPTmp)-iCoordEnd)
else
iCoord=sPTmp
sPTmp=""
End If
if iCoord="" then iCoodr=0
End Function
This extracts the Meshinfo into map-files