=== CAA2dlIPrint2DLayout.CATScript ===
' COPYRIGHT DASSAULT SYSTEMES 2006

' ***********************************************************************
'   Purpose     : This macro allows you to print the part 2D layout         
'   Author      : TBU
'   Languages   : VBScript
'   Locales     : English 
'   CATIA Level : V5R17
' ***********************************************************************

Sub CATMain()

  ' Define the application default printer
  CATIA.ActivePrinter = CATIA.Printers.Item("Printer TIF")
  Dim oDocument As Document
  ' Retrieve the active document
  Set oDocument = CATIA.ActiveDocument
  ' Look for the document type, if it is not a product document the macro stops
  If TypeName(oDocument) = "ProductDocument" Then
    Dim oProductDocument As ProductDocument
    Set oProductDocument = oDocument
  Else
    MsgBox "This macro can be run with a product document only."
    Exit Sub
  End If
  ' Call the procedure to search the parts in document
  Call SearchPartsInProduct(oProductDocument.Product)

End Sub

Sub SearchPartsInProduct(ProductParent As Object)

  Dim oProduct As Product
  Dim oProductReference As Product
  Dim oShapeRepresentation As CATBaseDispatch
  Dim oPart As Part
  Dim oLayout2DRoot As Layout2DRoot
  Dim oLayout2DSheets As Layout2DSheets
  Dim oLayout2DSheet As Layout2DSheet
        
  ' Search for the parts in the product structure
  For Each oProduct In ProductParent.Products
    ' Look for product children
    If oProduct.Products.Count <> 0 Then
      ' Call the procedure to search the parts in document
      Call SearchPartsInProduct(oProduct)
    Else
      ' Retrieve the reference product
      Set oProductReference = oProduct.ReferenceProduct
      ' Look for the product existence
      If Not oProductReference Is Nothing Then
          ' Look for the product shape representation
          If oProduct.HasAMasterShapeRepresentation Then
            ' Retrieve the shape representation
            Set oShapeRepresentation = oProduct.GetMasterShapeRepresentation(False)
            ' Look for the shape representation document type
            If Right(oShapeRepresentation.Name, 7) = "CATPart" Then
              ' Retrieve the part
              Set oPart = oShapeRepresentation.Part
              ' Retrieve the 2D Layout
              Set oLayout2DRoot = oPart.GetItem("CATLayoutRoot")
              ' Look for the 2D Layout existence
              If Not oLayout2DRoot Is Nothing Then
                ' Retrieve the sheet collection
                Set oLayout2DSheets = oLayout2DRoot.Sheets
                ' Retrieve the sheets contained in the collection
                For iSheet = 1 To oLayout2DSheets.Count
                  ' Retrieve the sheet
                  Set oLayout2DSheet = oLayout2DSheets.Item(iSheet)
                  ' Print the sheet in a TIFF file
                  oLayout2DSheet.PrintToFile "F:\tmp\2D3DDesign\print\" + oLayout2DSheet.Name + ".tif", _
                    catRenderQuickHiddenLinesRemovalWithHiddenEdgesWithOutlinesWithoutVertices
                  Set oLayout2DSheet = Nothing
                  Set oLayout2DSheets = Nothing
                Next
                Set oLayout2DRoot = Nothing
                Set oShapeRepresentation = Nothing
            End If
            Set oPart = Nothing
          End If
        End If
      End If
      Set oProductReference = Nothing
    End If
  Next
  
End Sub


=== CAADriCreateView.CATScript ===
Option Explicit
' COPYRIGTH DASSAULT SYSTEMES 2000

' ***********************************************************************
'   Purpose:      Create A Drawing document with a front view and a projection view
'   Assumtions:   Looks for MyPart.CATPart in the DocView   
'   Author: 
'   Languages:    VBScript
'   Locales:      English 
'   CATIA Level:  V5R6 
' ***********************************************************************


Sub CATMain()


    ' ----------------------------------------------------------- 
    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If
    ' ----------------------------------------------------------- 

    ' Open the Part document 
    Dim oPartToDraw As PartDocument
    Set oPartToDraw = CATIA.Documents.Open(sDocPath & _
             "\online\CAAScdDriUseCases\samples\Cube.CATPart")

    ' Create a drawing document: it becomes the active document.
    Dim oDrawing As DrawingDocument
    Set oDrawing = CATIA.Documents.Add("Drawing")

    ' Retrieve the active sheet
    Dim oSheet As DrawingSheet
    Set oSheet = oDrawing.Sheets.ActiveSheet

    ' Create a view called "Front View" in this sheet
    Dim oFrontView As DrawingView
    Set oFrontView = oSheet.Views.Add("Front View")

    ' Retrieve it generative behavior
    Dim oFrontViewGB As DrawingViewGenerativeBehavior
    Set oFrontViewGB = oFrontView.GenerativeBehavior

    ' Declare the part to draw in this front view
    oFrontViewGB.Document = oPartToDraw

    ' Define this view as a front view, with the XY plane (in oPartToDraw) as projection plane 
    oFrontViewGB.DefineFrontView 1, 0, 0, 0, 1, 0

    ' Position the View in the Sheet
    oFrontView.x = 300
    oFrontView.y = 150

    ' Update the view
    oFrontViewGB.Update 

End Sub



=== CAADriDetailSheet.CATScript ===
Option Explicit
' COPYRIGTH DASSAULT SYSTEMES 2001

' ***********************************************************************
'   Purpose:      Creates constraints between assembly Parts using Publications
'   Assumtions:   Looks for CAADriDetailSheet.CATDrawing in the DocView   
'   Author: 
'   Languages:    VBScript
'   Locales:      English 
'   CATIA Level:  V5R7 
' ***********************************************************************


Sub CATMain()


    ' ----------------------------------------------------------- 
    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If
    ' ----------------------------------------------------------- 

    ' Open the Drawing document 
    Dim oDoc As Document
    set oDoc = CATIA.Documents.Open(sDocPath & _
                 "\online\CAAScdDriUseCases\samples\CAADriDetailSheet.CATDrawing")


' ------------
' Get the sheets collection of the drawing
' ------------
Dim oDrawingSheets As DrawingSheets
Set oDrawingSheets = oDoc.Sheets

' ------------
' Add the detail sheet with a default name to the sheets collection of the drawing
' ------------
MsgBox "Click OK to create the new sheet."
Dim oDrawingSheet As DrawingSheet
Set oDrawingSheet = oDrawingSheets.AddDetail("New Detail Sheet") 

' ------------
' Activate the detail sheet
' ------------
MsgBox "Click OK to activate the new detail sheet."
oDrawingSheet.Activate 

End Sub


=== CAADriDimension.CATScript ===
Dim Language as String
Language="VBScript"


'---------------------------------------------------------------------------
'COPYRIGHT DASSAULT SYSTEMES 2002

' ****************************************************************************
'
' Purpose:       To analyze a subset of dimensions pointed by text leaders
'                in the active drafting document.
'                That macro checks all dimensions pointed by text leader elements.
'                If dimensions have a wrong display (tolerances or wrong frame)
'                text leader object is highlighted.
'
' Assumptions:   A Drafting document should be active
'
' Author: 
' Languages:     VBScript
' Version:       V5R10
' Locales:       English 
' CATIA Level: V5R10 
'
' ****************************************************************************

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

Sub CATMain()

    ' Set the CATIA popup file alerts to False
    ' It prevents to stop the macro at each alert during its execution
    CATIA.DisplayFileAlerts = False

    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If

  ' Open the Drawing document 
    Dim oDoc As Document
    set oDoc = CATIA.Documents.Open(sDocPath & _
                 "\online\CAAScdDriUseCases\samples\CAADriDimension.CATDrawing")

'---------------------------------------------------------------------------
'1/ Read active CATDrawing Document
'---------------------------------------------------------------------------
Dim DrwDoc As DrawingDocument
Set DrwDoc = CATIA.ActiveDocument

' Get Selection Object and clear it
Dim DrwSelect As Selection
Set DrwSelect = DrwDoc.Selection

' Variables declaration
Dim ElemDispatch As CATBaseDispatch
Dim NomObj As String
Dim numsheet As Long
Dim numview As Long
Dim numtxt As Long
Dim numleader As Long

'---------------------------------------------------------------------------
'2/ Scan all the sheet of the current drawing (Included detail sheet)
'---------------------------------------------------------------------------
Dim DrwSheets As DrawingSheets
Set DrwSheets = DrwDoc.Sheets
Dim CurrentSheet As DrawingSheet

'Read the current sheet to restore it at the end of the macro
Dim SheetToRestore As DrawingSheet
Set SheetToRestore = DrwSheets.ActiveSheet

For numsheet = 1 To DrwSheets.Count

   Set CurrentSheet = DrwSheets.Item(numsheet)
   
   ' Active Currentsheet
   CurrentSheet.Activate
   
   ' Clear the selection
   DrwSelect.Clear
   
   Dim DrwViews As DrawingViews
   Set DrwViews = CurrentSheet.Views
   
   'Read the current view to restore it at the end of the macro
   Dim ViewToRestore As DrawingView
   Set ViewToRestore = DrwViews.ActiveView

'---------------------------------------------------------------------------
'3/ Scan all the view of the current sheet
'---------------------------------------------------------------------------
   Dim CurrentView As DrawingView
   
   For numview = 1 To DrwViews.Count
   
      Set CurrentView = DrwViews.Item(numview)
      
      'Active the current view
      CurrentView.Activate

'---------------------------------------------------------------------------
'4/ Scan all the texts of the current view
'---------------------------------------------------------------------------

      Dim Texts As DrawingTexts
      Set Texts = CurrentView.Texts
         
      For numtxt = 1 To Texts.Count
         
         Dim CurrentText As DrawingText
         Set CurrentText = Texts.Item(numtxt)
            
'---------------------------------------------------------------------------
'5/ Scan all the leaders of the current text
'---------------------------------------------------------------------------
               
         Dim Leaders As DrawingLeaders
         Set Leaders = CurrentText.Leaders
 
         For numleader = 1 To Leaders.Count
            Dim CurrentLeader As DrawingLeader
            Set CurrentLeader = Leaders.Item(numleader)
                    
            ' Manage error on HeadTaget method when
            ' no element is pointed by the text leader.
            On Error Resume Next
            ' Get object pointed on the leader
            Set ElemDispatch = Nothing
            Set ElemDispatch = CurrentLeader.HeadTarget
            NomObj = TypeName(ElemDispatch)
                       
'------------------------------------------------------------------------------
'6/ Check tolerances and the frame type of the dimension pointed by text leader
'------------------------------------------------------------------------------

            ' A dimension is pointed by text leader
            If NomObj = "DrawingDimension" Then
                            
               ' Get the dimension object
               Dim PointedDim As DrawingDimension
               Set PointedDim = ElemDispatch
                   
               ' Read dimension tolerances
               Dim oTolType As Long
               Dim oDisplayMode As Long
               Dim oTolName As String
               Dim oUpTolS As String
               Dim oLowTolS As String
               Dim oUpTolD As Double
               Dim oLowTolD As Double
               PointedDim.GetTolerances oTolType, oTolName, oUpTolS, oLowTolS, oUpTolD, oLowTolD, oDisplayMode
    
               ' Read dimension frame type
               Dim TypeFrame As CatDimFrame
               TypeFrame = PointedDim.ValueFrame
               
'---------------------------------------------------------------------------
'7/ Change the visualization of the text leader linked to that dimension
'---------------------------------------------------------------------------
            
               ' If dimension does not respect the criteria text leader object is highlighted
               If oTolType <> 0 Or TypeFrame <> catFraRectangle Then
                  DrwSelect.Add CurrentText
                  DrwSelect.VisProperties.SetRealColor 255, 0, 0, 0
                  DrwSelect.VisProperties.SetRealWidth 6, 1
               End If
             
            End If
         Next

      Next

    'Restore the view
    ViewToRestore.Activate

   Next

 Next 

'Restore the Drawing Document sheet
SheetToRestore.Activate
   
End Sub


=== CAADriDrawingTable.CATScript ===
Option Explicit
' COPYRIGHT DASSAULT SYSTEMES 2002

' ***********************************************************************
'   Purpose:      This macro allows you to create a title block 
'                       from Drawing Table
'   Author: 
'   Languages:   VBScript
'   Locales:       English 
'   CATIA Level: V5R10 
' ***********************************************************************

Sub CATMain()

    ' Set the CATIA popup file alerts to False
    ' It prevents to stop the macro at each alert during its execution
    CATIA.DisplayFileAlerts = False

    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If

    ' Variables declaration
    Dim oDrwDocument As DrawingDocument
    Dim oDrwSheets As DrawingSheets
    Dim oDrwSheet As DrawingSheet
    Dim oDrwView As DrawingView
    Dim oDrwTables As DrawingTables
    Dim oDrwTable As DrawingTable
    
    ' Create a new drawing document
    Set oDrwDocument = CATIA.Documents.Add("Drawing")

    ' Set the drawing document standard
    oDrwDocument.Standard = catISO
    
    ' Retrieve the drawing document's sheets collection
    Set oDrwSheets = oDrwDocument.Sheets

    ' Retrieve the active sheet
    Set oDrwSheet = oDrwSheets.ActiveSheet

    ' Set the sheet properties
    oDrwSheet.PaperSize = catPaperA4
    oDrwSheet.Orientation = catPaperLandscape
    oDrwSheet.Scale2 = 1
    
    ' Retrieve the active view of the sheet
    Set oDrwView = oDrwSheet.Views.ActiveView
    ' Retrieve the viewt's tables collection
    Set oDrwTables = oDrwView.Tables
    
    ' Create a new drawing table
    Set oDrwTable = oDrwTables.Add(107, 70, 9, 9, 5, 20)
    
    ' Set the drawing table's name
    oDrwTable.Name = "Title Block"

    ' Do not update drawing table modifications
    oDrwTable.ComputeMode = CatTableComputeOFF

    ' Merge drawing table's cells
    oDrwTable.MergeCells 1, 1, 2, 2
    oDrwTable.MergeCells 1, 3, 1, 7
    oDrwTable.MergeCells 2, 3, 2, 7
    oDrwTable.MergeCells 4, 3, 1, 7
    oDrwTable.MergeCells 5, 4, 1, 5
    oDrwTable.MergeCells 6, 3, 2, 1
    oDrwTable.MergeCells 6, 4, 2, 5
    oDrwTable.MergeCells 6, 9, 2, 1
    oDrwTable.MergeCells 7, 1, 2, 1
    oDrwTable.MergeCells 7, 2, 2, 1
    oDrwTable.MergeCells 8, 3, 2, 1
    oDrwTable.MergeCells 8, 4, 2, 1
    oDrwTable.MergeCells 8, 5, 2, 1
    oDrwTable.MergeCells 8, 6, 2, 1
    oDrwTable.MergeCells 8, 7, 2, 1
    oDrwTable.MergeCells 8, 8, 2, 1
    oDrwTable.MergeCells 8, 9, 2, 1

    ' Set the drawing table's row sizes
    oDrwTable.SetRowSize 1, 20
    oDrwTable.SetRowSize 2, 4
    oDrwTable.SetRowSize 3, 5
    oDrwTable.SetRowSize 4, 7
    oDrwTable.SetRowSize 5, 5
    oDrwTable.SetRowSize 6, 7
    oDrwTable.SetRowSize 7, 2
    oDrwTable.SetRowSize 8, 3
    oDrwTable.SetRowSize 9, 7

    ' Set the drawing table's column sizes
    oDrwTable.SetColumnSize 1, 45
    oDrwTable.SetColumnSize 2, 20
    oDrwTable.SetColumnSize 3, 15
    oDrwTable.SetColumnSize 4, 15
    oDrwTable.SetColumnSize 5, 27
    oDrwTable.SetColumnSize 6, 18
    oDrwTable.SetColumnSize 7, 20
    oDrwTable.SetColumnSize 8, 15
    oDrwTable.SetColumnSize 9, 15
    
    ' Update drawing table modifications
    oDrwTable.ComputeMode = CatTableComputeON

    CATIA.ActiveWindow.ActiveViewer.Reframe 

End Sub


=== CAADriDuplicateAView.CATScript ===
Option Explicit
' COPYRIGHT DASSAULT SYSTEMES 2003

' ***********************************************************************
'   Purpose:      This macro allows you to copy a view from an 
'                 existing drawing document into a new drawing
'                 document
'   Author: 
'   Languages:   VBScript
'   Locales:     English 
'   CATIA Level: V5R11
' ***********************************************************************

Sub CATMain()

    ' Set the CATIA popup file alerts to False
    ' It prevents to stop the macro at each alert during its execution
    CATIA.DisplayFileAlerts = False

    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If

    ' Open the Drawing document
    Dim oDrawingSource As DrawingDocument
    Set oDrawingSource = CATIA.Documents.Open(sDocPath & _
             "\online\CAAScdDriUseCases\samples\CAADriDuplicateAView.CATDrawing")
    
    ' Fit in window the opened document
    CATIA.ActiveWindow.ActiveViewer.Reframe
    
    ' Retrieve the sheet containing the view to be duplicated
    Dim oSheetSource As DrawingSheet
    Set oSheetSource = oDrawingSource.Sheets.Item("Sheet.1")
    
    ' Retrieve the view to be duplicated
    Dim oViewSource As DrawingView
    Set oViewSource = oSheetSource.Views.Item("Front view")
    
    ' Create an object of selection for the source document
    Dim oSelectionSource As Selection
    Set oSelectionSource = oDrawingSource.Selection
    
    ' Clear the selection
    oSelectionSource.Clear
    ' Add the view to be duplicated in the selection
    oSelectionSource.Add oViewSource
    ' Copy the view
    oSelectionSource.Copy
    ' Clear the selection
    oSelectionSource.Clear
    
    ' Create the Drawing document where the view will be pasted
    Dim oDrawingTarget As DrawingDocument
    Set oDrawingTarget = CATIA.Documents.Add("Drawing")
    
    ' Retrieve the where the view will be pasted
    Dim oSheetTarget As DrawingSheet
    Set oSheetTarget = oDrawingTarget.Sheets.Item("Sheet.1")
    
    ' Set the sheet paper size
    oSheetTarget.PaperSize = catPaperA0
    
    ' Create an object of selection for the source document
    Dim oSelectionTarget As Selection
    Set oSelectionTarget = oDrawingTarget.Selection
    
    ' Clear the selection
    oSelectionTarget.Clear
    ' Add the sheet where the view will be pasted in the selection
    oSelectionTarget.Add oSheetTarget
    ' Paste the clipboard
    oSelectionTarget.Paste
    ' Clear the selection
    oSelectionTarget.Clear

    ' Fit in window the active document    
    CATIA.ActiveWindow.ActiveViewer.Reframe
    
    ' Clear the variables
    Set oSelectionTarget = Nothing
    Set oSheetTarget = Nothing
    Set oDrawingTarget = Nothing
    Set oSelectionSource = Nothing
    Set oViewSource = Nothing
    Set oSelectionSource = Nothing
    Set oDrawingSource = Nothing
    
End Sub


=== CAADriInstantiateInnerDitto.CATScript ===
Option Explicit
' COPYRIGHT DASSAULT SYSTEMES 2003

' ***********************************************************************
'   Purpose:      This macro allows you to instantiate a ditto in 
'                      a view from a detail view
'   Author: 
'   Languages:   VBScript
'   Locales:       English 
'   CATIA Level: V5R11
' ***********************************************************************

Sub CATMain()

    ' Set the CATIA popup file alerts to False
    ' It prevents to stop the macro at each alert during its execution
    CATIA.DisplayFileAlerts = False

    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If

    ' Open the drawing document
    Dim oDrawing As DrawingDocument
    Set oDrawing = CATIA.Documents.Open(sDocPath & _
             "\online\CAAScdDriUseCases\samples\CAADriInstantiateDittoSource.CATDrawing")
    
    ' Retrieve the sheets collection of the drawing document
    Dim oSheets As DrawingSheets
    Set oSheets = oDrawing.Sheets
    
    ' Retrieve the sheet where the detail view will be instantiated
    Dim oSheet As DrawingSheet
    Set oSheet = oSheets.Item("Sheet.1")
    
    ' Retrieve the view where the detail view will be instantiated
    Dim oView As DrawingView
    Set oView = oSheet.Views.Item("View.3")
    oView.Activate
    
    ' Retrieve the detail sheet containing the detail view to be instantiated
    Dim oDetailSheet As DrawingSheet
    Set oDetailSheet = oSheets.Item("Sheet.2 (Detail)")
    
    ' Retrieve the detail view to be instantiated
    Dim oDetailView As DrawingView
    Set oDetailView = oDetailSheet.Views.Item("DrwDetail.1")
    
    ' Indicate the ditto location
    Dim ReturnStatus As String
    Dim iDittoCoordinates(1)
    Dim oDraw
    Set oDraw = oDrawing
    iDittoCoordinates(0)= 15.0 ' Default value
    iDittoCoordinates(1)= 15.0 ' Default value
    ReturnStatus = oDraw.Indicate2D("Indicate the ditto location", iDittoCoordinates)
       
    ' Retrieve the drawing components collection of the target drawing view
    Dim o2DComponents As DrawingComponents
    Set o2DComponents = oView.Components
    
    ' Create the ditto
    Dim o2DComponent As DrawingComponent
    Set o2DComponent = o2DComponents.Add(oDetailView, iDittoCoordinates(0), iDittoCoordinates(1))
    
    ' Retrieve the modifiable text of the ditto
    Dim oText As DrawingText
    Set oText = o2DComponent.GetModifiableObject(1)
    
    ' Modify the modifiable text value
    Dim ReturnValue As String
    ReturnValue = InputBox( "Enter a value", "New Value For Text","Default Text" )
    oText.Text = ReturnValue

    ' Clear the variables
    Set oText = Nothing
    Set o2DComponent = Nothing
    Set o2DComponents = Nothing
    Set oDraw = Nothing
    Set oDetailView = Nothing
    Set oDetailSheet = Nothing
    Set oView = Nothing
    Set oSheet = Nothing
    Set oSheets = Nothing
    Set oDrawing = Nothing
    
End Sub


=== CAADriInstantiateOuterDitto.CATScript ===
Option Explicit
' COPYRIGHT DASSAULT SYSTEMES 2003

' ***********************************************************************
'   Purpose:      This macro allows you to instantiate a ditto in 
'                 a view from a ditto in another document
'   Author: 
'   Languages:   VBScript
'   Locales:     English 
'   CATIA Level: V5R11
' ***********************************************************************

Sub CATMain()

    ' Set the CATIA popup file alerts to False
    ' It prevents to stop the macro at each alert during its execution
    CATIA.DisplayFileAlerts = False

    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If

    ' Open the drawing document containing the existing ditto
    Dim oDrawingSource As DrawingDocument
    Set oDrawingSource = CATIA.Documents.Open(sDocPath & _
             "\online\CAAScdDriUseCases\samples\CAADriInstantiateDittoSource.CATDrawing")
    
    ' Retrieve the sheet containing the ditto to be copied
    Dim oSheetSource As DrawingSheet
    Set oSheetSource = oDrawingSource.Sheets.Item("Sheet.3")
    
    ' Retrieve the view containing the ditto to be copied
    Dim oViewSource As DrawingView
    Set oViewSource = oSheetSource.Views.Item("View.1")
    
    ' Retrieve the ditto
    Dim oDitto As DrawingComponent
    Set oDitto = oViewSource.Components.Item(1)
    
    ' Create an object of selection for the source document
    Dim oSelectionSource As Selection
    Set oSelectionSource = oDrawingSource.Selection
    
    ' Clear the selection
    oSelectionSource.Clear
    ' Add the ditto to be duplicated in the selection
    oSelectionSource.Add oDitto
    ' Copy the view
    oSelectionSource.Copy
    ' Clear the selection
    oSelectionSource.Clear
    
    ' Open the drawing document where the ditto will be instantiated
    Dim oDrawingTarget As DrawingDocument
    Set oDrawingTarget = CATIA.Documents.Open(sDocPath & _
             "\online\CAAScdDriUseCases\samples\CAADriInstantiateDittoTarget.CATDrawing")
    CATIA.ActiveWindow.ActiveViewer.Reframe
    
    ' Retrieve the sheet where the ditto will be instantiated
    Dim oSheetTarget As DrawingSheet
    Set oSheetTarget = oDrawingTarget.Sheets.Item("Sheet.1")
    oSheetTarget.Activate

    ' Retrieve the view where the ditto will be instantiated
    Dim oViewTarget As DrawingView
    Set oViewTarget = oSheetTarget.Views.Item("View.3")
    
    ' Indicate the ditto location
    Dim ReturnStatus As String
    Dim iDittoCoordinates(1)
    Dim oDraw
    Set oDraw = oDrawingTarget
    ReturnStatus = oDraw.Indicate2D("Indicate the ditto location", iDittoCoordinates)
       
    ' Create an object of selection for the target document
    Dim oSelectionTarget As Selection
    Set oSelectionTarget = oDrawingTarget.Selection
    
    ' Clear the selection
    oSelectionTarget.Clear
    ' Add the view in the selection, where the ditto will be instantiated
    oSelectionTarget.Add oViewTarget
    ' Paste the clipboard
    oSelectionTarget.Paste
    ' Clear the selection
    oSelectionTarget.Clear
    
    ' Retrieve the drawing components collection of the target drawing view
    Dim o2DComponents As DrawingComponents
    Set o2DComponents = oViewTarget.Components
    
    ' Retrieve the ditto and define its location
    Dim o2DComponent As DrawingComponent
    Set o2DComponent = o2DComponents.Item("DrwDetail.1")
    o2DComponent.X = iDittoCoordinates(0)
    o2DComponent.Y = iDittoCoordinates(1)
    
    ' Retrieve the modifiable text of the ditto
    Dim oText As DrawingText
    Set oText = o2DComponent.GetModifiableObject(1)
    
    ' Modify the modifiable text value
    Dim ReturnValue As String
    ReturnValue = InputBox("Enter a value", "", "New Value For Text")
    oText.Text = ReturnValue

    ' Clear the variables
    Set oText = Nothing
    Set o2DComponent = Nothing
    Set o2DComponents = Nothing
    Set oSelectionTarget = Nothing
    Set oDraw = Nothing
    Set oViewTarget = Nothing
    Set oSheetTarget = Nothing
    Set oDrawingTarget = Nothing
    Set oSelectionSource = Nothing
    Set oViewSource = Nothing
    Set oSheetSource = Nothing
    Set oDrawingSource = Nothing
    
End Sub


=== CAADriSetPrintArea.CATScript ===
' COPYRIGHT DASSAULT SYSTEMES 2003

' ***********************************************************************
'   Purpose     : This macro allows you to set the drafting print area
'                 from the mouse selection, then to visualize it.
'   Author      : TBU
'   Languages   : VBScript
'   Locales     : English 
'   CATIA Level : V5R14
' ***********************************************************************

Sub CATMain()

' Retrieve the active document
Dim oDocument As Document
Set oDocument = CATIA.ActiveDocument

' Test the document's type, if it is not a drawing document the macro stops
If TypeName(oDocument) = "DrawingDocument" Then
    Dim oDrawingDocument As DrawingDocument
    Set oDrawingDocument = oDocument
Else
    MsgBox "This macro can be run with a drawing document only."
    Exit Sub
End If

' Retrieve the active sheet of the document
Dim oSheet As DrawingSheet
Set oSheet = oDrawingDocument.Sheets.ActiveSheet

' Retrieve the selection of the document
Dim oSelection 'As Selection
Set oSelection = oDrawingDocument.Selection
' Clear the selection
oSelection.Clear

' Define the object type allowed to be selected, here a drawing point
Dim InputObjectType(0)
InputObjectType(0) = "Point2D"
Dim ReturnStatus As String
Dim oView As DrawingView
Dim ObjectSelected As Boolean

Dim iFirstPoint 'As Point2D
Dim oFirstPointRelative(1)
Dim oFirstPointAbsolute(1)

' Retrieve the first point location to set the print area from the mouse selection
ReturnStatus = oSelection.IndicateOrSelectElement2D("Select the first point", InputObjectType, True, True, False, ObjectSelected, oFirstPointAbsolute)

' Test of the selection content from the ObjectSelected value
If ObjectSelected = True Then
    ' A drawing point has been selected
    ' Retrieve the drawing point object
    Set iFirstPoint = oSelection.Item(1).Value
    ' Retrieve the drawing point's view form the FindObject method of the selection
    Set oView = oSelection.FindObject("CATIADrawingView")
    ' Retrieve the drawing point's coordinates,
    ' these coordinates are defined from the view's reference axis
    iFirstPoint.GetCoordinates oFirstPointRelative
    ' Compute the drawing point's coordinates according to the sheet's reference axis
    CatAbsoluteCoordinates oView, oFirstPointAbsolute, oFirstPointRelative
End If
oSelection.Clear

Dim iSecondPoint 'As Point2D
Dim oSecondPointRelative(1)
Dim oSecondPointAbsolute(1)

' Retrieve the second point location to set the print area from the mouse selection
ReturnStatus = oSelection.IndicateOrSelectElement2D("Select the second point", InputObjectType, True, True, False, ObjectSelected,  oSecondPointAbsolute)

If ObjectSelected = True Then
    ' A drawing point has been selected
    ' Retrieve the drawing point object
    Set iSecondPoint = oSelection.Item(1).Value
    ' Retrieve the drawing point's view form the FindObject method of the selection
    Set oView = oSelection.FindObject("CATIADrawingView")
    ' Retrieve the drawing point's coordinates,
    ' these coordinates are defined from the view's reference axis
    iSecondPoint.GetCoordinates oSecondPointRelative
    ' Compute the drawing point's coordinates according to the sheet's reference axis
    CatAbsoluteCoordinates oView, oSecondPointAbsolute, oSecondPointRelative
End If
oSelection.Clear

' Define the coordinates of the print area's point
Dim XPrintArea As Double
Dim YPrintArea As Double

If oFirstPointAbsolute(0) > oSecondPointAbsolute(0) Then
    XPrintArea = oSecondPointAbsolute(0)
Else
    XPrintArea = oFirstPointAbsolute(0)
End If

If oFirstPointAbsolute(1) > oSecondPointAbsolute(1) Then
    YPrintArea = oSecondPointAbsolute(1)
Else
    YPrintArea = oFirstPointAbsolute(1)
End If

Dim WidthPrintArea As Double
Dim HeightPrintArea As Double

' Define the width and height of the print area
WidthPrintArea = Abs(oSecondPointAbsolute(0) - oFirstPointAbsolute(0))
HeightPrintArea = Abs(oSecondPointAbsolute(1) - oFirstPointAbsolute(1))

' Define and activate the print area of the drawing document
Dim oPrintArea As PrintArea
Set oPrintArea = oSheet.PrintArea

oPrintArea.SetArea XPrintArea, YPrintArea, WidthPrintArea, HeightPrintArea
oPrintArea.ActivationState = True

' Run the "Visualize Print Area" command from its id, the sheet must be selected before !
oSelection.Add oSheet
CATIA.StartCommand "CATDrwVisualizePrintAreaHdr"
oSelection.Clear

End Sub

Private Sub CatAbsoluteCoordinates(CatDrawingView As Object, AbsoluteCoordinates(), RelativeCoordinates())

' Compute the coordinates of a point in a view according to the sheet's reference axis
' Location, Angle and Scale factor of the view are take into account
AbsoluteCoordinates(0) = CatDrawingView.xAxisData + (RelativeCoordinates(0) * Cos(CatDrawingView.Angle) - RelativeCoordinates(1) * Sin(CatDrawingView.Angle)) * CatDrawingView.Scale2
AbsoluteCoordinates(1) = CatDrawingView.yAxisData + (RelativeCoordinates(0) * Sin(CatDrawingView.Angle) + RelativeCoordinates(1) * Cos(CatDrawingView.Angle)) * CatDrawingView.Scale2

End Sub


=== CAADriSheet.CATScript ===
Option Explicit
' COPYRIGTH DASSAULT SYSTEMES 2001

' ***********************************************************************
'   Purpose:      Creates constraints between assembly Parts using Publications
'   Assumtions:   Looks for CAADriSheet.CATDrawing in the DocView   
'   Author: 
'   Languages:    VBScript
'   Locales:      English 
'   CATIA Level:  V5R7 
' ***********************************************************************


Sub CATMain()


    ' ----------------------------------------------------------- 
    ' Optional: allows to find the sample wherever it's installed
    dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    If (Not CATIA.FileSystem.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If
    ' ----------------------------------------------------------- 

    ' Open the Drawing document 
    Dim oDoc As Document
    set oDoc = CATIA.Documents.Open(sDocPath & _
                 "\online\CAAScdDriUseCases\samples\CAADriSheet.CATDrawing")


' ------------
' Get the sheets collection of the drawing
' ------------
Dim oDrawingSheets As DrawingSheets
Set oDrawingSheets = oDoc.Sheets

' ------------
' Add the sheet with a default name to the sheets collection of the drawing
' ------------
MsgBox "Click OK to create the new sheet."
Dim oDrawingSheet As DrawingSheet
Set oDrawingSheet = oDrawingSheets.Add("New Sheet") 

' ------------
' Activate the sheet
' ------------
MsgBox "Click OK to activate the new sheet."
oDrawingSheet.Activate 

End Sub


=== CAADriUpdateSheets.CATScript ===
Option Explicit
' COPYRIGTH DASSAULT SYSTEMES 2000
Dim Language as String
Language="VBScript"

' ***********************************************************************
'   Purpose:      This macro allows you to update all the sheets contained
'                 in all Drawing document of a specified folder
'   Assumtions:      
'   Author: 
'   Languages:    VBScript
'   Locales:      English (United States)
'   CATIA Level:  V5R6 
' ***********************************************************************

Sub CATMain()

    ' Set the CATIA popup file alerts to False
    ' It prevents to stop the macro at each alert during its execution
    CATIA.DisplayFileAlerts = False

    ' Set the file system object containig the folder
    Dim oFileSys As FileSystem
    Set oFileSys = CATIA.FileSystem 

    ' ----------------------------------------------------------- 
    ' Optional: allows to find the sample wherever it's installed
    Dim sDocPath As String 
    sDocPath=CATIA.SystemService.Environ("CATDocView")
    
    If (Not oFileSys.FolderExists(sDocPath)) Then
      Err.Raise 9999,,"No Doc Path Defined"
    End If
    ' ----------------------------------------------------------- 

    ' Define the path's folder where we are looking for Drawing documents
    Dim sFolderPath As String
    sFolderPath = CATIA.FileSystem.ConcatenatePaths(sDocPath, _
		"online\CAAScdDriUseCases\samples")
    
    sFolderPath = InputBox( "Enter a folder path:", "Update All Sheets Of a Folder", sFolderPath)
    If (Not oFileSys.FolderExists(sFolderPath)) Then
      Err.Raise 9999,,sFolderPath & ": This Folder does not exist"
    End If

    ' Set the folder object
    Dim oFolder As Folder 
    Set oFolder = oFileSys.GetFolder(sFolderPath) 

    ' Loop on the files collection of the folder
    ' For Each File In Folder.Files
    Dim iI, iJ
    For iI = 1 To oFolder.Files.Count
        Dim oFile As Object
        Set oFile = oFolder.Files.Item(iI)
    
        '  Retrieve in the files collection only the Drawing documents from its extension
        If InStr(oFile.Name, ".CATDrawing") <> 0 Then

            ' Set and open a Drawing document
            Dim oDoc As Document 
            Set oDoc = CATIA.Documents.Open(oFile.Path)
            MsgBox "Updating Document " & oFile.Path, 0  ' VBOKOnly

            ' Loop on the sheets collection of the drawing document
            ' For Each sheet In oDoc.Sheets 
            For iJ = 1 To oDoc.Sheets.Count
                ' Update the sheet even is not necessary
                oDoc.Sheets.Item(iJ).ForceUpdate 
            Next

            ' Save the Drawing document
            ' oDoc.Save
            ' Close the Drawing document
            oDoc.Close
        End If

    Next

End Sub
 
