VBA Changer de set Geometrique

Bonjour à tous,

Voilà, je cherche à changer une entité de set geometrique.
j'arrive à connaitre le nom du set en utilisant:

Code:


Debug.Print hybridShapes2.Parent.Name


le problème est que c'est du read only.

Est ce quelqu'un peut me donner la solution?

Merci d'avance

Code:

Code:

faut faire un copier coller, et ensuite tu effaces la source

Salut Guss_,

Et non ça aurait été trop simple... Mon entité comporte plein d'enfants donc cela ne fonctionne pas.

Qaund tu dis "changer" ? qu'est ce que tu veux dire par là en fait?

changer de nom de place dans l'arborescence, modifier des éléments?

Ce que je souhaite faire, c'est l'équivalent de clic droit / objet « toto » / changer de Set Géométrique tout en gardant le nom et garantir la pérennité des enfants

Ok, as tu essayer de faire un enregistrement de macro en effectuant manuellement la manipulation que tu veux automatiser ?

Salut,
Oui, ça été mon premier reflexe après avoir cherché désespérément dans V5Automation.

Je pense appliquer la méthode suivante :
Copier coller de l’entité en question dans le set de destination
Faire un remplacer de mon ancienne entité la nouvelle
Puis la supprimer.

Il ne me reste plus qu’a trouver la commande pour le remplacement si tu as une idée…

Je trouve cette méthodo un peu lourde pour ce type de d’action qui est très utile.

Dis-moi si tu vois une méthodo plus appropriée.

Voilà quelques piste du copier coller

Il faut jouer avec des sélections


c'est une macro qui sélectionne des points dans une série de part identiques dans un produit pour les copier dans une autre part puis en sortir des coordonnées de chaque point dans un tableau excel

Code:

Public Excel As Object

'--- fonction permettant de positioner la fenetre d'une application en premier plan
Private Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long

Sub CATMain()

    '' initialisation des objets
    Dim docs As Documents
    Set docs = CATIA.Documents
    Dim document_actif As Document
    Set document_actif = CATIA.ActiveDocument
    ' origine
    Dim Product_origine As Part
    Set Product_origine = select_("selectioner depart", "Part")
    Dim part_origine As Part
    Dim Product_origine_Hshapes As HybridShapes
    Set Product_origine_Hshapes = Product_origine.Bodies.Item("CsI_T2Q1_B001").HybridBodies.Item(1).HybridShapes
        'destination
    Dim Product_dest As Part
    Set Product_dest = select_("selectioner destination", "Part")
    Dim set_geo As HybridBodies
    Set set_geo = Product_dest.HybridBodies
    nb_points = Product_origine_Hshapes.Count
    Dim selection As selection
    Set selection = document_actif.selection
    selection.Clear
    Dim point As point
    For traite_point = 1 To nb_points
      Set point = Product_origine_Hshapes.Item(traite_point)
      selection.Clear
      selection.Add point
      selection.Copy
      Dim points As HybridShapes
      selection.Clear
      selection.Add Product_dest
      selection.PasteSpecial "CATPrtResult"
    Next
   
    Product_dest.HybridBodies.Add
    start_excel
    Dim dest As HybridBody
    Dim ref As Reference
    Dim point_traite As point
    np_points = Product_dest.HybridBodies.Item(1).HybridShapes.Count
   
    For traite_point = 1 To nb_points
        Set point_traite = Product_dest.HybridBodies.Item(1).HybridShapes.Item(traite_point)
        Set ref = Product_dest.CreateReferenceFromObject(point_traite)
        Set dest = Product_dest.HybridBodies.Item(2)
        Dim dest_fact As HybridShapeFactory
        Set dest_fact = Product_dest.HybridShapeFactory
        Dim new_point As HybridShapePointCoord
        Set new_point = dest_fact.AddNewPointCoordWithReference(0, 0, 0, ref)
       
        dest.AppendHybridShape new_point
        Product_dest.Update
        Dim shapes_dest As HybridShapes
        Set shapes_dest = Product_dest.HybridBodies.Item(2).HybridShapes
       
        Dim coor(2)
        new_point.Name = point_traite.Name
        dest.HybridShapes.Item(traite_point).GetCoordinates coor
       
        point_vers_excel new_point.Name, CStr(coor(0)), CStr(coor(1)), CStr(coor(2)), CInt(traite_point)
    Next
   
    Dim produit_base As Product
    Set produit_base = document_actif.Product
    produit_base.Update

End Sub


Function select_(texte As String, type_ As String) As Object ' fonction séléctionant un porduit

    Dim EnableSelectionFor(0), UserSelection
   
    EnableSelectionFor(0) = type_
    Set selection = CATIA.ActiveDocument.selection
    selection.Clear
    MsgBox texte
    UserSelection = selection.SelectElement2(EnableSelectionFor, texte, False)
   
   
    If UserSelection <> "Normal" Then
        message = MsgBox("Erreur avec la sélèction!", vbCritical, "Error")
        End
    Else
        Set sel = selection.Item(1)
        Set select_ = sel.Value 'retourne la part séléctioner
    End If
End Function

Sub start_excel()
 lignes = 10
 colonnes = 3
   
    '---- initialisation excel
    On Error Resume Next
    Set Excel = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Set Excel = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Excel.Visible = True
   
'---- position Excel en 1er plan
    BringWindowToTop (Excel.hwnd)
   
'---- création de la feuille excel
    Excel.Workbooks.Add
End Sub


Public Sub point_vers_excel(nom As String, x As String, y As String, z As String, nb_point As Integer)

    Set wbks = Excel.ActiveWorkbook
    Set wbk = wbks.Sheets(1)
   
'------- passage catia -> excel
    wbk.cells(nb_point, 1) = nom
    wbk.cells(nb_point, 2) = x
    wbk.cells(nb_point, 3) = y
    wbk.cells(nb_point, 4) = z
   
End Sub



Bon en fait ce n'est pas possible dixit le support DS

Tant pis je vais essayer autre chose.

:/