Excel escravizando o autocad

Uma simples macro que exemplifica como o excel poderia criar layers no autocad!!

Veja o código...

'adicione as referencias:
'autocad 2008 type library (ou a sua versão)
'autocad/objectdbx commom 17.0 type libray (ou a sua versão do cad)

'define as variaveis globais a seguir
Dim Acad As IAcadApplication
Dim Thisdrawing As AcadDocument

'função que "linka" o cad QUE JÁ ESTÁ ABERTO
'se  nao estiver aberto, abra-o, ou implemente a função CREATEOBJECT
Function getacaddoc() As Boolean
  On Error GoTo erro
  'corrija aqui a versão correta do seu autocad
  '2009 => 17.2
  '2008 => 17.1
  '2007 => 17.0
  Set Acad = GetObject(, "Autocad.Application.17.1")
  
  'pega o dwg que estiver aberto
  Set Thisdrawing = Acad.ActiveDocument
ok:
  getacaddoc = True
  Exit Function
erro:
  getacaddoc = False
End Function

'função que obtem um layer pelo seu nome, criando caso nao exista
Function get_or_create_layer(name As String) As AcadLayer
  On Error GoTo cria
  Set get_or_create_layer = Thisdrawing.Layers.Item(name)
  Exit Function
cria:
  Set get_or_create_layer = Thisdrawing.Layers.Add(name)
End Function


'macro que cria layers no cad no dwg que estiver aberto
'defina a coluna "A" da planilha atual com os nomes
'defina a coluna "B" com as cores dos layers
'exemplo:
'   A       B
'1  teste   1
'2  jj      5
'3  lay2    66

Sub Teste()
  If getacaddoc() Then
    'MsgBox Thisdrawing.Name
  Else
    MsgBox "Erro:" & Err.Description
    Err.Clear
    Exit Sub
  End If
  
  Dim layer As AcadLayer
  Dim i As Long
  
  For i = 1 To 10
   If Me.Cells(i, 1) <> "" Then
     Set layer = get_or_create_layer(Me.Cells(i, 1))
     layer.Color = Me.Cells(i, 2)
   End If
  Next
  MsgBox "Pronto!!"
End Sub

Para usar, abra o excel, nele abra o editor do visual basic for applications e cole o código na "Plan1" por exemplo...


Em seguida, preencha a coluna "A" com o nomes dos layers a criar e na coluna "B" as cores, por exemplo, A1=lay1, A2=lay2 e B1=1 B2=3:

Depois aperte o "Play" hehehehe

Ah, claro, não esqueça de adicionar as referencias (menu ferramentas, referências no editor do vba):
autocad 2008 type library (ou a sua versão)
autocad/objectdbx commom 17.0 type libray (ou a sua versão do cad)
e claro, tenha o excel e o autocad já abertos nas planilhas e dwg de ua escolha!!

é isso...