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