1 Attachment(s)
Rotina layers2xls.lsp... e mais, muito mais
Olá a todos!
Aqui vai mais uma das minhas rotinas. Esta rotina escreve para um ficheiro de excel os layers que estão num desenho e indica algumas das propriedades desses layers, tais como a côr e tipo de linha e ainda indica quantos objectos estão a ser usados em cada layer, a rotina até pode não ser muito util no dia a dia mas é um exemplo de como se pode ligar ao excel ou a outros programas através de activex e ainda a utilização das propriedades e métodos activex de um objecto e tudo isto usando o AutoLISP.
Cumprimentos
RE: Rotina layers2xls.lsp
muito bacana!!!
e é util sim, as vezes precisamos montar uma lista de layers para traduzir em outros nomes...
tambem gostaria de postar uma:
http://tbn2.blogspot.com/2006/11/lay...inusculos.html
fiz ela no ano passado, volta e meia me vem desenho com os layers em nomes maiusculos e minusculos misturados.... esta serve para padronizar um pouco...
Re: Rotina layers2xls.lsp
Olá,
Gostaria de uma ajuda. Fazendo analogia ao proposto, gostaria de saber se é possível, e como se faz (sou iniciante no que diz respeito à programação em AutoCAD) para buscar as coordenadas de polilinhas e de objetos texto, para tabulá-los em Excel, na forma de um memorial descritivo.
Agradeço a cooperação,
ClauCampbell
Re: Rotina layers2xls.lsp
Quote:
Originally Posted by
pferreira
Olá a todos!
Aqui vai mais uma das minhas rotinas. Esta rotina escreve para um ficheiro de excel os layers que estão num desenho e indica algumas das propriedades desses layers, tais como a côr e tipo de linha e ainda indica quantos objectos estão a ser usados em cada layer, a rotina até pode não ser muito util no dia a dia mas é um exemplo de como se pode ligar ao excel ou a outros programas através de activex e ainda a utilização das propriedades e métodos activex de um objecto e tudo isto usando o AutoLISP.
Cumprimentos
Viva
Ora bem, aqui está finalmente o inicio daquilo que eu tanto procurei...
Fiz imensas pesquisas e nada...
Gostaria de ligar os dados duma tabela de excel ao ACAD, ou seja, pretendia que, ao actualizar o conteudo duma célula, com base numa rotina, ele mudasse a cor da linha, do layer ou do hatch. QUeria aplicar isto a hatch de parcelas que serão expropradas numa obra pública. ALguém conhece algo que me possa ajudar??
Não estou minimamente a par de VBA para ACAD porque os meus conhecimentos de CAD são os básicos dum principiante. COnheço a linguagem de VBA e utilizo-a em Excel.
Re: Rotina layers2xls.lsp
creio que um link direto assim nao seja a melhor opção, pois te força a abrir o cad caso nao esteja aberto, e isso pode causar erros caso as ações que o excel viesse a disparar no cad fossem tais que não admitissem nenhum erro.
MAS, se você garantir que o excel e o cad estejam abertos na planilha e dwg corretos, então dará certo...
inicialmente pensei no dbconnect do cad, mas se coisas irão ser modificada no cad, complica, temos de programar as ações a mão mesmo
um exemplo de como conectar o cad e criar layers e modificar as suas cores:
Code:
'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
no mais, voce disse que entende de vba no excel e usa ele, então comece a "brincar" com as variaveis "Thisdrawing" e "Acad" que eu implemento neste pequeno código... verá que é bem simples...
alguns eventos monitorando sua planilha de excel audará naquelo que você deseja fazer, ok?