pause dans une macro
Page 1 sur 1
pause dans une macro
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 :
merci d'avance pour votre aide
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
- Messages : 11
Date d'inscription : 06/06/2017
Localisation : paris
Sujets similaires
» Détection de la lanque dans une Macro VBA
» Macro Changement de la couleur d'un Part dans un Product suivant une recherche du nom dans un tableau excel
» recupérer des mesures dans une macro
» Macro dans catia inertie
» Dessiner dans un Drawing par macro
» Macro Changement de la couleur d'un Part dans un Product suivant une recherche du nom dans un tableau excel
» recupérer des mesures dans une macro
» Macro dans catia inertie
» Dessiner dans un Drawing par macro
Page 1 sur 1
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum
|
|