LayerBack

Merhaba,
çiziminiz de ki bir objeyi seçmeniz istenir ve
seçtiğiniz objeye ait Layer'e ait objelerin hepsini arkaya atar.

AutoCAD diliyle anlatmak gerekir se
Layer e ait tüm objeleri seçer ve DrawOrder Send To Back uygular.

Public Sub SendLayerBack(strLayer As String)
Dim fType(0) As Integer
Dim fData(0) As Variant
fType(0) = 8: fData(0) = strLayer

With ThisDrawing.PickfirstSelectionSet
.Clear
.Select acSelectionSetAll, , , fType, fData
If .Count > 0 Then ThisDrawing.SendCommand ("DrawOrder p  Back") & vbCr
End With

End Sub

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

On Error Resume Next
TEKRARSEC:
ThisDrawing.Utility.GetEntity objEnt, emptyPt, "Arkaya göndermek 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

SendLayerBack objEnt.Layer

GoTo TEKRARSEC

End Sub

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

Kolay gelsin.

Düzeltme : 06.09.2007

Programcı bir arkadaşım uyarıda bulundu
Kodlar da kullandığım GoTo nun
eskide kaldığı ve artık kullanılmadığını söyledi.

Bizde arkadaşımızı kırmadık
kodları evirdik çevirdik, olmadı yan yatırdık hallettik :)

Buyrun alternatif yeni kodlar :

Sub LayerBack()
Dim objEnt As AcadObject

On Error Resume Next

Do
Do While Err = 0
ThisDrawing.Utility.GetEntity objEnt, emptyPt, "Arkaya göndermek 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
Exit Do
End If
End If
SendLayerBack objEnt.Layer
Loop
Loop

End Sub

Kolay gelsin.