---

Guten Morgenzusammen,
ich habe mir folgenden Code hier aus dem Forum kopiert um die Layerüberschreibungen einer IDW zurückzusetzen. Oft bleibt der Code aber in der Zeile "For Each oDrawCurveSegment In oDrawCurve.Segments" hängen.
Hat jemand hier eine schnelle Lösung woran es liegen könnte?

Private Sub ResetLayers()
    Dim oApp As Inventor.Application
    Set oApp = ThisApplication
 
    If oApp.Documents.Count = 0 Or Not oApp.ActiveDocumentType = kDrawingDocumentObject Then
    MsgBox "Funktion nur in Zeichnungsableitungen möglich.", vbCritical, "ResetLayer"
    Exit Sub
    End If
 
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = oApp.ActiveDocument
 
   
        Call ResetAllViews(oDrawDoc.ActiveSheet)

    MsgBox "Fertig", vbInformation, "ResetLayer"
End Sub
Private Sub ResetAllViews(ByVal oSheet As Sheet)
    Dim oView As DrawingView
    For Each oView In oSheet.DrawingViews
        Call ResetView(oSheet, oView)
    Next
End Sub

Private Sub ResetView(ByVal oSheet As Sheet, ByVal oView As DrawingView)
    Dim oDrawCurves As DrawingCurvesEnumerator
    Set oDrawCurves = oView.DrawingCurves()
 
    If Not oDrawCurves Is Nothing Then
        Dim oDrawCurveSegColl As ObjectCollection
        Set oDrawCurveSegColl = GetAllResetCurveSegs(oDrawCurves)
     
        Call ThisApplication.ActiveDocument.SelectSet.Clear
        Call ThisApplication.ActiveDocument.SelectSet.SelectMultiple(oDrawCurveSegColl)
     
        Call oSheet.ChangeLayer(oDrawCurveSegColl, Nothing)
     
        Call ThisApplication.ActiveDocument.SelectSet.Select(oView)
        Call ThisApplication.CommandManager.ControlDefinitions("AppLocalUpdateCmd").Execute
    End If
End Sub

Private Function GetAllResetCurveSegs(ByVal oDrawCurves As DrawingCurvesEnumerator) As ObjectCollection
    Dim oDrawCurve As DrawingCurve
    Dim oDrawCurveSegment As DrawingCurveSegment
    Dim oDrawCurveSegColl As ObjectCollection
    Set oDrawCurveSegColl = ThisApplication.TransientObjects.CreateObjectCollection
 
  For Each oDrawCurve In oDrawCurves
        For Each oDrawCurveSegment In oDrawCurve.Segments
            If oDrawCurveSegment.HiddenLine = False And oDrawCurveSegment.Visible = True Then
                Call oDrawCurveSegColl.Add(oDrawCurveSegment)
            End If
        Next
    Next
 
    Set GetAllResetCurveSegs = oDrawCurveSegColl
End Function

'https://ww3.cad.de/foren/ubb/Forum50/HTML/022563.shtml

------------------
MFG

BlueJay

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

---

Moin

Was meinst du mit "hängen bleiben" gibt es da eine Fehlermeldung oder steigt das Makro einfach aus und beendet sich?
Wie äußert sich das hängen?

------------------
MfG
Ralf

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

---

Danke für die Rückfrage:
Laufzeitfehler 424 in der Zeile "For Each oDrawCurveSegment In oDrawCurve.Segments" Diese hat es aber schon mehrmals durchlaufen und auch einige Ansichten wurden auch zurückgesetzt.
LG

------------------
MFG

BlueJay

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

---

Moin

Passiert das immer wieder an der gleichen Stelle in der IDW oder funktioniert es bei mehrfachem Durchlauf plötzlich? Ist die betroffene Ansicht eine Erstansicht oder eine Detail/Ausbruch/Schnitt? In den abgeleiteten Ansichten macht die DIVA immer wieder mal seltsame Dinge.
Kannst du mir eine betroffene IDW samt den 3D-Modellen zur Verfügung stellen?

------------------
MfG
Ralf

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

---

Leider kann ich aus Datenschutzgründen nichts hochladen. Aber es handelt sich immer um abgeleitete Ansichten und Schnittansichten.
Ich forsche mal weiter
Danke aber für die Hilfe

------------------
MFG

BlueJay

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

---

Moin

Probiere es mal vorübergehend mit einem ignorieren des Fehlers. Ich vermute in der Ansicht nicht sichtbare Linien werden in der Sammlung der DrawingCurves gelistet, liefern aber beim Zugriff irgendwas oder nichts zurück.

Code:

---

Private Function GetAllResetCurveSegs(ByVal oDrawCurves As DrawingCurvesEnumerator) As ObjectCollection
    Dim oDrawCurve As DrawingCurve
    Dim oDrawCurveSegment As DrawingCurveSegment
    Dim oDrawCurveSegColl As ObjectCollection
    Set oDrawCurveSegColl = ThisApplication.TransientObjects.CreateObjectCollection

'zum Testen alle Fehler ignorieren
On Error Resume Next

  For Each oDrawCurve In oDrawCurves
        For Each oDrawCurveSegment In oDrawCurve.Segments
            If oDrawCurveSegment.HiddenLine = False And oDrawCurveSegment.Visible = True Then
                Call oDrawCurveSegColl.Add(oDrawCurveSegment)
            End If
        Next
    Next

On Error Goto 0

    Set GetAllResetCurveSegs = oDrawCurveSegColl
End Function

---

------------------
MfG
Ralf

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