Catia V5R19 Capture image Without OLE object

[joacom]

Hello Everyone

Some of the catia drawers at work asked me the question if they could Pixel capture from catia and paste it to powerpoint witout using objects (OLE)

The problem with copy objects is if you dont deleet the link to catiafile the image changes view in powerpoint if its changed in the catia file.

I asked them if they dont just can grab the screen.. but problem is that the screencapture also copies the blue background, that is white if you capture with the Pixel capture option... anyone have som good idea of how to preform this? we are using Catia V5R19


Thnks for all the great help i gets in this forum :O)

 

[joacom]

Forgot to Tell somethimes they just want to grab image of half the model, thats exacly what Pixel capture does, but the ole object ruins everything... :O/

 

[jackk]

If you use CATIA's Image Capture tool, there are options to make the background white and only capture the geometry. Once it is pasted into the powerpoint, you can break the link back to CATIA.

Most of time, I use Snag-It to capture CATIA images. Then I can add comments and other markups.

 

[joacom]

Hello jackk, thanks for your answer, I found a macro on internet, and modified it, as follow:

Start powerpoint press Alt + F11 (opens visual basic editor)
right click on the text vbaProject in the tree, and choose insert -> module

Paste this text into the new module:

Sub Auto_Open()
    Dim oToolbar As CommandBar
    Dim oButton As CommandBarButton
    Dim MyToolbar As String

    ' Give the toolbar a name
    MyToolbar = "Ole Link Removal"

    On Error Resume Next
    ' so that it doesn't stop on the next line if the toolbar's already there

    ' Create the toolbar; PowerPoint will error if it already exists
    Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
        Position:=msoBarFloating, Temporary:=True)
    If Err.Number <> 0 Then
          ' The toolbar's already there, so we have nothing to do
          Exit Sub
    End If

    On Error GoTo ErrorHandler

    ' Now add a button to the new toolbar
    Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)

    ' And set some of the button's properties
    With oButton
         .DescriptionText = "This Removes OLE links From Powerpoint"
          'Tooltip text when mouse if placed over button
         .Caption = "Remove OLE Links"
         'Text if Text in Icon is chosen
         .OnAction = "Button1"
          'Runs the Sub Button1() code when clicked
         .Style = msoButtonIcon
          ' Button displays as icon, not text or both
         .FaceId = 52
          '52 is my favorite pig;
          ' chooses icon #52 from the available Office icons
    End With

    ' Repeat the above for as many more buttons as you need to add
    ' Be sure to change the .OnAction property at least for each new button

    ' You can set the toolbar position and visibility here if you like
    ' By default, it'll be visible when created
    oToolbar.Top = 150
    oToolbar.Left = 150
    oToolbar.Visible = True

NormalExit:
    Exit Sub   ' so it doesn't go on to run the errorhandler code

ErrorHandler:
     'Just in case there is an error
     MsgBox Err.Number & vbCrLf & Err.Description
     Resume NormalExit:
End Sub

Sub Button1()
' This code will run when you click Button 1 added above
' Add a similar subroutine for each additional button you create on the toolbar
    ' This is just some silly example code.
    ' You'd put your real working code here to do whatever
    ' it is that you want to do
    Dim oSld As Slide
Dim oShp As Shape
Dim oCmdButton As CommandBarButton
Set oCmdButton = CommandBars("Standard").Controls.Add(Id:=2956)
ActiveWindow.ViewType = ppViewSlide
For Each oSld In ActivePresentation.Slides
    For Each oShp In oSld.Shapes
        If oShp.Type = msoLinkedOLEObject Then
            ActiveWindow.View.GotoSlide oSld.SlideIndex
            oShp.Select
            Application.CommandBars.FindControl(Id:=2956).Execute
            ' Do not forget to add this line else you will get erratic
            ' results since the code execution does not halt while menu
            ' command is executed hence we have to let the execution
            ' complete before proceeding.
            DoEvents
        End If
    Next oShp
Next oSld
oCmdButton.Delete
ActiveWindow.ViewType = ppViewNormal
    MsgBox "Done!"
End Sub

Save document as PPT (for later purposes.... if you just skip this step say goodbye to change the script later...)
When you have done so!
Press File -> save as
Choose to save as Powerpoint add-in (*.ppa)

When you have done so, go to tools -> macro and change the security settings to Medium or low (i choosed low, because am lazy :OP),
Then press tools -> add-ins -> add new..

Locate youre newly created ppa file and press ok
Press enable macros and ok.

You have now a toolbar with a button that actually deeleetes links between OLE objects and Ie Catia, and creates images out of the files :O)

I used this in Office 2003, but it should work in newer versions to :OD

 

[ferdo]

Hi,

The bellow code is working in a CATScript, so you can adapt to your code and eventually improve it. If your will run the code from PowerPOint don't forget to get the CATIA object and put the right Reference libraries. There are also few catvba's on Internet which are doing same job (images2MSOffice).
' ======================================================
' Purpose: Macro will take a screen capture in an active CATIA document window
' Usage: 1 - A CATIA document window must be active
' 2 - Run macro
'By ferdo, 6th June 2008
'Comments & small bugfix by JeNdArK
'Adapted for three tipes of photo by Pertu10 ,21/04/2010, for auxcad.com
' ======================================================
Language = "VBSCRIPT"

Sub CATMain()

Dim MyWindow As Window
Dim MyViewer As Viewer

Set MyWindow = CATIA.ActiveWindow
Set MyViewer = MyWindow.ActiveViewer

'**** SET ISOMETRIC VIEW (SITUAR EN VISTA ISOMETRICA)

Dim specsAndGeomWindow1 As Window
Set specsAndGeomWindow1 = CATIA.ActiveWindow

Dim viewer3D1 As Viewer
Set viewer3D1 = specsAndGeomWindow1.ActiveViewer
Dim viewpoint3D1 As Viewpoint3D
Set viewpoint3D1 = viewer3D1.Viewpoint3D
viewer3D1.Reframe
Set viewpoint3D1 = viewer3D1.Viewpoint3D

Dim BGcolor(2) ' Create Array for vector type (x,y,z) // Creamos un array de dimension 1x3
MyViewer.GetBackgroundColor BGcolor ' Keep Background color in the array // Guardamos el color de fondo actual
MyViewer.PutBackgroundColor Array(1, 1, 1) ' Change background color to WHITE // Cambiamos el color del fondo a blanco

' ****** SELECCIONAMOS EL TIPO DE FICHERO *****

Dim extension As String

' ****** PARA ESCOGER LA EXTENSION VALIDA *****

Dim Control As Integer
Control = 0
While Control = 0
If extension = "BMP" Or extension = "JPG" Or extension = "TIFF" Then
Control = 1
Else
extension = UCase(InputBox("Tipo Fichero SIN PUNTO" & Chr(13) & "BMP , JPG o TIFF"))
End If
Wend

'***** ESCOGEMOS LA EXTENSION DEL FICHERO A GRABAR *****

If extension = "BMP" Then
Tipo = catCaptureFormatBMP
End If
If extension = "JPG" Then
Tipo = catCaptureFormatJPEG
End If
If extension = "TIFF" Then
Tipo = catCaptureFormatTIFF
End If

Dim Ruta As String
CapturePath = CATIA.FileSelectionBox("NOMBRE DEL FICHERO", extension, CatFileSelectionModeSave)
Ruta = CapturePath & "." & extension

MyViewer.CaptureToFile Tipo, Ruta ' MAIN SENTENCE!! STORE THE PICTURE IN ANY FORMAT // SENTENCIA PRINCIPAL, GUARDAMOS LA IMAGEN COMO BMP
MyViewer.PutBackgroundColor BGcolor ' Change background color to the original color // Cambiamos el color del fondo al color original

MsgBox (" Capture was saved ") ' Show what we have done / Mostramos lo que hemos hecho

End Sub

Regards
Fernando

https://picasaweb.google.com/102257836106335725208