[CATIA VBA] Pièce symétrique

[CATIADEV]

Bonjour,

 

Je développe aujourd'hui un outil qui permet de réaliser la pièce symétrique (toto_201.CATPart) d'une originale (tata_200.CATPart)

 

Contenu de l'originale :

1 - Un à plusieurs Open body,

2 - un à plusieurs Holes, final Holes, etc.

3 - Un à plusieurs Geometrical set

4 - En plus du trièdre de la pièce, il y a un trièdre qui sert de plan de symétrie (x,z) ce trièdre doit être détruis à la fin du processus dans la pièce original

 

L'outil fait :

 

1 - ouvre la pièce sélectionnée,

2 - créer un nouveau part et génère son nom en fonction de la pièce originale. (ici je n'arrive pas à faire des copier coller depuis la pièce originale vers la nouvelle pièce) PasteSpecial As result

Donc pour le moment je suis obligé de fermer ma pièce 201.

3 - je sélectionne le premier open body et je le copie.

4 - j'essaye de le coller et CATIA plante.

"Command Interruped"

 

Si quelqu'un peu m'aider à comprendre?

 

Voici mon code actuel :

 Function fPart(PartFile As String)
'Dim intCountItem As Integer
'Dim CourantObject As String
CATIA.RefreshDisplay = False
CATIA.DisplayFileAlerts = False


'Renomme les fichiers PRODUCT, replace les PART et sauvegarde ceux-ci dans le répertoire temporaire OUT

'-------------------------------------
'
' Open a part 200
'
'-------------------------------------

Language = "VBSCRIPT"

Set Documents1 = CATIA.Documents

Dim partDocument1 As Document
Set partDocument1 = Documents1.Open(PartFile)

' Retrieving a Part HybridBodies collection to attaching OpenBodies (Geometrical set)
Dim hybridBodies1 As HybridBodies
Set hybridBodies1 = partDocument1.Part.HybridBodies

Dim partBodies1 As Bodies
Set partBodies1 = partDocument1.Part.Bodies

Dim partBody As Body

Dim strNameBody As String
strNameBody = partDocument1.Part.InWorkObject.Name

Set partBody = partDocument1.Part.Bodies.Item(strNameBody)

Dim str201PartName As String
str201PartName = Replace(PartFile, "200", "201")

'-------------------------------------
'
' Create a new part for 201
'
'-------------------------------------


Dim intPosition As Integer
intPosition = InStrRev(PartFile, "\")

Dim strShortFileOpenName As String
strShortFileOpenName = Mid(PartFile, intPosition + 1)
Dim str201Name As String

str201Name = Replace(strShortFileOpenName, "20000", "20100", 1, vbTextCompare)

'MsgBox str201Name, vbCritical, "New Part Name"

Dim intDotPosition As Integer
intDotPosition = InStrRev(str201Name, ".")

Dim strNewFile201 As String
strNewFile201 = Left(str201Name, intDotPosition - 1)

Set documents2 = CATIA.Documents
Set partDocument2 = documents2.Add("Part")

' renomme le fichier standard part en part 201 -------------------------------------

Set product2 = partDocument2.Product
product2.PartNumber = Replace(partDocument2.Name, partDocument2.Name, strNewFile201)


partDocument2.Close
'-------------------------------------
'
'From 200 / copy / paste to 201
'
'-------------------------------------

Set specsAndGeomWindow2 = CATIA.ActiveWindow

Set partDocument1 = CATIA.ActiveDocument
Dim selection1 As Selection
Set selection1 = partDocument1.Selection

If Selection = True Then
       selection1.Clear
       Else
   End If
   
Dim part1 As Part
Set part1 = partDocument1.Part
Dim bodies1 As Bodies
Dim body1 As Body
Set bodies1 = part1.Bodies
Set body1 = bodies1.Item(strNameBody)
selection1.Add body1
selection1.Copy

' Fait planter CATIA !!!!!!!

'CATIA.ActiveDocument.Selection.PasteSpecial "CATIA_RESULT"

                                   'Set specsAndGeomWindow2 = CATIA.ActiveWindow
                                   'Set viewerpoint3D2 = specsAndGeomWindow2.ActiveViewer
                                   'Set viewpoint3D2 = viewerpoint3D2.Viewpoint3D
                                   '
                                   ''Dim partDocument2 As Document
                                   'Set partDocument2 = CATIA.ActiveDocument
                                   '
                                   'Dim part2 As PartDocument
                                   'Set part2 = partDocument2
                                   '
                                   'part2.Activate
                                   '
                                   'Set bodies2 = part2.Selection
                                   
                                   
                                   'Set body2 = bodies1.Item("Res")
                                   'partBodies1.Add
                                   'selection1.PasteSpecial (fgfd)
                                   'CATIA.ActiveDocument.Selection.PasteSpecial "CATIA_RESULT"
                                   

'******************************
' Updating CATIA PArt
 'partDocument1.Part.Update


partDocument2.SaveAs str201PartName
partDocument2.Close
End Function

 

Cordialement,

CATIADEV