---

Servus miteinander,

mich plagt mal wieder ein Problem 

Ich schreibe gerade ein Makro welches mir alle unbenötigten Elemente
einer Productstruktur löschen soll, was bisher auch wunderbar
funktioniert. Aufbau ist wie folgt:

Product wird geupdatet
Alle defekten Constraints werden gelöscht
Alle defekten Formeln werden gelöscht
Alle Linien, Punkte, Kurven usw. ohne Kinder werden gelöscht
Meldung an User was alles gelöscht wurde und wie viele jeweils

Es wird nochmals nach defekten Constraints gesucht
Falls ein Fund vorhanden ist erhält der User eine Warnmeldung das
sich diese Constraints auf die gerade gelöschten Elemente bezogen
haben und er die Schritte gegebenenfalls rückgängig machen soll.

Soweit so gut. Nun will ich aber noch alle Skizzen löschen welche
keine Verwendung haben ich weiß jedoch nicht wie... So geht es nicht:

Code:

---

oSel.Search "CATPrtSearch.Sketch.IsRoot=TRUE, all"
        Sketch = oSel.Count
    If oSel.Count > 0 Then
      oSel.Delete
      oSel.Clear
    End If

---

Das eigentliche Problem ist nun das ich alle ungeladenen Parts und
Products aus der Struktur löschen will mit Rückgabe der Stückzahl
dieser Elemente. Auch hier wieder keine Ahnung wie... So prüfe ich
meine Struktur ob solche Parts / Products enthalten sind aber wie
diese nun löschen?!

Code:

---

CATIA.HSOSynchronized=False
  Set oSel = CATIA.ActiveDocument.Selection
  oSel.Search "(CATProductSearch.Product),all"

      for i = 1 to oSel.Count 
      Set oElement = oSel.FindObject("CATIAProduct")

  On Error Resume Next
      Set Document = oElement.ReferenceProduct.Parent
        If Err.Number <> 0 Then
          RetCode = MsgBox( "Es befinden sich ungeladene Elemente in der Struktur." & vbLF & _
          "Korrigieren Sie die Struktur und starten Sie das Makro erneut!" ,48, "Defekte Struktur")

            Exit Sub
        End If
      Next
CATIA.HSOSynchronized=True

---

Vielen Dank schon mal 

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

---

Servus also für das ungeladene Parts/Products löschen habe ich
inzwischen eine Lösung:

Code:

---

oSel.Search "(CATProductSearch.Product),all"

   On Error Resume Next
      for i = 1 to oSel.Count 
      Set oElement = oSel.FindObject("CATIAProduct")

   If oElement.PartNumber=FALSE Then
      oSel.Add oElement
   End If
      Next
   On Error GoTo 0

   DeathLink = oSel.Count
      If oSel.Count > 0 Then
         oSel.Delete
         oSel.Clear
      End If

---

Mit dem Skizzenproblem bin ich noch nicht wirklich weiter gekommen.
Jemand ne Idee??? Ich habe hier etwas gefunden, bekomm das
aber net wirklich hin...

[Diese Nachricht wurde von shoutz000 am 27. Mai. 2015 editiert.]

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

---

Servus
Was willst du mit der Zeile "Set oElement = oSel.FindObject("CATIAProduct")"?
Musst du nicht zuerst auf jedes Element zugreifen (sonst bringt deine Schleife ja nichts)? zB

Code:

---

Set oElement = oSel.item2(i).Value

---

Dieses kannst du dann prüfen. (ggf besser wenn die Partnumber abrufbar ist aus der Selektion entfernen, dann bleiben am Schluss nur die nicht geladenen Objekte in der Selektion)

Gruß
Bernd

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

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

---

Meinst Du so?

Code:

---

'----------------------------------------
'Alle ungeladenen Parts / Products löschen
oSel.Search "(CATProductSearch.Product),all"

  On Error Resume Next
      for i = 1 to oSel.Count 
      Set oElement = oSel.item2(i).Value

  If oElement.PartNumber=TRUE Then
      oSel.Remove oElement
  End If
      Next
  On Error GoTo 0

MsgBox oSel.Count

---

So werden mir alle Elemente ausgegeben. Nach meinem Script werden
nur die 3 defekten Elemente ausgegeben welche ich eingebaut habe...

Mit den Skizzen komme ich aber auch eiterhin nicht weiter.

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

---

Servus
Führe mal dein Makro schrittweise aus. (ich versteh nicht wie es funktionieren soll)
Ich würde es so machen (in CATVBA)

Code:

---

osel.Search "(CATProductSearch.Product),all"

For i = osel.Count To 1 Step -1
Set oElement = osel.Item2(i).Value
    On Error Resume Next
    If IsError(oElement.PartNumber) Then
        osel.Remove i
    End If
    On Error GoTo 0
Next

MsgBox osel.Count

End Sub

---

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

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

---

Mein Makro läuft unter CatScript. So funktioniert es auch:

Code:

---

Sub CATMain()
Set oDoc = CATIA.ActiveDocument
Set oSel = oDoc.Selection

  oSel.Search "(CATProductSearch.Product),all"

  For i = oSel.Count To 1 Step -1
      Set oElement = oSel.Item2(i).Value
  On Error Resume Next
      If oElement.PartNumber=IsError Then
      oSel.Remove i
  End If
      On Error GoTo 0
  Next

MsgBox oSel.Count

End Sub

---

Aber so sind jetzt alle Elemente selektiert welche in Ordnung sind.

[Diese Nachricht wurde von shoutz000 am 27. Mai. 2015 editiert.]

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

---

Bin gerade an den Zeichnungen dran und komm nicht weiter...
Hab mal des zusammengestümpert :-P

Meckert die ganze Zeit rum das der Index i falsch gewählt wurde...
er muss zwischen 0 und 1 liegen. Liegt an der -1 aber ohn (-)
werden die Skizzen nur selektiert und mehr nicht?!

Code:

---

Sub CATMain()
Set oDoc = CATIA.ActiveDocument
Set oSel = oDoc.Selection

  oSel.Search "CATPrtSearch.Sketch,all"

      For i = oSel.Count To 1 Step -1
        Set oSketch = oSel.Item2(i).Value
        oSel.Delete

      Set oDocSel = oSel.Item2(i).Document

      If oDocSel.IsUpToDate=True Then
        CATIA.StartCommand "UnDo"
      End If
  Next

      MsgBox oSel.Count

End Sub

---

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

---

Hallo,

siehe meine Kommentare:

Zitat:

---

Code:

---

Sub CATMain()
Set oDoc = CATIA.ActiveDocument
Set oSel = oDoc.Selection

   oSel.Search "CATPrtSearch.Sketch,all"

      For i = oSel.Count To 1 Step -1
         Set oSketch = oSel.Item2(i).Value
         oSel.Delete                        Was machst Du hier?

      Set oDocSel = oSel.Item2(i).Document  oSel ist jetzt leer!

      If oDocSel.IsUpToDate=True Then
         CATIA.StartCommand "UnDo"
      End If
   Next

      MsgBox oSel.Count

End Sub

---

---

Wenn Du oSel nach der MsgBox löscht, macht's Sinn.

Tschau,
Joe

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

---

Servus
Wären dem ersten Schleifendurchlauf löschst du die ganze Selektion. Somit ist oSel.Count = 0.
Deshalb muss du wohl die Skizzieren suchen, diese in einer Collection/Array zwischen speichern. Danach die Skizze einzeln selektieren und löschen, ...

Gruß
Bernd

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

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

---

Ich kenn mich mit beidem nicht aus und habe jetzt mal die Collection
versucht. Aber anscheinend ist die nicht definiert... Finde zu beidem
aber nicht wirklich etwas hilfreiches...

Code:

---

Sub CATMain()
Set oDoc = CATIA.ActiveDocument

  Set oList = New Collection
  Set oProd = oDoc.Product.Products
  For Each Sketch in oProd
      oList.Add Sketch
  next

  Set oSel = oDoc.Selection
      oSel.clear
  for i = 1 to oList.Count
      oSel.Add oProd.Item(oList.Item(i))
  oSel.Delete

  If oProd.IsUpToDate=Tru Then
      CATIA.StartCommand "UnDo"
  End If
      Next

End Sub

---

Aber für heut ist gut 

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

---

Servus
Ein paar Hinweise von mir:
In der Products-Collection gibt es mit Sicherheit direkt keine Skizzen darunter, somit geht die for-each nicht (siehe Struktur in der Doku).
Kannst du im Produkt direkt Skizzen manuell selektieren und löschen? Ich würde jedes Part einzeln abarbeiten, dort dann über oSel.Search die Skizzen selektieren.
ggf gibt es in catvbs (bzw auch CATSript??) keine Collection, dann auf einen Array ausweichen.

Gruß
Bernd

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

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

---

Also ich habe ein CatScript in dem eine Collection ist aber die
ist nicht anderst definiert, funktioniert aber?! Aber über die Suche
habe ich auch keine Collection für CatScript gefunden...

Bin ich mit der Array auf dem richtigem Weg?! Da sollen jetzt erstmal
alle Parts drin sein. Ich habe aber keine Ahnung ob das tatsächlich
der Fall ist und gute Beispiele wie man so etwas aufbaut habe ich
nicht gefunden...?!

Code:

---

Sub CATMain()
  Set oDoc = CATIA.ActiveDocument
  Set oSel = oDoc.Selection
      oArray = Array(PartDocument)
      oArrSize = -1

  oSel.Search"(CATProductSearch.Product),all"
  For i = 1 to oSel.Count 
      Set oElement = oSel.FindObject("CATIAProduct")
      If TypeName(oElement.ReferenceProduct.Parent) = "PartDocument"  Then

      ReDim Preserve oArray(oArrSize)
  End If
Next
End Sub

---

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

---

Ok ich bin weiter xD

Code:

---

Sub CATMain()
  Set oDoc = CATIA.ActiveDocument
  Set oSel = oDoc.Selection
      oSel.Search "(CATProductSearch.Part),all"
      DocCount = oSel.Count
      SketchCount = oSel.Count

  For i = 1 To DocCount
      ReDim Preserve PartArray(i)
      Set PartArray(i) = oSel.Item(i).Value
  Next

  For i = 1 To DocCount
      Set Part = PartArray(i)
  Next

        oSel.Search "(CATPrtSearch.Sketch),sel"
            For n = 1 To SketchCount
              ReDim Preserve SketchArray(n)
              Set SketchArray(n) = oSel.Item(n).Value
            Next

            For n = 1 To SketchCount
              Set oSketch = SketchArray(n)
            oSel.Delete

  If IsUpToDate(oDoc)=True Then
      CATIA.StartCommand "UnDo"
  End If
      Next
End Sub

---

Also die Array der Parts funktioniert jetzt. Die Array der Sketches... vllt?! Löschen funktioniert auch
(es werden aber alle auf einmal gelöscht kann das sein)? IsUpToDate funktioniert auch noch nicht   

[Diese Nachricht wurde von shoutz000 am 29. Mai. 2015 editiert.]

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

---

Zu den ungeladenen Elementen. Also ich bekomm jetzt die Anzahl dieser
Elemente ausgegeben, aber wie lösche ich diese?

Code:

---

Sub CATMain()
  Set oDoc = CATIA.ActiveDocument
  Set oSel = oDoc.Selection
  Set oDelete = oDoc.Product.Products
      oSel.Search "(CATProductSearch.Product),all"

  For i = oSel.Count To 1 Step -1
      Set oElement = oSel.Item2(i).Value

  On Error Resume Next
      If oElement.PartNumber=IsError Then
        oDelete.Add i
      End If
  On Error GoTo 0
      Next

        oSel.Clear
      MsgBox oDelete.Count
End Sub

---

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

---

Servus
Falls du nur in der obersten Ebene der Baugruppe suchen willst geht es auch so.

Code:

---

Sub CATMain()
    Dim oDoc As ProductDocument
    Dim oSel As Object
    Dim oProducts As Products
    Dim oProduct As Product
   
    Set oDoc = CATIA.ActiveDocument
    Set oSel = oDoc.Selection
    Set oProducts = oDoc.Product.Products
   
    oSel.Clear
   
    For Each oProduct In oProducts
        On Error Resume Next
        If IsError(oProduct.PartNumber) Then
            oSel.Add oProduct
        End If
        On Error GoTo 0
    Next
     
    MsgBox oSel.Count
    oSel.del
End Sub

---

Gruß
Bernd

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

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

---

...oder so:

Code:

---

Sub CATMain()
  Set oDoc = CATIA.ActiveDocument
  Set oSel = oDoc.Selection
  Set oDelete = oDoc.Product.Products
      oSel.Search "(CATProductSearch.Product),all"

  For i = oSel.Count To 1 Step -1
      Set oElement = oSel.Item2(i).Value

  On Error Resume Next
      x = oElement.PartNumber

if Err.Number = 0 then
        oSel.remove i
    On Error GoTo 0
end if

      Next

        oSel.delete
     
End Sub

---

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

---

Hey servus imation1999. Coll danke funktioniert.
Meins zwar auch aber das versteht ja anscheinend wohl keiner wie
(Ich auch nicht so ganz  )

Jetzt haperts nur noch an den Sketches 

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

---

Servus
Zu deinem Makro mit den Sketches: Nachdem du diese im Array zwischengespeichert hast, musst du diese einzeln selektieren, dann löschen und mit IsUpToDate prüfen (bitte in die Doku schauen wie die Funktion aufgerufen wird).
Zusätzlich sind deine Schleifen (Parts und Sketches) etwas sonderbar (oder gar nicht) verschachtelt.
Ich empfehle dir im VBA-Editor zu programmieren (mit Option Explicite). Dann hast du Intelisense und bekommst nicht so ein Durcheinander mit den Objekten (falsche Typ, falsche Methoden). Zusätzlich kannst du das Makro schrittweie abarbeiten in die Objekt im Watch-Fenster untersuchen.

Gruß
Bernd

PS: Vorsicht bei StartCommands, die sind sprachabhängig

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

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

---

Also ich habe jetzt des ganze We mit dem Editor rumgemacht und
versucht mich da mal rein zu arbeiten. Die Hilfe mit der Array
ist nur teilweiße aufschlussreich...

In einander verschachteln parts in array dann ein part raus dann sketches
in die nächste array usw... ich versuchs zwar aber wirklich weiter gekommen
bin ich mit dem editor trotzdem nicht... So der aktuelle Stand:
Bei Fett gibts jeweils Fehler?!

Code:

---

    Public PartArray()
    Public SketchArray()
Sub CATMain()
  Set oDoc = CATIA.ActiveDocument
  Set oSel = oDoc.Selection
      oSel.Search "(CATProductSearch.Part),all"
      DocCount = oSel.Count
      SketchCount = oSel.Count

  For i = 1 To DocCount
      ReDim Preserve PartArray(i)
      Set PartArray(i) = oSel.Item(i).Value
  Next

  For i = 1 To DocCount
      Set oPart = PartArray(i)
  Next

        oSel.Search "(CATPrtSearch.Sketch),sel"
            For n = 1 To SketchCount
              ReDim Preserve SketchArray(n)
              Set SketchArray(n) = oSel.Item(n).Value
            Next

            For n = 1 To SketchCount
              Set oSketch = SketchArray(n)
            oSel.Delete

  If oPart.IsUpToDate = True Then
      CATIA.StartCommand "UnDo"
  End If
      Next
End Sub

---

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

---

Servus
Was für einen Zweck hat diese Schleife?

Code:

---

For i = 1 To DocCount
      Set oPart = PartArray(i)
  Next

---

Du bearbeitest immer das letzte Part!

Code:

---

Set SketchArray(n) = oSel.Item(n).Value

---

Lass mal das "Set" weg. (Vorsicht bei einem Array fängt der Zähler bei 0 an)
Zu IsUpToDae: Schau mal in die Doku. vermutlich müsst es so heißen (ungetestet):

Code:

---

If oPart.IsUpToDate(oPart) = False then

---

Diese Zeile kommt mir sonderbar vor:

Code:

---

oSel.Search "(CATPrtSearch.Sketch),sel"

---

Du Suchst nur in der Selektion selektierst aber zuvor nichts.

Gruß
Bernd

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

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

---

Ich gebs glaub auf. Ich kann ändern was ich will ich produzier nur
fehler. Vöölig egal ob mit set oder ohne... der zickt an allem rum.
Vorher nichts selektiert oO KA?!

trotzdem danke

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

---

Servus
Ich hab mal die Struktur (damit der Ablauf klarer wird) überarbeitet. Versuch mal Ablauf zu verstehen.
Allerdings scheint bei der Abfrage "IsUpToDate" was nicht zu passen, es wird immer FALSE zurückgeliefert.

Code:

---

Sub CATMain()
    Dim oDoc As Document
    Dim oSel As Selection
    Dim objSel As Object
    Dim oPart As Part
    Dim oSketch As Sketch
    Dim PartArray() As Object
    Dim SketchArray() As Object
    Dim i As Integer
    Dim n As Integer

    'Start
    Set oDoc = CATIA.ActiveDocument
    Set objSel = oDoc.Selection
    Set oSel = objSel
   
    'Parts suchen und in Array zwischenspeichern
    oSel.Search "(CATProductSearch.Part),all"
   
    'wenn kein Part gefunden: Makro beenden
    If oSel.Count = 0 Then
        Exit Sub
    End If
   
    ReDim Preserve PartArray(oSel.Count)
   
    For i = 1 To oSel.Count
      Set PartArray(i) = oSel.Item(i).Value.ReferenceProduct.Parent.Part
    Next
   
    'Parts einzeln selektierien und darin nach Sketches suchen
    For i = 1 To UBound(PartArray)
       
        Set oPart = PartArray(i)
        oSel.Clear
        oSel.Add oPart
        oSel.Search "(CATPrtSearch.Sketch),sel"
       
        'wenn keine Skizze gefunden wurde: raus hier
        If oSel.Count = 0 Then
            Exit For
        End If
       
        'Sketches in Array zwischenspeichern
        ReDim Preserve SketchArray(oSel.Count)
        For n = 1 To oSel.Count
            Set SketchArray(n) = oSel.Item(n).Value
        Next
       
        'Sketch einzeln selektieren und löschen
        For n = 1 To UBound(SketchArray)
            Set oSketch = SketchArray(n)
            oSel.Clear
            oSel.Add oSketch
           
            'Selektion löschen und mit IsUpdate prüfen ob was benötiges gelöscht wurde
            oSel.Delete
           
            If oPart.IsUpToDate(oPart) = False Then  'Auswertung schein noch nicht zu passen, es wird immer FALSE zurückgeliefert
                CATIA.StartCommand "Widerrufen" 'deutsche Sprachumgebung
                'CATIA.StartCommand "UnDo"    'englische Sprachumgebung
            End If
           
        Next
    Next
End Sub

---

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

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

---

Coal :-)

Ja das ist eig nachvollziehbar. Ohne IsUpToDate müssten doch theoretisch alle Parts und
alle Sketches durchgangen und die Sketches gelöscht werden ohne Rücksicht auf Verluste oder?!

Bei einer kleinen Baugruppe nur mit Sketches und Pads ist das auch so, in dem eigentlichen
Testproduct mit masure pads sketches points lines planes usw. wird nur ein einziger sketch
gelöscht obwohl ja eigentlich alle weg sein müssten oO

ich experimentier mal bissel rum

[Diese Nachricht wurde von shoutz000 am 04. Jun. 2015 editiert.]

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