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
' Reg. Settings: English (United States)
' ****************************************************************************
'**************************************************************************
' PROGRAM: Text_block
'**************************************************************************
'                        IBM Product Lifecyle Management Solutions
'                        Engineering e-Business
'
' (C) COPYRIGHT International Business Machines Corp. 2002
'**************************************************************************
'                	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
'
'
'
'**********************************************************************************


'-------------------------------------------------- change path for your installation ----------
os = getos()

if os = "windows" then
	sInstallDir = "C:\titleblock\v2.4.14"
else
	sInstallDir = "/usr/DassaultSystemes/TBlock/v2.4.14"
	Wish_Command = "/usr/local/bin/wish8.3"
end if

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

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 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 CALL_GUI_Mode		as string
public numComponents		as integer
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


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

Sub CATMain()
	if instr(sInstallDir," ") > 0 then
		msgbox "The install path must not contain blanks, exiting"
		exit sub
	end if
	IBMinit
	if IBMBackgroundViewIsEmpty(DrwViews) 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
		iback = MsgBox ("No Title Block entries found in sheet, ok to delete background", vbOKCancel)
		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
			msgbox "hello"

		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 "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
	if is_init = "initialised" then
	else
		trace_is_init = false

		is_init = "initialised"
		set fs = CATIA.FileSystem

		if os = "windows" then
			set fso = CreateObject("Scripting.FileSystemObject")
			sTempFolder = fso.GetSpecialFolder(2)
'			set fso = nothing
		else
			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"

		if os = "windows" then
			wish = sInstallDir & "\bin\MyTextblock.exe "
		else
			wish = Wish_Command & " -f " & sInstallDir & "/bin/my_textblock_entry.tcl "
		end if

		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"

		if not os = "windows" 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 , "\","/")
		end if



		If os = "windows" then
			if Not fs.FileExists(wish) Then
				MsgBox "Command >" & wish & "< not found, check sInstallDir in IBMTextblock.CATScript"
			end if
		else
			if Not fs.FileExists(Wish_Command) Then
				MsgBox "Command not found, check Wish_Command in IBMTextblock.CATScript"
			end if
		end if


		' read basic info
		Set basics_in 		= fs.GetFile(basics_config)
	 	set basics_stream 	= basics_in.OpenAsTextStream("ForReading")
   		Do until basics_stream.atEndOfStream
   		   zeile = basics_stream.ReadLine
  	   		if not mid(zeile,1,1) = "'" then
       			num_fields = IBMSplit(fields,zeile, "=")
       			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
       			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


'		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 mid(zeile,1,1) = "'" then
           			num_fields = IBMSplit(fields,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


		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 = "windows" 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
		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 "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.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 ()
'   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)
	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")

	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
	For Each oSheet In cSheets

		IF oSheet.Isdetail then
			Exit for
		end if

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

'		check for 3d references
		links_found = 0
		For Each oView In Views
			if links_found = 0 then
				links_found = CATLinks (0, datei, oView, oSheet)
			else
				links_found = CATLinks (1, datei, oView, oSheet)
      		end if
		Next

		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,15) = "TitleBlock_Text"  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
				  '-------------------------------------------------------------------------------
				  'insert catia version info
				  '-------------------------------------------------------------------------------
  				  	if Left(name,25)="TitleBlock_Text_CADSystem" then
  						datei.Write "TitleBlock_Text_CADSystem§" & sCATIAVERSION  & vbCrLf
				  	else
						datei.Write 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,15) = "TitleBlock_Text"  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 oVarText.name & "§" & IBMReplaceChar (oVarText.Text, vbLF, "%%") & vbCrLf
						End If
					next
				end if
			next
		end if
		if lBlock = 1 then
			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
  '-------------------------------------------------------------------------------
    	On Error Resume Next
    	Dim ProductDrawn As ProductDocument
    	Set ProductDrawn = oView.GenerativeBehavior.Document

    	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

      			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
			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 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
           	num_fields = IBMSplit(fields,zeile, "§")
           	' separate variables
           	s_check = fields(0)

           	if s_check = "work" then
                   work = fields(1)

            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 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


            Else
           			iNumNames = iNumNames + 1
               		sNames (iNumNames) = fields(0)
           			sValues(iNumNames) = fields(1)
           	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 & "Create and reconnect Parameters?"
		elseif parmDirtyFlag then ' --> disconnected
			errorstring = errorstring & "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 Boolean
	num_elems = IBMGetBackgroundView(Views).GeometricElements.Count + IBMGetBackgroundView(Views).Texts.Count
	if num_elems = 1 then			'Hauptachse ist vorhanden
		IBMBackgroundViewIsEmpty = True
	else
		IBMBackgroundViewIsEmpty = False
	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

Sub deleteTd1Parms
' Thanx to Martin Röcker!
' Kill existing parameters
  	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 "Field >" & td1_parm_ids(i) & "< not found on sheet " & blNr, vbInformation, "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()
	Value = CATIA.SystemService.Environ("OS") ' auf unix
	if Value = "" Then  ' falls nicht dann auf windows:
		Value =  CATIA.SystemService.Environ("OS_TYPE")
	end if
	if left(Value,7) = "Windows" then
		getos = "windows"
	else
		getos = "unix"
	end if
	tracer "getos", "Value = " & Value
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