pega aqui!!
Se você tem a sua e quiser compartilhar comigo, poste ela nos comentários, assim todos poderão ter uma "segunda opinião", hehehe!!!!
(defun c:dtal (/ cr pe d ds pts compt dist getent lay tmp)
(tbn:error-init (list
;lista de variaveis a serem configuradas:
(list "cmdecho" 0)
;função a executar em caso de erro:
'(high-ligth (list cr pe) nil)))
;função que pede a seleção de uma linha:
;ela aceita "não selecionar" para terminar a rotina
(setq getent
(lambda (s)
(while
(progn
(prompt
(strcat
"\nValem: LINE, SPLINE, LWPOLILINE\nSelecione "
s " do talude"))
(if (setq tmp
(ssget ":S"
'((0 . "LINE,LWPOLYLINE,SPLINE"))))
(not (setq tmp (ssname tmp 0)))
(/= 52 (getvar "errno")))))
(if tmp (high-ligth tmp t)) tmp)
;seleciona a crista:
cr (getent "a crista")
;selecionou a crista?, então seleciona o "pé"
pe (if cr
(getent "o pé")
(exit))
;numero de divisoes a fazer:
ds (* 2 (fix (get-length-of cr)))
;recupera o valor padrao do layer:
lay (getcfg "Appdata/desenha_talude/layer")
;valida o nome do layer:
lay (if (validate-layname lay) lay "talude")
;prompt interativo de configuração dos parametros:
;sim, eu podia usar um dcl, mas as vezes mais atrapalha q ajuda
tmp (while
(progn
(initget "L" 0)
(setq d
(getint
(strcat
"\n\nLayer: " lay
"\nQuantas divisões fazer? [Layer] <"
(itoa ds) ">")))
(if (= "L" d)
(if (/= ""
(setq tmp
(getstring
(strcat "\nQual o nome do layer? <"
lay ">"))))
(not (if (validate-layname tmp)
(setq lay tmp)
(prompt "\nNome inválido")))))
(= 'str (type d))))
d (if d d ds);numero de divisoes efetivas a fazer
dist (/ (get-length-of cr) d);distancia entre divisoes
tmp 0 ;contador
tmp (repeat d ;lista dos pontos onde terá linha
(setq pts
(append pts
(list (vlax-curve-getPointAtDist cr tmp)))
tmp (+ tmp dist)))
pts (append pts (list (vlax-curve-getendpoint cr)))
d nil ;alterna entre nil e T
;calcula e desenha as linhas:
d (mapcar
'(lambda (p1 / p2)
(if
(setq p2
(vlax-curve-getclosestpointtoprojection
pe p1 '(0 0 1) nil))
(vlax-ename->vla-object
(entmakex (list '(0 . "LINE")
(cons 10 p1)
(cons 11
(if (setq d (not d))
p2
(media p1 p2)))
(cons 8 lay))))))
pts))
;grava o layer usado... dificilmente mudará, então use
;como padrão
(setcfg "Appdata/desenha_talude/layer" lay)
;cria um GROUP com as linhas:
(vla-AppendItems
(vla-add (vla-get-Groups
;|thisdrawing:|;(vla-get-activedocument(vlax-get-acad-object)))
;|nome do GROUP|; (dxf 5 (car d)))
;cria a SAFEARRAY de entidades:
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject
(cons 0 (1- (length d))))
d))
;se chegou ate aqui, nao deu erro, entao remove o
;destaque das linhas de pé e de crista:
(high-ligth (list cr pe) nil)
;sai sem erro:
(tbn:error-restore ))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, high-ligth, get-length-of, validate-layname, media, dxf, tbn:error-restore
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, high-ligth, get-length-of, validate-layname, media, dxf, tbn:error-restore
(tbn:error-init (list
;lista de variaveis a serem configuradas:
(list "cmdecho" 0)
;função a executar em caso de erro:
'(high-ligth (list cr pe) nil)))
;função que pede a seleção de uma linha:
;ela aceita "não selecionar" para terminar a rotina
(setq getent
(lambda (s)
(while
(progn
(prompt
(strcat
"\nValem: LINE, SPLINE, LWPOLILINE\nSelecione "
s " do talude"))
(if (setq tmp
(ssget ":S"
'((0 . "LINE,LWPOLYLINE,SPLINE"))))
(not (setq tmp (ssname tmp 0)))
(/= 52 (getvar "errno")))))
(if tmp (high-ligth tmp t)) tmp)
;seleciona a crista:
cr (getent "a crista")
;selecionou a crista?, então seleciona o "pé"
pe (if cr
(getent "o pé")
(exit))
;numero de divisoes a fazer:
ds (* 2 (fix (get-length-of cr)))
;recupera o valor padrao do layer:
lay (getcfg "Appdata/desenha_talude/layer")
;valida o nome do layer:
lay (if (validate-layname lay) lay "talude")
;prompt interativo de configuração dos parametros:
;sim, eu podia usar um dcl, mas as vezes mais atrapalha q ajuda
tmp (while
(progn
(initget "L" 0)
(setq d
(getint
(strcat
"\n\nLayer: " lay
"\nQuantas divisões fazer? [Layer] <"
(itoa ds) ">")))
(if (= "L" d)
(if (/= ""
(setq tmp
(getstring
(strcat "\nQual o nome do layer? <"
lay ">"))))
(not (if (validate-layname tmp)
(setq lay tmp)
(prompt "\nNome inválido")))))
(= 'str (type d))))
d (if d d ds);numero de divisoes efetivas a fazer
dist (/ (get-length-of cr) d);distancia entre divisoes
tmp 0 ;contador
tmp (repeat d ;lista dos pontos onde terá linha
(setq pts
(append pts
(list (vlax-curve-getPointAtDist cr tmp)))
tmp (+ tmp dist)))
pts (append pts (list (vlax-curve-getendpoint cr)))
d nil ;alterna entre nil e T
;calcula e desenha as linhas:
d (mapcar
'(lambda (p1 / p2)
(if
(setq p2
(vlax-curve-getclosestpointtoprojection
pe p1 '(0 0 1) nil))
(vlax-ename->vla-object
(entmakex (list '(0 . "LINE")
(cons 10 p1)
(cons 11
(if (setq d (not d))
p2
(media p1 p2)))
(cons 8 lay))))))
pts))
;grava o layer usado... dificilmente mudará, então use
;como padrão
(setcfg "Appdata/desenha_talude/layer" lay)
;cria um GROUP com as linhas:
(vla-AppendItems
(vla-add (vla-get-Groups
;|thisdrawing:|;(vla-get-activedocument(vlax-get-acad-object)))
;|nome do GROUP|; (dxf 5 (car d)))
;cria a SAFEARRAY de entidades:
(vlax-safearray-fill
(vlax-make-safearray vlax-vbObject
(cons 0 (1- (length d))))
d))
;se chegou ate aqui, nao deu erro, entao remove o
;destaque das linhas de pé e de crista:
(high-ligth (list cr pe) nil)
;sai sem erro:
(tbn:error-restore ))
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, high-ligth, get-length-of, validate-layname, media, dxf, tbn:error-restore
Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, high-ligth, get-length-of, validate-layname, media, dxf, tbn:error-restore
Olá Neyton.
ResponderExcluirEstava tentando usar sua rotina do talude mas está dando erro:
Quando mando verificar se está tudo OK aparecem as seguintes mensagens:
; warning: local variable used as function: GETENT
; warning: local variable used as function: GETENT
; warning: too many arguments: (ENTMAKEX (CONS 10 P1) (CONS 11 ( ... )))
Os 2 primeiros WARNING dá para ignorar mas o terceiro está fazendo que a execução pare.
VEJA ABAIXO:
Command: dtal
Valem: LINE, SPLINE, LWPOLILINE
Selecione a crista do talude
Select objects:
Valem: LINE, SPLINE, LWPOLILINE
Selecione o pé do talude
Select objects:
Layer: talude
Quantas divisões fazer? [Layer] <138>
Error: too many arguments
undoing
O erro está aparecendo no seguinte trecho:
(entmakex (cons 10 p1)
(cons 11
(if (setq d (not d))
p2
(media p1 p2))))
Estou fazendo algo errado?
Abraços.
Eduardo
Olá Neyton.
ResponderExcluirA rotina está apresentando o seguinte erro:
Error: too many arguments
Isso ocorre logo depois de perguntar quantas divisões fazer.
O erro é no seguinte trecho da lisp:
(entmakex (cons 10 p1)
(cons 11
(if (setq d (not d))
p2
(media p1 p2))))
Estou fazendo algo errado?
Abraços.
já corrigi, nao sei por que, mas faltou um list ali no meio...
ResponderExcluirobrigado por indicar o erro!!
Usa também ename-of.lsp sem a qual não funciona mas é encontrado no site.
ResponderExcluirEsta quase boa.
O algoritmo usado deixa alguns vazios entre entidades curvas, que não acontecia na função original clássica "By José Sagi Neto"
que funcionou bem até a versão +-2002 e após só opera se entrar com espaçamento clicando em dois pontos. Bugue estranho que ninguém ainda conseguiu sanar e que virou um desafio.
E falta opção de espaçamento constante, mas acho que da pra contornar entrando com porcentagem do espaçamento oferecido.
tem outras versões dessse programa aqui no blog, inclusive já compilado para VLX.
ResponderExcluirse preferir
quanto ao espacamento variavel, eu uso assim porque em espaços maiores a densidade de linhas ficava feio, a meu ver.
o fonte está ai, pode ser modificado para tal.
no mais, mais um post antigo que voltou, muito bom, valeu camarada!!!
Tá.
ResponderExcluirArrumei a original pros interpretadores atuais. Não sei se posso postar aqui.
Pensei bem e acho que você esta certo quanto a espaçamento maior em taludes maiores.
Mas tem maiores em comprimento, largura e altura.
Talvez a densidade da hachura deva refletir a inclinação.
E esta é função da largura do talude e diferença de nível, dado que a rotina não tem e muitas vezes nem o usuário tem.
Se pedir vai perder a elegância de ser simples e funcional que a fez tão popular.
Mas isso não deu tempo de mexer.
Enquanto isso vou bolando como computar a altura de maneira mais sutil para o cálculo do espaçamento adequado.
Talvez como sub-opção sob um "initget" ".
Boas programações.
pode postar sim, se prefirir faço um novo post com o seu código, devidamente creditado
ResponderExcluirTa aqui arrumada:
ResponderExcluirhttps://sites.google.com/site/autolispfun/btalude.lsp
Entender a lógica de outra cabeça é atordoante.
O site de compatibilização da Autodesk também não ajudou por salada de versões.
Usei a manha de colocar break point antes do erro e rodar as demais funções colando uma a uma no prompt.
Dá pra espalhar por ai que vai ficar bom tempo operacional
Isso se não bolirem muito no interpretador.
Ela explora rulesurf de maneira bem funcional.
A tua parece que usa vlax-curve-getPointAtDist pra coletar pontos.
Se tiver tempo vou fazer uma coletando com o comando divide.
Tem a vantagem de não usar visual lisp que virou Torre de Babel e é incompatível com as versões básicas facilmente compreensíveis a programadores não especialistas.
E que no frigir dos ovos faz o mesmo omelete.