26 | 04 | 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
    Else
    I = I + 1
    AcadLayer.Freeze = True
    End If
 
  Next AcadLayer
 
  MsgBox I & " Layers have been Frozen"
 
End Sub

 

Download AutoCad Block sample Here

 

Login

Sign up now and upload your code to the website.

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