Macro VBA qui ne fonctionne pas

[Invité Quieto]

Bonjour à tous,

J'ai fait une ptetie macro pour extraire une surface, apres selection par l'utilisateur de la surface (c'est le point de départ de ma macro en fait). Problème : le code que j'ai fait me parait correct, mais apres la selection de la face, il ne se passe plus rien. Le programme arrive à sa fin, et puis c'est tout.

Des conseils ?

 

Le code :

 
Sub CATMain()
Dim myDoc As PartDocument
Set myDoc = CATIA.ActiveDocument

Dim myPart As Part
Set myPart = myDoc.Part

Dim myHSF As HybridShapeFactory
Set myHSF = myPart.HybridShapeFactory

Dim myBodies As Bodies
Set myBodies = myPart.Bodies

Dim myBody As Body
Set myBody = myPart.MainBody

Dim mySelection
Dim Status

Dim InputObjectType(0)
Set mySelection = myDoc.Selection
'We propose to the user that he select the first face
InputObjectType(0) = "Face"
Status = mySelection.SelectElement2(InputObjectType, "Select the first face", True)
If (Status = "cancel") Then Exit Sub
Set FirstFace = mySelection.Item(1).Value

mySelection.Clear


Dim myHSE As HybridShapeExtract
Set myHSE = myHSF.AddNewExtract(FirstFace)

myHSE.PropagationType = 1

myHSE.ComplementaryExtract = False

myHSE.IsFederated = False

myPart.InWorkObject = myBody

myPart.Update

End Sub

[marc54]

Bonjour,

 

Essaie ceci :

 

 Dim myDoc As PartDocument

Set myDoc = CATIA.ActiveDocument



Dim myPart As Part

Set myPart = myDoc.Part



Dim myHSF As HybridShapeFactory

Set myHSF = myPart.HybridShapeFactory



Dim myBodies As Bodies

Set myBodies = myPart.Bodies


Dim myHBBody As HybridBody

Set myHBBody = myPart.HybridBodies.Item(1)


Dim mySelection

Dim Status



Dim InputObjectType(0)

Set mySelection = myDoc.Selection

'We propose to the user that he select the first face

InputObjectType(0) = "Face"

Status = mySelection.SelectElement2(InputObjectType, "Select the first face", True)

If (Status = "cancel") Then Exit Sub

Set FirstFace = mySelection.Item(1).Value


mySelection.Clear


Dim myHSE As HybridShapeExtract

Set myHSE = myHSF.AddNewExtract(FirstFace)

myHSE.PropagationType = 1


myHBBody.AppendHybridShape myHSE


myHSE.ComplementaryExtract = False



myHSE.IsFederated = False



'myPart.InWorkObject = myBody



myPart.Update

 

Chaque fois que tu fais qqc dans un hybridbody, tu dois faire un AppendHybridShape pour le faire apparaitre.

 

[Invité Quieto]

Ok, merci ca fonctionne, c'est cette notion de AppendHybridShape qu'il me manquait. Merci.