Faire un C/c d'une HybridShapeCurveExplicit entre 2 CATPart

Bonjour tout le monde,

Je continue mon aventure avec mes lignes à copier, à remplacer, tout ça.
Je bloque lorsque j'essaie de Copier/Coller une ligne d'un fichier CATPart à un autre...

Peut-être que le problème vient de là, mais la ligne à copier est de type HybridShapeCurveExplicit.

L'enregistreur de macro place mon HybridShapeCurveExplicit dans "Parameters" Je suis un peu surprise...

Voici le code que j'ai fait :

Code:

Set CATIA = GetObject(, "CATIA.Application")

Dim specsAndGeomWindow1 As SpecsAndGeomWindow
Set specsAndGeomWindow1 = CATIA.Windows.Item("Fichier1.CATPart")

Dim part1 As Part
Set part1 = CATIA.ActiveDocument.Part

specsAndGeomWindow1.Activate

Dim ObjSel As Selection
Set ObjSel = CATIA.ActiveDocument.Selection
ObjSel.Clear

'HybridShapeCurveExplicit peut-etre pas dans HybridShapes
Set hybridSCE = part1.HybridBodies.Item("Lignes").HybridShapes.Item("LigneACopier")

ObjSel.Add hybridSCE
ObjSel.Copy
ObjSel.Clear

Dim specsAndGeomWindow2 As SpecsAndGeomWindow
Set specsAndGeomWindow2 = CATIA.Windows.Item("Fichier2.CATPart")

Dim part2 As Part
Set part2 = CATIA.ActiveDocument.Part

specsAndGeomWindow2.Activate

Dim Set_geo As HybridBodies
Set Set_geo = part2.HybridBodies.Item("Lignes2")

ObjSel.Add Set_geo

CATIA.ActiveDocument.Selection.PasteSpecial "CATPrtResultWithOutLink"

ObjSel.Clear

End Sub

L'erreur obtenue est "Propriété ou méthode non gérée par l'objet" pour les deux lignes de code suivantes :

Code:

Set hybridSCE = part1.HybridBodies.Item("Lignes").HybridShapes.Item("LigneACopier")

Code:

Set Set_geo = part2.HybridBodies.Item("Lignes2")

J'avoue être perdue pour le coup.

Merci d'avance si jamais quelqu'un aurait une idée

ça ne serait pas getitem(" ") à écrire, plutôt que item(" ") ?

Salut Stagiaire en mousse !

Je doit t'avouer que je suis exactement dans la même galère que toi à la différence que moi c'est une extraction de surface !^^
en utilisant ta méthode avec PasteSpecial pour moi non plus il ne marche pas, enfin il ne m'annonce pas d'erreur mais il ne copie/colle rien non plus...)

Si tu as trouvé une sotlution je serais bien intéressé

Bonne journée !

Re Bonjour, alors j'ai fait quelques petites recherches ce matin car ce problème m'embête vraiment beaucoup !

Premièrement un bon code que j'ai trouvé sur
http://www.gtwiki.org/mwiki/index.php?title=Copy_and_Paste_from_Part_to_Part

Code:


Sub CATMain()
  
  Dim part1 As PartDocument
  Set part1 = CATIA.Documents.Add("CATPart")    ' create new part   (use this code on an empty session of CATIA)
  
  Dim ActDoc As Document
  Set ActDoc = CATIA.ActiveDocument             ' Makes the Current Document the Active one
  
  Dim HSF As HybridShapeFactory
  Set HSF = part1.Part.HybridShapeFactory       ' Provides the Shape Factory
  
  '  Retrieving HybridBodies collection in Part Document
  
  Dim hybridBodies1 As HybridBodies
  Set hybridBodies1 = part1.Part.HybridBodies
  
  Dim GSet As HybridBody
  
  Set GSet = hybridBodies1.Add()
  
  Set GSet = part1.Part.HybridBodies.Item(1)    ' Makes an abitrary Geometrical Set
  
  '  make some geometry
  Dim Pt1, Pt2, Pt3 As HybridShapePointCoord    ' Makes abitrary geometry to do the copy/paste
  Set Pt1 = HSF.AddNewPointCoord(10, 20, 30)
  Set Pt2 = HSF.AddNewPointCoord(10, -20, -30)
  Set Pt3 = HSF.AddNewPointCoord(-10, 20, 30)
  GSet.AppendHybridShape Pt1
  GSet.AppendHybridShape Pt2
  GSet.AppendHybridShape Pt3
  part1.Part.Update
  
  Set ActSel = ActDoc.Selection                 ' This is the Selection Object
  
  ActSel.Add Pt1                                ' Add the Geometry to the Object
  ActSel.Add Pt2
  ActSel.Add Pt3
  
  ActSel.Copy                                   ' Copy the Geometry
  
  ActSel.Clear                                  ' Clear the selection
  
  '  create second part
  
  Dim part2
  Set part2 = CATIA.Documents.Add("CATPart")    ' Makes a new CATPart and thusly, new actdoc
  Set ActDoc = CATIA.ActiveDocument             ' New ActDoc
  
  '  Retrieving HybridBodies collection in Part Document
  
  Dim hybridBodies2 As HybridBodies
  Set hybridBodies2 = part2.Part.HybridBodies
  
  Dim GSet1 As HybridBody
  
  Set GSet1 = hybridBodies2.Add()
  
  Set GSet1 = part2.Part.HybridBodies.Item(1)
  
  Set ActSel = ActDoc.Selection                ' Create an object of selection for the Target document
  
  ActSel.Add GSet1                             ' Add the Set where the copied data will be pasted in the selection
  
  ActSel.Paste                                 ' Pastes in the new Window
  
  
  End Sub

Mais ce code marche pour deux parts distinctes et non présentes dans un assemblage !

En fait en lisant d'autre source j'ai compris que pour pouvoir copier/coller ou éditer des parts dans un même product il était nécessaire de rendre à chaque fois la part "Active" (quand vous double cliquez sur la part celle ci devient bleu et ouvre le part/Shape Design) sauf que c'est loin d'être aisé à refaire via vba....

Enfin bref voilà le code qui est censé fonctionner la manip importante, est, semble-t-il de:
sélectionner un élément de la part
Utiliser la commande CATIA.StartWorkbench("PrtCfg") et par exemple faire le Copy
redevenir actif dans le product via CATIA.StartWorkbench("Assembly")
puis refaire la première manip pour faire le paste dans l'autre part !

voici le code issu du forum anglais :
http://www.coe.org/p/fo/et/thread=12279..

Code:

The code below could be used to allow a user to select one part and edit it and then select a different part and edit it.

 

Dim CATIA As INFITF.Application

CATIA = GetObject(, "CATIA.Application")

Dim myProductDocument As ProductDocument

myProductDocument = CATIA.ActiveDocument

 

'Select the first part to be activated

Dim sel_First As Selection

sel_First = myProductDocument.Selection

Dim status As String

Dim filter(0)

filter(0) = "PlanarFace"

status = sel_First.SelectElement2(filter, "Select a face on the first part to be edited", False)

If status = "Cancel" Then

MsgBox("Selection Canceled")

Exit Sub

End If

'edit the first part

CATIA.StartWorkbench("PrtCfg")

'clear first selection

sel_First.Clear()

 

'select the root product

Dim sel_PartProduct As Selection

sel_PartProduct = myProductDocument.Selection

'clear second selection

sel_PartProduct.Clear()

sel_PartProduct.Add(myProductDocument.Product)

'edit the part product

CATIA.StartWorkbench("Assembly")

'clear part product selection

sel_PartProduct.Clear()

 

'Select the second part to be activated

Dim sel_Second As Selection

sel_Second = myProductDocument.Selection

Dim status2 As String

Dim filter2(0)

filter2(0) = "PlanarFace"

status2 = sel_Second.SelectElement2(filter2, "Select a face on the second part to be edited", False)

If status = "Cancel" Then

MsgBox("Selection Canceled")

Exit Sub

End If

'edit the second part

CATIA.StartWorkbench("PrtCfg")

'clear second selection

sel_Second.Clear()


si quelqu'un peut me confirmer son fonctionnement je vais tenter de l'implanter dans mon code mais ayant plusieurs userforms avec des private sub et plusieurs objets sélection j'appréhende grandement !

Bonne journée !

ça marche pour moi Enfin, faie attention c'est assez instable comme méthode (je bloque pour copier une multi-sélection)

(bien penser à clear les selections, même avant la première sélection réalisée )