Faster way to change lines on view?

[s.mich]

Hello,

I currently have a rule that selects all the edges of a view and changes the layer to adjust the line thickness if the view is a shaded view. It works to do what I want it to do pretty well, but it takes a long time to run. Turning screen updating off doesn't seem to make it run much faster. Can anyone think of any improvements like being able to select all curves at the same time and batch layer change?

Sub Main()
    On Error Resume Next
'	ThisApplication.ScreenUpdating = False
	
	Dim oDoc As DrawingDocument
    oDoc = ThisApplication.ActiveDocument
    
    Dim oSheet As Sheet
    oSheet = oDoc.ActiveSheet
    
    Dim olayers As LayersEnumerator
    olayers = oDoc.StylesManager.layers
    
    Dim VisXNarrow As Layer
    VisXNarrow = olayers.Item("Visible Extra Narrow (ANSI)")

    Dim oView As DrawingView
    For Each oSheet In oDoc.Sheets
		For Each oView In oSheet.DrawingViews

		        If oView.ViewStyle = kShadedDrawingViewStyle _
				Or oView.ViewStyle = kShadedHiddenLineDrawingViewStyle Then
'				Or oView.ViewStyle = kFromBaseDrawingViewStyle 
					
					Dim oCurves As DrawingCurvesEnumerator = oView.DrawingCurves()
					Dim oCurve As DrawingCurve

					For Each oCurve In oCurves
						For i = 1 To oCurve.Segments.Count
							oCurve.Segments.Item(i).Layer = VisXNarrow
						Next
					Next
				End If
	      Next
	Next

ThisApplication.ScreenUpdating = True

End Sub

Thanks.

[JelteDeJong]

You might want to have a look at this article "Improving Your Program’s Performance"

you can also try this:

Dim oDoc As DrawingDocument = ThisApplication.ActiveDocument
Dim oSheet As Sheet = oDoc.ActiveSheet
Dim olayers As LayersEnumerator = oDoc.StylesManager.Layers
Dim VisXNarrow As Layer = olayers.Item("Visible Extra Narrow (ANSI)")

Dim segments = oDoc.Sheets.Cast(Of Sheet).
    SelectMany(Function(sheet) sheet.DrawingViews.Cast(Of DrawingView)).
    Where(Function(view)
                Return view.ViewStyle = DrawingViewStyleEnum.kShadedDrawingViewStyle Or
                view.ViewStyle = DrawingViewStyleEnum.kShadedHiddenLineDrawingViewStyle
            End Function).
    SelectMany(Function(view) view.DrawingCurves.Cast(Of DrawingCurve)).
    SelectMany(Function(curve) curve.Segments.Cast(Of DrawingCurveSegment)).
    ToList()

Dim trans As Transaction = ThisApplication.TransactionManager.StartTransaction(oDoc, "Set layer")
ThisApplication.ScreenUpdating = False
For Each segment As DrawingCurveSegment In segments
    segment.Layer = VisXNarrow
Next
ThisApplication.ScreenUpdating = True
trans.End()

[s.mich]

Thank you for the improved code, it seems to run marginally faster, but it still seems to run into the trouble of having to pick each segment so it still takes some time. I will look into the article that you linked to see if I can find anything that will help .

Thanks