Kasper
that was actually just a safety guessing of mine
I very often hear or read about the warning concerning looping through collection inside a for-each loop, so I avoid them anyway
It may very well be collection would do it. my knowlwdge isn't as deep as it should be for handling this issue all the way
No doubt the "Collection" way is an elegant way, as you properly pointed out.
Actually, the safest way is collecting all to-be-removed objects in a temporary container (a SelectionSet, a Collection) during the main loop through the first SelectionSet/Collection and then erase them after exiting that loop
as for instance
Option Explicit
' same as cutlines_2 but erasing object collecting them in a temporary selectionset
' it should be the safest way
Private Sub cutlines_3()
Dim linesToChange As Integer
Dim totalLines As Long
Dim layerName As String
Dim Trim_global As Double
Dim a As Integer
Dim ssobjs(0) As AcadEntity ' necessary for adding items to selectionset
layerName = "Etch"
Trim_global = 20
Dim ssetLinesToRemove As AcadSelectionSet
Dim ssetLinesInLayers As AcadSelectionSet
Set ssetLinesToRemove = Sset("SsetLinesToRemove", False)
Set ssetLinesInLayers = Sset("SsetLinesInLayer", True, layerName)
linesToChange = ssetLinesInLayers.Count 'counting lines on proper layer
'loops through every selected line and trims it. thne it adds that item to the selectionset for future erasing
For a = 0 To (linesToChange - 1)
Call TrimLines(ssetLinesInLayers.Item(a), Trim_global)
Set ssobjs(0) = ssetLinesInLayers.Item(a)
ssetLinesToRemove.AddItems (ssobjs)
Next a
ssetLinesToRemove.Erase 'delete objects from SelectionSet and from the drawing
ssetLinesToRemove.Delete
ssetLinesInLayers.Delete
'MsgBox ("Bending lines found / total lines " & changes & "/" & total_lines)
End Sub along with this mian sub revision I had to make some minor modifications to the other two subs, as follows
Function Sset(SsetName As String, Optional okSelect As Variant, Optional layerName As Variant) As AcadSelectionSet
Dim gpCode(0 To 1) As Integer
Dim dataValue(0 To 1) As Variant
Dim ssetObj As AcadSelectionSet
If IsMissing(okSelect) Then okSelect = False ' if not specified, do not select any lines
If IsMissing(layerName) Then layerName = "*" ' if no layerName is passed then select all layers
On Error Resume Next
Set ssetObj = ThisDrawing.SelectionSets.Item(SsetName)
If Err <> 0 Then
Set ssetObj = ThisDrawing.SelectionSets.Add(SsetName)
Else
ssetObj.Clear
End If
On Error GoTo 0
If okSelect Then
ZoomExtents
'selecting Line objects in the active drawing in the proper layer
gpCode(0) = 0: dataValue(0) = "LINE"
gpCode(1) = 8: dataValue(1) = layerName
ssetObj.Select acSelectionSetAll, , , gpCode, dataValue
End If
Set Sset = ssetObj
End Function while in "TrimLines" you just have to comment out the following line (which is at the very bottom)
'CurrentLine.Delete
may be eljoseppo can test all these options to find out the quickest and the safest
