Adaptation macro cartouche

Bonjour à tous,

j'aurais besoin d'aide d'expert pour modifier une macro catia.
Pour mon travail, je voulais adapter un des cartouches proposé par défaut dans catia v5. Et ce afin de ne pas a avoir a enregistrer un fichier drawing "type" que je dois ressortir à chaque fois que je fais une mise en plan.
Dans un premier temps, j'ai modifié les textes qui étaient en anglais (ex: checked by -> vérifier par...)
Tout fonctionne sauf que maintenant lorsque j'utilise ce cartouche, les actions sont en anglais. Comment faire pour revenir a une interface en français?


Après j'aurais deux autres questions:
- comment ajouter le logo de l'entreprise à gauche du nom de la société?


- comment ajouter un block de texte dans le coin inférieur gauche de la feuille avec les infos suivantes:


-MATIÈRE ET CARACTÉRISTIQUES:
TRAITÉ POUR:
-COTES NON TOLÉRANCES: ISO 2768, m-k
-ÉTATS DE SURFACE NON SPÉCIFIÉS: Ra<3.2
-TRAITEMENT-PROTECTION DE SURFACE:
-ARÊTES VIVES: CH 0.5 x 45°

Code:

'COPYRIGHT DASSAULT SYSTEMES 2001

' ****************************************************************************
' Purpose:       To draw a Frame and TitleBlock
'
' Assumptions:   A Drafting document should be active
'
' Author:        GDG\DU\PYW
' Languages:     VBScript
' Version:       V5R18
' Reg. Settings: English (United States)
' ****************************************************************************
Public ActiveDoc     As Document
Public Sheets
Public Sheet
Public Views
Public View
Public Texts         As DrawingTexts
Public Text          As DrawingText
Public Fact          As Factory2D
Public Selection     As Selection

Function Col(idx As Integer) As Variant
  Col = Array(-190, -145, -125, -110, -95, -50, -30, -15)(idx - 1)
End Function

Function Row(idx As Integer) As Variant
  Row = Array(10, 12, 24, 36, 40, 60)(idx - 1)
End Function

Function GetRulerLength() As Double
  GetRulerLength = 200#
End Function

Function GetMacroID() As String
  GetMacroID = "Drawing_Ateliers_Serres"
End Function

Function GetNbOfRevision() As Integer
  GetNbOfRevision = 9
End Function

Function GetRevRowHeight() As Double
  GetRevRowHeight = 10#
End Function

Function GetDisplayFormat() As String
  GetDisplayFormat = Array("Letter", "Legal", "A0", "A1", "A2", "A3", "A4", "A", "B", "C", "D", "E", "F", "User")(Sheet.PaperSize)
End Function

Function GetOffset() As Double
  If Sheet.PaperSize = CatPaperA0 Or Sheet.PaperSize = CatPaperA1 Or (Sheet.PaperSize = CatPaperUser And (GetWidth() > 594# Or GetHeight() > 594#)) Then
    GetOffset = 20#
  Else
    GetOffset = 10#
  End If
End Function

Function GetWidth() As Double
  Select Case TypeName(Sheet)
    Case "DrawingSheet": GetWidth = Sheet.GetPaperWidth
    Case "Layout2DSheet": GetWidth = Sheet.PaperWidth
  End Select
End Function
  
Function GetHeight() As Double
  Select Case TypeName(Sheet)
    Case "DrawingSheet": GetHeight = Sheet.GetPaperHeight
    Case "Layout2DSheet": GetHeight = Sheet.PaperHeight
  End Select
End Function
  
Function GetOH() As Double
  GetOH = GetWidth() - GetOffset()
End Function

Function GetOV() As Double
  GetOV = GetOffset()
End Function

Function GetColRev(index As Integer)
  GetColRev = Array(-190, -175, -140, -20)(index - 1)
End Function

Function GetRevLetter(index As Integer)
   GetRevLetter = Chr(Asc("A") + index - 1)
End Function

Function CreateLine(iX1 As Double, iY1 As Double, iX2 As Double, iY2 As Double, iName As String) As Curve2D
  '-------------------------------------------------------------------------------
  ' Creates a sketcher lines thanks to the current 2D factory set to the global variable Fact
  ' The created line is reneamed to the given iName
  ' Start point  and End point are created and renamed iName&"_start", iName&"_end"
  '-------------------------------------------------------------------------------
  Set CreateLine = Fact.CreateLine(iX1, iY1, iX2, iY2)
  CreateLine.Name = iName
  Set Point = CreateLine.StartPoint 'Create the start point
  point.Name = iName&"_start"
  Set Point = CreateLine.EndPoint 'Create the start point
  point.Name = iName&"_end"
End Function

Function CreateText(iCaption As String, iX As Double, iY As Double, iName As String) As DrawingText
  '-------------------------------------------------------------------------------
  'How to create a text
  '-------------------------------------------------------------------------------
  Set CreateText = Texts.Add(iCaption, iX, iY)
  CreateText.Name = iName
  CreateText.AnchorPosition = catMiddleCenter
End Function

Function CreateTextAF(iCaption As String, iX As Double, iY As Double, iName As String, iAnchorPosition As CatTextAnchorPosition, iFontSize As Double) As DrawingText
  '-------------------------------------------------------------------------------
  'How to create a text
  '-------------------------------------------------------------------------------
  Set CreateTextAF = Texts.Add(iCaption, iX, iY)
  CreateTextAF.Name = iName
  CreateTextAF.AnchorPosition = iAnchorPosition
  CreateTextAF.SetFontSize 0, 0, iFontSize
End Function

Sub SelectAll(iQuery As String)
  Selection.Clear
  Selection.Add (View)
  'MsgBox iQuery
  Selection.Search iQuery&",sel"
End Sub

Sub DeleteAll(iQuery As String)
  '-------------------------------------------------------------------------------
  'Delete all elements  matching the query string iQuery
  'Pay attention no to provide a localized query string.
  '-------------------------------------------------------------------------------
  Selection.Clear
  Selection.Add (View)
  'MsgBox iQuery
  Selection.Search iQuery&",sel"
  ' Avoid Delete failure in case of an empty query result
  If Selection.Count2 <> 0 Then Selection.Delete
End Sub

Sub CATMain()
  If Not CATInit(targetSheet) Then Exit Sub
  On Error Resume Next
    Name = Texts.GetItem("Reference_" + GetMacroID()).Name
  If Err.Number <> 0 Then
    Err.Clear
    Name = "none"
  End If
  On Error GoTo 0
  If (Name = "none") Then
    CATDrw_Creation
  Else
    CATDrw_Resizing
    CATDrw_Update
  End If
  CATExit
End Sub

Sub CATDrw_Creation(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to create the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(1) Then Exit Sub 'To check whether a FTB exists already in the sheet
  CATCreateReference          'To place on the drawing a reference point
  CATFrame      'To draw the frame
  CATCreateTitleBlockFrame    'To draw the geometry
  CATTitleBlockText     'To fill in the title block
  CATColorGeometry 'To change the geometry color
  CATExit targetSheet      'To save the sketch edition
End Sub

Sub CATDrw_Deletion(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to delete the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  DeleteAll "..Name=Frame_*"
  DeleteAll "..Name=TitleBlock_*"
  DeleteAll "..Name=RevisionBlock_*"
  DeleteAll "..Name=Reference_*"
  CATExit targetSheet
End Sub

Sub CATDrw_Resizing(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to resize the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  Dim TbTranslation(2)
  ComputeTitleBlockTranslation TbTranslation
  Dim RbTranslation(2)
  ComputeRevisionBlockTranslation RbTranslation
  If TbTranslation(0) <> 0 Or TbTranslation(1) <> 0 Then
    ' Redraw Sheet Frame
    DeleteAll "CATDrwSearch.DrwText.Name=Frame_Text_*"
    DeleteAll "CATDrwSearch.2DGeometry.Name=Frame_*"
    CATFrame
    
    ' Redraw Title Block Frame
    CATDeleteTitleBlockFrame
    CATCreateTitleBlockFrame
    CATMoveTitleBlockText TbTranslation
    ' Redraw revision block
    CATDeleteRevisionBlockFrame
    CATCreateRevisionBlockFrame
    CATMoveRevisionBlockText RbTranslation
    
    ' Move the views
    CATColorGeometry
    CATMoveViews TbTranslation
    CATLinks
    
  End If
  CATExit targetSheet
End Sub

Sub CATDrw_Update(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to update the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  CATLinks
  CATColorGeometry
  CATExit targetSheet

End Sub

Function GetContext()
  ' Find execution context
  Select Case TypeName(Sheet)
    Case "DrawingSheet"
      Select Case TypeName(ActiveDoc)
        Case "DrawingDocument": GetContext = "DRW"
        Case "ProductDocument": GetContext = "SCH"
        Case Else: GetContext = "Unexpected"
      End Select
      
    Case "Layout2DSheet": GetContext = "LAY"
    Case Else: GetContext = "Unexpected"
  End Select
End Function

Sub CATDrw_CheckedBy(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to update a bit more the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  CATFillField "TitleBlock_Text_Check_1", "TitleBlock_Text_CDate_1", "checked"
  CATExit targetSheet
End Sub

Sub CATDrw_AddRevisionBlock(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to create or modify a revison block
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  
  CATAddRevisionBlockText 'To fill in the title block
  CATDeleteRevisionBlockFrame
  CATCreateRevisionBlockFrame 'To draw the geometry
    
  CATColorGeometry
  CATExit targetSheet
End Sub

Function CATInit(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to init the dialog and create main objects
  '-------------------------------------------------------------------------------
  Set Selection = CATIA.ActiveDocument.Selection
  Set Sheet = targetSheet
  Set Sheets = Sheet.Parent
  Set ActiveDoc = Sheets.Parent
  Set Views = Sheet.Views
  Set View = Views.Item(2)        'Get the background view
  Set Texts = View.Texts
  Set Fact = View.Factory2D
  
  If GetContext() = "Unexpected" Then
      Msg = "The macro runs in an inappropriate environment." & Chr(13) & "The script will terminate wihtout finishing the current action."
      Title = "Unexpected environement error"
      MsgBox Msg, 16, Title
    CATInit = False 'Exit with error
      Exit Function
  End If

  Selection.Clear
  CATIA.HSOSynchronized = False

  'Exit without error
  CATInit = True 'Exit without error
End Function

Sub CATExit(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to restore the document working mode
  '-------------------------------------------------------------------------------
  Selection.Clear
  CATIA.HSOSynchronized = True

  View.SaveEdition
End Sub


Sub CATCreateReference()
  '-------------------------------------------------------------------------------
  'How to create a reference text
  '-------------------------------------------------------------------------------
  Set Text = Texts.Add("", GetWidth() - GetOffset(), GetOffset())
  Text.Name = "Reference_" + GetMacroID
End Sub

Function CATCheckRef(Mode As Integer) As Integer
  '-------------------------------------------------------------------------------
  'How to check that the called macro is the right one
  '-------------------------------------------------------------------------------
  nbTexts = Texts.Count
  i = 0
  notFound = 0
  While (notFound = 0 And i < nbTexts)
    i = i + 1
    Set Text = Texts.Item(i)
    WholeName = Text.Name
    leftText = Left(WholeName, 10)
    If (leftText = "Reference_") Then
      notFound = 1
      refText = "Reference_" + GetMacroID()
      If (Mode = 1) Then
        MsgBox "Frame and Titleblock already created!"
        CATCheckRef = 1
        Exit Function
      ElseIf (Text.Name <> refText) Then
        MsgBox "Frame and Titleblock created using another style:" + Chr(10) + "        " + GetMacroID()
        CATCheckRef = 1
        Exit Function
      Else
        CATCheckRef = 0
        Exit Function
      End If
    End If
  Wend

  If Mode = 1 Then
    CATCheckRef = 0
  Else
    MsgBox "No Frame and Titleblock!"
    CATCheckRef = 1
  End If

End Function

Function CATCheckRev() As Integer
  '-------------------------------------------------------------------------------
  'How to check that a revision block alredy exists
  '-------------------------------------------------------------------------------
  SelectAll "CATDrwSearch.DrwText.Name=RevisionBlock_Text_Rev_*"
  CATCheckRev = Selection.Count2
End Function

Sub CATFrame()
  '-------------------------------------------------------------------------------
  'How to create the Frame
  '-------------------------------------------------------------------------------
  Dim Cst_1   As Double  'Length (in cm) between 2 horinzontal marks
  Dim Cst_2   As Double  'Length (in cm) between 2 vertical marks
  Dim Nb_CM_H As Integer 'Number/2 of horizontal centring marks
  Dim Nb_CM_V As Integer 'Number/2 of vertical centring marks
  Dim Ruler   As Integer 'Ruler length (in cm)

  CATFrameStandard Nb_CM_H, Nb_CM_V, Ruler, Cst_1, Cst_2
  CATFrameBorder
  CATFrameCentringMark Nb_CM_H, Nb_CM_V, Ruler, Cst_1, Cst_2
  CATFrameText Nb_CM_H, Nb_CM_V, Ruler, Cst_1, Cst_2
  CATFrameRuler Ruler, Cst_1
End Sub

Sub CATFrameStandard(Nb_CM_H As Integer, Nb_CM_V As Integer, Ruler As Integer, Cst_1 As Double, Cst_2 As Double)
  '-------------------------------------------------------------------------------
  'How to compute standard values
  '-------------------------------------------------------------------------------
  Cst_1 = 74.2 '297, 594, 1189 are multiples of 74.2
  Cst_2 = 52.5 '210, 420, 841  are multiples of 52.2

  If Sheet.Orientation = CatPaperPortrait And _
     (Sheet.PaperSize = CatPaperA0 Or _
      Sheet.PaperSize = CatPaperA2 Or _
      Sheet.PaperSize = CatPaperA4) Or _
      Sheet.Orientation = CatPaperLandscape And _
     (Sheet.PaperSize = CatPaperA1 Or _
      Sheet.PaperSize = CatPaperA3) Then
    Cst_1 = 52.5
    Cst_2 = 74.2
  End If

  Nb_CM_H = CInt(0.5 * GetWidth() / Cst_1)
  Nb_CM_V = CInt(0.5 * GetHeight() / Cst_2)
  Ruler = CInt((Nb_CM_H - 1) * Cst_1 / 50) * 100   'here is computed the maximum ruler length
  If GetRulerLength() < Ruler Then Ruler = GetRulerLength()
End Sub

Sub CATFrameBorder()
  '-------------------------------------------------------------------------------
  'How to draw the frame border
  '-------------------------------------------------------------------------------
  On Error Resume Next
    CreateLine GetOV(), GetOV(), GetOH(), GetOV(), "Frame_Border_Bottom"
    CreateLine GetOH(), GetOV(), GetOH(), GetHeight() - GetOffset(), "Frame_Border_Left"
    CreateLine GetOH(), GetHeight() - GetOffset(), GetOV(), GetHeight() - GetOffset(), "Frame_Border_Top"
    CreateLine GetOV(), GetHeight() - GetOffset(), GetOV(), GetOV(), "Frame_Border_Right"
    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub

Sub CATFrameCentringMark(Nb_CM_H As Integer, Nb_CM_V As Integer, Ruler As Integer, Cst_1 As Double, Cst_2 As Double)
  '-------------------------------------------------------------------------------
  'How to draw the centring marks
  '-------------------------------------------------------------------------------
  On Error Resume Next
    CreateLine 0.5 * GetWidth(), GetHeight() - GetOffset(), 0.5 * GetWidth(), GetHeight(), "Frame_CentringMark_Top"
    CreateLine 0.5 * GetWidth(), GetOV(), 0.5 * GetWidth(), 0#, "Frame_CentringMark_Bottom"
    CreateLine GetOV(), 0.5 * GetHeight(), 0#, 0.5 * GetHeight(), "Frame_CentringMark_Left"
    CreateLine GetWidth() - GetOffset(), 0.5 * GetHeight(), GetWidth(), 0.5 * GetHeight(), "Frame_CentringMark_Right"
    For i = Nb_CM_H To Ruler / 2 / Cst_1 Step -1
      If (i * Cst_1 < 0.5 * GetWidth() - 1#) Then
        x = 0.5 * GetWidth() + i * Cst_1
        CreateLine x, GetOV(), x, 0.25 * GetOffset(), "Frame_CentringMark_Bottom_" & Int(x)
        x = 0.5 * GetWidth() - i * Cst_1
        CreateLine x, GetOV(), x, 0.25 * GetOffset(), "Frame_CentringMark_Bottom_" & Int(x)
      End If
    Next
    For i = 1 To Nb_CM_H
      If (i * Cst_1 < 0.5 * GetWidth() - 1#) Then
        x = 0.5 * GetWidth() + i * Cst_1
        CreateLine x, GetHeight() - GetOffset(), x, GetHeight() - 0.25 * GetOffset(), "Frame_CentringMark_Top_" & Int(x)
        x = 0.5 * GetWidth() - i * Cst_1
        CreateLine x, GetHeight() - GetOffset(), x, GetHeight() - 0.25 * GetOffset(), "Frame_CentringMark_Top_" & Int(x)
      End If
    Next

    For i = 1 To Nb_CM_V
      If (i * Cst_2 < 0.5 * GetHeight() - 1#) Then
        y = 0.5 * GetHeight() + i * Cst_2
        CreateLine GetOV(), y, 0.25 * GetOffset(), y, "Frame_CentringMark_Left_" & Int(y)
        CreateLine GetOH(), y, GetWidth() - 0.25 * GetOffset(), y, "Frame_CentringMark_Right_" & Int(y)
        y = 0.5 * GetHeight() - i * Cst_2
        CreateLine GetOV(), y, 0.25 * GetOffset(), y, "Frame_CentringMark_Left_" & Int(y)
        CreateLine GetOH(), y, GetWidth() - 0.25 * GetOffset(), y, "Frame_CentringMark_Right_" & Int(y)
      End If
    Next
    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub

Sub CATFrameText(Nb_CM_H As Integer, Nb_CM_V As Integer, Ruler As Integer, Cst_1 As Double, Cst_2 As Double)
  '-------------------------------------------------------------------------------
  'How to create coordinates
  '-------------------------------------------------------------------------------
  On Error Resume Next

    For i = Nb_CM_H To (Ruler / 2 / Cst_1 + 1) Step -1
      CreateText Chr(65 + Nb_CM_H - i), 0.5 * GetWidth() + (i - 0.5) * Cst_1, 0.5 * GetOffset(), "Frame_Text_Bottom_1_" & Chr(65 + Nb_CM_H - i)
      CreateText Chr(64 + Nb_CM_H + i), 0.5 * GetWidth() - (i - 0.5) * Cst_1, 0.5 * GetOffset(), "Frame_Text_Bottom_2_" & Chr(65 + Nb_CM_H + i)
    Next
  
    For i = 1 To Nb_CM_H
      t = Chr(65 + Nb_CM_H - i)
      CreateText(t, 0.5 * GetWidth() + (i - 0.5) * Cst_1, GetHeight() - 0.5 * GetOffset(), "Frame_Text_Top_1_" & t).Angle = -90
      t = Chr(64 + Nb_CM_H + i)
      CreateText(t, 0.5 * GetWidth() - (i - 0.5) * Cst_1, GetHeight() - 0.5 * GetOffset(), "Frame_Text_Top_2_" & t).Angle = -90
    Next

    For i = 1 To Nb_CM_V
      t = CStr(Nb_CM_V + i)
      CreateText t, GetWidth() - 0.5 * GetOffset(), 0.5 * GetHeight() + (i - 0.5) * Cst_2, "Frame_Text_Right_1_" & t
      CreateText(t, 0.5 * GetOffset(), 0.5 * GetHeight() + (i - 0.5) * Cst_2, "Frame_Text_Left_1_" & t).Angle = -90
      
      t = CStr(Nb_CM_V - i + 1)
      CreateText t, GetWidth() - 0.5 * GetOffset(), 0.5 * GetHeight() - (i - 0.5) * Cst_2, "Frame_Text_Right_1_" & t
      CreateText(t, 0.5 * GetOffset(), 0.5 * GetHeight() - (i - 0.5) * Cst_2, "Frame_Text_Left_2" & t).Angle = -90
    Next

    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub

Sub CATFrameRuler(Ruler As Integer, Cst_1 As Single)
  '-------------------------------------------------------------------------------
  'How to create a ruler
  '-------------------------------------------------------------------------------
  'Frame_Ruler_Guide -----------------------------------------------
  'Frame_Ruler_1cm   | | | | | | | | | | | | | | | | | | | | | | | |
  'Frame_Ruler_5cm   |         |         |         |         |
  
  On Error Resume Next
    CreateLine 0.5 * GetWidth() - Ruler / 2, 0.75 * GetOffset(), 0.5 * GetWidth() + Ruler / 2, 0.75 * GetOffset(), "Frame_Ruler_Guide"

    For i = 1 To Ruler / 100
      CreateLine 0.5 * GetWidth() - 50 * i, GetOV(), 0.5 * GetWidth() - 50 * i, 0.5 * GetOffset(), "Frame_Ruler_1_" & i
      CreateLine 0.5 * GetWidth() + 50 * i, GetOV(), 0.5 * GetWidth() + 50 * i, 0.5 * GetOffset(), "Frame_Ruler_2_" & i
      For j = 1 To 4
        CreateLine .5 * GetWidth() - 50 * i + 10 * j,  GetOV(),  .5 * GetWidth() - 50 * i + 10 * j,  .75 * GetOffset(), "Frame_Ruler_3"&i&"_"&j
        CreateLine .5 * GetWidth() + 50 * i - 10 * j,  GetOV(),  .5 * GetWidth() + 50 * i - 10 * j,  .75 * GetOffset(), "Frame_Ruler_4"&i&"_"&j
      Next
    Next

    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub
Sub CATDeleteTitleBlockFrame()
    DeleteAll "CATDrwSearch.2DGeometry.Name=TitleBlock_Line_*"
End Sub
Sub CATCreateTitleBlockFrame()
  '-------------------------------------------------------------------------------
  'How to draw the title block geometry
  '-------------------------------------------------------------------------------
    CreateLine GetOH() + Col(1), GetOV(), GetOH(), GetOV(), "TitleBlock_Line_Bottom"
    CreateLine GetOH() + Col(1), GetOV(), GetOH() + Col(1), GetOV() + Row(6), "TitleBlock_Line_Left"
    CreateLine GetOH() + Col(1), GetOV() + Row(6), GetOH(), GetOV() + Row(6), "TitleBlock_Line_Top"
    CreateLine GetOH(), GetOV() + Row(6), GetOH(), GetOV(), "TitleBlock_Line_Right"
    CreateLine GetOH() + Col(3), GetOV() + Row(1), GetOH(), GetOV() + Row(1), "TitleBlock_Line_Row_1"
    CreateLine GetOH() + Col(1), GetOV() + Row(2), GetOH() + Col(3), GetOV() + Row(2), "TitleBlock_Line_Row_2"
    CreateLine GetOH() + Col(1), GetOV() + Row(3), GetOH(), GetOV() + Row(3), "TitleBlock_Line_Row_3"
    CreateLine GetOH() + Col(1), GetOV() + Row(4), GetOH() + Col(3), GetOV() + Row(4), "TitleBlock_Line_Row_4"
    CreateLine GetOH() + Col(3), GetOV() + Row(5), GetOH(), GetOV() + Row(5), "TitleBlock_Line_Row_5"
    CreateLine GetOH() + Col(2), GetOV(), GetOH() + Col(2), GetOV() + Row(4), "TitleBlock_Line_Column_1"
    CreateLine GetOH() + Col(3), GetOV(), GetOH() + Col(3), GetOV() + Row(6), "TitleBlock_Line_Column_2"
    CreateLine GetOH() + Col(4), GetOV() + Row(1), GetOH() + Col(4), GetOV() + Row(3), "TitleBlock_Line_Column_3"
    CreateLine GetOH() + Col(5), GetOV(), GetOH() + Col(5), GetOV() + Row(1), "TitleBlock_Line_Column_4"
    CreateLine GetOH() + Col(6), GetOV(), GetOH() + Col(6), GetOV() + Row(1), "TitleBlock_Line_Column_5"
    CreateLine GetOH() + Col(7), GetOV(), GetOH() + Col(7), GetOV() + Row(1), "TitleBlock_Line_Column_6"
    CreateLine GetOH() + Col(8), GetOV() + Row(1), GetOH() + Col(8), GetOV() + Row(3), "TitleBlock_Line_Column_7"
End Sub


Sub CATTitleBlockText()
  '-------------------------------------------------------------------------------
  'How to fill in the title block
  '-------------------------------------------------------------------------------
  Text_01 = "CONÇU PAR"
  Text_02 = CATIA.SystemService.Environ("LOGNAME")
  If Text_02 = "" Then Text_02 = CATIA.SystemService.Environ("USERNAME")
  Text_03 = "DATE"
  Text_04 = "XXX"
  Text_05 = "VÉRIFIÉ PAR"
  Text_06 = "DESSINÉ PAR"
  Text_07 = "Ce document est la propriété." + Chr(10) + _
        "des ATELIERS SERRES." + Chr(10) + _
        "Il ne peut être communiqué" + Chr(10) + _
        "à des tiers et/ou reproduit." + Chr(10) + _
        "sans autorisation écrite."

  Text_08 = "ÉCHELLE"
  Text_09 = "MASSE (kg)"
  Text_10 = "FEUILLE"
  Text_11 = "FORMAT"
  Text_12 = "XXX" ' Paper Format
  Text_13 = "RÉFÉRENCE – N° PLAN"
  Text_14 = "INDICE"
  Text_15 = "X"
  Text_16 = "TITRE - DÉSIGNATION"
  Text_17 = "ATELIERS SERRES"

  CreateTextAF Text_01, GetOH() + Col(1) + 1#, GetOV() + Row(2), "TitleBlock_Text_Design", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + Col(1) + 1#, GetOV(), "TitleBlock_Text_Design_1", catBottomLeft, 4
  CreateTextAF Text_03, GetOH() + Col(2) + 1#, GetOV() + Row(2), "TitleBlock_Text_DeDate", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + 0.5 * (Col(2) + Col(3)), GetOV(), "TitleBlock_Text_DeDate_1", catBottomCenter, 2
  CreateTextAF Text_05, GetOH() + Col(1) + 1#, GetOV() + Row(3), "TitleBlock_Text_Check", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + Col(1) + 1#, GetOV() + Row(2), "TitleBlock_Text_Check_1", catBottomLeft, 4
  CreateTextAF Text_03, GetOH() + Col(2) + 1#, GetOV() + Row(3), "TitleBlock_Text_CDate", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + 0.5 * (Col(2) + Col(3)), GetOV() + Row(2), "TitleBlock_Text_CDate_1", catBottomCenter, 2
  CreateTextAF Text_06, GetOH() + Col(1) + 1#, GetOV() + Row(4), "TitleBlock_Text_Drawn", catTopLeft, 3
  CreateTextAF Text_02, GetOH() + Col(1) + 1#, GetOV() + Row(3), "TitleBlock_Text_Drawn_1", catBottomLeft, 4
  CreateTextAF Text_03, GetOH() + Col(2) + 1#, GetOV() + Row(4), "TitleBlock_Text_DrDate", catTopLeft, 3
  CreateTextAF "" & Date, GetOH() + 0.5 * (Col(2) + Col(3)), GetOV() + Row(3), "TitleBlock_Text_DrDate_1", catBottomCenter, 2
  CreateTextAF Text_07, GetOH() + 0.5 * (Col(1) + Col(3)), GetOV() + 0.5 * (Row(6) + Row(4)), "TitleBlock_Text_Rights", catMiddleCenter, 2.5
  CreateTextAF Text_08, GetOH() + Col(3) + 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Scale", catMiddleLeft, 3
  ' Insert Text Attribute link on sheet's scale
  Set Text = CreateTextAF("", GetOH() + Col(5) - 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Scale_1", catMiddleRight, 3)
  Select Case GetContext():
    Case "LAY": Text.InsertVariable 0, 0, ActiveDoc.Part.GetItem("CATLayoutRoot").Parameters.Item(ActiveDoc.Part.GetItem("CATLayoutRoot").Name + "\" + Sheet.Name + "\ViewMakeUp2DL.1\Scale")
    Case "DRW": Text.InsertVariable 0, 0, ActiveDoc.DrawingRoot.Parameters.Item("Drawing\" + Sheet.Name + "\ViewMakeUp.1\Scale")
    Case Else: Text.Text = "XX"
  End Select
  
  CreateTextAF Text_09, GetOH() + Col(5) + 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Weight", catMiddleLeft, 3
  CreateTextAF Text_04, GetOH() + Col(6) - 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Weight_1", catMiddleRight, 3
  CreateTextAF Text_10, GetOH() + Col(7) + 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Sheet", catMiddleLeft, 3
  CreateTextAF Text_04, GetOH() - 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Sheet_1", catMiddleRight, 3
  CreateTextAF Text_11, GetOH() + Col(3) + 1, GetOV() + Row(3), "TitleBlock_Text_Size", catTopLeft, 3
  CreateTextAF Text_12, GetOH() + 0.5 * (Col(3) + Col(4)), GetOV() + Row(1), "TitleBlock_Text_Size_1", catBottomCenter, 4
  CreateTextAF Text_13, GetOH() + Col(4) + 1, GetOV() + Row(3), "TitleBlock_Text_Number", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + 0.5 * (Col(4) + Col(8)), GetOV() + Row(1), "TitleBlock_Text_EnoviaV5_Effectivity", catBottomCenter, 4
  CreateTextAF Text_14, GetOH() + Col(8) + 1, GetOV() + Row(3), "TitleBlock_Text_Rev", catTopLeft, 3
  CreateTextAF Text_15, GetOH() + 0.5 * Col(8), GetOV() + Row(1), "TitleBlock_Text_Rev_1", catBottomCenter, 4
  CreateTextAF Text_16, GetOH() + Col(3) + 1, GetOV() + Row(5), "TitleBlock_Text_Title", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + 0.5 * Col(3), GetOV() + Row(3), "TitleBlock_Text_Title_1", catBottomCenter, 4
  CreateTextAF Text_17, GetOH() + 0.5 * Col(3), GetOV() + 0.5 * (Row(5) + Row(6)), "TitleBlock_Text_Company", catMiddleCenter, 5

  CATLinks
End Sub

Sub CATDeleteRevisionBlockFrame()
    DeleteAll "CATDrwSearch.2DGeometry.Name=RevisionBlock_Line_*"
End Sub

Sub CATCreateRevisionBlockFrame()
  '-------------------------------------------------------------------------------
  'How to draw the revision block geometry
  '-------------------------------------------------------------------------------
  
  revision = CATCheckRev()
  If revision = 0 Then Exit Sub
  For ii = 0 To revision
    iX = GetOH()
    iY1 = GetHeight() - GetOV() - GetRevRowHeight() * ii
    iY2 = GetHeight() - GetOV() - GetRevRowHeight() * (ii + 1)
    CreateLine iX + GetColRev(1), iY1, iX + GetColRev(1), iY2, "RevisionBlock_Line_Column_" + GetRevLetter(ii) + "_1"
    CreateLine iX + GetColRev(2), iY1, iX + GetColRev(2), iY2, "RevisionBlock_Line_Column_" + GetRevLetter(ii) + "_2"
    CreateLine iX + GetColRev(3), iY1, iX + GetColRev(3), iY2, "RevisionBlock_Line_Column_" + GetRevLetter(ii) + "_3"
    CreateLine iX + GetColRev(4), iY1, iX + GetColRev(4), iY2, "RevisionBlock_Line_Column_" + GetRevLetter(ii) + "_4"
    CreateLine iX + GetColRev(1), iY2, iX, iY2, "RevisionBlock_Line_Row_" + GetRevLetter(ii)
  Next
End Sub

Sub CATAddRevisionBlockText()
  '-------------------------------------------------------------------------------
  'How to fill in the revision block
  '-------------------------------------------------------------------------------
  revision = CATCheckRev() + 1
  x = GetOH()
  y = GetHeight() - GetOV() - GetRevRowHeight() * (revision - 0.5)

  Init = InputBox("This review has been done by:", "Reviewer's name", "XXX")
  Description = InputBox("Comment to be inserted:", "Description", "None")

  If revision = 1 Then
    CreateTextAF "REV", x + GetColRev(1) + 1#, y, "RevisionBlock_Text_Rev", catMiddleLeft, 5
    CreateTextAF "DATE", x + GetColRev(2) + 1#, y, "RevisionBlock_Text_Date", catMiddleLeft, 5
    CreateTextAF "DESCRIPTION", x + GetColRev(3) + 1#, y, "RevisionBlock_Text_Description", catMiddleLeft, 5
    CreateTextAF "INIT", x + GetColRev(4) + 1#, y, "RevisionBlock_Text_Init", catMiddleLeft, 5
  End If

  CreateTextAF GetRevLetter(revision), x + 0.5 * (GetColRev(1) + GetColRev(2)), y - GetRevRowHeight(), "RevisionBlock_Text_Rev_" + GetRevLetter(revision), catMiddleCenter, 5
  CreateTextAF "" & Date, x + 0.5 * (GetColRev(2) + GetColRev(3)), y - GetRevRowHeight(), "RevisionBlock_Text_Date_" + GetRevLetter(revision), catMiddleCenter, 3.5
  CreateTextAF Description, x + GetColRev(3) + 1#, y - GetRevRowHeight(), "RevisionBlock_Text_Description_" + GetRevLetter(revision), catMiddleLeft, 2.5
  CreateTextAF Init, x + 0.5 * GetColRev(4), y - GetRevRowHeight(), "RevisionBlock_Text_Init_" + GetRevLetter(revision), catMiddleCenter, 5

  On Error Resume Next
    Texts.GetItem("TitleBlock_Text_MDate_" + GetRevLetter(revision)).Text = "" & Date
    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub

Sub ComputeTitleBlockTranslation(TranslationTab As Variant)
  TranslationTab(0) = 0#
  TranslationTab(1) = 0#
  
  On Error Resume Next
    Set Text = Texts.GetItem("Reference_" + GetMacroID()) 'Get the reference text
    If Err.Number <> 0 Then
      Err.Clear
    Else
      TranslationTab(0) = GetWidth() - GetOffset() - Text.x
      TranslationTab(1) = GetOffset() - Text.y
      Text.x = Text.x + TranslationTab(0)
      Text.y = Text.y + TranslationTab(1)
    End If
  On Error GoTo 0
End Sub

Sub ComputeRevisionBlockTranslation(TranslationTab As Variant)
  TranslationTab(0) = 0#
  TranslationTab(1) = 0#

  On Error Resume Next
    Set Text = Texts.GetItem("RevisionBlock_Text_Init") 'Get the reference text
    If Err.Number <> 0 Then
      Err.Clear
    Else
      TranslationTab(0) = GetWidth() - GetOffset() + GetColRev(4) - Text.x
      TranslationTab(1) = GetHeight() - GetOffset() - 0.5 * GetRevRowHeight() - Text.y
    End If
  On Error GoTo 0
End Sub



Sub CATRemoveFrame()
  '-------------------------------------------------------------------------------
  'How to remove the whole frame
  '-------------------------------------------------------------------------------
  DeleteAll "CATDrwSearch.DrwText.Name=Frame_Text_*"
  DeleteAll "CATDrwSearch.2DGeometry.Name=Frame_*"
  DeleteAll "CATDrwSearch.2DPoint.Name=TitleBlock_Line_*"
End Sub


Sub CATMoveTitleBlockText(Translation As Variant)
  '-------------------------------------------------------------------------------
  'How to translate the whole title block after changing the page setup
  '-------------------------------------------------------------------------------
  SelectAll "CATDrwSearch.DrwText.Name=TitleBlock_Text_*"
  Count = Selection.Count2
  For ii = 1 To Count
    Set Text = Selection.Item2(ii).Value
    Text.x = Text.x + Translation(0)
    Text.y = Text.y + Translation(1)
  Next
End Sub

Sub CATMoveViews(Translation As Variant)
  '-------------------------------------------------------------------------------
  'How to translate the views after changing the page setup
  '-------------------------------------------------------------------------------
  For i = 3 To Views.Count
    Views.Item(i).UnAlignedWithReferenceView
  Next
  For i = 3 To Views.Count
      Set View = Views.Item(i)
      View.x = View.x + Translation(0)
      View.y = View.y + Translation(1)
      View.AlignedWithReferenceView
  Next
End Sub

Sub CATMoveRevisionBlockText(Translation As Varient)
  '-------------------------------------------------------------------------------
  'How to translate the whole revision block after changing the page setup
  '-------------------------------------------------------------------------------
  SelectAll "CATDrwSearch.DrwText.Name=RevisionBlock_Text_*"
  Count = Selection.Count2
  For ii = 1 To Count
    Set Text = Selection.Item2(ii).Value
    Text.x = Text.x + Translation(0)
    Text.y = Text.y + Translation(1)
  Next
End Sub

Sub CATLinks()
  '-------------------------------------------------------------------------------
  'How to fill in texts with data of the part/product linked with current sheet
  '-------------------------------------------------------------------------------
  On Error Resume Next
  Dim ViewDocument
  
  Select Case GetContext():
    Case "LAY": Set ViewDocument = CATIA.ActiveDocument.Product
    Case "DRW":
      If Views.Count >= 3 Then
        Set ViewDocument = Views.Item(3).GenerativeBehavior.Document
      Else
        Set ViewDocument = Nothing
      End If
    Case Else: Set ViewDocument = Nothing
  End Select
  
  'Find the product document
  Dim ProductDrawn
  Set ProductDrawn = Nothing
  For i = 1 To 8
    If TypeName(ViewDocument) = "PartDocument" Then
      Set ProductDrawn = ViewDocument.Product
      Exit For
    End If
    If TypeName(ViewDocument) = "Product" Then
      Set ProductDrawn = ViewDocument
      Exit For
    End If
    Set ViewDocument = ViewDocument.Parent
  Next
    
  If ProductDrawn <> Nothing Then
    Texts.GetItem("TitleBlock_Text_EnoviaV5_Effectivity").Text = ProductDrawn.PartNumber
    Texts.GetItem("TitleBlock_Text_Title_1").Text = ProductDrawn.Definition
    Dim ProductAnalysis As Analyze
    Set ProductAnalysis = ProductDrawn.Analyze
    Texts.GetItem("TitleBlock_Text_Weight_1").Text = FormatNumber(ProductAnalysis.Mass, 2)
  End If

  '-------------------------------------------------------------------------------
  'Display sheet format
  '-------------------------------------------------------------------------------
  Dim textFormat As DrawingText
  Set textFormat = Texts.GetItem("TitleBlock_Text_Size_1")
  textFormat.Text = GetDisplayFormat()
  If Len(GetDisplayFormat()) > 4 Then
    textFormat.SetFontSize 0, 0, 2.5
  Else
    textFormat.SetFontSize 0, 0, 4#
  End If

  '-------------------------------------------------------------------------------
  'Display sheet numbering
  '-------------------------------------------------------------------------------
  Dim nbSheet  As Integer
  Dim curSheet As Integer
  If Not DrwSheet.IsDetail Then
    For Each itSheet In Sheets
      If Not itSheet.IsDetail Then nbSheet = nbSheet + 1
    Next
    For Each itSheet In Sheets
      If Not itSheet.IsDetail Then
        curSheet = curSheet + 1
        itSheet.Views.Item(2).Texts.GetItem("TitleBlock_Text_Sheet_1").Text = CStr(curSheet) & "/" & CStr(nbSheet)
      End If
    Next
  End If
  On Error GoTo 0
End Sub

Sub CATFillField(string1 As String, string2 As String, string3 As String)
  '-------------------------------------------------------------------------------
  'How to call a dialog to fill in manually a given text
  '-------------------------------------------------------------------------------
  Dim TextToFill_1 As DrawingText
  Dim TextToFill_2 As DrawingText
  Dim Person As String

  Set TextToFill_1 = Texts.GetItem(string1)
  Set TextToFill_2 = Texts.GetItem(string2)

  Person = TextToFill_1.Text
  If Person = "XXX" Then Person = "John Smith"
  
  Person = InputBox("This Document has been " + string3 + " by:", "Controller's name", Person)
  If Person = "" Then Person = "XXX"
  
  TextToFill_1.Text = Person
  TextToFill_2.Text = "" & Date
End Sub


Sub CATColorGeometry()
  '-------------------------------------------------------------------------------
  'How to color all geometric elements of the active view
  '-------------------------------------------------------------------------------
  
  ' Uncomment the following sections if needed
  Select Case GetContext():
    'Case "DRW":
    '    SelectAll "CATDrwSearch.2DGeometry"
    '    Selection.VisProperties.SetRealColor 0,0,0,0
    '    Selection.Clear
    Case "LAY":
        SelectAll "CATDrwSearch.2DGeometry"
        Selection.VisProperties.SetRealColor 255, 255, 255, 0
        Selection.Clear
    'Case "SCH":
    '    SelectAll "CATDrwSearch.2DGeometry"
    '    Selection.VisProperties.SetRealColor 0,0,0,0
    '    Selection.Clear
    
  End Select
End Sub

Sub CATDrw_DesignedBy(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to update a bit more the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  
  If CATCheckRef(0) Then Exit Sub
  CATFillField "TitleBlock_Text_Design_1", "TitleBlock_Text_DeDate_1", "designed"
  CATExit targetSheet
End Sub

Bonjour,

Pour insérer un logo :
[code][/ Set LogoPicture = DrwView.Pictures.Add("C:\Temp\logo_cartouche.jpg", 120, 65)
LogoPicture.format = "JPG"
LogoPicture.ratioLock = 1
LogoPicture.Height = 24
LogoPicture.Width = 70
LogoPicture.Name = "Nom_Logo1"code]

A adapter à ton code. Les valeurs 120 et 65 sont les positions du logo.
Pour le texte il suffit de reprendre l'exemple de la "Sub CATTitleBlockText()" sauf si tu veux rendre le contenu interactif.

Salut Filipe,

J'ai testé la modif dans le script Dassault de base et ça donne:

Pour le texte j'ai rajouté la variable Text_16.

Pour le Logo, il y avait une petite erreur (à priori la ligne LogoPicture.format = "JPG" n'est pas reconnue en VBScript), j'ai également nommé l'image avec la racine ""TitleBlock_*" pour permettre sa suppression. Les modifs sont dans "Sub CATTitleBlockText()"

Code:

Sub CATTitleBlockText()
  '-------------------------------------------------------------------------------
  'How to fill in the title block
  '-------------------------------------------------------------------------------
  
  Text_01 = "This drawing is our property; it can't be reproduced or communicated without our written agreement."
  Text_02 = "SCALE"
  Text_03 = "XXX"
  Text_04 = "WEIGHT (kg)"
  Text_05 = "XXX"
  Text_06 = "DRAWING NUMBER"
  Text_07 = "SHEET"
  Text_08 = "SIZE"
  Text_09 = "USER"
  Text_10 = "XXX"                ' Paper Format
  Text_11 = "DASSAULT SYSTEMES"
  Text_12 = "CHECKED BY:"
  Text_13 = "DATE:"
  Text_14 = "DESIGNED BY:"
  Text_15 = CATIA.SystemService.Environ("LOGNAME")

  '*************************
  'modif Marc,rajout Text_16
  '*************************

  Text_16 = "MATIERE : "& chr(10)& "TRAITE POUR : " ' CHR(10) pour aller )à la ligne
 CreateTextAF Text_16,(GetWidth()-GetOH())+5,GetOV()+5   ,"TitleBlock_Text_libre" , catBottomLeft   ,5
  'modif Marc,rajout Logo
  Set LogoPicture = View.Pictures.Add("C:\Temp\logo_cartouche.jpg", GetOH()-145, GetOV()+45)
LogoPicture.ratioLock = 1
LogoPicture.Height = 25
LogoPicture.Width = 25
LogoPicture.Name = "TitleBlock_Logo"
  
'***************
'fin modif Marc
'**************

  If Text_15 = "" Then Text_15 = CATIA.SystemService.Environ("USERNAME")
  CreateTextAF Text_01,GetOH() + Col(1) + 1.       ,GetOV() + .5*Row(1)  ,"TitleBlock_Text_Rights" , catMiddleLeft   ,1.5
  CreateTextAF Text_02,GetOH() + Col(1) + 1.       ,GetOV() + Row(2)     ,"TitleBlock_Text_Scale"  , catTopLeft     ,1.5
  ' Insert Text Attribute link on sheet's scale
  Set Text= CreateTextAF("", GetOH()+.5*(Col(1)+Col(2))-4, GetOV() + Row(1) ,"TitleBlock_Text_Scale_1", catBottomCenter,5)

  Select Case GetContext():
    Case "LAY": Text.InsertVariable 0, 0, ActiveDoc.Part.GetItem("CATLayoutRoot").Parameters.Item(ActiveDoc.Part.GetItem("CATLayoutRoot").Name+"\"+Sheet.Name+"\ViewMakeUp2DL.1\Scale")
    Case "DRW": Text.InsertVariable 0, 0, ActiveDoc.DrawingRoot.Parameters.Item("Drawing\"+Sheet.Name+"\ViewMakeUp.1\Scale")    
    Case Else:Text.Text = "XX"
  End Select
  
  CreateTextAF Text_04,GetOH() + Col(2) + 1.       ,GetOV() + Row(2)            ,"TitleBlock_Text_Weight"      ,catTopLeft     ,1.5
  CreateTextAF Text_05,GetOH() + .5*(Col(2)+Col(3)),GetOV() + Row(1)            ,"TitleBlock_Text_Weight_1"    ,catBottomCenter,5
  CreateTextAF Text_06,GetOH() + Col(3) + 1.       ,GetOV() + Row(2)            ,"TitleBlock_Text_Number"      ,catTopLeft     ,1.5
  CreateTextAF Text_05,GetOH() + .5*(Col(3)+Col(4)),GetOV() + Row(1)            ,"TitleBlock_Text_EnoviaV5_Effectivity"    ,catBottomCenter,4
  CreateTextAF Text_07,GetOH() + Col(4) + 1.       ,GetOV() + Row(2)            ,"TitleBlock_Text_Sheet"       ,catTopLeft     ,1.5
  CreateTextAF Text_05,GetOH() + .5*(Col(4)+Col(5)),GetOV() + Row(1)            ,"TitleBlock_Text_Sheet_1"     ,catBottomCenter,5
  CreateTextAF Text_08,GetOH() + Col(1) + 1.       ,GetOV() + Row(3)            ,"TitleBlock_Text_Size"        ,catTopLeft     ,1.5
  If (Sheet.PaperSize  = 13) Then
    CreateTextAF Text_09, GetOH() + .5*(Col(1)+Col(2)), GetOV() + Row(2) + 2    ,"TitleBlock_Text_Size_1"      ,catBottomCenter, 5
  Else
    CreateTextAF Text_10, GetOH() + .5*(Col(1)+Col(2)), GetOV() + Row(2) + 2    ,"TitleBlock_Text_Size_1"      ,catBottomCenter, 5
  End If
  
  CreateTextAF Text_11,GetOH() + .5*(Col(3)+Col(5)),GetOV() + .5*(Row(2)+Row(3)),"TitleBlock_Text_Company"     ,catMiddleCenter,5
  CreateTextAF Text_12,GetOH() + Col(1) + 1.       ,GetOV() + Row(4)            ,"TitleBlock_Text_Controller"  ,catTopLeft     ,1.5
  CreateTextAF Text_05,GetOH() + Col(2) + 2.5      ,GetOV() + .5*(Row(3)+Row(4)),"TitleBlock_Text_Controller_1",catBottomCenter,3
  CreateTextAF Text_13,GetOH() + Col(1) + 1.       ,GetOV() + .5*(Row(3)+Row(4)),"TitleBlock_Text_CDate"       ,catTopLeft     ,1.5
  CreateTextAF Text_05,GetOH() + Col(2) + 2.5      ,GetOV() + Row(3)            ,"TitleBlock_Text_CDate_1"     ,catBottomCenter,3
  CreateTextAF Text_14,GetOH() + Col(1) + 1.       ,GetOV() + Row(5)            ,"TitleBlock_Text_Designer"    ,catTopLeft     ,1.5
  CreateTextAF Text_15,GetOH() + Col(2) + 2.5      ,GetOV() + .5*(Row(4)+Row(5)),"TitleBlock_Text_Designer_1"  ,catBottomCenter,3
  CreateTextAF Text_13,GetOH() + Col(1) + 1.       ,GetOV() + .5*(Row(4)+Row(5)),"TitleBlock_Text_DDate"       ,catTopLeft     ,1.5
  CreateTextAF ""&Date,GetOH() + Col(2) + 2.5      ,GetOV() + Row(4)            ,"TitleBlock_Text_DDate_1"     ,catBottomCenter,3
  CreateTextAF Text_05,GetOH() + .5*(Col(3)+Col(5)),GetOV() + Row(4)            ,"TitleBlock_Text_Title_1"     ,catMiddleCenter,7
  For ii = 1 To GetNbOfRevision()
    iY=GetOV() + (ii-.5) * Row(5)/GetNbOfRevision()
    CreateTextAF GetRevLetter(ii),GetOH() + .5*(Col(5)+Col(6)),iY,"TitleBlock_Text_Modif_" + GetRevLetter(ii),catMiddleCenter,2.5
    CreateTextAF "_"             ,GetOH() + .5*Col(6)         ,iY,"TitleBlock_Text_MDate_" + GetRevLetter(ii),catMiddleCenter,2.
  Next
 
  CATLinks
End Sub

Résultat :

Bonjour lumpazepfel,


Je te remercie beaucoup pour ton aide.
Par contre j'ai testé ma macro avec tes modifs, et il semble que ça ne fonctionne pas.
Un message d'erreur apparait.
Si ça ne te dérange pas, pourrais-tu jeter un coup d’œil et voir si je m'y suis mal pris.

Code:

'COPYRIGHT DASSAULT SYSTEMES 2001

' ****************************************************************************
' Purpose:       To draw a Frame and TitleBlock
'
' Assumptions:   A Drafting document should be active
'
' Author:        GDG\DU\PYW
' Languages:     VBScript
' Version:       V5R18
' Reg. Settings: English (United States)
' ****************************************************************************
Public ActiveDoc     As Document
Public Sheets
Public Sheet
Public Views
Public View
Public Texts         As DrawingTexts
Public Text          As DrawingText
Public Fact          As Factory2D
Public Selection     As Selection

Function Col(idx As Integer) As Variant
  Col = Array(-190, -145, -125, -110, -95, -50, -30, -15)(idx - 1)
End Function

Function Row(idx As Integer) As Variant
  Row = Array(10, 12, 24, 36, 40, 60)(idx - 1)
End Function

Function GetRulerLength() As Double
  GetRulerLength = 200#
End Function

Function GetMacroID() As String
  GetMacroID = "Drawing_Ateliers_Serres"
End Function

Function GetNbOfRevision() As Integer
  GetNbOfRevision = 9
End Function

Function GetRevRowHeight() As Double
  GetRevRowHeight = 10#
End Function

Function GetDisplayFormat() As String
  GetDisplayFormat = Array("Letter", "Legal", "A0", "A1", "A2", "A3", "A4", "A", "B", "C", "D", "E", "F", "User")(Sheet.PaperSize)
End Function

Function GetOffset() As Double
  If Sheet.PaperSize = CatPaperA0 Or Sheet.PaperSize = CatPaperA1 Or (Sheet.PaperSize = CatPaperUser And (GetWidth() > 594# Or GetHeight() > 594#)) Then
    GetOffset = 20#
  Else
    GetOffset = 10#
  End If
End Function

Function GetWidth() As Double
  Select Case TypeName(Sheet)
    Case "DrawingSheet": GetWidth = Sheet.GetPaperWidth
    Case "Layout2DSheet": GetWidth = Sheet.PaperWidth
  End Select
End Function
  
Function GetHeight() As Double
  Select Case TypeName(Sheet)
    Case "DrawingSheet": GetHeight = Sheet.GetPaperHeight
    Case "Layout2DSheet": GetHeight = Sheet.PaperHeight
  End Select
End Function
  
Function GetOH() As Double
  GetOH = GetWidth() - GetOffset()
End Function

Function GetOV() As Double
  GetOV = GetOffset()
End Function

Function GetColRev(index As Integer)
  GetColRev = Array(-190, -175, -140, -20)(index - 1)
End Function

Function GetRevLetter(index As Integer)
   GetRevLetter = Chr(Asc("A") + index - 1)
End Function

Function CreateLine(iX1 As Double, iY1 As Double, iX2 As Double, iY2 As Double, iName As String) As Curve2D
  '-------------------------------------------------------------------------------
  ' Creates a sketcher lines thanks to the current 2D factory set to the global variable Fact
  ' The created line is reneamed to the given iName
  ' Start point  and End point are created and renamed iName&"_start", iName&"_end"
  '-------------------------------------------------------------------------------
  Set CreateLine = Fact.CreateLine(iX1, iY1, iX2, iY2)
  CreateLine.Name = iName
  Set Point = CreateLine.StartPoint 'Create the start point
  point.Name = iName&"_start"
  Set Point = CreateLine.EndPoint 'Create the start point
  point.Name = iName&"_end"
End Function

Function CreateText(iCaption As String, iX As Double, iY As Double, iName As String) As DrawingText
  '-------------------------------------------------------------------------------
  'How to create a text
  '-------------------------------------------------------------------------------
  Set CreateText = Texts.Add(iCaption, iX, iY)
  CreateText.Name = iName
  CreateText.AnchorPosition = catMiddleCenter
End Function

Function CreateTextAF(iCaption As String, iX As Double, iY As Double, iName As String, iAnchorPosition As CatTextAnchorPosition, iFontSize As Double) As DrawingText
  '-------------------------------------------------------------------------------
  'How to create a text
  '-------------------------------------------------------------------------------
  Set CreateTextAF = Texts.Add(iCaption, iX, iY)
  CreateTextAF.Name = iName
  CreateTextAF.AnchorPosition = iAnchorPosition
  CreateTextAF.SetFontSize 0, 0, iFontSize
End Function

Sub SelectAll(iQuery As String)
  Selection.Clear
  Selection.Add (View)
  'MsgBox iQuery
  Selection.Search iQuery&",sel"
End Sub

Sub DeleteAll(iQuery As String)
  '-------------------------------------------------------------------------------
  'Delete all elements  matching the query string iQuery
  'Pay attention no to provide a localized query string.
  '-------------------------------------------------------------------------------
  Selection.Clear
  Selection.Add (View)
  'MsgBox iQuery
  Selection.Search iQuery&",sel"
  ' Avoid Delete failure in case of an empty query result
  If Selection.Count2 <> 0 Then Selection.Delete
End Sub

Sub CATMain()
  If Not CATInit(targetSheet) Then Exit Sub
  On Error Resume Next
    Name = Texts.GetItem("Reference_" + GetMacroID()).Name
  If Err.Number <> 0 Then
    Err.Clear
    Name = "none"
  End If
  On Error GoTo 0
  If (Name = "none") Then
    CATDrw_Creation
  Else
    CATDrw_Resizing
    CATDrw_Update
  End If
  CATExit
End Sub

Sub CATDrw_Creation(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to create the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(1) Then Exit Sub 'To check whether a FTB exists already in the sheet
  CATCreateReference          'To place on the drawing a reference point
  CATFrame      'To draw the frame
  CATCreateTitleBlockFrame    'To draw the geometry
  CATTitleBlockText     'To fill in the title block
  CATColorGeometry 'To change the geometry color
  CATExit targetSheet      'To save the sketch edition
End Sub

Sub CATDrw_Deletion(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to delete the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  DeleteAll "..Name=Frame_*"
  DeleteAll "..Name=TitleBlock_*"
  DeleteAll "..Name=RevisionBlock_*"
  DeleteAll "..Name=Reference_*"
  CATExit targetSheet
End Sub

Sub CATDrw_Resizing(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to resize the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  Dim TbTranslation(2)
  ComputeTitleBlockTranslation TbTranslation
  Dim RbTranslation(2)
  ComputeRevisionBlockTranslation RbTranslation
  If TbTranslation(0) <> 0 Or TbTranslation(1) <> 0 Then
    ' Redraw Sheet Frame
    DeleteAll "CATDrwSearch.DrwText.Name=Frame_Text_*"
    DeleteAll "CATDrwSearch.2DGeometry.Name=Frame_*"
    CATFrame
    
    ' Redraw Title Block Frame
    CATDeleteTitleBlockFrame
    CATCreateTitleBlockFrame
    CATMoveTitleBlockText TbTranslation
    ' Redraw revision block
    CATDeleteRevisionBlockFrame
    CATCreateRevisionBlockFrame
    CATMoveRevisionBlockText RbTranslation
    
    ' Move the views
    CATColorGeometry
    CATMoveViews TbTranslation
    CATLinks
    
  End If
  CATExit targetSheet
End Sub

Sub CATDrw_Update(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to update the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  CATLinks
  CATColorGeometry
  CATExit targetSheet

End Sub

Function GetContext()
  ' Find execution context
  Select Case TypeName(Sheet)
    Case "DrawingSheet"
      Select Case TypeName(ActiveDoc)
        Case "DrawingDocument": GetContext = "DRW"
        Case "ProductDocument": GetContext = "SCH"
        Case Else: GetContext = "Unexpected"
      End Select
      
    Case "Layout2DSheet": GetContext = "LAY"
    Case Else: GetContext = "Unexpected"
  End Select
End Function

Sub CATDrw_CheckedBy(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to update a bit more the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  CATFillField "TitleBlock_Text_Check_1", "TitleBlock_Text_CDate_1", "checked"
  CATExit targetSheet
End Sub

Sub CATDrw_AddRevisionBlock(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to create or modify a revison block
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  If CATCheckRef(0) Then Exit Sub
  
  CATAddRevisionBlockText 'To fill in the title block
  CATDeleteRevisionBlockFrame
  CATCreateRevisionBlockFrame 'To draw the geometry
    
  CATColorGeometry
  CATExit targetSheet
End Sub

Function CATInit(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to init the dialog and create main objects
  '-------------------------------------------------------------------------------
  Set Selection = CATIA.ActiveDocument.Selection
  Set Sheet = targetSheet
  Set Sheets = Sheet.Parent
  Set ActiveDoc = Sheets.Parent
  Set Views = Sheet.Views
  Set View = Views.Item(2)        'Get the background view
  Set Texts = View.Texts
  Set Fact = View.Factory2D
  
  If GetContext() = "Unexpected" Then
      Msg = "The macro runs in an inappropriate environment." & Chr(13) & "The script will terminate wihtout finishing the current action."
      Title = "Unexpected environement error"
      MsgBox Msg, 16, Title
    CATInit = False 'Exit with error
      Exit Function
  End If

  Selection.Clear
  CATIA.HSOSynchronized = False

  'Exit without error
  CATInit = True 'Exit without error
End Function

Sub CATExit(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to restore the document working mode
  '-------------------------------------------------------------------------------
  Selection.Clear
  CATIA.HSOSynchronized = True

  View.SaveEdition
End Sub


Sub CATCreateReference()
  '-------------------------------------------------------------------------------
  'How to create a reference text
  '-------------------------------------------------------------------------------
  Set Text = Texts.Add("", GetWidth() - GetOffset(), GetOffset())
  Text.Name = "Reference_" + GetMacroID
End Sub

Function CATCheckRef(Mode As Integer) As Integer
  '-------------------------------------------------------------------------------
  'How to check that the called macro is the right one
  '-------------------------------------------------------------------------------
  nbTexts = Texts.Count
  i = 0
  notFound = 0
  While (notFound = 0 And i < nbTexts)
    i = i + 1
    Set Text = Texts.Item(i)
    WholeName = Text.Name
    leftText = Left(WholeName, 10)
    If (leftText = "Reference_") Then
      notFound = 1
      refText = "Reference_" + GetMacroID()
      If (Mode = 1) Then
        MsgBox "Frame and Titleblock already created!"
        CATCheckRef = 1
        Exit Function
      ElseIf (Text.Name <> refText) Then
        MsgBox "Frame and Titleblock created using another style:" + Chr(10) + "        " + GetMacroID()
        CATCheckRef = 1
        Exit Function
      Else
        CATCheckRef = 0
        Exit Function
      End If
    End If
  Wend

  If Mode = 1 Then
    CATCheckRef = 0
  Else
    MsgBox "No Frame and Titleblock!"
    CATCheckRef = 1
  End If

End Function

Function CATCheckRev() As Integer
  '-------------------------------------------------------------------------------
  'How to check that a revision block alredy exists
  '-------------------------------------------------------------------------------
  SelectAll "CATDrwSearch.DrwText.Name=RevisionBlock_Text_Rev_*"
  CATCheckRev = Selection.Count2
End Function

Sub CATFrame()
  '-------------------------------------------------------------------------------
  'How to create the Frame
  '-------------------------------------------------------------------------------
  Dim Cst_1   As Double  'Length (in cm) between 2 horinzontal marks
  Dim Cst_2   As Double  'Length (in cm) between 2 vertical marks
  Dim Nb_CM_H As Integer 'Number/2 of horizontal centring marks
  Dim Nb_CM_V As Integer 'Number/2 of vertical centring marks
  Dim Ruler   As Integer 'Ruler length (in cm)

  CATFrameStandard Nb_CM_H, Nb_CM_V, Ruler, Cst_1, Cst_2
  CATFrameBorder
  CATFrameCentringMark Nb_CM_H, Nb_CM_V, Ruler, Cst_1, Cst_2
  CATFrameText Nb_CM_H, Nb_CM_V, Ruler, Cst_1, Cst_2
  CATFrameRuler Ruler, Cst_1
End Sub

Sub CATFrameStandard(Nb_CM_H As Integer, Nb_CM_V As Integer, Ruler As Integer, Cst_1 As Double, Cst_2 As Double)
  '-------------------------------------------------------------------------------
  'How to compute standard values
  '-------------------------------------------------------------------------------
  Cst_1 = 74.2 '297, 594, 1189 are multiples of 74.2
  Cst_2 = 52.5 '210, 420, 841  are multiples of 52.2

  If Sheet.Orientation = CatPaperPortrait And _
     (Sheet.PaperSize = CatPaperA0 Or _
      Sheet.PaperSize = CatPaperA2 Or _
      Sheet.PaperSize = CatPaperA4) Or _
      Sheet.Orientation = CatPaperLandscape And _
     (Sheet.PaperSize = CatPaperA1 Or _
      Sheet.PaperSize = CatPaperA3) Then
    Cst_1 = 52.5
    Cst_2 = 74.2
  End If

  Nb_CM_H = CInt(0.5 * GetWidth() / Cst_1)
  Nb_CM_V = CInt(0.5 * GetHeight() / Cst_2)
  Ruler = CInt((Nb_CM_H - 1) * Cst_1 / 50) * 100   'here is computed the maximum ruler length
  If GetRulerLength() < Ruler Then Ruler = GetRulerLength()
End Sub

Sub CATFrameBorder()
  '-------------------------------------------------------------------------------
  'How to draw the frame border
  '-------------------------------------------------------------------------------
  On Error Resume Next
    CreateLine GetOV(), GetOV(), GetOH(), GetOV(), "Frame_Border_Bottom"
    CreateLine GetOH(), GetOV(), GetOH(), GetHeight() - GetOffset(), "Frame_Border_Left"
    CreateLine GetOH(), GetHeight() - GetOffset(), GetOV(), GetHeight() - GetOffset(), "Frame_Border_Top"
    CreateLine GetOV(), GetHeight() - GetOffset(), GetOV(), GetOV(), "Frame_Border_Right"
    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub

Sub CATFrameCentringMark(Nb_CM_H As Integer, Nb_CM_V As Integer, Ruler As Integer, Cst_1 As Double, Cst_2 As Double)
  '-------------------------------------------------------------------------------
  'How to draw the centring marks
  '-------------------------------------------------------------------------------
  On Error Resume Next
    CreateLine 0.5 * GetWidth(), GetHeight() - GetOffset(), 0.5 * GetWidth(), GetHeight(), "Frame_CentringMark_Top"
    CreateLine 0.5 * GetWidth(), GetOV(), 0.5 * GetWidth(), 0#, "Frame_CentringMark_Bottom"
    CreateLine GetOV(), 0.5 * GetHeight(), 0#, 0.5 * GetHeight(), "Frame_CentringMark_Left"
    CreateLine GetWidth() - GetOffset(), 0.5 * GetHeight(), GetWidth(), 0.5 * GetHeight(), "Frame_CentringMark_Right"
    For i = Nb_CM_H To Ruler / 2 / Cst_1 Step -1
      If (i * Cst_1 < 0.5 * GetWidth() - 1#) Then
        x = 0.5 * GetWidth() + i * Cst_1
        CreateLine x, GetOV(), x, 0.25 * GetOffset(), "Frame_CentringMark_Bottom_" & Int(x)
        x = 0.5 * GetWidth() - i * Cst_1
        CreateLine x, GetOV(), x, 0.25 * GetOffset(), "Frame_CentringMark_Bottom_" & Int(x)
      End If
    Next
    For i = 1 To Nb_CM_H
      If (i * Cst_1 < 0.5 * GetWidth() - 1#) Then
        x = 0.5 * GetWidth() + i * Cst_1
        CreateLine x, GetHeight() - GetOffset(), x, GetHeight() - 0.25 * GetOffset(), "Frame_CentringMark_Top_" & Int(x)
        x = 0.5 * GetWidth() - i * Cst_1
        CreateLine x, GetHeight() - GetOffset(), x, GetHeight() - 0.25 * GetOffset(), "Frame_CentringMark_Top_" & Int(x)
      End If
    Next

    For i = 1 To Nb_CM_V
      If (i * Cst_2 < 0.5 * GetHeight() - 1#) Then
        y = 0.5 * GetHeight() + i * Cst_2
        CreateLine GetOV(), y, 0.25 * GetOffset(), y, "Frame_CentringMark_Left_" & Int(y)
        CreateLine GetOH(), y, GetWidth() - 0.25 * GetOffset(), y, "Frame_CentringMark_Right_" & Int(y)
        y = 0.5 * GetHeight() - i * Cst_2
        CreateLine GetOV(), y, 0.25 * GetOffset(), y, "Frame_CentringMark_Left_" & Int(y)
        CreateLine GetOH(), y, GetWidth() - 0.25 * GetOffset(), y, "Frame_CentringMark_Right_" & Int(y)
      End If
    Next
    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub

Sub CATFrameText(Nb_CM_H As Integer, Nb_CM_V As Integer, Ruler As Integer, Cst_1 As Double, Cst_2 As Double)
  '-------------------------------------------------------------------------------
  'How to create coordinates
  '-------------------------------------------------------------------------------
  On Error Resume Next

    For i = Nb_CM_H To (Ruler / 2 / Cst_1 + 1) Step -1
      CreateText Chr(65 + Nb_CM_H - i), 0.5 * GetWidth() + (i - 0.5) * Cst_1, 0.5 * GetOffset(), "Frame_Text_Bottom_1_" & Chr(65 + Nb_CM_H - i)
      CreateText Chr(64 + Nb_CM_H + i), 0.5 * GetWidth() - (i - 0.5) * Cst_1, 0.5 * GetOffset(), "Frame_Text_Bottom_2_" & Chr(65 + Nb_CM_H + i)
    Next
  
    For i = 1 To Nb_CM_H
      t = Chr(65 + Nb_CM_H - i)
      CreateText(t, 0.5 * GetWidth() + (i - 0.5) * Cst_1, GetHeight() - 0.5 * GetOffset(), "Frame_Text_Top_1_" & t).Angle = -90
      t = Chr(64 + Nb_CM_H + i)
      CreateText(t, 0.5 * GetWidth() - (i - 0.5) * Cst_1, GetHeight() - 0.5 * GetOffset(), "Frame_Text_Top_2_" & t).Angle = -90
    Next

    For i = 1 To Nb_CM_V
      t = CStr(Nb_CM_V + i)
      CreateText t, GetWidth() - 0.5 * GetOffset(), 0.5 * GetHeight() + (i - 0.5) * Cst_2, "Frame_Text_Right_1_" & t
      CreateText(t, 0.5 * GetOffset(), 0.5 * GetHeight() + (i - 0.5) * Cst_2, "Frame_Text_Left_1_" & t).Angle = -90
      
      t = CStr(Nb_CM_V - i + 1)
      CreateText t, GetWidth() - 0.5 * GetOffset(), 0.5 * GetHeight() - (i - 0.5) * Cst_2, "Frame_Text_Right_1_" & t
      CreateText(t, 0.5 * GetOffset(), 0.5 * GetHeight() - (i - 0.5) * Cst_2, "Frame_Text_Left_2" & t).Angle = -90
    Next

    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub

Sub CATFrameRuler(Ruler As Integer, Cst_1 As Single)
  '-------------------------------------------------------------------------------
  'How to create a ruler
  '-------------------------------------------------------------------------------
  'Frame_Ruler_Guide -----------------------------------------------
  'Frame_Ruler_1cm   | | | | | | | | | | | | | | | | | | | | | | | |
  'Frame_Ruler_5cm   |         |         |         |         |
  
  On Error Resume Next
    CreateLine 0.5 * GetWidth() - Ruler / 2, 0.75 * GetOffset(), 0.5 * GetWidth() + Ruler / 2, 0.75 * GetOffset(), "Frame_Ruler_Guide"

    For i = 1 To Ruler / 100
      CreateLine 0.5 * GetWidth() - 50 * i, GetOV(), 0.5 * GetWidth() - 50 * i, 0.5 * GetOffset(), "Frame_Ruler_1_" & i
      CreateLine 0.5 * GetWidth() + 50 * i, GetOV(), 0.5 * GetWidth() + 50 * i, 0.5 * GetOffset(), "Frame_Ruler_2_" & i
      For j = 1 To 4
        CreateLine .5 * GetWidth() - 50 * i + 10 * j,  GetOV(),  .5 * GetWidth() - 50 * i + 10 * j,  .75 * GetOffset(), "Frame_Ruler_3"&i&"_"&j
        CreateLine .5 * GetWidth() + 50 * i - 10 * j,  GetOV(),  .5 * GetWidth() + 50 * i - 10 * j,  .75 * GetOffset(), "Frame_Ruler_4"&i&"_"&j
      Next
    Next

    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub
Sub CATDeleteTitleBlockFrame()
    DeleteAll "CATDrwSearch.2DGeometry.Name=TitleBlock_Line_*"
End Sub
Sub CATCreateTitleBlockFrame()
  '-------------------------------------------------------------------------------
  'How to draw the title block geometry
  '-------------------------------------------------------------------------------
    CreateLine GetOH() + Col(1), GetOV(), GetOH(), GetOV(), "TitleBlock_Line_Bottom"
    CreateLine GetOH() + Col(1), GetOV(), GetOH() + Col(1), GetOV() + Row(6), "TitleBlock_Line_Left"
    CreateLine GetOH() + Col(1), GetOV() + Row(6), GetOH(), GetOV() + Row(6), "TitleBlock_Line_Top"
    CreateLine GetOH(), GetOV() + Row(6), GetOH(), GetOV(), "TitleBlock_Line_Right"
    CreateLine GetOH() + Col(3), GetOV() + Row(1), GetOH(), GetOV() + Row(1), "TitleBlock_Line_Row_1"
    CreateLine GetOH() + Col(1), GetOV() + Row(2), GetOH() + Col(3), GetOV() + Row(2), "TitleBlock_Line_Row_2"
    CreateLine GetOH() + Col(1), GetOV() + Row(3), GetOH(), GetOV() + Row(3), "TitleBlock_Line_Row_3"
    CreateLine GetOH() + Col(1), GetOV() + Row(4), GetOH() + Col(3), GetOV() + Row(4), "TitleBlock_Line_Row_4"
    CreateLine GetOH() + Col(3), GetOV() + Row(5), GetOH(), GetOV() + Row(5), "TitleBlock_Line_Row_5"
    CreateLine GetOH() + Col(2), GetOV(), GetOH() + Col(2), GetOV() + Row(4), "TitleBlock_Line_Column_1"
    CreateLine GetOH() + Col(3), GetOV(), GetOH() + Col(3), GetOV() + Row(6), "TitleBlock_Line_Column_2"
    CreateLine GetOH() + Col(4), GetOV() + Row(1), GetOH() + Col(4), GetOV() + Row(3), "TitleBlock_Line_Column_3"
    CreateLine GetOH() + Col(5), GetOV(), GetOH() + Col(5), GetOV() + Row(1), "TitleBlock_Line_Column_4"
    CreateLine GetOH() + Col(6), GetOV(), GetOH() + Col(6), GetOV() + Row(1), "TitleBlock_Line_Column_5"
    CreateLine GetOH() + Col(7), GetOV(), GetOH() + Col(7), GetOV() + Row(1), "TitleBlock_Line_Column_6"
    CreateLine GetOH() + Col(8), GetOV() + Row(1), GetOH() + Col(8), GetOV() + Row(3), "TitleBlock_Line_Column_7"
End Sub


Sub CATTitleBlockText()
  '-------------------------------------------------------------------------------
  'How to fill in the title block
  '-------------------------------------------------------------------------------
  Text_01 = "CONÇU PAR"
  Text_02 = CATIA.SystemService.Environ("LOGNAME")
  If Text_02 = "" Then Text_02 = CATIA.SystemService.Environ("USERNAME")
  Text_03 = "DATE"
  Text_04 = "XXX"
  Text_05 = "VÉRIFIÉ PAR"
  Text_06 = "DESSINÉ PAR"
  Text_07 = "Ce document est la propriété." + Chr(10) + _
        "des ATELIERS SERRES." + Chr(10) + _
        "Il ne peut être communiqué" + Chr(10) + _
        "à des tiers et/ou reproduit." + Chr(10) + _
        "sans autorisation écrite."

  Text_08 = "ÉCHELLE"
  Text_09 = "MASSE (kg)"
  Text_10 = "FEUILLE"
  Text_11 = "FORMAT"
  Text_12 = "XXX" ' Paper Format
  Text_13 = "RÉFÉRENCE – N° PLAN"
  Text_14 = "INDICE"
  Text_15 = "X"
  Text_16 = "TITRE - DÉSIGNATION"
  Text_17 = "ATELIERS SERRES"
  Text_18 = "MATIERE : " & Chr(10) & "TRAITE POUR : " ' CHR(10) pour aller )à la ligne
 CreateTextAF Text_18, (GetWidth() - GetOH()) + 5, GetOV() + 5, "TitleBlock_Text_libre", catBottomLeft, 5
  'modif Marc,rajout Logo
  Set LogoPicture = View.Pictures.Add("C:\Temp\LogoAS.jpg", GetOH() - 125, GetOV() + 40)
LogoPicture.ratioLock = 1
LogoPicture.Height = 25
LogoPicture.Width = 25
LogoPicture.Name = "TitleBlock_Logo"

  CreateTextAF Text_01, GetOH() + Col(1) + 1#, GetOV() + Row(2), "TitleBlock_Text_Design", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + Col(1) + 1#, GetOV(), "TitleBlock_Text_Design_1", catBottomLeft, 4
  CreateTextAF Text_03, GetOH() + Col(2) + 1#, GetOV() + Row(2), "TitleBlock_Text_DeDate", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + 0.5 * (Col(2) + Col(3)), GetOV(), "TitleBlock_Text_DeDate_1", catBottomCenter, 2
  CreateTextAF Text_05, GetOH() + Col(1) + 1#, GetOV() + Row(3), "TitleBlock_Text_Check", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + Col(1) + 1#, GetOV() + Row(2), "TitleBlock_Text_Check_1", catBottomLeft, 4
  CreateTextAF Text_03, GetOH() + Col(2) + 1#, GetOV() + Row(3), "TitleBlock_Text_CDate", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + 0.5 * (Col(2) + Col(3)), GetOV() + Row(2), "TitleBlock_Text_CDate_1", catBottomCenter, 2
  CreateTextAF Text_06, GetOH() + Col(1) + 1#, GetOV() + Row(4), "TitleBlock_Text_Drawn", catTopLeft, 3
  CreateTextAF Text_02, GetOH() + Col(1) + 1#, GetOV() + Row(3), "TitleBlock_Text_Drawn_1", catBottomLeft, 4
  CreateTextAF Text_03, GetOH() + Col(2) + 1#, GetOV() + Row(4), "TitleBlock_Text_DrDate", catTopLeft, 3
  CreateTextAF "" & Date, GetOH() + 0.5 * (Col(2) + Col(3)), GetOV() + Row(3), "TitleBlock_Text_DrDate_1", catBottomCenter, 2
  CreateTextAF Text_07, GetOH() + 0.5 * (Col(1) + Col(3)), GetOV() + 0.5 * (Row(6) + Row(4)), "TitleBlock_Text_Rights", catMiddleCenter, 2.5
  CreateTextAF Text_08, GetOH() + Col(3) + 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Scale", catMiddleLeft, 3
  ' Insert Text Attribute link on sheet's scale
  Set Text = CreateTextAF("", GetOH() + Col(5) - 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Scale_1", catMiddleRight, 3)
  Select Case GetContext():
    Case "LAY": Text.InsertVariable 0, 0, ActiveDoc.Part.GetItem("CATLayoutRoot").Parameters.Item(ActiveDoc.Part.GetItem("CATLayoutRoot").Name + "\" + Sheet.Name + "\ViewMakeUp2DL.1\Scale")
    Case "DRW": Text.InsertVariable 0, 0, ActiveDoc.DrawingRoot.Parameters.Item("Drawing\" + Sheet.Name + "\ViewMakeUp.1\Scale")
    Case Else: Text.Text = "XX"
  End Select
  
  CreateTextAF Text_09, GetOH() + Col(5) + 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Weight", catMiddleLeft, 3
  CreateTextAF Text_04, GetOH() + Col(6) - 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Weight_1", catMiddleRight, 3
  CreateTextAF Text_10, GetOH() + Col(7) + 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Sheet", catMiddleLeft, 3
  CreateTextAF Text_04, GetOH() - 1, GetOV() + 0.5 * Row(1), "TitleBlock_Text_Sheet_1", catMiddleRight, 3
  CreateTextAF Text_11, GetOH() + Col(3) + 1, GetOV() + Row(3), "TitleBlock_Text_Size", catTopLeft, 3
  CreateTextAF Text_12, GetOH() + 0.5 * (Col(3) + Col(4)), GetOV() + Row(1), "TitleBlock_Text_Size_1", catBottomCenter, 4
  CreateTextAF Text_13, GetOH() + Col(4) + 1, GetOV() + Row(3), "TitleBlock_Text_Number", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + 0.5 * (Col(4) + Col(8)), GetOV() + Row(1), "TitleBlock_Text_EnoviaV5_Effectivity", catBottomCenter, 4
  CreateTextAF Text_14, GetOH() + Col(8) + 1, GetOV() + Row(3), "TitleBlock_Text_Rev", catTopLeft, 3
  CreateTextAF Text_15, GetOH() + 0.5 * Col(8), GetOV() + Row(1), "TitleBlock_Text_Rev_1", catBottomCenter, 4
  CreateTextAF Text_16, GetOH() + Col(3) + 1, GetOV() + Row(5), "TitleBlock_Text_Title", catTopLeft, 3
  CreateTextAF Text_04, GetOH() + 0.5 * Col(3), GetOV() + Row(3), "TitleBlock_Text_Title_1", catBottomCenter, 4
  CreateTextAF Text_17, GetOH() + 0.5 * Col(3), GetOV() + 0.5 * (Row(5) + Row(6)), "TitleBlock_Text_Company", catMiddleCenter, 5

  CATLinks
End Sub

Sub CATDeleteRevisionBlockFrame()
    DeleteAll "CATDrwSearch.2DGeometry.Name=RevisionBlock_Line_*"
End Sub

Sub CATCreateRevisionBlockFrame()
  '-------------------------------------------------------------------------------
  'How to draw the revision block geometry
  '-------------------------------------------------------------------------------
  
  revision = CATCheckRev()
  If revision = 0 Then Exit Sub
  For ii = 0 To revision
    iX = GetOH()
    iY1 = GetHeight() - GetOV() - GetRevRowHeight() * ii
    iY2 = GetHeight() - GetOV() - GetRevRowHeight() * (ii + 1)
    CreateLine iX + GetColRev(1), iY1, iX + GetColRev(1), iY2, "RevisionBlock_Line_Column_" + GetRevLetter(ii) + "_1"
    CreateLine iX + GetColRev(2), iY1, iX + GetColRev(2), iY2, "RevisionBlock_Line_Column_" + GetRevLetter(ii) + "_2"
    CreateLine iX + GetColRev(3), iY1, iX + GetColRev(3), iY2, "RevisionBlock_Line_Column_" + GetRevLetter(ii) + "_3"
    CreateLine iX + GetColRev(4), iY1, iX + GetColRev(4), iY2, "RevisionBlock_Line_Column_" + GetRevLetter(ii) + "_4"
    CreateLine iX + GetColRev(1), iY2, iX, iY2, "RevisionBlock_Line_Row_" + GetRevLetter(ii)
  Next
End Sub

Sub CATAddRevisionBlockText()
  '-------------------------------------------------------------------------------
  'How to fill in the revision block
  '-------------------------------------------------------------------------------
  revision = CATCheckRev() + 1
  x = GetOH()
  y = GetHeight() - GetOV() - GetRevRowHeight() * (revision - 0.5)

  Init = InputBox("This review has been done by:", "Reviewer's name", "XXX")
  Description = InputBox("Comment to be inserted:", "Description", "None")

  If revision = 1 Then
    CreateTextAF "REV", x + GetColRev(1) + 1#, y, "RevisionBlock_Text_Rev", catMiddleLeft, 5
    CreateTextAF "DATE", x + GetColRev(2) + 1#, y, "RevisionBlock_Text_Date", catMiddleLeft, 5
    CreateTextAF "DESCRIPTION", x + GetColRev(3) + 1#, y, "RevisionBlock_Text_Description", catMiddleLeft, 5
    CreateTextAF "INIT", x + GetColRev(4) + 1#, y, "RevisionBlock_Text_Init", catMiddleLeft, 5
  End If

  CreateTextAF GetRevLetter(revision), x + 0.5 * (GetColRev(1) + GetColRev(2)), y - GetRevRowHeight(), "RevisionBlock_Text_Rev_" + GetRevLetter(revision), catMiddleCenter, 5
  CreateTextAF "" & Date, x + 0.5 * (GetColRev(2) + GetColRev(3)), y - GetRevRowHeight(), "RevisionBlock_Text_Date_" + GetRevLetter(revision), catMiddleCenter, 3.5
  CreateTextAF Description, x + GetColRev(3) + 1#, y - GetRevRowHeight(), "RevisionBlock_Text_Description_" + GetRevLetter(revision), catMiddleLeft, 2.5
  CreateTextAF Init, x + 0.5 * GetColRev(4), y - GetRevRowHeight(), "RevisionBlock_Text_Init_" + GetRevLetter(revision), catMiddleCenter, 5

  On Error Resume Next
    Texts.GetItem("TitleBlock_Text_MDate_" + GetRevLetter(revision)).Text = "" & Date
    If Err.Number <> 0 Then Err.Clear
  On Error GoTo 0
End Sub

Sub ComputeTitleBlockTranslation(TranslationTab As Variant)
  TranslationTab(0) = 0#
  TranslationTab(1) = 0#
  
  On Error Resume Next
    Set Text = Texts.GetItem("Reference_" + GetMacroID()) 'Get the reference text
    If Err.Number <> 0 Then
      Err.Clear
    Else
      TranslationTab(0) = GetWidth() - GetOffset() - Text.x
      TranslationTab(1) = GetOffset() - Text.y
      Text.x = Text.x + TranslationTab(0)
      Text.y = Text.y + TranslationTab(1)
    End If
  On Error GoTo 0
End Sub

Sub ComputeRevisionBlockTranslation(TranslationTab As Variant)
  TranslationTab(0) = 0#
  TranslationTab(1) = 0#

  On Error Resume Next
    Set Text = Texts.GetItem("RevisionBlock_Text_Init") 'Get the reference text
    If Err.Number <> 0 Then
      Err.Clear
    Else
      TranslationTab(0) = GetWidth() - GetOffset() + GetColRev(4) - Text.x
      TranslationTab(1) = GetHeight() - GetOffset() - 0.5 * GetRevRowHeight() - Text.y
    End If
  On Error GoTo 0
End Sub



Sub CATRemoveFrame()
  '-------------------------------------------------------------------------------
  'How to remove the whole frame
  '-------------------------------------------------------------------------------
  DeleteAll "CATDrwSearch.DrwText.Name=Frame_Text_*"
  DeleteAll "CATDrwSearch.2DGeometry.Name=Frame_*"
  DeleteAll "CATDrwSearch.2DPoint.Name=TitleBlock_Line_*"
End Sub


Sub CATMoveTitleBlockText(Translation As Variant)
  '-------------------------------------------------------------------------------
  'How to translate the whole title block after changing the page setup
  '-------------------------------------------------------------------------------
  SelectAll "CATDrwSearch.DrwText.Name=TitleBlock_Text_*"
  Count = Selection.Count2
  For ii = 1 To Count
    Set Text = Selection.Item2(ii).Value
    Text.x = Text.x + Translation(0)
    Text.y = Text.y + Translation(1)
  Next
End Sub

Sub CATMoveViews(Translation As Variant)
  '-------------------------------------------------------------------------------
  'How to translate the views after changing the page setup
  '-------------------------------------------------------------------------------
  For i = 3 To Views.Count
    Views.Item(i).UnAlignedWithReferenceView
  Next
  For i = 3 To Views.Count
      Set View = Views.Item(i)
      View.x = View.x + Translation(0)
      View.y = View.y + Translation(1)
      View.AlignedWithReferenceView
  Next
End Sub

Sub CATMoveRevisionBlockText(Translation As Varient)
  '-------------------------------------------------------------------------------
  'How to translate the whole revision block after changing the page setup
  '-------------------------------------------------------------------------------
  SelectAll "CATDrwSearch.DrwText.Name=RevisionBlock_Text_*"
  Count = Selection.Count2
  For ii = 1 To Count
    Set Text = Selection.Item2(ii).Value
    Text.x = Text.x + Translation(0)
    Text.y = Text.y + Translation(1)
  Next
End Sub

Sub CATLinks()
  '-------------------------------------------------------------------------------
  'How to fill in texts with data of the part/product linked with current sheet
  '-------------------------------------------------------------------------------
  On Error Resume Next
  Dim ViewDocument
  
  Select Case GetContext():
    Case "LAY": Set ViewDocument = CATIA.ActiveDocument.Product
    Case "DRW":
      If Views.Count >= 3 Then
        Set ViewDocument = Views.Item(3).GenerativeBehavior.Document
      Else
        Set ViewDocument = Nothing
      End If
    Case Else: Set ViewDocument = Nothing
  End Select
  
  'Find the product document
  Dim ProductDrawn
  Set ProductDrawn = Nothing
  For i = 1 To 8
    If TypeName(ViewDocument) = "PartDocument" Then
      Set ProductDrawn = ViewDocument.Product
      Exit For
    End If
    If TypeName(ViewDocument) = "Product" Then
      Set ProductDrawn = ViewDocument
      Exit For
    End If
    Set ViewDocument = ViewDocument.Parent
  Next
    
  If ProductDrawn <> Nothing Then
    Texts.GetItem("TitleBlock_Text_EnoviaV5_Effectivity").Text = ProductDrawn.PartNumber
    Texts.GetItem("TitleBlock_Text_Title_1").Text = ProductDrawn.Definition
    Dim ProductAnalysis As Analyze
    Set ProductAnalysis = ProductDrawn.Analyze
    Texts.GetItem("TitleBlock_Text_Weight_1").Text = FormatNumber(ProductAnalysis.Mass, 2)
  End If

  '-------------------------------------------------------------------------------
  'Display sheet format
  '-------------------------------------------------------------------------------
  Dim textFormat As DrawingText
  Set textFormat = Texts.GetItem("TitleBlock_Text_Size_1")
  textFormat.Text = GetDisplayFormat()
  If Len(GetDisplayFormat()) > 4 Then
    textFormat.SetFontSize 0, 0, 2.5
  Else
    textFormat.SetFontSize 0, 0, 4#
  End If

  '-------------------------------------------------------------------------------
  'Display sheet numbering
  '-------------------------------------------------------------------------------
  Dim nbSheet  As Integer
  Dim curSheet As Integer
  If Not DrwSheet.IsDetail Then
    For Each itSheet In Sheets
      If Not itSheet.IsDetail Then nbSheet = nbSheet + 1
    Next
    For Each itSheet In Sheets
      If Not itSheet.IsDetail Then
        curSheet = curSheet + 1
        itSheet.Views.Item(2).Texts.GetItem("TitleBlock_Text_Sheet_1").Text = CStr(curSheet) & "/" & CStr(nbSheet)
      End If
    Next
  End If
  On Error GoTo 0
End Sub

Sub CATFillField(string1 As String, string2 As String, string3 As String)
  '-------------------------------------------------------------------------------
  'How to call a dialog to fill in manually a given text
  '-------------------------------------------------------------------------------
  Dim TextToFill_1 As DrawingText
  Dim TextToFill_2 As DrawingText
  Dim Person As String

  Set TextToFill_1 = Texts.GetItem(string1)
  Set TextToFill_2 = Texts.GetItem(string2)

  Person = TextToFill_1.Text
  If Person = "XXX" Then Person = "John Smith"
  
  Person = InputBox("This Document has been " + string3 + " by:", "Controller's name", Person)
  If Person = "" Then Person = "XXX"
  
  TextToFill_1.Text = Person
  TextToFill_2.Text = "" & Date
End Sub


Sub CATColorGeometry()
  '-------------------------------------------------------------------------------
  'How to color all geometric elements of the active view
  '-------------------------------------------------------------------------------
  
  ' Uncomment the following sections if needed
  Select Case GetContext():
    'Case "DRW":
    '    SelectAll "CATDrwSearch.2DGeometry"
    '    Selection.VisProperties.SetRealColor 0,0,0,0
    '    Selection.Clear
    Case "LAY":
        SelectAll "CATDrwSearch.2DGeometry"
        Selection.VisProperties.SetRealColor 255, 255, 255, 0
        Selection.Clear
    'Case "SCH":
    '    SelectAll "CATDrwSearch.2DGeometry"
    '    Selection.VisProperties.SetRealColor 0,0,0,0
    '    Selection.Clear
    
  End Select
End Sub

Sub CATDrw_DesignedBy(targetSheet As CATIABase)
  '-------------------------------------------------------------------------------
  'How to update a bit more the FTB
  '-------------------------------------------------------------------------------
  If Not CATInit(targetSheet) Then Exit Sub
  
  If CATCheckRef(0) Then Exit Sub
  CATFillField "TitleBlock_Text_Design_1", "TitleBlock_Text_DeDate_1", "designed"
  CATExit targetSheet
End Sub





Bonjour,

J'avais tester ta macro et reçu le même message d'erreur.
J'ai donc fais mes modifications dans le script Dassault d'origine et une première différence que j'ai pu remarquer c'est qu'il n'y a pas  les # derrière les nombres (il y a un point):
ta macro : GetRulerLength = 200#
macro Dassault :GetRulerLength = 200.
Je ne sais pas quel est la différence mais regarde dans ce sens.
As tu testé une macro Dassault non modifiée?

En remplaçant tous les # par des . je n'ai plus d'erreur.

Salut,

Pour le problème de langue, je suppose qu'il doit y avoir un fichier de configuration, mais où? Mystère!
La solution que j'ai trouvée est de réutiliser un nom de macro de Dassault pour ta propre macro:

Merci beaucoup pour le coup de main, tu sais pas comment ça va me simplifier la vie au boulot.

Par curiosité, connaitrais-tu le code qui définie la taille du texte. Par exemple dans mon cas: matière, traité pour

De rien

Pour tous les textes créés avec la fonction CreateTxtAF, la taille du texte est défini par le nombre à la fin des lignes :
CreateTextAF Text_03, GetOH() + Col(2) + 1#, GetOV() + Row(4), "TitleBlock_Text_DrDate", catTopLeft, 3
L'argument catTopLeft indique le point d'ancrage du texte (ici en haut, à gauche)