Tenha uma nova experiência ao navegar no Fórum pelo computador de forma integrada ao portal principal. Acesse o seguinte link: https://www.autolisp.com.br/board/. Entretanto para dispositivos móveis recomendamos acessar este outro link: https://www.autolisp.com.br/forum/

Ajuda Rotina Autolisp

Moderador: Moderadores

Responder
SALDANHA
Novato
Novato
Mensagens: 1
Registrado em: Seg 13 Abr 2020 8:40:46 pm

Ajuda Rotina Autolisp

Mensagem por SALDANHA » Seg 13 Abr 2020 9:20:50 pm

Boa noite meus caros, estou pela primeira vez neste blog, não sou programador, estou arriscando alguns comando no autocad. Estou com uma rotina que antigamente lá em 2005 ela funcionava muito bem, ela cotava as linhas automaticamente assim que selecionava as mesmas e colocava a distância do vão e a informação do cabo que inicialmente era solicitada. Ela usa para isso blocos existente no autocad, porém ela não está colocando o valor do vão e sim somente ("xx.m"(, e a informação inicial que escrevo após a solicitação também não, mas esta informação não é mais necessária hoje, será que alguém pode me ajudar a corrigir está rotina?


(defun c:RED ()
(setq PO "n")

(SETQ PO (getstring "\nDeseja postes (s/n): ""n"))
(command "LAYER" "N" "CABO" "")
(setq meio 0.0)
(setq dist 0.0)
(setq sdt2 0.0)
(command "osnap" "none")
(setq ss (ssget))
(setq n (sslength ss))
(setq i 0)
(while (< i n)
(setq en (ssname ss i)
pnt1 (cdr (assoc 10 (entget en)))
pnt3 (cdr (assoc 11 (entget en)))
)
(setq
X1 (car pnt1)
Y1 (cadr pnt1)
X3 (car pnt3)
Y3 (cadr pnt3)
Xm (/ (+ X3 X1) 2)
Ym (/ (+ Y3 Y1) 2)
X0 (+ Xm 0.000000001)
Y0 (+ Ym 0.000000001)
dt1 (distance pnt1 pnt3)
meio (/ dt1 2)
txt (RTOS dt1 2 2)
)
(progn

(cond
((and (< x0 x3) (< Y0 Y3))
(setq pnt (list x0 y3)
pnti pnt1
pntf pnt3
)
)
((and (< x0 x3) (> Y0 Y3))
(setq pnt (list x3 y0)
pnti pnt1
pntf pnt3
)
)
((and (> x0 x3) (< Y0 Y3))
(setq pnt (list x0 y3)
pnti pnt3
pntf pnt1
)
)
((and (> x0 x3) (> Y0 Y3))
(setq pnt (list x3 y0)
pnti pnt3
pntf pnt1
)
)
(t nil)
)
)
(setq dist (strcat (rtos dt1 2 2) " "))
(SETQ M1 (/ (- Y3 Y0) (- X3 X0)))
(SETQ TETA (angtos (atan (/ -1 M1)) 0 6))
(progn
(command "ucs" "n" "3" pnti pntf pnt)
(command "_insert" ;;;;"PODE CLOCAR QUALQUER NOME DE BLOCO EXISTENTE NO AUTOCAD QUE ELA IRA FUNCIONAR";;;
(list meio 0) "" "" "" cabo dist) ;;;;ACHO QUE É ALGUMA COISA POR AQUI QUE NÃO ESTÁ FUNCIONANDO;;;;
(command "_CHANGE" "_L" "" "_P" "_LA" "CAB_P" "" "")

(IF (OR (EQUAL PO "s")
(EQUAL PO "S")
)
(PROGN
(command "_insert" ;;;;"PODE CLOCAR QUALQUER NOME DE BLOCO EXISTENTE NO AUTOCAD QUE ELA IRA FUNCIONAR";;;; (list DT1 0) "" "" "" "" )
(command "_CHANGE" "_L" "" "_P" "_LA" "PTE_P" "" "")
)
)
(command "ucs" "w")
)
(SETQ i (1+ i))
)

)

PARA ELA FUNCIONAR É SÓ COLOCAR O NOME NO BLOCO AQUI:
(command "_insert" ;;;;"PODE CLOCAR QUALQUER NOME DE BLOCO EXISTENTE NO AUTOCAD QUE ELA IRA FUNCIONAR";;;
(list meio 0) "" "" "" cabo dist) ;;;;ACHO QUE É ALGUMA COISA POR AQUI QUE NÃO ESTÁ FUNCIONANDO;;;;
E AQUI
(command "_insert" ;;;;"PODE CLOCAR QUALQUER NOME DE BLOCO EXISTENTE NO AUTOCAD QUE ELA IRA FUNCIONAR";;;; (list DT1 0) "" "" "" "" )
QUE ELA IRÁ FUNCIONAR.
Agradeço ajuda de você, não sou programador por isso não consigo encontrar o erro. Desde já agradeço.

Avatar do usuário
Carlos Fernando
Madeira
Madeira
Mensagens: 20
Registrado em: Sex 29 Dez 2017 4:17:25 pm

Re: Ajuda Rotina Autolisp

Mensagem por Carlos Fernando » Ter 14 Abr 2020 8:54:26 pm

Saldanha

Modifiquei tanto seu código que acabei fazendo outro kkk
Antes de rodar a rotina abaixo faça o seguinte:

- vc deve substituir o texto "meu_bloco" pelo nome
do bloco que vc quer inserir (entre aspas) e tenha certeza que esse bloco esta na
pasta de caminho de suporte do Autocad;

- crie um estilo de cota somente com o texto, ou seja, suprima a linha de cota e
as linhas de chamadas e coloque o layer que quiser nesse esstilo;

Daí rode a rotina abaixo e selecione as linhas.

Ve se é isso que vc procurava.

Se precisar de mais suporte retorne.

Flw

Código: Selecionar todos

(defun c:red (/ *error* osmode layer op ss i pt1 pt2 pti ptf)
    (vl-load-com)
    (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
    (setq osmode (getvar 'osmode)
          layer  (getvar 'clayer)
    )
    (defun *error* (msg)
        (setvar 'osmode osmode)
        (setvar 'clayer layer)
        (vla-EndUndoMark (vla-get-activedocument vlax-get-acad-object))
        (prompt "\nErro ou comando cancelado pelo usuário.")
    )
    (initget "S s N n")
    (setq op (getkword "\Deseja postes? [S / N]: "))
    (setq ss (ssget))
    (setq i 0)
    (while (< i (sslength ss))
        (setq pt1 (cdr (assoc 10 (entget (ssname ss i))))
              pt2 (cdr (assoc 11 (entget (ssname ss i))))
        )
        (command "_dimaligned" pt1 pt2 pt2)
        (if (or (= op "S") (= op "s"))
            (progn (cond ((> (car pt1) (car pt2))
                          (setq ptf pt1
                                pti pt2
                          )
                         )
                         ((> (car pt2) (car pt1))
                          (setq ptf pt2
                                pti pt1
                          )
                         )
                         ((and (= (car pt1) (car pt2)) (> (cadr pt1) (cadr pt2)))
                          (setq ptf pt1
                                pti pt2
                          )
                         )
                         ((and (= (car pt1) (car pt2)) (> (cadr pt2) (cadr pt1)))
                          (setq ptf pt2
                                pti pt1
                          )
                         )
                   )
                   (if (= nil (tblsearch "layer" "PTE_P"))
                       (command "_-layer" "_m" "PTE_P" "")
                   )
                   (setvar 'clayer "PTE_P")
                   (command "_-insert" "meu_bloco" ptf "" "" "")
            )
        )
        (setq i (1+ i))
    )
    (setvar 'osmode osmode)
    (setvar 'clayer layer)
    (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
    (princ)
)

Responder