---

Halo Zusammen

Ich habe kleines Makro geschrieben für copy / paste special Function (siehe Code). Was das Makro macht ist:
-kopiert mehrere Bodies vom Product
-unter Ziel-Part mit original Farben und Body-Namen einfügt
(so wie generate allcatpart Function, aber ein bischen erweitert  )

Es funct ganz Gut, aber das Problem ist, wenn Quelle-Part mehrere Bodies mit gleiche Namen hast, dann alle Bodies sind kopiert unter das gleiches Platz in 3D  Wie kann ich das Problem losen?
Der Code unter. Ich entschuldige mich für mein Deutsch - es ist kein Mutterspräche für mich 

Code:

---

Public sNew_body_name As String
Public Sub CATMain()

Dim visPropSet As VisPropertySet

  Set oRoot = CATIA.ActiveDocument
  If TypeName(oRoot) <> "ProductDocument" Then
      MsgBox "Das aktive Dokument ist kein .CATProduct    " & vbLf _
      & "Abbruch.      ", 16, " " & TypeName(oRoot) & " geöffnet."
      Exit Sub
  End If

  CATIA.DisplayFileAlerts = False
  Set oRootProd = oRoot.Product

  If CATIA.GetWorkbenchId <> "Assembly" Then
      MsgBox "Scriptausführung nur in der AssemblyDesignWorkbench möglich.    " & vbLf & "Abbruch.", 16, " Aktive Workbench " & CATIA.GetWorkbenchId
      Exit Sub
  End If

  Set oselection = CATIA.ActiveDocument.Selection

  Dim InputObjectType(0)
  Dim Status
  InputObjectType(0) = "Body"

  'oselection.Clear
  Status = oselection.SelectElement3(InputObjectType, "****************    Bitte ein oder mehrere Bodies  auswählen oder <ESC> drücken zum Abbrechen            " & _
                            "****************", True, CATMultiSelTriggWhenUserValidatesSelection, False)

  If (Status <> "Normal") Then
      Exit Sub
  Else
      'Dim aSelectedElements()
      ReDim aSelectedElements(0)
      iSelCounter = oselection.Count
      Dim i As Integer
      For i = 1 To oselection.Count
        Dim sRefString As String
        Set oSelElement = oselection.Item(i).value  'oSelection.Item(1).Value
        sRefString = "!" & oSelElement.Name
        Set oleafprod = oselection.Item(i).LeafProduct
        Set oParent = oleafprod
        sRefString = oParent.Name & "/" & sRefString
        Do
            Set oParent = FUNC_PathToRoot(oParent)
            sRefString = oParent.Name & "/" & sRefString
        Loop Until LCase(oParent.Parent.Parent.Name) = "cnext"
        Dim bNotInBooleanOp As Boolean
        bNotInBooleanOp = FUNC_NotInBooleanOp(oSelElement, oleafprod)
        If bNotInBooleanOp Then
            ReDim Preserve aSelectedElements(UBound(aSelectedElements) + 1)
            Set aSelectedElements(UBound(aSelectedElements)) = oRootProd.CreateReferenceFromName(sRefString)
        End If
      Next
  End If

  Dim InputObjectType2(0)
 
  Name_version.Show
 
Ziel:
  InputObjectType2(0) = "Product"

  oselection.Clear
  Status = oselection.SelectElement2(InputObjectType2, "****************    Bitte das Zielpart auswählen oder <ESC> drücken zum Abbrechen              " & _
                            "****************", False)

  If (Status <> "Normal") Then
      Exit Sub
  Else
      If oselection.Count <> 1 Then
        MsgBox oselection.Count & " Elemente selektiert.      " & vbLf & "Abbruch.", 16, " Falsche Selektion."
        Exit Sub
      Else
        Set oZP = oselection.Item(1).value
        oselection.Clear
      End If
  End If
 
  '--- Ziel-Part
  Dim j As Integer
  For j = 1 To UBound(aSelectedElements)
      Set oZPBodies = oZP.ReferenceProduct.Parent.Part.Bodies
      oselection.Clear
      oselection.Add aSelectedElements(j)
      oselection.Copy
      oselection.Clear
      oselection.Add oZPBodies
      oselection.PasteSpecial "CATPrtResultWithOutLink"
      oselection.Clear
      oZP.Update
       
      Set oLastBody = oZPBodies.Item(oZPBodies.Count)
      If sNew_body_name = "full_name" Then
        oLastBody.Name = aSelectedElements(j).DisplayName 'bLastBodyName(0) 'aLastBodyName(0) & aLastBodyName(1)
      Else
        aLastBodyName = Split(aSelectedElements(j).DisplayName, "!")
        bLastBodyName = Split(aLastBodyName(1), "/")
        oLastBody.Name = bLastBodyName(0) 'aLastBodyName(0) & aLastBodyName(1)
      End If
      oZP.ReferenceProduct.Parent.Part.Update
  Next

  oselection.Clear
New_target = MsgBox("Möchten Sie änder Ziel-Produkt nahmen?", vbOKCancel, "Neues Ziel-Produkt")
If New_target = 1 Then
    GoTo Ziel
End If

End Sub

Function FUNC_PathToRoot(oProdOnWayToRoot)
  Set FUNC_PathToRoot = oProdOnWayToRoot.Parent.Parent
End Function

Function FUNC_NotInBooleanOp(oSelectedElement, oSelProd)
  bIsInBoolOp = oSelectedElement.InBooleanOperation
  If bIsInBoolOp = 0 Then
      FUNC_NotInBooleanOp = True
  Else
      sBodyName = oSelectedElement.Name
      MsgBox oSelectedElement.Name & " im Part " & oSelProd.Name & vbLf _
            & "wird nicht kopiert    ", 16, " Body in boolscher Operation enthalten"
      FUNC_NotInBooleanOp = False
  End If
End Function

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus Lukas

Wenn wirklich mehrere Bodies im Part gleich heißen (was meiner Ansicht eine schlechte Idee ist), hilft wohl vermutlich nur ein (ggf auch nur temporäres) umbenennen auf eindeutige Namen.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von bgrittmann:
Servus Lukas

Wenn wirklich mehrere Bodies im Part gleich heißen (was meiner Ansicht eine schlechte Idee ist), hilft wohl vermutlich nur ein (ggf auch nur temporäres) umbenennen auf eindeutige Namen.

Gruß
Bernd

---

Halo Bernd

Was wurde die beste Methode?

Code:

---

Set oLastBody = oZPBodies.Item(oZPBodies.Count)
  'hier oLastBody.Name mit oZPBodies.Item(oZPBodies.Count-1).Name vergleichen?
      If sNew_body_name = "full_name" Then
        oLastBody.Name = aSelectedElements(j).DisplayName 'bLastBodyName(0) 'aLastBodyName(0) & aLastBodyName(1)
      Else
        aLastBodyName = Split(aSelectedElements(j).DisplayName, "!")
        bLastBodyName = Split(aLastBodyName(1), "/")
        oLastBody.Name = bLastBodyName(0) 'aLastBodyName(0) & aLastBodyName(1)
      End If
      oZP.ReferenceProduct.Parent.Part.Update

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus Lukas

Du müsstest den Körper vor dem Kopieren (bzw auch vor dem Bilden des Pfads) umbenennen.
Also zB vor dem Bilden des Pfades ein Prä- bzw Postfix an den Namen anfügen (zurück umbenennen dann schon nach den kopieren möglich, oder erst nach dem Einfügen?)

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus

Das erscheint zu komplex für mich  Auf jeden Fall, ich möchte kein Name des Quelle-Body ändern 

Die einige Losung welsche ich im Kopf habe, is ganze Makro-struktur umbauen: zuerst Collection mit Original-Namen, Zwischen-Namen und R G B Farbe für jedes Qelle-Body bauen, aber das erscheint als von dem Anfang zu starten 

Hast du vielleicht andere Idee? Kannst du mir bischen weiter Helfen?

Gruß

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo zusammen,

Ich habe gerade mal ein wenig getestet (manuell) und konnte das Problem nicht nachvollziehen.

Bist du dir sicher dass das (Bodies mit gleichen Namen) überhaupt die Ursache ist, oder kann es sein das du das Problem nur bei Teilen hast die mehrfach in deiner Baugruppe verbaut sind?

Gruß Randle

------------------
Planung ersetzt Fehler durch Irrtum!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus

Ich befürchte dass es nicht ohne eindeutige Namen der Bodies geht.
Also in deinem Fall nur durch eine temporäre Umbenennung im Quellpart.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

es geht, wenn die InternalName angewendet werden, um den Pfad sRefString zu bauen:

Code:

---

Dim MyInternalName As String
MyInternalName = MyObject.GetItem(„ModelElement“).InternalName

---

Damit sind die Namen von Bodies eindeutig. CATIA kommt damit normalerweise zu recht um später eine Referenz mit CreateReferenceFromName zu machen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Sylas,

Das Einfügen sollte nicht das Problem sein. CATIA fügt auch mehrere Bodies mit dem selben Namen ein. Der InternalName ist ja dennoch unterschiedlich.

Ich habe ein ähnliches Problem gehabt. Bei mir sind es jedoch Skizzen gewesen, die aus unterschiedlichen Parts kommen, aber den gleichen namen aufweisen. Wie Bernd schon geschrieben hat, musst du diese Elemente umbenennen.
Ich habe das ganze jedoch nach dem Einfügen in das ZielPart gemacht. Ich weiß in meinem Beispiel jedoch auch, was kopiert und wo es eingefügt wird. daher kann ich nach dem Kopiervorgang einfach das letzte Element suchen und den Namen ändern.

Hier ein Auszug aus meinem Code:
[...]
Sel.Clear
Sel.Add objSkt
Sel.Copy
Sel.Clear
Sel.Add partZiel
Sel.PasteSpecial "CATPrtResult"

Set HBs = partZiel.HybridBodies
Set HBExternalRef = HBs.Item("External References")
Set objNew = HBExternalRef.HybridSketches.Item(HBExternalRef.HybridSketches.Count)
objNew.Name = strName  '## Neuer Name
Sel.Clear

[...]

Und eine kleine Anmerkung noch:
Ich kopiere die Elemente alle der Reihe nach und nicht alle aufeinmal, um die Elemente im ZielPart finden zu können.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von ptit.tom:
es geht, wenn die InternalName angewendet werden, um den Pfad sRefString zu bauen:

Code:

---

Dim MyInternalName As String
MyInternalName = MyObject.GetItem(„ModelElement“).InternalName

---

Damit sind die Namen von Bodies eindeutig. CATIA kommt damit normalerweise zu recht um später eine Referenz mit CreateReferenceFromName zu machen

---

Hello
Vielleicht mache ich etwas falsch, aber auf Ihre Weise erhalte ich in den meisten Fällen für denselben Körpernamen, zum Beispiel MANIFOLD_SOLID_BREP #292560, denselben InternalName
"MechanicalTool.1" daher sind die internen Namen nicht eindeutig 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,
du musst die Körper über eine Referenz kopieren, damit auch wirklich der Körper aus der jeweils richtigen Instanz kopiert wird. In diesem Zusammenhang vielleicht mal hier reinschauen:
https://ww3.cad.de/foren/ubb/Forum137/HTML/003749.shtml#000021]

Gruß
Randle

------------------
Planung ersetzt Fehler durch Irrtum!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus Lukas

In meinem Kurztest gibt InternalName einen eindeutigen Namen zurück.
Ohne den ensprechenden Teil des Codes zu sehen ist es schwierig zu bewerten an was es liegt.

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von bgrittmann:
Servus Lukas

In meinem Kurztest gibt [i]InternalName einen eindeutigen Namen zurück.
Ohne den ensprechenden Teil des Codes zu sehen ist es schwierig zu bewerten an was es liegt.

Gruß
Bernd

Halo Bend

Der Code befindet sich unter

[URL=https://ww3.cad.de/foren/ubb/Forum137/HTMLna/007028.shtml][/URL]

[/i]

---

Ich versuche beide Themen zusammenfassen. Sorry.

Gruß

Lucas

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP