Option Explicit
' COPYRIGTH DASSAULT SYSTEMES 2003
' ***********************************************************************
' Purpose: Import a material library from a text file
'
' Version: 1.0
' Author: BMB
' Languages: CATScript
' Locales: English
' CATIA Level: V5R12
' ***********************************************************************
' Main
Sub CATMain()
' Get the file system object
Dim oFileSys as FileSystem
Set oFileSys = CATIA.FileSystem
' Get the documents collection
Dim oCollection As Documents
Set oCollection = CATIA.Documents
' test if no document is open
If 0=oCollection.Count Then
msgbox "A new material library document must be active to execute this macro.", vbOKOnly, "Import Material Library"
Exit Sub
End If
' Get material library
Dim oCat As Document
Set oCat = CATIA.ActiveDocument
' test if the active document is a material library (CATMaterial)
If 0=InStr(oCat.Name, ".CATMaterial") Then
msgbox "A new material library document must be active to execute this macro.", vbOKOnly, "Import Material Library"
Exit Sub
End If
' Get name of the material library text file
Dim sAnswer As String
sAnswer = CATIA.FileSelectionBox("Select a material library text file", "*.matlib", CatFileSelectionModeOpen)
If ""<>sAnswer Then ' CANCEL
' Determine the file separator
Dim sSep As String
sSep = oFileSys.FileSeparator
' Create the material library text file
Dim oFileIn As File
Set oFileIn = oFileSys.GetFile(sAnswer)
Dim oStream As TextStream
Set oStream = oFileIn.OpenAsTextStream("ForReading")
' Get the icon folder path
Dim sFolderIcon As String
sFolderIcon = Left(sAnswer, InstrRev(sAnswer, sSep)-1)
' Declarations and initializations
Dim sLine As String
Dim sParam As String
Dim sValue As String
Dim sBuffer As String
Dim iInc As Int ' counter of line
iInc = 0
Dim iCurLevel As Int ' current param level
iCurLevel = 0
Dim bMinimumDone As Boolean ' is TRUE if the file contains at least 1 LIBRARY and 1 FAMILY
bMinimumDone = False
Dim bFirstLibMat As Boolean ' is TRUE until the NewFamily and the NewMaterial haven't been initialized
bFirstLibMat = True
Dim oFamilies As MaterialFamilies
Dim oFamily As MaterialFamily
Dim oMaterials As Materials
Dim oMaterial As Material
Dim oRenderingMaterial As RenderingMaterial
Dim oAnalysisMaterial As AnalysisMaterial
Dim aTab(2) As Double
Dim aTabString As Array
Dim aTabString2 As Array
Dim iNumDouble As Double
Dim iNumInt As Int
Dim K As Int
' Read the input file line by line
Do Until oStream.AtEndOfStream
' Read the current line
sLine = oStream.ReadLine
sBuffer = Left(sLine, 1)
' Test if the line is empty or a comment
If 0<>StrComp(sBuffer, "#") And 0<Len(sBuffer) And 0<>FindChar(sLine) Then
' Parse the line, determine param and value
If 0=ParseLine(sLine, sParam, sValue) Then ' test for syntax error
SYNTAX_ERROR iInc
Exit Sub
Else
' special case for the first param (LIBRARY)
If iCurLevel=0 And 0<>StrComp(sParam, "LIBRARY") Then
SEMANTIC_ERROR iCurLevel
Exit Sub
Else
If 0<>iCurLevel Then
If LevelParam(sParam) > iCurLevel Then ' test for semantic error
SEMANTIC_ERROR iCurLevel
Exit Sub
Else
If 0<>StrComp(sParam, "FAMILY") Then
bMinimumDone = True
End If
' case with no error
If 0=StrComp(sParam, "FAMILY") Then ' FAMILY treatment
' Init families
Set oFamilies = oCat.Families
' Init the new family
Set oFamily = oFamilies.Add
' Affect name
oFamily.Name = sValue
Else
If 0=StrComp(sParam, "MATERIAL") Then ' MATERIAL treatment
' Init materials
Set oMaterials = oFamily.Materials
' Init the new material
Set oMaterial = oMaterials.Add
' Affect name
oMaterial.Name = sValue
' Affect icon
If oFileSys.FileExists(sFolderIcon & sSep & oFamily.Name & sSep & oMaterial.Name & ".jpg") Then
oMaterial.PutIcon(sFolderIcon & sSep & oFamily.Name & sSep) ' & oMaterial.Name & ".jpg")
End If
Else
If 0=StrComp(sParam, "PROPERTY") Then ' PROPERTY treatment
If 0=StrComp(sValue, "Rendering") Then ' rendering case
' Add rendering data on the new material
Set oRenderingMaterial = oMaterial.CreateRenderingData
End If
If 0=StrComp(sValue, "AnalysisIsotropic") Then ' AnalysisIsotropic case
' Add Analysis data on the new material
Set oAnalysisMaterial = oMaterial.CreateAnalysisData("SAMIsotropicMaterial")
End If
If 0=StrComp(sValue, "AnalysisOrthotropic") Then ' AnalysisOrthotropic case
' Add Analysis data on the new material
Set oAnalysisMaterial = oMaterial.CreateAnalysisData("SAMOrthotropicMaterial")
End If
Else ' AmbientCoefficient, DiffuseCoefficient, ... treatment
' one variable mode (format: var)
If 0=StrComp(sParam, "MAPPINGTYPE") Then
oRenderingMaterial.MappingType = sValue
End If
If oRenderingMaterial.MappingType = 5 Then ' Manual mapping
If 0=StrComp(sParam, "ADAPTIVECOEFF") Then
oRenderingMaterial.AdaptiveCoeff = sValue
End If
End If
If 0=StrComp(sParam, "PREVIEWSIZE") Then
oRenderingMaterial.PreviewSize = sValue
End If
If 0=StrComp(sParam, "AMBIENTCOEFFICIENT") Then
oRenderingMaterial.AmbientCoefficient = sValue
End If
If 0=StrComp(sParam, "DIFFUSECOEFFICIENT") Then
oRenderingMaterial.DiffuseCoefficient = sValue
End If
If 0=StrComp(sParam, "SPECULARCOEFFICIENT") Then
oRenderingMaterial.SpecularCoefficient = sValue
End If
If 0=StrComp(sParam, "SPECULAREXPONENT") Then
oRenderingMaterial.SpecularExponent = sValue
End If
If 0=StrComp(sParam, "TRANSPARENCYCOEFFICIENT") Then
oRenderingMaterial.TransparencyCoefficient = sValue
End If
If 0=StrComp(sParam, "REFRACTIONCOEFFICIENT") Then
oRenderingMaterial.RefractionCoefficient = sValue
End If
If 0=StrComp(sParam, "REFLECTIVITYCOEFFICIENT") Then
oRenderingMaterial.ReflectivityCoefficient = sValue
End If
If 0=StrComp(sParam, "ENVIRONMENTIMAGE") Then
oRenderingMaterial.EnvironmentImage = sValue
End If
If 0=StrComp(sParam, "REFLECTIONMODE") Then
oRenderingMaterial.ReflectionMode = sValue
End If
If 4=oRenderingMaterial.ReflectionMode Then ' 4=CUSTOM
If 0=StrComp(sParam, "REFLECTIONHEIGHT") Then
oRenderingMaterial.ReflectionHeight = sValue
End If
If 0=StrComp(sParam, "REFLECTIONLENGTH") Then
oRenderingMaterial.ReflectionLength = sValue
End If
End If
If 0=StrComp(sParam, "TEXTURETYPE") Then
oRenderingMaterial.TextureType = sValue
End If
If 0=StrComp(sParam, "BUMP") Then
oRenderingMaterial.Bump = sValue
End If
If 0=StrComp(sParam, "TEXTUREIMAGE") Then
oRenderingMaterial.TextureImage = sValue
End If
If 0=StrComp(sParam, "FLIPU") Then
oRenderingMaterial.FlipU = sValue
End If
If 0=StrComp(sParam, "FLIPV") Then
oRenderingMaterial.FlipV = sValue
End If
If 0=StrComp(sParam, "REPEATU") Then
oRenderingMaterial.RepeatU = sValue
End If
If 0=StrComp(sParam, "REPEATV") Then
oRenderingMaterial.RepeatV = sValue
End If
If 0=StrComp(sParam, "SCALEU") Then
oRenderingMaterial.ScaleU = sValue
End If
If 0=StrComp(sParam, "SCALEV") Then
oRenderingMaterial.ScaleV = sValue
End If
If 0=StrComp(sParam, "POSITIONU") Then
oRenderingMaterial.PositionU = sValue
End If
If 0=StrComp(sParam, "POSITIONV") Then
oRenderingMaterial.PositionV = sValue
End If
If 0=StrComp(sParam, "ORIENTATION") Then
oRenderingMaterial.Orientation = sValue
End If
If 0=StrComp(sParam, "COLORNUMBER") Then
oRenderingMaterial.ColorNumber = sValue
End If
If 0=StrComp(sParam, "TEXTURECOMPLEXITY") Then
oRenderingMaterial.TextureComplexity = sValue
End If
If 0=StrComp(sParam, "TEXTUREAMPLITUDE") Then
oRenderingMaterial.TextureAmplitude = sValue
End If
If 0=StrComp(sParam, "TEXTUREVEINAMPLITUDE") Then
oRenderingMaterial.TextureVeinAmplitude = sValue
End If
If 0=StrComp(sParam, "TEXTUREPERTURBATION") Then
oRenderingMaterial.TexturePerturbation = sValue
End If
If 0=StrComp(sParam, "TEXTUREGAIN") Then
oRenderingMaterial.TextureGain = sValue
End If
If 0=StrComp(sParam, "TEXTURETURBULENCE") Then
oRenderingMaterial.TextureTurbulence = sValue
End If
If 0=StrComp(sParam, "CHESSBOARDTILEWIDTH") Then
oRenderingMaterial.ChessboardTileWidth = sValue
End If
If 0=StrComp(sParam, "CHESSBOARDTILEHEIGHT") Then
oRenderingMaterial.ChessboardTileHeight = sValue
End If
If 0=StrComp(sParam, "CHESSBOARDOFFSET") Then
oRenderingMaterial.ChessboardOffset = sValue
End If
If 0=StrComp(sParam, "CHESSBOARDJOINTWIDTH") Then
oRenderingMaterial.ChessboardJointWidth = sValue
End If
If 0=StrComp(sParam, "CHESSBOARDJOINTHEIGHT") Then
oRenderingMaterial.ChessboardJointHeight = sValue
End If
' array mode (format: var/var/var)
If 0=StrComp(sParam, "AMBIENTCOLOR") Then
aTabString = Split(sValue, "/")
aTab(0) = CDbl(aTabString(0))
aTab(1) = CDbl(aTabString(1))
aTab(2) = CDbl(aTabString(2))
oRenderingMaterial.PutAmbientColor aTab
End If
If 0=StrComp(sParam, "DIFFUSECOLOR") Then
aTabString = Split(sValue, "/")
aTab(0) = CDbl(aTabString(0))
aTab(1) = CDbl(aTabString(1))
aTab(2) = CDbl(aTabString(2))
oRenderingMaterial.PutDiffuseColor aTab
End If
If 0=StrComp(sParam, "SPECULARCOLOR") Then
aTabString = Split(sValue, "/")
aTab(0) = CDbl(aTabString(0))
aTab(1) = CDbl(aTabString(1))
aTab(2) = CDbl(aTabString(2))
oRenderingMaterial.PutSpecularColor aTab
End If
If 0=StrComp(sParam, "TRANSPARENCYCOLOR") Then
aTabString = Split(sValue, "/")
aTab(0) = CDbl(aTabString(0))
aTab(1) = CDbl(aTabString(1))
aTab(2) = CDbl(aTabString(2))
oRenderingMaterial.PutTransparencyColor aTab
End If
If 0=StrComp(sParam, "3DTEXTURESCALE") Then
aTabString = Split(sValue, "/")
aTab(0) = CDbl(aTabString(0))
aTab(1) = CDbl(aTabString(1))
aTab(2) = CDbl(aTabString(2))
oRenderingMaterial.Put3DTextureScale aTab
End If
If 0=StrComp(sParam, "3DTEXTUREPOSITION") Then
aTabString = Split(sValue, "/")
aTab(0) = CDbl(aTabString(0))
aTab(1) = CDbl(aTabString(1))
aTab(2) = CDbl(aTabString(2))
oRenderingMaterial.Put3DTexturePosition aTab
End If
If 0=StrComp(sParam, "3DTEXTUREORIENTATION") Then
aTabString = Split(sValue, "/")
aTab(0) = CDbl(aTabString(0))
aTab(1) = CDbl(aTabString(1))
aTab(2) = CDbl(aTabString(2))
oRenderingMaterial.Put3DTextureOrientation aTab
End If
' index mode (format: :i:var/var/var:i:var/var/var... OU :i:var:i:var...)
If 0=StrComp(sParam, "3DTEXTURECOLOR") Then
aTabString = Split(sValue, ":")
For K = 0 To oRenderingMaterial.ColorNumber-1
aTabString2 = Split(aTabString(2*K+2), "/")
aTab(0) = CDbl(aTabString2(0))
aTab(1) = CDbl(aTabString2(1))
aTab(2) = CDbl(aTabString2(2))
oRenderingMaterial.Put3DTextureColor CInt(aTabString(2*K+1)), aTab
Next
End If
If 0=StrComp(sParam, "3DTEXTURECOLORCOEFFICIENT") Then
aTabString = Split(sValue, ":")
For K = 0 To oRenderingMaterial.ColorNumber-1
oRenderingMaterial.Put3DTextureColorCoefficient CInt(aTabString(2*K+1)), CDbl(aTabString(2*K+2))
Next
End If
' Analysis variable
If 0=StrComp(sParam, "SAMDENSITY") Then
oAnalysisMaterial.PutValue "SAMDensity", sValue
End If
' Isotropic properties
If 0=StrComp(sParam, "SAMTHERMALEXPANSION") Then
oAnalysisMaterial.PutValue "SAMThermalExpansion", sValue
End If
If 0=StrComp(sParam, "SAMYOUNGMODULUS") Then
oAnalysisMaterial.PutValue "SAMYoungModulus", sValue
End If
If 0=StrComp(sParam, "SAMPOISSONRATIO") Then
oAnalysisMaterial.PutValue "SAMPoissonRatio", sValue
End If
If 0=StrComp(sParam, "SAMSHEARMODULUS") Then
oAnalysisMaterial.PutValue "SAMShearModulus", sValue
End If
' Orthotropic properties
If 0=StrComp(sParam, "SAMYOUNGMODULUS_11") Then
oAnalysisMaterial.PutValue "SAMYoungModulus_11", sValue
End If
If 0=StrComp(sParam, "SAMYOUNGMODULUS_22") Then
oAnalysisMaterial.PutValue "SAMYoungModulus_22", sValue
End If
If 0=StrComp(sParam, "SAMPOISSONRATIO_12") Then
oAnalysisMaterial.PutValue "SAMPoissonRatio_12", sValue
End If
If 0=StrComp(sParam, "SAMSHEARMODULUS_12") Then
oAnalysisMaterial.PutValue "SAMShearModulus_12", sValue
End If
If 0=StrComp(sParam, "SAMSHEARMODULUS_1Z") Then
oAnalysisMaterial.PutValue "SAMShearModulus_1Z", sValue
End If
If 0=StrComp(sParam, "SAMSHEARMODULUS_2Z") Then
oAnalysisMaterial.PutValue "SAMShearModulus_2Z", sValue
End If
If 0=StrComp(sParam, "SAMTENSILESTRESSLIMIT_X") Then
oAnalysisMaterial.PutValue "SAMTensileStressLimit_X", sValue
End If
If 0=StrComp(sParam, "SAMTENSILESTRESSLIMIT_Y") Then
oAnalysisMaterial.PutValue "SAMTensileStressLimit_Y", sValue
End If
If 0=StrComp(sParam, "SAMCOMPRESSIVESTRESSLIMIT_X") Then
oAnalysisMaterial.PutValue "SAMCompressiveStressLimit_X", sValue
End If
If 0=StrComp(sParam, "SAMCOMPRESSIVESTRESSLIMIT_Y") Then
oAnalysisMaterial.PutValue "SAMCompressiveStressLimit_Y", sValue
End If
If 0=StrComp(sParam, "SAMTHERMALEXPANSION_X") Then
oAnalysisMaterial.PutValue "SAMThermalExpansion_X", sValue
End If
If 0=StrComp(sParam, "SAMTHERMALEXPANSION_Y") Then
oAnalysisMaterial.PutValue "SAMThermalExpansion_Y", sValue
End If
End If
End If
End If
End If
End If
' update the level
iCurLevel = LevelParam(sParam) +1
End If
End If
End If
iInc = iInc +1
Loop
If bMinimumDone=False Then
msgbox "ERROR : input file must contain at least 1 LIBRARY and 1 FAMILY", vbOKOnly, "Import Material Library"
Exit Sub
End If
' Save the new CATMaterial
'oCat.SaveAs(Left(sAnswer, InStr(sAnswer, ".matlib")-1) & ".CATMaterial")
' End message
'msgbox "Operation succeed." & Chr(10) & "The material library has been saved at this location :" & Chr(10) & Chr(10) & Left(sAnswer, InStr(sAnswer, ".matlib")-1) & ".CATMaterial", vbOKOnly, "Import Material Library"
msgbox "Operation succeed." & Chr(10) & "The material library has been imported.", vbOKOnly, "Import Material Library"
End If
End Sub
'************************************************************************************
' Subs and Functions code
'************************************************************************************
'------------------------------------------------------------------------------------
' ParseLine
' Parse a line with the format "PARAM=Value" and return the PARAM and the Value
' Return 0 if there is a syntax error on the line
' Return 1 either
'------------------------------------------------------------------------------------
Public Function ParseLine(ByVal sLine As String, sParam, sValue) As Int
' Test the line format
If 0=InStr(sLine, "=") Then
ParseLine = 0
Exit Function
Else
If FindChar(sLine)=InStr(sLine, "=") Or _
0=StrComp(Mid(sLine, InStr(sLine, "=")-1, 1), Chr(9)) Or _
0=StrComp(Mid(sLine, InStr(sLine, "=")-1, 1), " ") Or _
0=StrComp(Mid(sLine, InStr(sLine, "=")+1, 1), Chr(9)) Or _
0=StrComp(Mid(sLine, InStr(sLine, "=")+1, 1), " ") Then
ParseLine = 0
Exit Function
Else
sParam = UCase(Mid(sLine, FindChar(sLine), InStr(sLine, "=")-FindChar(sLine)))
sValue = Mid(sLine, InStr(sLine, "=")+1, FindCharLeft(sLine)-InStr(sLine, "="))
ParseLine = 1
End If
End If
End Function
'------------------------------------------------------------------------------------
' FindChar
' Return the position of the first character which is not a space or a tab in a string
' Return 0 either
'------------------------------------------------------------------------------------
Public Function FindChar(ByVal sLine As String) As Int
Dim iCount As Int
FindChar = 0
For iCount = 1 To Len(sLine)
' Avoid the space and tab characters
If 0<>StrComp(Mid(sLine, iCount, 1), Chr(9)) And 0<>StrComp(Mid(sLine, iCount, 1), " ") Then
FindChar = iCount
Exit For
End If
Next
End Function
'------------------------------------------------------------------------------------
' FindCharLeft
' Return the position of the first character which is not a space or a tab in a string
' starting at the left
' Return 0 either
'------------------------------------------------------------------------------------
Public Function FindCharLeft(ByVal sLine As String) As Int
Dim iCount As Int
FindCharLeft = 0
For iCount = Len(sLine) To 1 Step -1
' Avoid the space and tab characters
If 0<>StrComp(Mid(sLine, iCount, 1), Chr(9)) And 0<>StrComp(Mid(sLine, iCount, 1), " ") Then
FindCharLeft = iCount
Exit For
End If
Next
End Function
'------------------------------------------------------------------------------------
' LevelParam
' Return the level of a param
' 0 -> LIBRARY
' 1 -> FAMILY
' 2 -> MATERIAL
' 3 -> PROPERTY
' 4 -> AmbientCoefficient, DiffuseCoefficient, ..., AnyWord
' -1 if the param is empty
'------------------------------------------------------------------------------------
Public Function LevelParam(ByVal sParam As String) As Int
If 0=StrComp(sParam, "LIBRARY") Then
LevelParam = 0
Else
If 0=StrComp(sParam, "FAMILY") Then
LevelParam = 1
Else
If 0=StrComp(sParam, "MATERIAL") Then
LevelParam = 2
Else
If 0=StrComp(sParam, "PROPERTY") Then
LevelParam = 3
Else
If 0<Len(sParam) Then
LevelParam = 4
Else
LevelParam = -1
End If
End If
End If
End If
End If
End Function
'------------------------------------------------------------------------------------
' SYNTAX_ERROR
' Stop the program and indicate the line error
'------------------------------------------------------------------------------------
Public Sub SYNTAX_ERROR(ByVal iInc As Int)
msgbox "SYNTAX ERROR : on line " & iInc, vbOKOnly, "Import Material Library"
End Sub
'------------------------------------------------------------------------------------
' SEMANTIC_ERROR
' Stop the program and indicate the word expected
'------------------------------------------------------------------------------------
Public Sub SEMANTIC_ERROR(ByVal iLevel As Int)
Dim sMsg As String
sMsg = "SEMANTIC ERROR : "
Select Case iLevel
Case 0
sMsg = sMsg & "LIBRARY"
Case 1
sMsg = sMsg & "FAMILY"
Case 2
sMsg = sMsg & "FAMILY or MATERIAL"
Case 3
sMsg = sMsg & "FAMILY or MATERIAL or PROPERTY"
Case 4
sMsg = sMsg & "FAMILY or MATERIAL or PROPERTY or AmbientCoefficient or ..."
End Select
sMsg = sMsg & " was expected"
msgbox sMsg, vbOKOnly, "Import Material Library"
End Sub