Taludes

pega aqui!!
 (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
Se você tem a sua e quiser compartilhar comigo, poste ela nos comentários, assim todos poderão ter uma "segunda opinião", hehehe!!!!

LinkWithin

Related Posts Plugin for WordPress, Blogger...