---

Hallo zusammen

habe folgendes Problem.Bastle mir grad ein Macro zusammen mit dem ich Catparts im Product zusammenbauen möchte.Mein Problem ist die selektion der referenzelemente.Das Macro soll für verschiedene Baugruppen funktioneren.DAs referenzelement Hilfsebene SGxx-xx ist immer enthalten .Habe über selection1.Search "Name=*Hilfsebene*,all"
auch keine Probleme das zu selektieren.Was muss ich aber machen das es als referenz gesetzt wird.So wie jetzt ist ist unbrauchbar da es nur mit einer Spanngruppe funktioniert.Ich denke das Problem liegt hier: Set reference1 = product1.CreateReferenceFromName("Spanngruppe 08.12/Adapterpart 08.1/!Result of Hilfsebene SG09-02")
Es soll quasi universell funktioneren und immer das element angesprochen werden das in seinem Namen "Hilfsebene" enthält.

Bitte um Hilfe!!!

Vielen Dank schonmal im voraus!!

Language="VBSCRIPT"

Sub CATMain()

Dim productDocument1 As Document
Set productDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = productDocument1.Selection

selection1.Search "Name=*Hilfsebene*,all"

Dim product1 As Product
Set product1 = productDocument1.Product

Dim constraints1 As Collection
Set constraints1 = product1.Connections("CATIAConstraints")

Dim reference1 As Reference
Set reference1 = product1.CreateReferenceFromName("Spanngruppe 08.12/Adapterpart 08.1/!Result of Hilfsebene SG09-02")

Dim reference2 As Reference
Set reference2 = product1.CreateReferenceFromName("Spanngruppe 08.12/X01 PA-Kontur 08-01.1/!Schnittebene.1")

Dim constraint1 As Constraint
Set constraint1 = constraints1.AddBiEltCst(catCstTypeOn, reference1, reference2)

constraint1.Orientation = catCstOrientSame

product1.Update

End Sub

Gruß Andi

[Diese Nachricht wurde von Augustiner am 16. Dez. 2005 editiert.]

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

---

Hi Augustiner,

versuch mal folgendes für deine reference1:

selection1.Search "Name=*Hilfsebene*,all"

Dim reference1 As Reference
' Hiermit solltest du die Referenz der selektierten Ebene bekommen
' eventuelle Behandlung falls mehrere Ebenen gefunden wurden
if (selection.count=1) then
  Set reference1 = selection.item(1).value
end if

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

---

Hallo Proofin

das was du geschrieben hast hab ich ja schon gemacht.Das Problem ist nach Dim reference1 As Reference
kommt dann

Set reference1 = product1.CreateReferenceFromName("Spanngruppe 08.12/Adapterpart 08.1/!Result of Hilfsebene SG09-02")

und hier liegt das Problem das er mir den ganzen namen des elements reinkopiert und das makro unbrauchbar wird wenn in der nächsten Spanngruppe die Hilfsebene dann z.b "Hilfsebene SG03-05" heisst.

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

---

Hallo,

die Schwierigkeit bei Constraints ist, das man die Referenz nur über die  Methode .CreateReferenceFromName setzten kann (nicht über die Objekte direkt), also immer den String am Hals hat. Das ist aber eigentlich gar nicht weiter tragisch.
Kopiere dir den folgenden Code mal in ein .CATScript und ruf eine Productstruktur auf, die Sub-Products und Parts enthält.
Starte das Script. Das Script löscht alle vorhandenen Baugruppenconstraints raus und setzt ein .Fix auf alle Parts und Products, die verbaut sind. Die Syntax des SuchStrings für die .CreateReferenceFromName-Methode ist über die Objekt Namen zusammengesetzt.

Hoffe der Code ist selbsterklärend und du kannst es auf deinen Fall übertragen, da du ja nichts Fixen willst. Aber das Prinzip ist das gleiche.

Vorsicht: Die Zeilen waren teilweise zu lang. D.h. aus einer Zeile wurden zwei. Im Script wieder in eine Zeile zusammenfügen, sonst hagelts Errors.

Falls du noch Probleme hast, melde dich.

Gruss

TomTom

Der Source-Code
________________________________

Language="VBSCRIPT"

Public oSelection

Sub CATMain()

Dim oProduct
Dim oProducts
Dim bIsAComponent As Boolean

Set oRoot = Catia.ActiveDocument

Set oProduct = oRoot.Product
Set oProducts = oProduct.Products

Set oSelection = Catia.ActiveDocument.Selection

SUB_ProdScan oProducts, False

End Sub

Sub SUB_ProdScan(oProducts, bIsAComponent) 'Rekursive Funktion: Scant alle Subs

If bIsAComponent = False Then
   Set oConnections = Catia.Documents.Item(oProducts.Parent.ReferenceProduct.Parent.Name).Product.Connections("CATIAConstraints")
ElseIf bIsAComponent = True Then
   Set oConnections = oProducts.Parent.Connections("CATIAConstraints")
End If
   
iConnectionsCount = oConnections.Count
oSelection.Clear
        
For a = 1 To iConnectionsCount
   oSelection.Add (oConnections.Item(a))
Next
        
If oSelection.Count > 0 Then
   'oSelection.Clear
   oSelection.Delete
  
End If
       
oSelection.Clear

For x = 1 To oProducts.Count 'zaehlt die Children des aktuellen Subs

   If bIsAComponent = False Then   'übergebenes Root ist keine Komponente
      Set oProductOpen = Catia.Documents.Item(oProducts.Parent.PartNumber & ".CATProduct").Product
      '-----------Fixieren
      Set oReference = oProductOpen.CreateReferenceFromName(oProductOpen.PartNumber & "/" & oProductOpen.Products.Item(x).Name & "/!" & oProductOpen.PartNumber & "/" & oProductOpen.Products.Item(x).Name & "/")
      Set oConstraint = oProductOpen.Connections("CATIAConstraints").AddMonoEltCst(catCstTypeReference, oReference)
   ElseIf bIsAComponent = True Then   'übergebenes Root ist eine Komponente
      Set oReference = oProducts.Parent.CreateReferenceFromName(oProducts.Parent.PartNumber & "/" & oProducts.Parent.Products.Item(x).Name & "/!" & oProducts.Parent.PartNumber & "/" & oProducts.Parent.Products.Item(x).Name & "/")
      Set oConstraint = oProducts.Parent.Connections("CATIAConstraints").AddMonoEltCst(catCstTypeReference, oReference)
   End If
   If TypeName(oProducts.Item(x).ReferenceProduct.Parent) = "PartDocument" Then 'Check ob PartDoc
      ' passiert gar nix
   ElseIf TypeName(oProducts.Item(x).ReferenceProduct.Parent) = "ProductDocument" Then
      Err.Number = 0
      On Error Resume Next
      Set oMasterShape = oProducts.Item(x).GetMasterShapeRepresentation(True)
      If Err.Number = 0 Then   'it s a others
         ' passiert gar nix
      ElseIf oProducts.Item(x).ReferenceProduct.Parent.Name = oProducts.Item(x).Parent.Parent.ReferenceProduct.Parent.Name Then   '---its a Component
         On Error GoTo 0
         SUB_ProdScan Catia.Documents.Item(oProducts.Item(x).ReferenceProduct.Parent.Name).GetItem(oProducts.Item(x).PartNumber).Products, True
      ElseIf oProducts.Item(x).ReferenceProduct.Parent.Name <> oProducts.Item(x).Parent.Parent.ReferenceProduct.Parent.Name Then   '---its a Product
         On Error GoTo 0
         If oProducts.Item(x).Products.Count > 0 Then
            Set oProductsUebergabe = oProducts.Item(x).Products
            SUB_ProdScan oProductsUebergabe, False
         End If
      End If
      On Error GoTo 0
   End If
Next

End Sub

------------------
tomtom1972

[Diese Nachricht wurde von tomtom1972 am 16. Dez. 2005 editiert.]

[Diese Nachricht wurde von tomtom1972 am 16. Dez. 2005 editiert.]

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

---

sorry hab ich nicht dazu geschrieben:
ich meinte auch Anstelle deiner Zuweisung:
Dim reference1 As Reference
Set reference1 = product1.CreateReferenceFromName("Spanngruppe 08.12/Adapterpart 08.1/!Result of Hilfsebene SG09-02")

meine Anweisung:
if (selection.count=1) then
  Set reference1 = selection.item(1).value
end if

dann sollte in reference1 deine benötigte Referenz stehen.

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

---

Hallo Proofin,

das funktioniert leider nicht für Constraints.
Die gehen wie gesagt nur über den .CreateReferenceFromName und nicht über die Objekte (selection.item(1).value) selbst.

Gruss TomTom

------------------
tomtom1972

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

---

Struktur.jpg Errorlog.jpg

Hallo tomtom

vielen Dank erstmal für Deine Hilfe.Tut mir leid das ich mich jetzt erst melde.Hatte aber leider erst jetzt die gelegenheit das zu testen.

Hab jetzt mal auf die schnelle dein script bei mir reinkopiert und es laufen lassen, aber es kommt eine fehlermeldung hier:
   siehe 2. Bild

keine Ahnung warum?? Muss auch dazu sagen das ich mich erst wieder in das Thema einarbeiten muss.......hab einiges vergessen über Weihnachten und neujahr...............

Gruß Andi

Hier noch die Struktur an der ich teste

[Diese Nachricht wurde von Augustiner am 18. Jan. 2006 editiert.]

[Diese Nachricht wurde von Augustiner am 18. Jan. 2006 editiert.]

[Diese Nachricht wurde von Augustiner am 18. Jan. 2006 editiert.]

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

---

Also hab bis jetzt Dein Script nicht zum laufen gebracht.Hab schon alles mögliche probiert.Wie war die Struktur aufgebaut an der Du es getestet hast??

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

---

error.jpg

Hallo Augustiner,

wenn ich deinen Screenshot richtig interpretiere, arbeitest du im CacheModus bzw. deine Struktur ist nur im Visualization Mode geladen.
Das Script fix auch alle Parts in Sub-Produkten. Dies erfolgt rekursiv, das heisst wenn ein .Item des Root-Products ein .CATProduct ist, ruft sich die Sub selbst auf. An der Stelle hängt es sich im CachModus auf (siehe Fehlermeldung im Anhang).

Wenn der entsprechende Teil aus dem Script gelöscht wird, läuft es (für die erste Ebene eines Products) auch im Cache Modus (siehe Code unten)

Das Script läuft völlig unabhängig von irgendeiner bestimmten Struktur (auf die Namen bezogen).

Ist meine Vermutung richtig?

Language="VBSCRIPT"

Public oSelection

Sub CATMain()

Dim oProduct
Dim oProducts
Dim bIsAComponent As Boolean

Set oRoot = Catia.ActiveDocument

Set oProduct = oRoot.Product
Set oProducts = oProduct.Products

Set oSelection = Catia.ActiveDocument.Selection

SUB_ProdScan oProducts, False

End Sub

Sub SUB_ProdScan(oProducts, bIsAComponent) 'Rekursive Funktion: Scant alle Subs

If bIsAComponent = False Then
  Set oConnections = Catia.Documents.Item(oProducts.Parent.ReferenceProduct.Parent.Name).Product.Connections("CATIAConstraints")
ElseIf bIsAComponent = True Then
  Set oConnections = oProducts.Parent.Connections("CATIAConstraints")
End If
   
iConnectionsCount = oConnections.Count
oSelection.Clear
       
For a = 1 To iConnectionsCount
  oSelection.Add (oConnections.Item(a))
Next
       
If oSelection.Count > 0 Then
  'oSelection.Clear
  oSelection.Delete
 
End If
       
oSelection.Clear

For x = 1 To oProducts.Count 'zaehlt die Children des aktuellen Subs

  If bIsAComponent = False Then  'übergebenes Root ist keine Komponente
      Set oProductOpen = Catia.Documents.Item(oProducts.Parent.PartNumber & ".CATProduct").Product
      '-----------Fixieren
      Set oReference = oProductOpen.CreateReferenceFromName(oProductOpen.PartNumber & "/" & oProductOpen.Products.Item(x).Name & "/!" & oProductOpen.PartNumber & "/" & oProductOpen.Products.Item(x).Name & "/")
      Set oConstraint = oProductOpen.Connections("CATIAConstraints").AddMonoEltCst(catCstTypeReference, oReference)
  ElseIf bIsAComponent = True Then  'übergebenes Root ist eine Komponente
      Set oReference = oProducts.Parent.CreateReferenceFromName(oProducts.Parent.PartNumber & "/" & oProducts.Parent.Products.Item(x).Name & "/!" & oProducts.Parent.PartNumber & "/" & oProducts.Parent.Products.Item(x).Name & "/")
      Set oConstraint = oProducts.Parent.Connections("CATIAConstraints").AddMonoEltCst(catCstTypeReference, oReference)
  End If
      On Error GoTo 0

Next

End Sub

TomTom

------------------
tomtom1972

[Diese Nachricht wurde von tomtom1972 am 19. Jan. 2006 editiert.]

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

---

Hallo

nein es ist alles im Design Modus geladen.

Anbei noch eine Frage, da Du Dich ja anscheinend recht gut auskennst mit Makros.Weisst Du wer Schulungen dazu anbietet und was sowas kostet?

[Diese Nachricht wurde von Augustiner am 19. Jan. 2006 editiert.]

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

---

Hallo,

zu den Schulungen:

schicke mir ne mail, dann sende ich dir Namen zu.
Standardschulungen taugen in dem Zusammenhang nichts. Die Schulungen, die ich besucht habe, waren deshalb immer als "Workshop" angelegt mit möglichst wenigen Teilnehmern (2-3). Preis lag immer so bei 850-1000 Euro pro Tag (pauschal, nicht pro Person).

zu deinem Problem: ich überlege noch.

Lässt du das ganze in einem CATScript laufen? Oder ein VBA?

Gruss
TomTom

------------------
tomtom1972

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

---

Errorlog.jpg

Ich lasse es in einem Catscript laufen und zum Schluss kommt die fehlermeldung.

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

---

Hallo,

das sieht so aus, als ob mit der For..Next schleife etwas nicht stimmt. D.h. das zum Bsp ein ... End if ... oder ähnliches fehlt.

Hast du den Code in ein anderes Script kopiert (in welchem schon anderer Code enthalten war) oder kopierts du nur den oben geposteten rein und sonst nichts?

TomTom

------------------
tomtom1972

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

---

Error2.jpg

Hab ich nur in ein leeres catscript reinkopiert.

Edit:

So nochmal neu reinkopiert ohne was zu ändern. 

Dann kommt die im Anhang gezeigte Fehlermeldung.

[Diese Nachricht wurde von Augustiner am 19. Jan. 2006 editiert.]

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

---

Hallo,

probiere mal folgendes:

Sub CATMain()
On Error Resume Next      '-----  <  Zeile zufügen
Dim oProduct

Jetzt müsste das Script auf jeden Fall ohne Fehlermeldung durchlaufen.
Stellt sich nur noch die Frage: Werden die Modelle in der ersten Strukturebene alle fixiert?

TomTom

------------------
tomtom1972

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

---

OK das funktioniert jetzt!!

aber nur in der ersten ebene

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

---

Hallo,
den Rest bekommen wir auch noch hin. Aber Morgen früh, für heute ist Schluss....

Gruss

TomTom

------------------
tomtom1972

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

---

Hallo

an dieser Stelle möchte ich mich mal recht herzlich bedanken für Deine bemühungen Tomtom 
Vielen Dank wirklich sehr nett von Dir!!!

Gruß Andi

P.S. Hab Dir eine PM geschickt mit meiner mail Adresse wegen den Schulungen oder Workshops.

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

---

Hallo,

noch mal der Code zum fixieren in einer Struktur, d.h. alle Parts/Products/cgrs/Components werden gefixt, egal in welcher
Strukturebene -/tiefe sie verbaut sind.

Das "On Error Resume Next" im Script bewirkt, das jeder auftretende Fehler einfach übersprungen wird. Das ist von programmieren her eigentlich unschön und bei mir läuft das Script auch ohne (also die Codefassung weiter oben). Von hier aus kann ich nicht feststellen, warum das Script bei dir einen Fehler ausgibt.

Da nun die Errors übersprungen werden kann ich dir nicht dafür garantieren, das alles gefixt wurde.

Ach ja: Eine Mail ist bei mir bisher keine angekommen.

Bis dann

TomTom

Language="VBSCRIPT"

Public oSelection

Sub CATMain()

On Error Resume Next

Dim oProduct
Dim oProducts
Dim bIsAComponent As Boolean

Set oRoot = Catia.ActiveDocument

Set oProduct = oRoot.Product
Set oProducts = oProduct.Products

Set oSelection = Catia.ActiveDocument.Selection

SUB_ProdScan oProducts, False

End Sub

Sub SUB_ProdScan(oProducts, bIsAComponent) 'Rekursive Funktion: Scant alle Subs

On Error Resume Next

If bIsAComponent = False Then
  Set oConnections = Catia.Documents.Item(oProducts.Parent.ReferenceProduct.Parent.Name).Product.Connections("CATIAConstraints")
ElseIf bIsAComponent = True Then
  Set oConnections = oProducts.Parent.Connections("CATIAConstraints")
End If
   
iConnectionsCount = oConnections.Count
oSelection.Clear
       
For a = 1 To iConnectionsCount
  oSelection.Add (oConnections.Item(a))
Next
       
If oSelection.Count > 0 Then
  'oSelection.Clear
  oSelection.Delete
 
End If
       
oSelection.Clear

For x = 1 To oProducts.Count 'zaehlt die Children des aktuellen Subs

  If bIsAComponent = False Then  'übergebenes Root ist keine Komponente
      Set oProductOpen = Catia.Documents.Item(oProducts.Parent.PartNumber & ".CATProduct").Product
      '-----------Fixieren
      Set oReference = oProductOpen.CreateReferenceFromName(oProductOpen.PartNumber & "/" & oProductOpen.Products.Item(x).Name & "/!" & oProductOpen.PartNumber & "/" & oProductOpen.Products.Item(x).Name & "/")
      Set oConstraint = oProductOpen.Connections("CATIAConstraints").AddMonoEltCst(catCstTypeReference, oReference)
  ElseIf bIsAComponent = True Then  'übergebenes Root ist eine Komponente
      Set oReference = oProducts.Parent.CreateReferenceFromName(oProducts.Parent.PartNumber & "/" & oProducts.Parent.Products.Item(x).Name & "/!" & oProducts.Parent.PartNumber & "/" & oProducts.Parent.Products.Item(x).Name & "/")
      Set oConstraint = oProducts.Parent.Connections("CATIAConstraints").AddMonoEltCst(catCstTypeReference, oReference)
  End If
  If TypeName(oProducts.Item(x).ReferenceProduct.Parent) = "PartDocument" Then 'Check ob PartDoc
      ' passiert gar nix
  ElseIf TypeName(oProducts.Item(x).ReferenceProduct.Parent) = "ProductDocument" Then
      Err.Number = 0
      Set oMasterShape = oProducts.Item(x).GetMasterShapeRepresentation(True)
      If Err.Number = 0 Then  'it s a others
        ' passiert gar nix
      ElseIf oProducts.Item(x).ReferenceProduct.Parent.Name = oProducts.Item(x).Parent.Parent.ReferenceProduct.Parent.Name Then  '---its a Component
        Err.Number = 0
        SUB_ProdScan Catia.Documents.Item(oProducts.Item(x).ReferenceProduct.Parent.Name).GetItem(oProducts.Item(x).PartNumber).Products, True
      ElseIf oProducts.Item(x).ReferenceProduct.Parent.Name <> oProducts.Item(x).Parent.Parent.ReferenceProduct.Parent.Name Then  '---its a Product
        Err.Number = 0
        If oProducts.Item(x).Products.Count > 0 Then
            Set oProductsUebergabe = oProducts.Item(x).Products
            SUB_ProdScan oProductsUebergabe, False
        End If
      End If
      Err.Number = 0
  End If
Next

End Sub

------------------
tomtom1972

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

---

@ tomtom:

Dein Programm läuft unerwartet. Alle bereits vorhandenen Bedingungen werden gelöscht.
Leider hatte ich noch nicht die Gelegenheit, den Code zu analysieren.

Mit freundlichem Gruß
Stephan

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

---

Servus Stephan
Wahrscheinlich hat tomtom durch das löschen aller Constrains ausgeschlossen, dass die Prodcts mehrere Constraints bekommen und nicht mehrfach fixiert werden (Prüfung entfällt).

Gruß
Bernd

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

[Diese Nachricht wurde von bgrittmann am 08. Jul. 2014 editiert.]

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

---

Hallo Bernd!

Das Löschen aller bereits vorhandenen Bedingungen ist ja nötig, ich habe es erkannt.
TOMTOM verdient für sein Makro ein Danke.

Dir, Bernd, danke ich für Deinen Hinweis!

Mit freundlichem Gruß
Stephan

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