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


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

if os = "windows" then
        sInstallDir = "C:\catia\sct\fdec\site\all\makros\TextBlock\v2.4.10"
else
        sInstallDir = "/catpro/CATScripts/TextBlock/v2.4.10"
        Wish_Command = "/usr/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(820)                 As String
Public sNames (820)                 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        (820)
public td1_parm_ids                (820)
public td1_parm_visible        (820)
public td1_parm_sheet1        (820)
public TD1_compliant                as boolean
public CALL_GUI_Mode                as string

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

Sub CATMain()
        IBMinit

        if work = "cancel" Then  ' Abbrechen wenn z.B. keine Drawing aktiv
           Exit Sub
        End If

        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
                        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
                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(130)
        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 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) =        "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


'                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

                On Error Resume Next
                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
                If (Err.Number <> 0) Then
                    MsgBox "Sie müssen ein CATDrawing aktiv haben um diese Aktion durchzuführen."
                    work = "cancel"
                    Exit Sub
                End If
                On Error Goto 0

        end if

        On Error Resume Next
        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
        If (Err.Number <> 0) Then
                    MsgBox "Sie müssen ein CATDrawing aktiv haben um diese Aktion durchzuführen."
                    work = "cancel"
                    Exit Sub
        End If
        On Error Goto 0
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

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

        set model = CATIA.Documents.Open(CatiaFileName)

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

    DrwSheet.PaperSize   = FromDrwSheet.PaperSize                                'get setup info and copy
        if FromDrwSheet.Papersize = CatPaperUser then
                DrwSheet.SetPaperHeight(FromDrwSheet.GetPaperHeight())
                DrwSheet.SetPaperWidth (FromDrwSheet.GetPaperWidth())
        end if
'        Keep the scale of the current drawing (Thanx Martin)
'        DrwSheet.Scale2      = FromDrwSheet.Scale2
        DrwSheet.Orientation = FromDrwSheet.Orientation

         FromDrwSelection.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 (130)
          On Error Resume Next

        On Error goto 0

'        Get the active sheet
        Set oSheet = CATIA.ActiveDocument.Sheets.ActiveSheet
        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

        iTitleblockTexts = 0

'        Get all sheets

        For Each oSheet In cSheets

                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
                                        datei.Write oText.name & "§" & IBMReplaceChar (oText.Text, vbLF, "%%") & vbCrLf
                                End If

                        Next
                End If

        Next
        datei.Write "cat_sheet_end" & vbCRLF

        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 (130)
        Dim sParms(820)
        Dim sTexts(820)

        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

        Set cSheets = DrwDocument.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 cTexts = IBMGetBackgroundView(cViews).Texts

                                        For Each obj In cTexts
                                                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(i)="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
                                                                                                                   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
                                        Next

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

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

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
