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


TBN2CAD - Novos comandos

E mais um, ou melhor 2 programas são adicionados ao TBN2CAD:

BLKPROPS - Ele extrai as propriedades (posição X,Y, escala e rotação) e atributos de blocos, criando uma lista. Isso para vários arquivos ao mesmo tempo!!!!

CHANGEBLK - Este usa os resultados do comando anterior e redefine os atributos e até substitui o bloco se necessário!!!

Imagine como fica fácil modificar listas de documentos!!