---

Hallo Leute!

Ich brauche deien Hilfe wieder 

Ich möchte meine Links kurzen, so die Linkfluss zwischen Parts ist nicht gebrochen, wenn ich die beide Parts (oder ein Part) irgendwo ins Product Struktur schiebe 
Ich muss dafür SourcePart in neu Fenster öffnen, Body kopieren und in TargetPart mit Link einfugen. Aber Ich weiß es nicht warum folgende Code func nur für erstes Source/TargetPart  Kann mir jemand zeigen wo habe ich Fehler gemacht?

Code:

---

Sub CATMain()

Dim oHP As Product
Dim oSel As Selection
Set oHP = CATIA.ActiveDocument.Product
Dim oSourceProd As Product
Dim oTargetProd As Product
Dim InputObjectType(0) As Variant
InputObjectType(0) = "Product"
Set oSel = CATIA.ActiveDocument.Selection
Dim Source As Part
Dim Target As Part

Dim vis As Variant 'VisPropertySet 'This must be variant for late binding. Otherwise you get an error.
Dim r As Long
Dim g As Long
Dim b As Long

Dim oBodies As Bodies
Dim oBody As Body
Dim oSF As ShapeFactory
Dim oElems As OriginElements
Dim oSymPlane As HybridShapePlaneExplicit
Dim oRef As Reference
Dim oSym As Symmetry
Dim oHSS As HybridShape

Dim oSourceCol As New VBA.Collection
Dim oTargetCol As New VBA.Collection

Dim oDSel
Set oDSel = oSel
oDSel.Clear

Set oSel2 = CATIA.ActiveDocument.Selection

Result = oDSel.SelectElement3(InputObjectType(), "Wybierz party źródłowe", True, CATMultiSelTriggWhenUserValidatesSelection, False)

For i = 1 To oDSel.Count
    oSourceCol.Add oDSel.Item(i).Value
Next
oDSel.Clear
Result = oDSel.SelectElement3(InputObjectType(), "Wybierz party docelowe", True, CATMultiSelTriggWhenUserValidatesSelection, False)

For i = 1 To oDSel.Count
    oTargetCol.Add oDSel.Item(i).Value
Next

For i = 1 To oSourceCol.Count
    Set Source = oSourceCol.Item(i).Products.Item(1).ReferenceProduct.Parent.Part
    CATIA.StartCommand "Open in New Window"
    Set Target = oTargetCol.Item(i).ReferenceProduct.Parent.Part
   
    oSel.Clear
    oSel.Add Source.MainBody
    Set vis = oSel.VisProperties
    vis.GetRealColor r, g, b
    oSel.Copy
    oSel.Clear

    oSel.Add Target
    oSel.PasteSpecial "CATPrtResult"
    vis.SetRealColor r, g, b, 0
    oSel.Clear
    Target.Update
    Set oBodies = Target.Bodies
    Set oBody = oBodies.Item(oBodies.Count)
    Target.InWorkObject = oBody
    Set oSF = Target.ShapeFactory
    Set oElems = Target.OriginElements
    Set oSymPlane = oElems.PlaneZX
    Set oRef = Target.CreateReferenceFromObject(oSymPlane)
    Set oSym = oSF.AddNewSymmetry2(oRef)
    Set oHSS = oSym.HybridShape
    Target.MainBody = oBody
    oSel.Add oBodies.Item("PartBody")
    oSel.Delete
    oSel.Clear
    Target.MainBody.Name = "PartBody"
    Target.Update
Next

End Sub

---

Gruß

Lucas

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

---

Servus Lucas

Willst du also keinen Kontext-Link, sondern einen Link direkt zwischen Part und Part?
Was meinst du mit func nur für erstes Source/TargetPart? Also nur für oSourceCol.Item(1)?

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 Lucas

Willst du also keinen Kontext-Link, sondern einen Link direkt zwischen Part und Part?
Was meinst du mit [i]func nur für erstes Source/TargetPart? Also nur für oSourceCol.Item(1)?

Gruß
Bernd

[/i]

---

Ja - das ist was ich will - Einfach Link zwischen beide Teile - ohne gantzte "Pfad" von dem Target zum Source Part.

[Diese Nachricht wurde von Sylas am 15. Jun. 2022 editiert.]

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

---

Servus

Und was funktioniert nicht? Bekommst du eine Fehlermeldung? Öffnet sich das richtige 2. Target-Part? Bringt dir Local/Watch-Fenster einen Hinweis was falsch läuft?
ggf erst Fenster des ersten Targetparts schließen, Fenster der Baugruppe aktivieren, zweites Target-Product selektieren und "Open in new Window" ausführen

Gruß
Bernd

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

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

---

Hallo Bernd

Ich habe Schritt per Schritt das Skript ausgefuhrt, und alles geht i.O. zum Schritt, wo ich die Body aus SourcePart kopiere. Ich siehe das Selektion ist nicht lehr. Dann schlisse ich die SourcePart mit

Code:

---

CATIA.activewindow.close

---

mache ich Selektion lehr, fuge ich das TargetPart hinzu, und einfuge mit

Code:

---

oSel.PasteSpecial "CATPrtResult"

---

aber garnichst ist eingefugt :(

Wo habe ich ein Fehler gemacht? (Voll Code unter)

Code:

---

Sub CATMain()

Dim oHP As Product
Dim oSel As Selection
Dim oSel2 As Selection
Set oHP = CATIA.ActiveDocument.Product
Dim oSourceProd As Product
Dim oTargetProd As Product
Dim InputObjectType(0) As Variant
InputObjectType(0) = "Product"
Set oSel = CATIA.ActiveDocument.Selection

Dim Source As Part
Dim Target As Part

Dim vis As Variant
Dim r As Long
Dim g As Long
Dim b As Long

Dim oBodies As Bodies
Dim oBody As Body
Dim oSF As ShapeFactory
Dim oElems As OriginElements
Dim oSymPlane As HybridShapePlaneExplicit
Dim oRef As Reference
Dim oSym As Symmetry
Dim oHSS As HybridShape

Dim oSourceCol As New VBA.Collection
Dim oTargetCol As New VBA.Collection

Dim oSourceMatrix(11) 'As Variant
Dim oTargetMatrix(11) 'As Variant

Dim oDSel
Set oDSel = oSel
oDSel.Clear

Result = oDSel.SelectElement3(InputObjectType(), "Wybierz party źródłowe", True, CATMultiSelTriggWhenUserValidatesSelection, False)

For i = 1 To oDSel.Count
    oSourceCol.Add oDSel.Item(i).Value
Next
oDSel.Clear
Result = oDSel.SelectElement3(InputObjectType(), "Wybierz party docelowe", True, CATMultiSelTriggWhenUserValidatesSelection, False)

For i = 1 To oDSel.Count
    oTargetCol.Add oDSel.Item(i).Value
Next

oDSel.Clear

For i = 1 To oSourceCol.Count

    'definicja partów: źrodłowego i mirrora
    Set Source = oSourceCol.Item(i).Products.Item(1).ReferenceProduct.Parent.Part
    Set Target = oTargetCol.Item(i).Products.Item(1).ReferenceProduct.Parent.Part
   
    'kopiowanie body ze żródła
    oSel.Clear
    oSel.Add Source
    CATIA.StartCommand "Open in New Window"
    Set oSel = CATIA.ActiveDocument.Selection
    oSel.Clear
    oSel.Add Source.MainBody
   
    'kopiowanie kolorów
    Set vis = oSel.VisProperties
    vis.GetRealColor r, g, b
    oSel.Copy
    oSel.Clear
   
    'zamykam okno Source
    CATIA.ActiveWindow.Close
   
    'otwieram okno Target
    Set oSel2 = CATIA.ActiveDocument.Selection
    oSel2.Clear
    oSel2.Add Target
    oSel2.PasteSpecial "CATPrtResult"
   
    'nadawanie kolorów
    vis.SetRealColor r, g, b, 0
    oSel.Clear
    Target.Update
   
    'dodawnie symetrii
   
    Set oBodies = Target.Bodies
    Set oBody = oBodies.Item(oBodies.Count)
    Target.InWorkObject = oBody
    Set oSF = Target.ShapeFactory
    Set oElems = Target.OriginElements
    Set oSymPlane = oElems.PlaneZX
    Set oRef = Target.CreateReferenceFromObject(oSymPlane)
    Set oSym = oSF.AddNewSymmetry2(oRef)
    Set oHSS = oSym.HybridShape
    Target.MainBody = oBody
    oSel.Add oBodies.Item("PartBody")
    oSel.Delete
    oSel.Clear
    Target.MainBody.Name = "PartBody"
    Target.Update

Next
Set oSel = CATIA.ActiveDocument.Selection
End Sub

---

Hilf mir hier, oder Ich werde verrückt 

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

---

Servus Lucas

Probier mal das Zielpart im extra Fenster zu öffnen.
Etwa so:

Code:

---

Set RootWindow = CATIA.ActiveWindow

For i = 1 To oSourceCol.Count
    'copy source body
    Set Source = oSourceCol.Item(i).Products.Item(1).ReferenceProduct.Parent.Part   
    oSel.Clear
    oSel.Add Source.MainBody
    oSel.Copy
    oSel.Clear
   
    'open Target
    Set TargetProduct = oTargetCol.Item(i).Products.Item(1).ReferenceProduct
    oSel.Add TargetProduct 
    CATIA.StartCommand "Open in New Window"
    'paste body
    oSel.Clear
    oSel.add TargetProduct.Parent.Part
    oSel.PasteSpecial "CATPrtResult"   
    oSel.Clear
    TargetProduct.Parent.Part.Update
   
    CATIA.ActiveWindow.Close
    RootWindow.Activate

Next

---

Vorsicht wenn die Anzahl der Elemente in den beiden Collections unterschiedlich sind.

Gruß
Bernd

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

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