Snapshot catia to word

Commenter

Contenu du snippet

Ce code est une macro pour CATIA qui crée une impression d'écran uniquement de la pièce ou du produit affiché, sans l'arbre, ni la boussole, et sur fond blanc.
Ensuite, l'image est envoyée sur le fichier Word préalablement ouvert.

Rajoutez un bouton dans CATIA pour lancer cette macro. Vous verrez, c'est très pratique!

Source / Exemple : 


Sub CATMain()
'****************************************************************************************************
'Pour permettre l'utilisation de cette Macro, activez la librairie word dans l'éditeur VB de Catia
'Outils->Reference->Microsoft Word 11.0 Object Librairy
'il faut aussi créer le raccourci clavier pour afficher la boussole avec F8
'Crée par : Wanours (Version 2, mise à jour du 5 avril 2007)
'****************************************************************************************************

On Error GoTo OupsGOublieWord

Call ShowHideTreeAndCompass

Dim MyViewer As Viewer
Set MyViewer = CATIA.ActiveWindow.ActiveViewer
Dim ADR As String

ADR = "C:\PrintScreen.bmp"

'-----Memorise le BackGround d'origine
    Dim color(2)
    Dim MyViewer_deb
    Set MyViewer_deb = MyViewer
    MyViewer_deb.GetBackgroundColor color

'-----Passe en fond blanc
    MyViewer_deb.PutBackgroundColor Array(1, 1, 1)

'-----Capture d'image
    MyViewer.CaptureToFile catCaptureFormatBMP, ADR

'-----Retour au fond d'écran d'origine
    MyViewer_deb.PutBackgroundColor (color) 

'-----On réaffiche Boussole et Arbre
    Call ShowHideTreeAndCompass 

'-----Insertion dans word
    Selection.InlineShapes.AddPicture FileName:=ADR, LinkToFile:=False, SaveWithDocument:=True
    Kill (ADR) 'Efface le fichier temporaire

Exit Sub

'-----Action en cas d'abscence de fichier Word préalablement ouvert
OupsGOublieWord:
A = MsgBox("Vous devez ouvrir un fichier word avant de lancer la macro!", 16, "Aucun fichier word Ouvert")
Kill (ADR)
End Sub

'-----Sub pour cacher/afficher la boussole et l'arbre de spécification------
Sub ShowHideTreeAndCompass()
'Cache la boussole (raccourci à configurer!)
SendKeys "{F8}"
Call Pause(0.1)
'cache l'arbre
SendKeys "{F3}"
Call Pause(0.1)
End Sub

'------Sub de temporisation générique----------------------------------------
Sub Pause(Temps As Long)

Dim Start As Long
Dim Check As Long
Dim Tempslim As Long

Start = Timer
Tempslim = Timer + Temps

Do Until Check >= Tempslim
   Check = Timer
   DoEvents
Loop

End Sub

Conclusion :


Cette mise à jour offre de nouvelles fonctionnalités.

-> Elle fonctionne avec n'importe quelle couleur du fond d'écran d'origine

-> Elle ne bug plus quand un fichier word n'est pas déjà lancé à l'avance. (un message apparaît simplement pour dire à l'utilisateur que ça ne marche qu'avec un

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.