20 | 09 | 2017

Freeze All Layers

Sometimes its usefull to run a routine that will freeze all layers. The following routine will do so expect for the current layer.

Sub FreezeLayers()
'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
    End If
  Next AcadLayer
  MsgBox I & " Layers have been Frozen"
End Sub


Download AutoCad Block sample Here



Sign up now and upload your code to the website.

Help us to continue.....
Articles View Hits
Latest Articles