VBA Changer de set Geometrique

Voir le sujet précédent Voir le sujet suivant Aller en bas

R?solu VBA Changer de set Geometrique

Message par lemok le Lun 10 Sep 2012 - 20:11

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:
avatar
lemok
timide
timide

Messages : 17
Date d'inscription : 17/05/2011
Localisation : Pau

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par Guss_ le Lun 10 Sep 2012 - 23:56

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

Guss_
Fédérateur
Fédérateur

Messages : 498
Date d'inscription : 08/01/2010

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par lemok le Mar 11 Sep 2012 - 1:28

Salut Guss_,

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

Messages : 17
Date d'inscription : 17/05/2011
Localisation : Pau

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par Guss_ le Mar 11 Sep 2012 - 1:53

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?

Guss_
Fédérateur
Fédérateur

Messages : 498
Date d'inscription : 08/01/2010

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par lemok le Mar 11 Sep 2012 - 2:14

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
avatar
lemok
timide
timide

Messages : 17
Date d'inscription : 17/05/2011
Localisation : Pau

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par Guss_ le Mar 11 Sep 2012 - 3:09

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

Guss_
Fédérateur
Fédérateur

Messages : 498
Date d'inscription : 08/01/2010

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par lemok le Mar 11 Sep 2012 - 18:32

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 Arrow 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.
avatar
lemok
timide
timide

Messages : 17
Date d'inscription : 17/05/2011
Localisation : Pau

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par Guss_ le Mar 11 Sep 2012 - 20:10

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



Guss_
Fédérateur
Fédérateur

Messages : 498
Date d'inscription : 08/01/2010

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par lemok le Jeu 11 Oct 2012 - 19:41

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

Tant pis je vais essayer autre chose.
avatar
lemok
timide
timide

Messages : 17
Date d'inscription : 17/05/2011
Localisation : Pau

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par Guss_ le Jeu 11 Oct 2012 - 19:47

:/

Guss_
Fédérateur
Fédérateur

Messages : 498
Date d'inscription : 08/01/2010

Revenir en haut Aller en bas

R?solu Re: VBA Changer de set Geometrique

Message par Contenu sponsorisé


Contenu sponsorisé


Revenir en haut Aller en bas

Voir le sujet précédent Voir le sujet suivant Revenir en haut

- Sujets similaires

 
Permission de ce forum:
Vous ne pouvez pas répondre aux sujets dans ce forum