Code:
' Setzt ALLE DrawingCurvge-Objekte einer Zeichnung zurück auf den Standardlayer (nach Norm) und entfernt Farbüberschreibungen.
' Es gibt in dem Sinne keinen Standardlayer. Weist man den Objekten als Layer NOTHING zu, weist Inventor wieder die Layer gemäß Stilvorgaben zu.
' Farbüberschreibungen werden entfernt, indem das Property OverrideColor der DrawingCurve auf NOTHING gesetzt wird.
' Überschriebene Linienstärken würden mit Stärke "0" zurückgesetzt, aber da kommen fehlerhafte Ergebnisse raus. :-/Private Sub ResetDrawingCurveSegments()
Dim myDrawDoc As DrawingDocument
Set myDrawDoc = ThisApplication.ActiveDocument
Dim mySheet As Sheet
For Each mySheet In myDrawDoc.Sheets
mySheet.Activate
Call UpdateSheet(mySheet)
mySheet.Update
Next
End Sub
Private Sub UpdateSheet(ByVal oSheet As Sheet)
Dim oView As DrawingView
For Each oView In oSheet.DrawingViews
If oView.Suppressed = False Then
Call UpdateView(oSheet, oView)
End If
Next
End Sub
Private Sub UpdateView(ByVal oSheet As Sheet, ByVal oView As DrawingView)
Dim oSelection As ObjectCollection
Set oSelection = ThisApplication.TransientObjects.CreateObjectCollection
Dim oDrawCurve As DrawingCurve
Dim oDrawingCurveSegment As DrawingCurveSegment
Dim oColor As Color
For Each oDrawCurve In oView.DrawingCurves
' Funktioniert nicht sauber
'If oDrawCurve.LineWeight > 0 Then
' oDrawCurve.LineWeight = 0
' End If
If Not oDrawCurve.LineType = kDefaultLineType Then
oDrawCurve.LineType = kDefaultLineType
End If
If oDrawCurve.Color.ColorSourceType = kOverrideColorSource Then
oDrawCurve.OverrideColor = oColor
End If
For Each oDrawCurveSegment In oDrawCurve.Segments
Call oSelection.Add(oDrawCurveSegment)
Next
Next
If oSelection.Count > 0 Then
Call ChangeLayer(oSheet, oSelection)
End If
End Sub
Private Sub ChangeLayer(ByVal oSheet As Sheet, ByVal oSelection As ObjectCollection)
Dim oLayer As Layer
Call oSheet.ChangeLayer(oSelection, oLayer)
End Sub