LayerOff - LayerOnAll

Merhaba,
çiziminizde ki bir objeyi seçmeniz istenir ve
sectiğiniz objeye ait Layer i kapatır.

eğer AutoCAD'iniz de expresstools yüklü ise
komut satırına layoff yazdıgınız da
oluşan işlemin aynısını gerçekleştirecektir

Sub LayerOff()
Dim objEnt As AcadObject
Dim i As Integer

On Error Resume Next
TEKRARSEC:
ThisDrawing.Utility.GetEntity objEnt, emptyPt, "Kapatmak istediğiniz Layer e ait bir obje seçiniz: "

If Err <> 0 Then
' esc, space veya enter tıklanırsa sonlandır
If CInt(ThisDrawing.GetVariable("ERRNO")) = 52 Then
ThisDrawing.SendCommand Chr(3)
Err.Clear
Exit Sub
Else
ThisDrawing.Utility.Prompt "Obje Seçmediniz" & vbCrLf
Err.Clear
GoTo TEKRARSEC
End If
End If

If ThisDrawing.ActiveLayer.Name <> objEnt.Layer Then
ThisDrawing.Layers(objEnt.Layer).LayerOn = False
ThisDrawing.Utility.Prompt objEnt.Layer & " Layeri Kapatıldı." & vbCrLf
Else
Dim SoruEH As String
SoruEH = "Evet Hayır"
ThisDrawing.Utility.InitializeUserInput 1, SoruEH
Dim returnString As String
returnString = ThisDrawing.Utility.GetKeyword("Kapatmak istediğiniz (" & objEnt.Layer & ") Layeri Aktif! Yine de kapatmak istiyormusun (Evet/Hayır): ")
If returnString = "Evet" Then
ThisDrawing.Layers(objEnt.Layer).LayerOn = False
ThisDrawing.Utility.Prompt objEnt.Layer &" Layeri Kapatıldı." & vbCrLf
End If
End If

GoTo TEKRARSEC

End Sub

Sub LayerOnAll()
Dim LayerAll As AcadLayers
Dim LayerOne As AcadLayer
Set LayerAll = ThisDrawing.Layers
On Error Resume Next
For Each LayerOne In LayerAll
LayerOne.LayerOn = True
Next LayerOne
End Sub

Ekler:
Dosya: LayerOff.zip
Dosya içeriği: LayerOff.bas

Kolay gelsin.