CATIA V5 | 3DEXPERIENCE
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.
-45%
Le deal à ne pas rater :
WHIRLPOOL OWFC3C26X – Lave-vaisselle pose libre 14 couverts – ...
339 € 622 €
Voir le deal

pause dans une macro

Aller en bas

pause dans une macro Empty pause dans une macro

Message par eyefighter Mar 6 Juin 2017 - 13:30

bonjour,

j'aimerais savoir si quelqu'un sais comment faire une pose dans une macro et donner la mains a lutilisateur.

je veux fair un systhème de capture d'écran qui séléctionne automatiquement les élément à prendre en capture. mais il faut aussi positionner le 3d dans le bon sens et pour sa seul l'utilisateur peut el faire.

voici mon code :
Code:
Sub testeCaptureEcran()
    

    CAPTURE_doccierRangement = "C:\Users\A221873\Desktop\capturre"
    
    Set ProductDocumentPrincipal = CATIA.ActiveDocument
    Set DocumentPrincipal = CATIA.Application.ActiveDocument
    Set productPrincipal = ProductDocumentPrincipal.Product
    
    
    ReDim CAPTURE_listeSelectionPart(1)
    Set CAPTURE_listeSelectionPart(0) = productPrincipal.Products.Item(1).Products.Item(1).Products.Item(1).Products.Item(1)
    Set CAPTURE_listeSelectionPart(1) = productPrincipal.Products.Item(1).Products.Item(1).Products.Item(2).Products.Item(1)
    
    
    CAPTURE_nomImage = "nanar"
    
    
    aaaa CAPTURE_nomImage, CAPTURE_doccierRangement, CAPTURE_listeSelectionPart
    'CaptureEcran.Show ' teste avec une userform
    
End Sub


Private Sub aaaa(nomImage As String, doccierRangement As String, listeSelection As Variant)

    ReDim InputObjectType(0) As Variant
    ReDim InputObjectType(0)
    Dim selec As Selection
    Set selec = CATIA.ActiveDocument.Selection
    selec.Clear
    
    Dim fenetre As Window
    Dim MyViewer As Viewer3D
    Dim Myviewpoint3D As Viewpoint3D
    Dim dimentionEcran(1) As Long
    Dim color(2)
    Dim affichageParalle As Boolean
    
    Set fenetre = CATIA.ActiveWindow
    Set MyViewer = fenetre.ActiveViewer
    Set Myviewpoint3D = MyViewer.Viewpoint3D
    
    '____________________________________________________ sauve du forma de l'écran
    '-----Memorise taille ecran d'origine
    dimentionEcran(0) = fenetre.Height
    dimentionEcran(1) = fenetre.Width
    '-----Memorise couleur de font
    Dim MyViewer_deb
    Set MyViewer_deb = MyViewer
    MyViewer_deb.GetBackgroundColor color
    '-----Memorise si affichage isométrique
    If Myviewpoint3D.ProjectionMode = catProjectionCylindric Then
        affichageParalle = True
    Else
        affichageParalle = False
    End If
    
    
    '____________________________________________________ modif du forma de l'écran
    'on cache l'arbre
    M_CreationBilan.CacherArbre
    '-----Passe en 800/800
    fenetre.Height = 800
    fenetre.Width = 800
    ACTUALISE 5
    '-----couleur du font en blanc
    MyViewer_deb.PutBackgroundColor Array(1, 1, 1)
    ' vue parallelle
    Myviewpoint3D.ProjectionMode = catProjectionCylindric
    ACTUALISE 5
    
    
    actuSelec listeSelection, True

    ' ________________________________________________ ici l'utilsateur positionne l'assemblage corectement
    'InputObjectType(0) = "Part"
    'Dim result As Variant
    'result = selec.SelectElement2(InputObjectType, "positionner la vue corectement", False)
    DoEvents
    If Me.CheckBox1 Then
    Me.Label1.Caption = "Annulé"
    Exit Sub
    End If

    
    actuSelec listeSelection, True
    
    'on fait la capture d'écran
    MyViewer.CaptureToFile catCaptureFormatJPEG, doccierRangement & "\" & nomImage & ".jpg"
    
    actuSelec listeSelection, False
    
    '____________________________________________________ restoration du forma de l'écran
    ' on rafiche l'arbre
    M_CreationBilan.CacherArbre
    'on remais la couleur du font d'origine
    MyViewer_deb.PutBackgroundColor (color)
    'on re dimenssionne l'écran corectement
    fenetre.Height = dimentionEcran(0)
    fenetre.Width = dimentionEcran(1)
    
    If affichageParalle = False Then
        Myviewpoint3D.ProjectionMode = catProjectionConic
    End If

    
End Sub

Private Function actuSelec(listeSelection As Variant, celecON As Boolean)
    
    Dim i As Integer
    Dim selec As Selection
    
    Set selec = CATIA.ActiveDocument.Selection
    
    selec.Clear
    If celecON = True Then
        For i = 0 To UBound(listeSelection, 1)
            selec.Add listeSelection(i)

        Next i
    End If
    
End Function

merci d'avance pour votre aide

eyefighter
timide
timide

Messages : 11
Date d'inscription : 06/06/2017
Localisation : paris

Revenir en haut Aller en bas

Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum