Language = "VBSCRIPT"
' Purpose:       Get a Title Block and fill Entries
'
' Assumptions:   A Drafting document should be active
'
' Author:        M. Neukirchen
'
' Languages:     VBScript
' Version:       V5R9 SP2, V5R9 GA,V5R10, V5R15
' Reg. Settings: English (United States)
' ****************************************************************************
'**************************************************************************
' PROGRAM: Text_block
'**************************************************************************
'                        IBM Product Lifecyle Management Solutions
'                        Engineering e-Business
'
' (C) COPYRIGHT Michael Neukirchen 2005
'**************************************************************************
'                	Erstellt: 01.09.2000      Name: M. Maier
'                	Update  : 20.07.2001      Name: M. Neukirchen
'			18.08.2001	V 2.1.1
'					Suppport of multiple sheets
'					Configuration Path to sInstallDir
'			05.11.2001	V 2.2.0   M. Neukirchen
'					Execute external program with ExecuteProcessus
'					Naming Convention according to Dassault Macros
'					Copy data from template to current sheet
'					exchange title block data
'			03.12.2001	V 2.2.1   M. Neukirchen
'					temp directory from environment
'			15.12.2001	V 2.3.0   M. Neukirchen
'					some compatibility with TeamPDM
'					Step1 : Drawing / Sheet fields
'			01.06.2002	V 2.3.1   M. Neukirchen
'					Error exchange frame fixed.
'			24.06.2002	V 2.3.2   M. Neukirchen
'					Re-activation of active view
'			02.08.2002	V 2.3.3   M. Neukirchen
'					regexp 					-> IBMReplace
'					\ 						-> / for Unix
'				   Split 					-> IBMSplit
'					VB file system object 	-> CATIA file system object
'					VB temp folder 			-> /tmp or VB special Folder on Windows
'					BackGroundView			-> integrated feedback from Helbling
'			01.10.2002	V 2.3.4   M. Neukirchen
'					Bugfix for parameters, copy of frames
'			03.10.2002  V 2.4.0
'					Parameter handling from M. Röcker
'					info on td1 compatibility
'			14.10.2002  V 2.4.1
'					Performance optimization, delete Parameters only if necessary
'					File Create problen in 5.10 fixed
'			25.11.2002  V 2.4.2
'					Detection of OS (getos function)
'			12.12.2002  V 2.4.3
'					TD1 configuration in basics.cfg config data set
'					CALL_GUI_Mode for foreground/background invocation of GUI
'			09.03.2003  V 2.4.7
'					Enable tracing
'			13.05.2003  V 2.4.9
'					Use the drawing scale of the existing drawing
'					Compliance for R11
'					tracing enhanced
'			24.09.2003  V 2.4.12
'					support for Details
'					check for " " in sInstallDir
'			20.01.2004  V 2.4.14
'					support for CATIAVERSION
'			28.07.2004  V 3.0.0
'					support for BOMs
'			04.11.2004  V 3.0.3
'					NLS support
'			13.01.2005  V 3.1.1
'					STARKIT Support UNIX
'					Check for CATDrawing as active document
'			18.02.2005  V 3.1.3
'					BOM error for Title at the bottom
'			18.06.2005  V 3.1.4
'					BOM reworked,  weight,volume,wetarea info added
'
'
'
'**********************************************************************************


'-------------------------------------------------- change path for your installation ----------
sInstallDir = "C:\CATScripts\Title_Block\v3.1.4"

'------------------------------------------------------------------------------------------------

public fs 					as object
public communication_1	 	as string
public communication_2 		as string
public communication_3 		as string

public command_edit     	as string
public command_select  	 	as string
public work             	as string
Public sValues(200) 		As String
Public sNames (200) 		As String
Public sCATIAVERSION		As String
public iNumNames 			as Integer

public DrwDocument   		as object
public DrwSheets     		as object
public DrwSelection  		as object
public DrwSheet      		as object
public DrwView       		as object
public DrwViewActive 		as object
public DrwViews      		as object
public DrwGeomElems  		as object
public DrwTexts      		as object
public ActiveWindow  		as object
public trace_dat     		as object
public trace_mode			as string
public trace				as boolean
public trace_is_init		as boolean
public data_trace			as object

public cur_sheet_active		as object
public cur_view_active		as object
public cur_sheet_background as object
public iTitleblockTexts 	as integer
public resolve_3d		    as boolean

public call_method   		as string
public is_init       		as string
'public td1_configured		as boolean
public num_td1_parms		as integer
public fso 					as object
public td1_parm_params	(100)
public td1_parm_ids		(100)
public td1_parm_visible	(100)
public td1_parm_sheet1	(100)
public TD1_compliant		as boolean
public check3DAnalysisData	as boolean
public CALL_GUI_Mode		as string
public numComponents		as integer
public sTempFolder
redim myComponents(1) 		as DrawingView
redim myComponents_m0(1)     as double
redim myComponents_m1(1)     as double
redim myComponents_m2(1) 	as double
redim myComponents_m3(1) 	as double
redim myComponents_m4(1) 	as double
redim myComponents_m5(1) 	as double
redim myTranslateStringsIn(1) as string
redim myTranslateStringsOut(1) as string
public numTransItems		as integer
public didIAskFor3D			as integer
public TBlockPrefix			as string
public TBlockPrefixLen		as integer
public os					as string
public fatalError			as integer
redim UnitFields(1)			as string
redim UnitSymbols(1)		as string
redim UnitDP(1)				as string
redim UnitFactor(1)			as string
redim UnitShow(1)			as string
public productWeights(100)	as string
public productWetAreas(100)	as string
public productVolumes(100)	as string
public productNames(100)	as string
public iNumParts			as integer
public iColWeight			as integer
public iColWetArea			as integer
public iColVolume			as integer
public iColPartNumber		as integer

public vbCr as string
vbCr = chr(13)
'-------------------------------------------------------------------------------
' ------------ Main Loop
'-------------------------------------------------------------------------------

Sub CATMain()
	IBMinit
	if fatalError > 0 then
		exit sub
	end if
	iBack = IBMBackgroundViewIsEmpty(DrwViews)
	if iBack = 2 then				'geometrz in the background without text, cancelled
		exit sub
	end if
	if iBack = 1 then 				'No choice, first get a title block
		if CATDrw_AddTitleBlock("init") = "cancelled" then
			exit sub
		end if
	end if

	work = "change title block"
	while work = "change title block"
		CATDrw_EditTitleBlock()
		if work = "change title block" then
			ModifyModel			            	'do additionally all the changes which have been made on the tabs (2.4.11)
			CATDrw_ExchangeTitleBlock("loop")
		end if
	wend
	IBM_exit
End Sub

'-------------------------------------------------------------------------------
' ------------ Add a new title block
'-------------------------------------------------------------------------------

Function CATDrw_AddTitleBlock (sMode as String) as String
	Dim CatiaFile as String
	IBMinit
	CatiaFile = IBMGetCatiaTemplate(sMode)
	CATDrw_AddTitleBlock = "ok"
	If CatiaFile = "cancelled" then
		CATDrw_AddTitleBlock = "cancelled"
		Exit Function
      Else
		IBMGetTitleBlock(CatiaFile)
	End If
End Function

'-------------------------------------------------------------------------------
' ------------ Call the Gui to edit title block entries
'-------------------------------------------------------------------------------

Sub CATDrw_EditTitleBlock()
	Tracer "CATDrw_EditTitleBlock", "--> entering"
	IBMinit
	Tracer "CATDrw_EditTitleBlock", "Scan Model"
	ScanModel
	work = "calling edit"  			'if something goes wrong, avoid loop in main
	if iTitleblockTexts > 0 then		'has scan model found Title Block Texts
		Tracer "CATDrw_EditTitleBlock", "Calling GUI"
		ExecuteOS command_edit
		Tracer "CATDrw_EditTitleBlock", "Calling ModifyModel"
		ModifyModel
	else
                                    sTemp= Translate("No Title Block entries found in sheet, ok to delete background")
		iback = MsgBox   (sTemp, vbYesNo)
		if iback = vbOK then
			IBMinit
				Tracer "CATDrw_EditTitleBlock", "Cleaning Background View"
			CATRemoveAll
				Tracer "CATDrw_EditTitleBlock", "Calling Title Block Chooser"
			CATDrw_AddTitleBlock("init")
				Tracer "CATDrw_EditTitleBlock", "Calling ScanModel"
			ScanModel
				Tracer "CATDrw_EditTitleBlock", "Calling GUI"
			ExecuteOS command_edit
				Tracer "CATDrw_EditTitleBlock", "Calling ModifyModel"

			ModifyModel

		end if
	end if
	Tracer "CATDrw_EditTitleBlock", "--> leaving"
End Sub
'-------------------------------------------------------------------------------
' ------------ change titel blocks
'-------------------------------------------------------------------------------

Sub CATDrw_ExchangeTitleBlock(sMode as String)
	Dim sCatiaFile as String
		Tracer "CATDrw_ExchangeTitleBlock", "--> entering with sMode=" & sMode
	IBMinit
	if CATCheckRef()=1 then
		sCatiaFile = IBMGetCatiaTemplate(sMode)
			Tracer "CATDrw_ExchangeTitleBlock", "IBMGetCatiaTemplate got:"&sCatiaFile
		if sCatiaFile = "cancelled" then
			exit sub
		end if
			Tracer "CATDrw_ExchangeTitleBlock", "Call ScanModel"
		ScanModel		'scan contents of title block
			Tracer "CATDrw_ExchangeTitleBlock", "Call CATRemoveAll"
		CATRemoveAll					'clear background view in current model
			Tracer "CATDrw_ExchangeTitleBlock", "Call IBMGetTitleBlock"
		IBMGetTitleBlock(sCatiaFile)	'get the title block from template
'		IBMinit							'set the current drawing info active
			Tracer "CATDrw_ExchangeTitleBlock", "Call ModifyModel"
		ModifyModel
	else
		msgbox Translate("title identifier not found, change impossible")
	end if
	Tracer "CATDrw_ExchangeTitleBlock", "--> leaving"
End Sub

'-------------------------------------------------------------------------------
' ------------ Init everything
'-------------------------------------------------------------------------------

sub IBMinit ()
	HKOMM=chr(34)
'	dim fields(20)
	dim sTemp as string
	fatalError = 0
	if is_init = "initialised" then
	else
		os = getos()

		if instr(sInstallDir," ") > 0 then
			msgbox translate("The install path must not contain blanks, exiting")
			fatalError = 1
			exit sub
		end if

		trace_is_init = false

		is_init = "initialised"
		set fs = CATIA.FileSystem

		didIAskFor3D = -999 'not yet asked for that

		if os = "intel" then
			set fso = CreateObject("Scripting.FileSystemObject")
			sTempFolder = fso.GetSpecialFolder(2)
'			set fso = nothing
		else
			sTempFolder = CATIA.SystemService.Environ("HOME")
'			sTempFolder = "/tmp"
		end if

		communication_1 = sTempFolder & "\cat_title_block.txt"
		communication_2 = sTempFolder & "\cat_title_block_2.txt"
		communication_3 = sTempFolder & "\cat_title_block_3.txt"

'		trace_dat_name = sTempFolder & "\cat_title_block_trace.txt"

		wish = sInstallDir & "\bin\" & os & "\MyTextblock.exe "


		command_edit   = wish  & sInstallDir & " bin\my_textblock_entry_script.tcl " &  sTempFolder & " " & wish
		command_select = wish  & sInstallDir & " bin\Choose_Frame_Body.tcl " & sTempFolder & " from_catia " & wish

		td1_config	   	= sInstallDir & "\config\td1_config.cfg"
		basics_config   = sInstallDir & "\config\basics.cfg"
		skinFile 		= sInstallDir & "\config\skin.tcl"

		if not os = "intel" then
			communication_1 = IBMReplaceChar (communication_1,"\","/")
			communication_2 = IBMReplaceChar (communication_2,"\","/")
			communication_3 = IBMReplaceChar (communication_3,"\","/")

			command_edit	= IBMReplaceChar (command_edit,   "\","/")
			command_select	= IBMReplaceChar (command_select, "\","/")
			trace_dat_name	= IBMReplaceChar (trace_dat_name, "\","/")
			td1_config		= IBMReplaceChar (td1_config	, "\","/")
			basics_config   = IBMReplaceChar (basics_config , "\","/")
			skinFile		= IBMReplaceChar (skinFile , "\","/")
			wish			= IBMReplaceChar (wish,   "\","/")
		end if

		if Not fs.FileExists(trim(wish)) Then
		   MsgBox Translate("Command >") & wish & Translate("< not found, check sInstallDir in IBMTextblock.CATScript")
		   fatalError = 1
		   exit sub
		end if

		' read basic info
		check3DAnalysisData = true
		Set basics_in 		= fs.GetFile(basics_config)
	 	set basics_stream 	= basics_in.OpenAsTextStream("ForReading")
		TBlockPrefix = "TitleBlock_Text"
		TBlockPrefixLen=15
   		Do until basics_stream.atEndOfStream
   		   zeile = basics_stream.ReadLine
  	   		if not mid(zeile,1,1) = "'" then
       			' num_fields = IBMSplit(fields,zeile, "=")
				fields = l_Split(zeile,"=")
				' num_fields = ubound(fields)
       			if fields(0) = "TD1_compliant" then
       				if Ucase(left(fields(1),4)) = "TRUE" then
       					TD1_compliant = true
       				else
       					TD1_compliant = false
       				end if
       			elseif fields(0) =	"CALL_GUI_Mode" then
       				CALL_GUI_Mode = fields(1)
       			elseif fields(0) =	"CADSystem" then
					sCATIAVERSION = fields(1)
       			elseif fields(0) =	"Trace_Mode" then
       				trace_mode = fields(1)
       				if trace_mode = "none" then
       					trace = false
       				else
       					trace = true
       				end if
       			elseif fields(0) = "3DAnalysis" then
       				if Ucase(left(fields(1),4)) = "TRUE" then
       					check3DAnalysisData = true
       				else
       					check3DAnalysisData = false
       				end if
       			elseif Trim(fields(0)) = "TBPrefix" then
					TBlockPrefix =Trim(fields(1))
					TBlockPrefixLen = Len(TBlockPrefix)
       			end if
       		end if
		Loop
		basics_stream.close


		tracer "IBMinit", "communication_1 = " & communication_1
		tracer "IBMinit", "communication_2 = " & communication_2
		tracer "IBMinit", "communication_3 = " & communication_3
		tracer "IBMinit", "command_edit    = " & command_edit
		tracer "IBMinit", "command_select  = " & command_select
		tracer "IBMinit", "td1_config      = " & td1_config
		tracer "IBMinit", "basics_config   = " & basics_config
		tracer "IBMinit", "os              = " & os
		tracer "IBMinit", "sTempFolder     = " & sTempFolder
		tracer "IBMinit", "CADSystems      = " & sCATIAVERSION
		tracer "IBMinit", "3D Analysis Data= " & check3DAnalysisData
		tracer "IBMinit", "TBlockPrefix    = " & TBlockPrefix
		tracer "IBMinit", "skinFile        = " & skinFile

		translateInit fs,skinFile, sInstallDir

'		Msgbox "TD1_compliant=" & 	TD1_compliant
'		Msgbox "CALL_GUI_Mode=" & CALL_GUI_Mode
		' check for td1 compatibility

		if TD1_compliant Then
			num_td1_parms  = 0
			Set td1_in 		= fs.GetFile(td1_config)
		 	set td1_stream 	= td1_in.OpenAsTextStream("ForReading")
    		Do until td1_stream.atEndOfStream
    	   		zeile = td1_stream.ReadLine
    	   		if not isComment(zeile) then
					fields = l_Split(zeile,";")
					td1_parm_params		(num_td1_parms) = fields(0)
					td1_parm_ids		(num_td1_parms) = fields(1)
					td1_parm_visible	(num_td1_parms) = fields(2)
					td1_parm_sheet1		(num_td1_parms) = fields(3)
           			num_td1_parms = num_td1_parms + 1
           		end if
           	Loop
           	td1_stream.close
		end if

		If CATIA.Documents.Count > 0 Then
	       If Not docIsDrawing(CATIA.ActiveDocument) Then
            	msgbox "Sie müssen ein CATDrawing aktiv haben um diese Aktion durchzuführen."
            	fatalError = 1
            	Exit Sub
		   End If
		Else
  		    msgbox "Sie müssen ein CATDrawing aktiv haben um diese Aktion durchzuführen."
  		    fatalError = X
  	    	Exit Sub
		End IF


		Set DrwDocument 	= CATIA.ActiveDocument
		Set DrwSheets   	= DrwDocument.Sheets
  		Set DrwSelection	= DrwDocument.Selection
  		Set cur_sheet_active= DrwSheets.ActiveSheet
		Set DrwViews		= cur_sheet_active.Views
		Set cur_view_active = DrwViews.ActiveView

		sTemp = CATIA.SystemConfiguration.Version
		sCATIAVERSION = IBMReplaceChar(sCATIAVERSION, "&Version", sTemp)
		sTemp = CATIA.SystemConfiguration.Release
		sCATIAVERSION = IBMReplaceChar(sCATIAVERSION, "&Release", sTemp)
		sTemp = CATIA.SystemConfiguration.ServicePack
		sCATIAVERSION = IBMReplaceChar(sCATIAVERSION, "&SP", sTemp)



	end if



	Set DrwDocument 	= CATIA.ActiveDocument
	Set DrwSheets   	= DrwDocument.Sheets
  	Set DrwSelection	= DrwDocument.Selection
  	Set DrwSheet    	= DrwSheets.ActiveSheet
	Set DrwViews		= DrwSheet.Views
	Set DrwViewActive	= DrwSheet.Views.ActiveView

	Set DrwBckView		= IBMGetBackgroundView(DrwViews)

	Set DrwTexts		= DrwBckView.Texts
	Set DrwGeomElems	= DrwBckView.GeometricElements

end sub

'-------------------------------------------------------------------------------
' ------------ Execute an OS command
'-------------------------------------------------------------------------------

sub ExecuteOS(command)

	' Brute Force communication
	' Starting the Application in foreground will cause CATIA not to
	' refresh the screen
	tracer "ExecuteOS","Command = " & command
	CATIA.StatusBar = "Executing " & command

	if os = "intel" and CALL_GUI_Mode="background" then
		if fs.FileExists(communication_3) then
			fs.DeleteFile(communication_3)
		end if
 		set check_dat= fs.CreateFile(communication_3, True)

		return = CATIA.SystemService.ExecuteBackgroundProcessus(command)

    	on error resume next
		do while fs.FileExists(communication_3)
		' if somebody knows a suitable sleep, I will put it here
		loop
		on error goto 0
	else
		 on error resume next			'compatible to r11!!
		 CATIA.RefreshDisplay = True
		 on error goto 0

		CATIA.SystemService.ExecuteProcessus(command)
	end if
end sub

'-------------------------------------------------------------------------------
' ------------ Clean all and go
'-------------------------------------------------------------------------------

Sub IBM_exit ()
'	cur_sheet_active.Activate -> activates 'Hintergrund' Mode
	cur_view_active.Activate
End Sub

'-------------------------------------------------------------------------------
' ------------ Copy a title block frame from another drawing
'-------------------------------------------------------------------------------

Sub IBMGetTitleBlock(CatiaFileName As String)

	Dim height as double
	Dim width  as double

'	get all components placed on the background view and put them on the target sheet
	set oView = IBMGetBackgroundView (DrwViews)
	numComponents = oView.Components.Count
	if numComponents > 0 then
		CATIA.ActiveDocument.Selection.Clear()
		for each Component in oView.Components
			CATIA.ActiveDocument.Selection.Add(Component)
		next
		CATIA.ActiveDocument.Selection.Copy()
	end if
	CATIA.ActiveDocument.Selection.Clear()

  	CATIA.StatusBar = "IBMGetTitleBlock"
		Tracer "IBMGetTitleBlock", "--> entering with CatiaFileName="&CatiaFileName

	set model = CATIA.Documents.Open(CatiaFileName)

 	Set FromDrwDocument = CATIA.ActiveDocument
  	Set FromDrwSheets   = FromDrwDocument.Sheets
  	Set FromSelection   = FromDrwDocument.Selection
  	Set FromDrwSheet    = FromDrwSheets.ActiveSheet
  	Set FromDrwViews    = FromDrwSheet.Views
	Set FromDrwWindow	= CATIA.ActiveWindow


	on error resume next
	ComponentsDeltax= DrwSheet.GetPaperWidth - FromDrwSheet.GetPaperWidth()

    DrwSheet.PaperSize   = FromDrwSheet.PaperSize				'get setup info and copy
    if err.number <> 0 then
    	msgbox Translate("Paper Size mismatch, probably ANSI / ISO mismatch - ignoring paper size")
    else
		if FromDrwSheet.Papersize = CatPaperUser then
			DrwSheet.SetPaperHeight(FromDrwSheet.GetPaperHeight())
			DrwSheet.SetPaperWidth (FromDrwSheet.GetPaperWidth())
		end if
	end if
	on error goto 0
'	Keep the scale of the current drawing (Thanx Martin)
'	DrwSheet.Scale2      = FromDrwSheet.Scale2
	DrwSheet.Orientation = FromDrwSheet.Orientation

'	Copy Components from Clipboard to the background view component collection
	if numComponents > 0 then
		FromSelection.Clear()
		set oView = IBMGetBackgroundView(FromDrwViews)
		FromSelection.Add(oView.Components)
		FromSelection.Paste()
		FromSelection.Clear()
		for each component in oView.Components
			Component.x = Component.x - ComponentsDeltax
		next
	End if
'   And now copy + paste the background view to the current active sheet

 	FromSelection.Add (IBMGetBackgroundView(FromDrwViews))

  	CATIA.ActiveDocument.Selection.Copy()
	CATIA.ActiveDocument.Selection.Clear()

 	DrwDocument.Activate
  	DrwSheet.Activate

	CATIA.ActiveDocument.Selection.Clear()
 	CATIA.ActiveDocument.Selection.Add (DrwViews)

  	CATIA.ActiveDocument.Selection.Paste

'  	CATIA.ActiveDocument.Selection.PasteSpecial "CATPrtResultWithOutLink"
	CATIA.ActiveDocument.Selection.Clear()

	DrwViewActive.Activate

'	FromDrwWindow.Close
		Tracer "IBMGetTitleBlock", "--> before FromDrwDocument.Close"

	FromDrwDocument.Close
		Tracer "IBMGetTitleBlock", "--> after FromDrwDocument.Close"

'	FromDrwWindow.Close
		Tracer "IBMGetTitleBlock", "--> leaving"


End Sub

'-------------------------------------------------------------------------------
' ------------ Prompt the user for a title block frame
'-------------------------------------------------------------------------------

function IBMGetCatiaTemplate (sMode as String) as String
	if sMode = "init" then
      	ExecuteOS(command_select)
	end if

		tracer "IBMGetCatiaTemplate", "communication_2 = " & communication_2

 	set data_set= fs.GetFile(communication_2)
 	set stream 	= data_set.OpenAsTextStream("ForReading")
    IBMGetCatiaTemplate = stream.ReadLine
	stream.close
end function

'-------------------------------------------------------------------------------
' ------------ Scan the actual view for title block entries
'-------------------------------------------------------------------------------
sub ScanModel ()

	if fs.FileExists(communication_1) then
		fs.DeleteFile(communication_1)
	end if
'   Scan the model, try to find title block entries
'   Name of texts must start with cat_title_block
'	set datei = fs.CreateTextFile(communication_1,true)
 	set data_set= fs.CreateFile(communication_1, True)
 	set datei 	= data_set.OpenAsTextStream("ForWriting")

	Dim Texts 	As DrawingTexts
	Dim oView 	As Object
	Dim oText 	As Object
	Dim cSheets As Object
	Dim oSheet 	As Object
	Dim cDrawingParameters As Object
	Dim oParameter As Object
	Dim sReplString As String
	Dim sfound (20)
  	On Error Resume Next

	On Error goto 0

 	DrwDocument.Activate
  	DrwSheet.Activate
	DrwViewActive.Activate

'	Get the active sheet
	Set oSheet = CATIA.ActiveDocument.Sheets.ActiveSheet
'	Set oSheet = DrwSheet
	datei.write "cat_active_sheet§" & oSheet.name & vbCrlf
	if TD1_compliant then
		datei.write "cat_configuration§td1" & vbCrLf
	end if


	Set cSheets = CATIA.ActiveDocument.Sheets
'	Set cSheets = DrwSheets

	iTitleblockTexts = 0

'	Get all sheets
	numSheets = cSheets.count

'   Count the number of all non detail sheets
	iNonDetailSheet = 0
	For Each oSheet In cSheets
		IF oSheet.Isdetail then
			Exit for
		end if
		iNonDetailSheet = 	iNonDetailSheet + 1
    next

   	Dim viewLinks As DrawingViewGenerativeLinks
	Dim firstLink As AnyObject

'	model_has_3d_links = false
	resolve_3d = true

	For Each oSheet In cSheets

		IF oSheet.Isdetail then
			Exit for
		end if

		iActSheet = iActSheet + 1

		Set Views = oSheet.Views ' get the collection of views

'		check for 3d references
		links_found = 0

		set oActiveView = Views.ActiveView

		set oView = IBMGetBackgroundView (Views)

		Set Texts = oView.Texts	' gets the collection of texts
		lBlock = 0
		if Texts.Count > 0 Then
			For Each oText In Texts
				name = oText.Name

'				Fits text to naming convention?
				If Left(name,TBlockPrefixLen) = TBlockPrefix  Or Left(name,18) = "RevisionBlock_Text" Then
					if lBlock = 0 Then
		        		lBlock = 1
						datei.Write "cat_sheet" & "§" & oSheet.name & "§" & oView.name  & vbCrLf
						For Each o3View In Views
							if links_found = 0 then
								links_found = CATLinks (0, datei, o3View, oSheet)
							else
								links_found = CATLinks (1, datei, o3View, oSheet)
      						end if
						Next

					End If
					iTitleblockTexts = iTitleblockTexts + 1
				  '-------------------------------------------------------------------------------
				  'insert catia version info
				  '-------------------------------------------------------------------------------
  				  	if Left(name,TBlockPrefixLen+11)=TBlockPrefix & "_" & "CADSystem" then
  						datei.Write "TitleBlock_Text_CADSystem§" & sCATIAVERSION  & vbCrLf
  					end if
         		  	if Left(name,TBlockPrefixLen+11)=TBlockPrefix & "_" & "NumSheets" then
          		  		if numSheets < 10 then
  							datei.Write "TitleBlock_Text_NumSheets§" & "0" & iNonDetailSheet  & vbCrLf
  						else
  							datei.Write "TitleBlock_Text_NumSheets§" & iNonDetailSheet  & vbCrLf
  						end if
				  	else
						datei.Write substituteTB(oText.name) & "§" & IBMReplaceChar (oText.Text, vbLF, "%%") & vbCrLf
				  	end if
				End If

			Next
		End If
'		Get Dittos with modifyable texts and write these texts to the file
		if oView.Components.Count > 0 then
			for each Component in oView.Components
				if Component.GetModifiableObjectsCount( )  > 0 then
					for icomp = 1 to Component.GetModifiableObjectsCount( )
						set oVarText = Component.GetModifiableObject(icomp)
						name = oVarText.Name
						If Left(name,TBlockPrefixLen) = TBlockPrefix  Or Left(name,18) = "RevisionBlock_Text" Then
							if lBlock = 0 Then
		        				lBlock = 1
								datei.Write "cat_sheet" & "§" & oSheet.name & "§" & oView.name  & vbCrLf
							End If
						iTitleblockTexts = iTitleblockTexts + 1
						datei.Write substituteTB(oVarText.name) & "§" & IBMReplaceChar (oVarText.Text, vbLF, "%%") & vbCrLf
						End If
					next
				end if
			next
		end if

		if lBlock = 1 then
	'
	'		unstream tables, if available
	'
			streamAllTables oView, datei

			if iActSheet < 10 then
				datei.Write "TitleBlock_Text_numActSheet§" & "0" & iActSheet & vbCrLf
			else
				datei.Write "TitleBlock_Text_numActSheet§" & iActSheet & vbCrLf
			end if

			datei.Write "TitleBlock_Text_SheetScale§" & sDec2Frac(oSheet.Scale2) & vbCrLf
			datei.Write "TitleBlock_Text_CADSystem§" & sCATIAVERSION  & vbCrLf
			set oTable = getBomTableFromDrawing(Views)
			if oTable is Nothing then
				datei.Write "cat_bom_info§0" & vbCrLf
			else
				datei.Write "cat_bom_info§1" & vbCrLf
			end if
			datei.Write "cat_sheet_end" & vbCRLF
		end if

	Next

	datei.close
end sub

Function CATLinks(imode, datei, oView, oSheet) As Integer
  	CATLinks = 0
  '-------------------------------------------------------------------------------
  'How to fill in texts with data of the part/product linked with current sheet
  '-------------------------------------------------------------------------------
	if	resolve_3d then

    	On Error Resume Next

    	Dim ProductDrawn As ProductDocument

'    	on error goto 0

    	Set ProductDrawn = oView.GenerativeBehavior.Document

		name = ProductDrawn.Parent.FullName

    	If Err.Number <> 0 Then
			'check, if the user has first selected a partbody
			name = ProductDrawn.Parent.Parent.Parent.FullName
		end if

    	If Err.Number = 0 Then

			CATLinks = 1
    		if imode = 0 then
				datei.Write "cat_generative_3dmodel" & "§" & osheet.Name & "§" & oView.Name & "§" & ProductDrawn.Parent.FullName  & vbCrLf
				datei.Write "cat_generative_sheet_Number" & "§" & ProductDrawn.PartNumber  & vbCrLf
				datei.Write "cat_generative_sheet_Title" & "§" & ProductDrawn.Definition  & vbCrLf
				datei.Write "cat_generative_sheet_Revision" & "§" & ProductDrawn.Revision  & vbCrLf
				datei.Write "cat_generative_sheet_Nomenclature" & "§" & ProductDrawn.Nomenclature  & vbCrLf
				datei.Write "cat_generative_sheet_Source" & "§" & ProductDrawn.Source  & vbCrLf
				datei.Write "cat_generative_sheet_Description" & "§" & ProductDrawn.DescriptionRef  & vbCrLf

				'
				' user properties
				'
				Set UserProps = ProductDrawn.UserRefProperties
				for i=1 to UserProps.count
					wert = UserProps.item(i).value
					propName = UserProps.item(i).name & ""
					myArray=Split(propName,"\",-1,1)
					propName = myArray(2)
					datei.Write "cat_generative_sheet_UP"& propName & "§" & wert & vbCrlf
				next
				'
				' be careful for CATProducts -> That can take a while
				'

				extension = GetFileExtension(ProductDrawn.Parent.FullName)
				if check3DAnalysisData then
				   if extension = "CATProduct" then
				   		if didIAskFor3D = -999 then
	   						didIAskFor3D = MsgBox (Translate("Process analysis - Weight, Volume, WetArea (that may take a while)?"), vbYesNo)
						end if
						if didIAskFor3D = vbYes then
'	      					Dim ProductAnalysis As Analyze
			      			Set ProductAnalysis = ProductDrawn.Analyze
							datei.Write "cat_generative_sheet_Weight" & "§" & FormatNumber(ProductAnalysis.Mass,2) & vbCrLf
							datei.Write "cat_generative_sheet_Volume" & "§" & FormatNumber(ProductAnalysis.Volume,2) & vbCrlf
							datei.Write "cat_generative_sheet_WetArea" & "§" & FormatNumber(ProductAnalysis.WetArea,2) & vbCrlf
							set products = ProductDrawn.Products
							for i = 1 to products.Count
				      			Set ProductAnalysis = products.Item(i).Analyze
				      			sTemp = l_Split(products.Item(i).name,".")
								datei.Write "passthrough_generative_sheet_PartInfo" & "§" & sTemp(0) & "§" & ProductAnalysis.Mass & ";" & ProductAnalysis.Volume & ";"  & ProductAnalysis.WetArea &  vbCrLf
							next
						end if
				   else
				   			on error goto 0
'	      					Dim ProductAnalysis As Analyze
			      			Set ProductAnalysis = ProductDrawn.Analyze
							datei.Write "cat_generative_sheet_Weight" & "§" & FormatNumber(ProductAnalysis.Mass,2) & vbCrLf
							datei.Write "cat_generative_sheet_Volume" & "§" & FormatNumber(ProductAnalysis.Volume,2) & vbCrlf
							datei.Write "cat_generative_sheet_WetArea" & "§" & FormatNumber(ProductAnalysis.WetArea,2) & vbCrlf

				   end if
				end if


			else
				datei.Write "cat_generative_3dmodel" & "§" & osheet.Name & "§" & oView.Name & "§" & ProductDrawn.Parent.FullName  & vbCrLf
			end if
    	End If
    	Err.Clear
		on error goto 0
	end if


End Function


'-------------------------------------------------------------------------------
' ------------ Modify the title block entries
'-------------------------------------------------------------------------------

sub ModifyModel ()
	'  Scan the model, try to find title block entries
	'  Name of texts must be equal to names in data set
	Dim cTexts As DrawingTexts
	Dim obj as Text
	Dim oView As Object
	Dim cViews As Object
	Dim cSheets As Object
	Dim oSheet As Object
	Dim cDrawingParameters As Object
'	Dim fields (20)
	Dim sParms(100)
	Dim sTexts(100)

	CATIA.StatusBar = "Modifying frame"
	Tracer "ModifyModel", "---> entering"

	if fs.FileExists(communication_1) then
 		set data_set= fs.GetFile(communication_1)
 		set datei 	= data_set.OpenAsTextStream("ForReading")
	end if

	DrwDocument.Activate
'	Set cSheets = DrwDocument.Sheets
	Set cSheets = CATIA.ActiveDocument.Sheets

	Set cDrawingParameters = DrwDocument.Parameters


	if TD1_compliant then	' initialise td1 related control variables
		parmDirtyFlag = false
		parmMissing   = false
		errorstring   = "Entry(ies) disconnected:" & vbCrLF
		errorparms    = "Parameter(s) missing:" & vbCrLF
	end if

    Do until datei.atEndOfStream
    	   	zeile = datei.ReadLine
'			msgbox zeile
			fields = l_Split(zeile,"§")
		' separate variables
           	s_check = fields(0)

           	if s_check = "work" then
                   work = fields(1)
			elseif s_check = "cat_global_info_UnitFields" then
					temp = l_Split(Fields(1),";")
					redim UnitFields(uBound(temp))
					for i = 0 to uBound(temp)
						UnitFields(i) = temp(i)
					next
			elseif s_check = "cat_global_info_UnitSymbols" then
					temp = l_Split(Fields(1),";")
					redim UnitSymbols(uBound(temp))
					for i = 0 to uBound(temp)
						UnitSymbols(i) = temp(i)
					next
			elseif s_check = "cat_global_info_UnitDP" then
					temp = l_Split(Fields(1),";")
					redim UnitDP(uBound(temp))
					for i = 0 to uBound(temp)
						UnitDP(i) = temp(i)
					next
			elseif s_check = "cat_global_info_UnitFactor" then
					temp = l_Split(Fields(1),";")
					redim UnitFactor(uBound(temp))
					for i = 0 to uBound(temp)
						UnitFactor(i) = temp(i)
					next
			elseif s_check = "cat_global_info_UnitShow" then
					temp = l_Split(Fields(1),";")
					redim UnitShow(uBound(temp))
					for i = 0 to uBound(temp)
						UnitShow(i) = temp(i)
					next

            elseif s_check = "cat_bom_info_modify" then
            	   if fields(1) ="1" then
            	   		modifyBom = true
            	   else
            	   		modifyBom = false
            	   end if

            elseif s_check = "cat_sheet" then
                   sheet_name 	= fields(1)
                   view_name  	= fields(2)
                   iNumNames	= 0
	               Tracer "ModifyModel","sheet_name=" & sheet_name & ",view_name=" & view_name

	        elseif s_check = "passthrough_generative_sheet_PartInfo" then
	        		tempar = l_Split(fields(2),";")
	        	    productNames(iNumParts) 	= fields(1)
	        	    productWeights(iNumParts) 	= tempar(0)
	        	    productWetAreas(iNumParts) 	= tempar(1)
	        	    productVolumes(iNumParts) 	= tempar(2)
	                iNumParts = iNumParts + 1

	   		elseif s_check = "TitleBlock_Text_TData_Start" then
					For blNr = 1 to cSheets.count  			'Get the right sheet
						if cSheets.item(blNr).name = sheet_name Then
							set oSheet = cSheets.item(blNr)
							Exit For
						end if
					Next


					Set cViews = oSheet.Views
					Set oView  = IBMGetBackgroundView(cViews)

         		   tableUnStreamer oView, zeile, datei
            elseif left(s_check,13) = "cat_sheet_end" then

					For blNr = 1 to cSheets.count  			'Get the right sheet
						if cSheets.item(blNr).name = sheet_name Then
							set oSheet = cSheets.item(blNr)
							Exit For
						end if
					Next


					Set cViews = oSheet.Views
					Set oView  = IBMGetBackgroundView(cViews)
					Set cTexts = oView.Texts

					For Each obj In cTexts
						call updateText(obj,blNr,cDrawingParameters,errorstring, errorparms, parmMissing)
					Next
					if oView.Components.Count > 0 then
						for each Component in oView.Components
							if Component.GetModifiableObjectsCount( )  > 0 then
								for icomp = 1 to Component.GetModifiableObjectsCount( )
									set oVarText = Component.GetModifiableObject(icomp)
									call updateText(oVarText,blNr,cDrawingParameters,errorstring, errorparms, parmMissing)
								next
							end if
						next
					end if

					' go and modify the bom
					' ask the user first
					if modifyBom then
						modBomInDrawing oSheet
					end if

            Else
					if zeile <> "" then
           				iNumNames = iNumNames + 1
           				temp = IBMReplaceChar(fields(0), "TitleBlock_Text", TBlockPrefix)
               			sNames (iNumNames) = temp
           				sValues(iNumNames) = fields(1)
					end if
           	End If

	Loop

	datei.close

	if TD1_compliant then  ' do we have text entries, which have wrong entries
		if parmMissing then ' --> parms missing
			errorstring = errorparms & Translate("Create and reconnect Parameters?")
		elseif parmDirtyFlag then ' --> disconnected
			errorstring = errorstring & Translate("Reconnect Parameters?")
		end if
		if parmMissing or parmDirtyFlag then
			answer  = msgbox (errorstring, vbYesNo)
			if answer = vbYes then
				deleteTD1Parms
				createTD1Parms
			end if
		end if
	end if

	CATIA.StatusBar = "Modification done"
	Tracer "ModifyModel", "---> leaving"

end sub


' check, if a suitable title block is in the model

Function CATCheckRef() As Integer
	CATCheckRef = 0
  	for i = 1 to DrwTexts.Count
    		If (Left(DrwTexts.Item(i).Name,11) = "TitleBlock_") Then
    			CATCheckRef = 1
    			Exit Function
    		end if
  	next
End Function

Sub CATRemoveAll()
'	DrwSelection.Clear()			'I don't understand it
'	DrwSelection.Add(DrwGeomElems)
'	DrwSelection.Add(DrwTexts)
'  	DrwSelection.Delete

End Sub

'-------------------------------------------------------------------------------
' ------------ Get the backgroung view
'-------------------------------------------------------------------------------

Function IBMGetBackgroundView (Views as object) as object
	Dim MyPrefix as CATBSTR
	Dim MyIdent as CATBSTR
	Dim MySuffix as CATBSTR
	Dim oView    as object

	MyPrefix = "                             "
	MyIdent  = "                             "
	MySuffix = "                             "

	For Each oView In Views
		oView.GetViewName MyPrefix,MyIdent, MySuffix

		if left (MyPrefix,15) = "Background View" then
			Set IBMGetBackgroundView=oView
			Exit Function
		end if
	Next
'   Background View not found, take item(2) --> Helbling info (thanx)
    IBMGetBackgroundView = Views.Item(2)
End Function

Function IBMBackgroundViewIsEmpty (Views as object) as Integer
	set oView = IBMGetBackgroundView(Views)
	num_elems = oView.GeometricElements.Count + oView.Texts.Count
    numTexts = oView.Texts.Count
'	check, if tblock texts are available
	Set Texts = oView.Texts	' gets the collection of texts

	lTblock = false
	if Texts.Count > 0 Then
		For Each oText In Texts
			name = oText.Name
			If Left(name,TBlockPrefixLen) = TBlockPrefix  Then
				lTblock = true
			end if
		next
	end if

	if lTblock then
		IBMBackgroundViewIsEmpty = 0     ' we have TBlock entries
	else
		if num_elems = 1 then			'nur Hauptachse ist vorhanden
			IBMBackgroundViewIsEmpty = 1
		else
			iback = MsgBox (Translate("No TitleBlock texts on background view, ok to delete background"), vbOKCancel)
			if iback = vbOK then
		    	IBMBackgroundViewIsEmpty = 1
			else
				IBMBackgroundViewIsEmpty = 2   'cancelled selected
			end if

		end if
	end if
end function

Function IBMReplaceChar (in_string, char_search, char_replace)
	out = ""
	ls = len(char_search)
	for i = 1 to len(in_string)
		if mid (in_string,i,ls) = char_search then
			out = out & char_replace
			i = i + ls - 1
		else
			out = out & mid (in_string,i,1)
		end if
	next
	IBMReplaceChar = out
end function


Function IBMSplit (out_field, text,char_split)
	numfields = 0
	out = ""
	for i = 0 to 20
		out_field (i) = ""
	next
	for i = 1 to len(text)
		if mid (text,i,1) = char_split then
			out_field (numfields) = Trim(IBMReplaceChar(out,vbCr," "))
			numfields = numfields + 1
			out = ""
		else
			if i = len(text) then
			    out = out & mid (text,i,1)
				out_field (numfields) = Trim(IBMReplaceChar(out,vbCr," "))
				numfields = numfields + 1
			else
				out = out & mid (text,i,1)
			end if
		end if
	next
	IBMSplit = numfields
End Function

Function IBMGetByName (cCollection, name) as object
	for each oElem in cCollection
	    if oElem.name = name then
	       set IBMGetByName = oElem
	       exit function
	    end if
	next
end function

function getWeight(product)
	getWeight = 0
	for i = 0 to iNumParts - 1
		if productNames(i) = product then
			getWeight = productWeights(i)
		end if
	next
end function

' Thanx to Martin Röcker!
' Kill existing parameters

Sub deleteTd1Parms
  	CATIA.StatusBar = "Deleting Paramters"
  	on error resume next
  	Set cDrwParams = CATIA.ActiveDocument.Parameters
  	if err.number = 0 then
    'all Parameters defined in td1_config data set
		max_count = cDrwParams.count
		For idx = max_count to 1 step -1
			oParam = cDrwParams(idx)
      		if not oParam.readonly then
      			for i = 0 to num_td1_parms
      				if oParam.name = "Drawing\"&td1_parm_params(i) then
        				cDrwParams.remove(idx)
        				exit for
        			end if
         		next
  		    end if
    	next
  	end if
  	err.clear
'	msgbox "Delete Done"
  	on error goto 0
end sub

sub createTd1Parms()
	' Thanx to Martin Röcker!
  	CATIA.StatusBar = "Creating Parameters"

  	Set DrwDocument = CATIA.ActiveDocument
  	Set DrwSheets   = DrwDocument.Sheets
  	Set DrwParams   = CATIA.ActiveDocument.Parameters

    For blNr = 1 To CATIA.ActiveDocument.Sheets.Count
      	Set DrwSheet = DrwSheets.item(blNr)
		set oBack = IBMGetBackgroundView(DrwSheet.views)

		if blNr > 1 then	'New parameters may be available
           Set DrwParams   = CATIA.ActiveDocument.Parameters
		end if

   	   	for i = 0 to num_td1_parms - 1
       		for each oText in oBack.Texts
       			text_found = false
       			if oText.Name = td1_parm_ids(i) then
       				if oText.Text = "" then
       					oText.Text = " "
       				end if
		      		if blNr = 1 then   					'create Parameter only on sheet 1
 	       				set oParameter = DrwParams.createString(td1_parm_params(i), oText.Text)
        				if td1_parm_visible(i) = "false" then
          					oParameter.hidden = true
        				else
          					oParameter.hidden = false
        				end if
        			else
	  		        	set oParameter = DrwParams.GetItem (td1_parm_params(i))
        			end if
        			if td1_parm_sheet1(i)="false" then
    	    			oText.InsertVariable 0, len(oText.Text)+1, oParameter
    	    		end if
					text_found = true
					exit for

				end if
			next
'		Get Dittos with modifyable texts and write these texts to the file
			if oBack.Components.Count > 0 then
				for each Component in oBack.Components
					if Component.GetModifiableObjectsCount( )  > 0 then
						for icomp = 1 to Component.GetModifiableObjectsCount( )
							set oText = Component.GetModifiableObject(icomp)
			       			if oText.Name = td1_parm_ids(i) then
       							if oText.Text = "" then
       								oText.Text = " "
       							end if
		      					if blNr = 1 then   					'create Parameter only on sheet 1
 	       							set oParameter = DrwParams.createString(td1_parm_params(i), oText.Text)
        							if td1_parm_visible(i) = "false" then
          								oParameter.hidden = true
        							else
          								oParameter.hidden = false
          							end if

        						else
	  		        				set oParameter = DrwParams.GetItem (td1_parm_params(i))
        						end if
        						if td1_parm_sheet1(i)="false" then
    	    						oText.InsertVariable 0, len(oText.Text)+1, oParameter
    	    					end if
								text_found = true
								exit for
							end if
						next
					end if
				next
			end if

			if not text_found then
    	    	msgBox Translate("Field >") & td1_parm_ids(i) & Translate("< not found on sheet ") & blNr, vbInformation, Translate("Text not on Drawing")
			end if
       	next

	next

  	On Error GoTo 0

end sub
'-------------------------------------------------------------------------------
' ------------ create parameters for ST
'-------------------------------------------------------------------------------
sub createParmsIfNecessary()

	on error resume next
  	Set cDrwParams   = CATIA.ActiveDocument.Parameters
   	for i = 0 to num_td1_parms - 1
   		found = false
   		for each oParameter in cDrwParams
   			if oParameter.Name = "Drawing\"&td1_parm_params(i) then
   				found = true
   				exit for
   			end if
   		next
   		if not found then
			set oParameter = cDrwParams.createString(td1_parm_params(i), " ")
       		if td1_parm_visible(i) = "false" then
       			oParameter.hidden = true
       		else
       			oParameter.hidden = false
       		end if
       	end if
   	next

 	On Error GoTo 0

end sub

function getos()
	'Dim fields (20)
	Value = CATIA.SystemConfiguration.OperatingSystem
	'numfields = IBMSplit(fields, Value, "_")
	fields = l_Split(Value,"_")
	tracer "getos", "Value = " & Value & "fields(0):" & fields(0)
	getos = fields(0)
end function
'-------------------------------------------------------------------------------
' ------------ trace some data in case of failure
'-------------------------------------------------------------------------------
sub tracer(routine, text)
	if trace = true then
		if trace_is_init = false then
			if fs.FileExists(trace_mode) then
				fs.DeleteFile(trace_mode)
			end if
			Set trace_data_set  = fs.CreateFile(trace_mode,True)
	 		set data_trace 	    = trace_data_set.OpenAsTextStream("ForWriting")
	 		trace_is_init = true
	 		msgbox "Tracing to:" & trace_mode
'	 		Check for communication data sets
			on error resume next
			if fs.FileExists(communication_1) then
				fs.DeleteFile(communication_1)
			end if

	 		set data_set= fs.CreateFile(communication_1, True)
 			set datei 	= data_set.OpenAsTextStream("ForWriting")
			datei.write "Hello World"
			datei.close
			data_trace.write "tracer >> communication_1 error message: " & err.description & vbCrLf

			if fs.FileExists(communication_2) then
				fs.DeleteFile(communication_2)
			end if

	 		set data_set= fs.CreateFile(communication_2, True)
 			set datei 	= data_set.OpenAsTextStream("ForWriting")
			datei.write "Hello World"
			datei.close
			data_trace.write "tracer >> communication_2 error message: " & err.description & vbCrLf

			if fs.FileExists(communication_3) then
				fs.DeleteFile(communication_3)
			end if

	 		set data_set= fs.CreateFile(communication_3, True)
 			set datei 	= data_set.OpenAsTextStream("ForWriting")
			datei.write "Hello World"
			datei.close
			data_trace.write "tracer >> communication_3 error message: " & err.description & vbCrLf
			on error goto 0
		end if
	   	data_trace.write routine & ">>" & text & vbCrLf
	end if
end sub

'-------------------------------------------------------------------------------
' ------------ modify the titleblock entries and reconnect to the parameters for ST
'-------------------------------------------------------------------------------
Sub updateText (obj as object, blNr, cDrawingParameters, errorstring, errorparms, parmMissing)
	name = obj.Name
	For i = 1 to iNumNames
		If sNames(i) = name Then
			temp = sValues(i)
			sTemp = IBMReplaceChar(temp,"%%",vbLF)   'check for newlines
			if TD1_compliant then
		 		for j = 0 to num_td1_parms - 1 ' is parameter associated?
		   			if td1_parm_sheet1(j)="false" or blNr <> 1 then
				  		if obj.Name = td1_parm_ids(j) then   ' get parameter object
							found = false
				 			for each oParameter in cDrawingParameters
					   			if oParameter.Name = "Drawing\"&td1_parm_params(j) then
   									found = true
   									oParameter.ValuateFromString (sTemp) ' set Parameter Value
   									if not obj.Text = sTemp then ' mismatch of values
   										parmDirtyFlag = true
   										errorstring = errorstring & sheet_name & ":" & obj.Name & vbCrLf
										FontName = obj.GetFontName(0,0)  ' explicitely set it
										obj.SetFontName 0,0, FontName    ' happens to change
										obj.Text = sTemp
										obj.InsertVariable 0, len(sTemp)+1 , oParameter
   									end if
'  									obj.InsertVariable 0, len(obj.Text)+1, oParameter
   									exit for
								end if
							next
							if not found then ' parameter is missing
								FontName = obj.GetFontName(0,0)
								obj.SetFontName 0,0, FontName
								obj.Text = sTemp
								errorparms = errorparms & sheet_name & ":" & obj.Name & vbCrLf
						    	parmMissing = true
							end if
   						end if
					 end if
				next
   				if not found then ' edit the text anyway
					FontName = obj.GetFontName(0,0)
					obj.SetFontName 0,0, FontName
					obj.Text = sTemp
   				end if
			else
				FontName = obj.GetFontName(0,0)
				obj.SetFontName 0,0, FontName
				obj.Text = sTemp
   			end if

		End If
	Next
End Sub

Function GetFileExtension(FileName As String) As String
	'Declaration of variables.
  	Dim i As Integer
  	Dim DotPos As Integer

  	GetFileExtension = FileName
  	DotPos = 0
  	'Retrieve after the last "." .
  	For i = Len(FileName) To 1 Step -1
    	If (Mid(FileName,i,1) = ".") Then
      		DotPos = i
'	  		Print "DotPos = " + cstr(DotPos)
	  		Exit For
    	End If
  	Next
  	If (DotPos <> 0) Then
    	GetFileExtension = Mid(FileName, DotPos+1, Len(FileName)-DotPos)
'		Print "GetFileExtension = " + Mid(FileName, DotPos+1, Len(FileName)-DotPos)
  	Else
		GetFileExtension = ""
  	End If
End Function

Function sDec2Frac(f)


   lUpperPart = 1
   lLowerPart = 1

   df = lUpperPart / lLowerPart
   While (df <> f)
      If (df < f) Then
         lUpperPart = lUpperPart + 1
      Else
         lLowerPart = lLowerPart + 1
         lUpperPart = int(f * lLowerPart)
      End If
      df = lUpperPart / lLowerPart
   Wend

	sDec2Frac = CStr(lUpperPart) & ":" & CStr(lLowerPart)
End Function

'
' get a user defined bom table from the drawing
'
Function getBomTableFromDrawing(Views) as object
	got_table = false
    For Each o2View In Views
       Set cTables = o2View.Tables
       If cTables.Count > 0 Then
          For Each oTable In cTables
          	  tName = oTable.Name
              If left(tName,10) = "MyBomTable" Then
                   set getBomTableFromDrawing = oTable
                   got_table = true
              end if
          Next
       End If
       If got_table Then
           Exit For
       End If
    next
    If not got_table Then
		set getBomTableFromDrawing = Nothing
	end if
end function

Sub modBomInDrawing (activeSheet)
'	dim splitList (20) as string
'
	Tracer "bomInDrawing", "--> entering"

    set cViews = activeSheet.Views
	Dim my_product As Object
'    Set CATIA = CreateObject("CATIA.Application")
'	Bom Table in the drawing?


    got_table = False
    For Each o2View In cViews
       Set cTables = o2View.Tables
       If cTables.Count > 0 Then
          For Each oTable In cTables
          	  tName = oTable.Name
              If left(tName,10) = "MyBomTable" Then
                   got_table = True
'                   sBomInfo = Split(tName,",",-1,1)
                    'numItems = IBMSplit(splitList,tName,",")
					splitList = l_Split(tName,",")
					numItems = uBound(splitList) + 1
                   ' check type of table
'                   sTableType = sBomInfo(1)
					sTableType = splitList(1)

                   if sTableType = "OneLevel" then
                         set bomTable = oTable
                         set cBomTables = cTables
                   elseif sTableType = "AllLevels" Then
                     	set bomTable = oTable
                        set cBomTables = cTables
                   else
                   		Msgbox  Translate("Unsupported BOM Type: >") & sTableType & "< ... quitting!"
                   		Exit For
				   end if
				   bomHeaderMode = splitList(2)

'				   bomHeaderMode = sBomInfo(2)
'				   Redim sBomEntries(uBound(sBomInfo)-3)
				   Redim sBomEntries(numItems-3)

				   iColPartNumber 	= -9
				   iColWetArea		= -9
				   iColVolume		= -9
				   iColWeight		= -9
				   for i = 1 to numItems - 3
				   		sBomEntries(i-1) = splitList(2+i)
				   		stemp = l_Split(sBomEntries(i-1),":")
				   		if ubound(stemp) = 1 then
				   			sBomEntries(i-1) = stemp(0)
				   			if stemp(1) = "Part Number" then
				   				iColPartNumber = i
				   			elseif stemp(1) = "WetArea" then
							   	iColWetArea		= i
				   			elseif stemp(1) = "Volume" then
				   				iColVolume		= i
				   			elseif stemp(1) = "Weight" then
				   				iColWeight		= i
				   			end if
				   		end if
				   next
              End If
          Next
       End If
       If got_table Then
           Exit For
       End If
     Next
     if not got_table then
'     	Msgbox ("No MyBOM_Table in the drawing ... quitting!")
		Tracer "bomInDrawing", "--> no table entry found"
     	exit sub
     end if

' 	link to 3d geometry available?
    got3d = False
    For Each o3View In cViews
        If o3View.IsGenerative Then
            Set oProduct = o3View.GenerativeBehavior.Document
			Tracer "bomInDrawing", "--> " & oProduct.Parent.FullName

'            MsgBox oProduct.Name
            if GetFileExtension(oProduct.Parent.FullName) = "CATProduct" then
	            got3d = True
	            Set my_product = oProduct
	            Exit For
            end if
        End If
    Next


    If Not got3d Then
		Tracer "bomInDrawing", "--> No link to 3D model available ... quitting!"
		MsgBox  Translate( "No Link to 3D CATProduct found, BOM not regenerated")
    	exit sub
    end if

	sBomFile = sTempFolder & "/cat_title_block_bom.txt"



	oldStatusNumerOfRows = bomTable.NumberOfRows


'   get header entries from CATIA


	Set assemblyConvertor = my_product.GetItem("BillOfMaterial")
	assemblyConvertor.SetCurrentFormat sBomEntries
	assemblyConvertor.SetSecondaryFormat sBomEntries
	assemblyConvertor.Print "TXT",sBomFile,my_product

	getBom my_product.Name,sBomFile, bomTable, sTableType, bomHeaderMode, fs

	numBomProp = bomTable.NumberOfColumns

    iProd = 0

    On Error GoTo 0

	' Delete old entries
	bomTable.ComputeMode = 0

	For iRow = 1 to oldStatusNumerOfRows - 2
		if bomHeaderMode = "Top" then
	       	bomTable.RemoveRow 2
		else
			bomTable.RemoveRow bomTable.NumberOfRows - 1
		end if
	Next

	if bomHeaderMode = "Top" then
		bomTable.RemoveRow bomTable.NumberOfRows
	else
		bomTable.RemoveRow 1
	end if
	bomTable.ComputeMode = 1



End Sub



Sub getBom(sPart,sBomFile,oTable,sTableType, bomHeaderMode,fso)
	'dim splitFields(20) as string
	set f = fso.getFile(sBomFile)
	Set TextStr = f.OpenAsTextStream("ForReading")
    oTable.ComputeMode = 0

	if sTableType="AllLevels" then

		Do until TextStr.atEndOfStream
		' search part
		zeile = TextStr.ReadLine
		numEqualSigns = 0

			if (left(zeile,1) = "=") then
                do until not (left(zeile,1) = "=") or TextStr.atEndOfStream
                    numEqualSigns = numEqualSigns+1
                    zeile = TextStr.ReadLine
                loop
                if numEqualSigns = 5 then

                    zeile = TextStr.ReadLine
                    ' Header lines merken
                    zeile = TextStr.ReadLine
'                    myHeader = Split(zeile,"|",-1,1)
                    zeile = TextStr.ReadLine

                    zeile = TextStr.ReadLine
                    do until left(zeile,1) = "+" or TextStr.atEndOfStream
                    	addBomLine  oTable,zeile, bomHeaderMode
                        zeile = TextStr.ReadLine
                    loop
                    exit do
                else
                    zeile = TextStr.ReadLine
                    numEqualSigns = 0
                end if
            end if
		Loop

	end if
	if sTableType="OneLevel" then
		Do until TextStr.atEndOfStream
		' search part
		zeile = TextStr.ReadLine
            if (left(zeile,1) = "=") then
                zeile = TextStr.ReadLine
'                msgbox zeile
'                myArray = Split(zeile,":",-1,1)
'                numItems = IBMSplit(splitFields,zeile,":")
				 splitFields = l_Split(zeile,":")
				 numItems = uBound(splitFields) + 1
                temp = splitFields(1)
                sPartFound = trim(replace(temp,"=",""))

                if sPartFound = sPart then
'                    msgbox "Got it"
                    zeile = TextStr.ReadLine
                    zeile = TextStr.ReadLine
                    zeile = TextStr.ReadLine
                    ' Header lines merken
                    zeile = TextStr.ReadLine
'                    myHeader = Split(zeile,"|",-1,1)
                    zeile = TextStr.ReadLine

                    zeile = TextStr.ReadLine
                    do until left(zeile,1) = "+" or TextStr.atEndOfStream
                    	addBomLine oTable,zeile, bomHeaderMode
                        zeile = TextStr.ReadLine

                    loop
                    exit do
                else
                    zeile = TextStr.ReadLine
                    zeile = TextStr.ReadLine
                end if
            end if
	   	Loop
	end if
    oTable.ComputeMode = 1
	TextStr.Close

end sub

sub addBomLine (oTable,zeile, bomHeaderMode)
	on error goto 0
	'dim splitFields(20)
	'numItems = IBMSplit(splitFields, zeile,"|")

	splitFields = l_Split(zeile,"|")
	numItems = uBound(splitFields) + 1

	if bomHeaderMode = "Top" then
		lineToAdd = oTable.NumberOfRows
		oTable.AddRow lineToAdd
		if oTable.NumberOfRows = 3 then
			'copy the orientation etc.
		    For icol = 1 To oTable.NumberOfColumns
				oTable.SetCellString 2, icol, oTable.GetCellString(3,icol)
				oTable.SetCellAlignment 2, icol,  oTable.GetCellAlignment(3,icol)
		    Next
		end if
	else
		lineToAdd = 2
		oTable.AddRow lineToAdd
	end if

	if iColPartNumber > -1 then
		sPart = splitFields(iColPartNumber)
	else
		sPart = "????"
	end if

    For icol = 1 To oTable.NumberOfColumns
		' check if unit has to be converted
'		msgbox splitFields(3)
'		msgbox getWeight(splitFields(3))
		temp = unitChecker(sPart, icol, splitFields(icol))
       	oTable.SetCellString lineToAdd, icol, temp
    Next

End Sub

' convert the units

function unitChecker (sPartName, iColumn, sValue)
	Dim sTemp as String
	unitChecker = sValue
	sField = "dummy"
	' get field names from tabName
    if iColWeight = iColumn  then
    	sField = "Weight"
    elseif iColWetArea = iColumn  then
    	sField = "WetArea"
    elseif iColVolume = iColumn  then
    	sField = "Volume"
	end if
'	msgbox iColumn & ":" & sField
	if sField <> "dummy" then
		' get the right part
'		msgBox sPartName
		for j=0 to uBound(productNames)
			if trim(productNames(j)) = trim(sPartName) then
'				msgbox "hello"
			' get the value
				if iColumn = iColWeight then
					sWert = productWeights(j)
				elseif iColumn = iColWetArea then
					sWert = productWetAreas(j)
				elseif iColumn = iColVolume then
					sWert = productVolumes(j)
				end if
	' check, if name is in the list of unit names for conversion
                for i = 0 to uBound(UnitFields)
                    if sField = UnitFields(i) then
                        'msgbox sValue
                        'msgBox UnitFields(i)
                        'msgbox UnitFactor(i)
                        if Trim(sWert) <> "" then
                            lValue = sWert * UnitFactor(i)
                            ' if yes, calculate the new value
                            lValue = Round(lValue, CInt(UnitDP(i)))
						    sTemp = FormatNum(lValue,2)
                            if UnitShow(i) = "yes" then
                                unitChecker = sTemp & " " & UnitSymbols(i)
                            else
                                unitChecker = sTemp & ""
                            end if
                        end if
                    end if
                next
             end if
      	next
      end if

end function

sub translateInit(fs,titleblockCFG,sInstallDir)
	' read config data set
	' find language
'	dim splitFields(20)
	numTransItems = 0


	Set translateIn 		= fs.GetFile(titleblockCFG)
	set translateInStream 	= translateIn.OpenAsTextStream("ForReading")
	lang = "No Translation"
   	Do until translateInStream.atEndOfStream
	   line = translateInStream.ReadLine
	   line = Trim(line)
	   if left(line,12) = "set language" then		' Pattern: set language "de"
			'numItems = IBMSplit(splitFields, line,chr(34))
			splitFields = l_Split(line,chr(34))
			numItems = uBound(splitFields) + 1
	   		lang = splitFields(1)
	   end if
	loop
	translateInStream.close


	if lang <> "No translation" then
		'check, if file exists
		msgFile = sInstallDir & "/config/" & lang & "/messages.cfg"
		if fs.FileExists(msgFile) then
			' open  language data set
			' fill translate array

			Set translateIn 		= fs.GetFile(msgFile)
			set translateInStream 	= translateIn.OpenAsTextStream("ForReading")
		   	Do until translateInStream.atEndOfStream
				line = translateInStream.ReadLine
				if line <> "" and left(line,1) <> "#" then
					numTransItems = numTransItems + 1
				end if
			loop

			redim myTranslateStringsIn(numTransItems)
			redim myTranslateStringsOut(numTransItems)
			translateInStream.close

			Set translateIn 		= fs.GetFile(msgFile)
			set translateInStream 	= translateIn.OpenAsTextStream("ForReading")

	   	   	numTransItems = 0
		   	Do until translateInStream.atEndOfStream
		   	   	line = translateInStream.ReadLine
				if line <> "" and left(line,1) <> "#" then
					numTransItems = numTransItems + 1
					'numItems = IBMSplit(splitFields, line,"=")
					splitFields = l_Split(line,"=")
					myTranslateStringsIn(numTransItems)  = Trim(splitFields(0))
					myTranslateStringsOut(numTransItems) = Trim(splitFields(1))
				end if
			loop
		end if
	end if
	translateInStream.close
End Sub

function translate(stringIn)
	'check if translate string is available, tranlate it or leave it as is
	' on unix no dictionary available, so we have to use arrays
	translate = stringIn
	for i = 1 to numTransItems
		if myTranslateStringsIn(i) = stringIn then
			translate = myTranslateStringsOut(i)
			exit function
		end if
	next
end function

function substituteTB (stringin)
	substituteTB = IBMReplaceChar (stringin,  TBlockPrefix,"TitleBlock_Text")
end function

function docIsDrawing (oDoc) as boolean
	on error resume next
	Set DrwSheets   	= oDoc.Sheets
    if err.number = 0 then
		docIsDrawing = true
	else
		docIsDrawing = false
	end if
	on error goto 0
end function

'check for tables with TBlockPrefix at the beginning

sub streamAllTables(oView, oStream)
    Set cTables = oView.Tables
    If cTables.Count > 0 Then
        For Each oTable In cTables
          tName = oTable.Name
          If Left(tName,TBlockPrefixLen)=TBlockPrefix Then
               tableStreamer oTable, oStream
          end if
        Next
    End If
end sub

' write the content of a table to the intermediate file

sub tableStreamer(oTable, oStream)
	' TitleBlock_Text_TData_Start_tabName
	' TitleBlock_Text_TData_;;data , delimeter ;;
	' TitleBlock_Text_TData_End_tabName
	oStream.Write "TitleBlock_Text_TData_Start" & "§" & oTable.name & vbCrLf
    For irow = 1 To oTable.NumberOfRows
    	line = ""
	    For icol = 1 To oTable.NumberOfColumns
    	   	line = line & ";" & oTable.getCellString(irow, icol)
    	Next
		oStream.Write "TitleBlock_Text_TData_Data" & "§" & line & vbCrLf
    next
	oStream.Write "TitleBlock_Text_TData_End" & "§" & oTable.name & vbCrLf
end sub

sub tableUnStreamer(oView, tabStartString, oStream)
	'dim splitFields(20) as string
	numadded = 0
	' find table

    Set cTables = oView.Tables
    If cTables.Count > 0 Then
        For Each oTable In cTables
          tName = oTable.Name
		  oTable.ComputeMode = 0
		  sTest = "TitleBlock_Text_TData_Start§" & tname
          If sTest = tabStartString Then
				' add lines to bottom
		      set oTabFound = oTable
    	   	  line = oStream.ReadLine
			  sTest = "TitleBlock_Text_TData_End§" & tname
              Do until line = sTest
				 oTabFound.AddRow oTabFound.NumberOfRows
				 numadded = numadded +1

    	   	  	 'numsplit = IBMSplit(splitFields,line,";")
				 splitFields = l_Split(line,";")
    			 For icol = 1 To oTable.NumberOfColumns
       			     oTabFound.SetCellString oTabFound.NumberOfRows-1, icol, splitFields(icol)
    		     Next
    	   	  	 line = oStream.ReadLine

              loop
          end if
        Next
    End If

	' delete last line and top lines

	For iRow = 1 to numadded - 1
       	oTabFound.RemoveRow 1
	Next
	oTabFound.RemoveRow oTabFound.NumberOfRows
    oTabFound.ComputeMode = 1

end sub

Function l_Split(FlatText As String, Delimiter As String) As Variant
	'This function behaves like the javascript split function or the Notes Formula @Explode function. It takes a delimited string and
	'returns an array of all the elements in the string. The Delimiter parameter should be only one character long. (I haven't tested with more).
	'Stan Dyck 4/15/98

	Redim DelimArray(0) As Integer 'records the positions of all the delimiters in the string
	Dim i As Integer
	Dim intNextDelim As Integer

	i = 0
	DelimArray(0) = 0
	Do
		intNextDelim = Instr(DelimArray(i) + 1, FlatText, Delimiter)
		If intNextDelim = 0 Then Exit Do
		i = i + 1
		Redim Preserve DelimArray(i)
		DelimArray(i) = intNextDelim
	Loop

	Redim tmpSplit(0) As String
	If Ubound(DelimArray) = 0 Then
		tmpSplit(0) = Mid(FlatText, (DelimArray(0) + 1))
	Else
		tmpSplit(0) = Mid(FlatText, DelimArray(0) + 1, DelimArray(1) - 1)
	End If
	If Ubound(DelimArray) > 0 Then
		For i = 1 To Ubound(DelimArray)
			Redim Preserve tmpSplit(i)
			If i <> Ubound(DelimArray) Then
				tmpSplit(i) = Mid(FlatText, DelimArray(i) + 1, (DelimArray(i+1) - DelimArray(i)) - 1)
			Else
				tmpSplit(i) = Mid(FlatText, DelimArray(i) + 1)
			End If
		Next
	End If
	l_Split = tmpSplit
End Function

function isComment(line) as boolean
	isComment = false
	if mid(line,1,1) = "'" then
		isComment = true
	elseif mid(line,1,1) = "#" then
		isComment = true
	elseif Trim(line) ="" then
		isComment = true
	end if
end function

Function Round(nValue As Double, nDigits As Integer) As Double
    Round = Int(nValue * (10 ^ nDigits) + _
    0.5) / (10 ^ nDigits)
End Function

Function FormatNum(value,decPl) as String
		if not os = "intel" then
		 	FormatNum = Format(value, "0." & String(decPL, "#"))
		else
			FormatNum = FormatNumber(value,decPL)
		end if
End Function