Catia V5R19 Capture image Without OLE object
Catia V5R19 Capture image Without OLE object
(OP)
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)
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)





RE: Catia V5R19 Capture image Without OLE object
RE: Catia V5R19 Capture image Without OLE object
Most of time, I use Snag-It to capture CATIA images. Then I can add comments and other markups.
RE: Catia V5R19 Capture image Without OLE object
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:
CODE -->
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 SubSave 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
RE: Catia V5R19 Capture image Without OLE object
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