Hi, guys
Just have thought, perhaps, there is need to add
the piece of code to work with locked layers...
Something like:
Sub ChangeAllToLayerZero()
Dim ssAll As AcadSelectionSet, mEntity As AcadEntity
On Error Resume Next
ThisDrawing.SelectionSets("AllEntities").Delete
If Err Then
Err.Clear
End If
Set ssAll = ThisDrawing.SelectionSets.Add("AllEntities")
ssAll.Select acSelectionSetAll
Dim lockedColl As New Collection
Dim itmLay As Variant, i As Long
With ThisDrawing
' set as active layer "0"
.ActiveLayer = .Layers("0")
If .Layers("0").Lock = True Then
.Layers("0").Lock = False
End If
For Each mEntity In ssAll
'unlock layer if this was locked
If .Layers(mEntity.Layer).Lock = True Then
.Layers(mEntity.Layer).Lock = False
mEntity.Layer = "0"
mEntity.color = acByLayer '// remove this line if no needed
mEntity.Lineweight = acLnWtByLayer '// remove this line if no needed
' add layer name to collection with key that allow to add just iniques only
i = i + 1
lockedColl.Add mEntity.Layer, CStr(i)
Else
mEntity.Layer = "0"
mEntity.color = acByLayer '// remove this line if no needed
mEntity.Lineweight = acLnWtByLayer '// remove this line if no needed
End If
Next
.Regen acAllViewports
For Each itmLay In lockedColl
'then turn back to lock all the unlocked layers
.Layers.Item(itmLay).Lock = True
Next
End With
ssAll.Clear
ssAll.Delete
Set ssAll = Nothing
End Sub
Bear in mind this will not change the layer
of subentities, say in blocks and also the
same thing with other complex objects like
the dimensions, leaders etc.
Regards,
Oleg
~'J'~