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