Freeze All Layers
Published on Wednesday, 06 February 2008 19:33
Sometimes its usefull to run a routine that will freeze all layers. The following routine will do so expect for the current layer.
'This routine freezes all layers except current
Dim AcadLayer As AcadLayer
Dim CurrLayer As AcadLayer
Set CurrLayer = ThisDrawing.ActiveLayer
Dim I As Integer
For Each AcadLayer In ThisDrawing.Layers
If AcadLayer.Name = CurrLayer.Name Then
I = I + 1
AcadLayer.Freeze = True
MsgBox I & " Layers have been Frozen"
Download AutoCad Block sample Here