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...

LinkWithin

Related Posts Plugin for WordPress, Blogger...