VBA: Criar um layer em Autocad, GstarCad, Zwcad e Bricscad

Fica aqui a primeira programação feita para ser utilizada em vários CAD's.

A rotina serve para criarmos uma nova layer, onde ela vai conferir se a layer já existe, se ela ainda não existir cria então a layer.

Fica aqui disponível para copy /past, directamente para o editor as rotinas assinaladas a vermelho as respectivas diferenças, entre o autocad e cada uma delas.

Para Autocad:

Public Sub layer()

Dim novalayer As String
Dim objlayer As AcadLayer

novalayer = InputBox("Nome da Nova Layer ?")

If "" = novalayer Then
Exit Sub
End If
On Error Resume Next

Set objlayer = ThisDrawing.Layers(novalayer)
If objlayer Is Nothing Then
Set objlayer = ThisDrawing.Layers.Add(novalayer)
If objlayer Is Nothing Then
MsgBox "Não é possivel criar a layer '" & novalayer & "'"
Else
MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
End If
Else
MsgBox "O Layer Já Existe"
End If

End Sub

Para GstarCad:

Public Sub layer()

Dim novalayer As String
Dim objlayer As GcadLayer

novalayer = InputBox("Nome da Nova Layer ?")

If "" = novalayer Then
Exit Sub
End If
On Error Resume Next

Set objlayer = thisDrawing.Layers(novalayer)
If objlayer Is Nothing Then
Set objlayer = thisDrawing.Layers.Add(

novalayer)
If objlayer Is Nothing Then
MsgBox "Não é possivel criar a layer '" & novalayer & "'"
Else
MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
End If
Else
MsgBox "O Layer Já Existe"
End If

End Sub

Para ZwCad:

Public Sub layer()

Dim novalayer As String
Dim objlayer As ZwcadLayer

novalayer = InputBox("Nome da Nova Layer: ")
If "" = novalayer Then Exit Sub

On Error Resume Next

Set objlayer = ThisDocument.Layers(novalayer)
  If objlayer Is Nothing Then
    Set objlayer = ThisDocument.Layers.Add(novalayer)
    If objlayer Is Nothing Then
      MsgBox "Não é possivel criar a layer '" & novalayer & "'"
    Else
      MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
    End If
  Else
    MsgBox "O Layer Já Existe"
  End If
End Sub

Para BricsCad (igual ao Autocad):

Public Sub layer()

Dim novalayer As String
Dim objlayer As AcadLayer

novalayer = InputBox("Nome da Nova Layer ?")

If "" = novalayer Then
Exit Sub
End If
On Error Resume Next

Set objlayer = ThisDrawing.Layers(novalayer)
If objlayer Is Nothing Then
Set objlayer = ThisDrawing.Layers.Add(novalayer)
If objlayer Is Nothing Then
MsgBox "Não é possivel criar a layer '" & novalayer & "'"
Else
MsgBox "Layer Nova Criada '" & objlayer.Name & "'"
End If
Else
MsgBox "O Layer Já Existe"
End If

End Sub

Boa programação