Ajuda Rotina Autolisp

[SALDANHA]

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.

[Carlos Fernando]

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

[SALDANHA]

Carlos Fernando boa noite, primeiramente que agradecer a ajuda, hoje que estou vendo sua resposta, peço desculpas pela demora, vou analisar e te retorno com o que você fez. Mas já de anti-mão lhe agradeço muito. Obrigado.

[WILIAM]

Pessoal, não consegui postar como pergunta...

Olá pessoal, tudo certo ?
Estou tentando criar uma lisp, mas tenho sofrido para elaborar.
Ela se baseia em uma ideia simples, são linhas tracejadas e contínuas.

As linhas tracejadas sendo vermelha, azul e verde.(acesse o link, que tem uma imagem)
As linhas contínuas sendo vermelha, azul e verde.(acesse o link, que tem uma imagem)

https://drive.google.com/drive/folders/ ... sp=sharing

As linhas quando clicadas em determinado ponto, precisam ter uma distancia do objeto e depois continuar..
Consegui apenas esta parte, mesmo assim possui algum erro...

Se alguém puder me ajudar, agradeço.


(defun c:MTP()
(command "layer" "new" "Cabo Projetado" "color" "red" "Cabo Projetado" "Ltype" "ACAD_ISO02W100" "Cabo Projetado" "LWeight" "0.02" "Cabo Projetado" "")
(command "layer" "set" "Cabo Projetado" "")
(command "plinewid" "0.02" "")
(command "pline")
)

[Aldo Cavalcante]

Não sei se é isso que precisa...
Veja se esse código abaixo pode lhe ajudar.

Código: Selecionar todos

;******************************
;ROTINA DE INSERÇÃO DE LINHAS.
;SOLUÇÕES EM AUTOLISP.
;******************************

(DEFUN c:MTP()
  (PROMPT "\nINÍCIO DA CRIAÇÃO DAS LINHAS...")
  (SETQ looping T)
  (WHILE (= looping T)
    (INITGET 1 "Tracejadas Continuas")
    (SETQ tipo (GETKWORD "\nInforme o tipo de linhas: Tracejadas ou Contínuas? <T/C>... "))
    (SETQ pt1 (GETPOINT "\nEntre com o primeiro ponto da linha..."))
    (SETQ pt2 (GETPOINT pt1 "\nEntre com o segundo ponto da linha..."))
    (IF (= tipo "Tracejadas") (linhas_tracejadas)
      (IF (= tipo "Continuas") (linhas_continuas)))
    (INITGET 1 "Sim Não")
    (SETQ desicao_loop (GETKWORD "\nDeseja continuar inserindo mais linhas (Sim ou Não)? <S/N>... "))
    (IF (= desicao_loop "Sim") (PROGN (SETQ looping T))
      (IF (= desicao_loop "Não") (PROGN (PROMPT "\nFOI INFORMADO QUE NÃO...") (SETQ looping NIL))))
  )
  (SETQ looping NIL)
  (PROMPT "\nA ROTINA TERMINA AQUI...")
  (PRINC)
)

; LINHAS TRACEJADAS:
(DEFUN linhas_tracejadas ()
  (INITGET 1)
  (SETVAR "osmode" 32)
  (COMMAND "._-linetype" "_set" "tracejadax2" "_load" "tracejadax2" "acadiso.lin" "_yes" "")
  (COMMAND "._layer" "_M" "CABO_PROJETADO_TRACEJADO" "_c" "1" "" "")
  (COMMAND "._line" pt1 pt2 "")
  (COMMAND "._-linetype" "_set" "bylayer" "_load" "tracejadax2" "acadiso.lin" "_yes" "")
  (PRINC)
)

; LINHAS CONTINUAS:
(DEFUN linhas_continuas ()
  (INITGET 1)
  (SETVAR "osmode" 32)
  (COMMAND "._layer" "_M" "CABO_PROJETADO_CONTINUO" "_c" "3" "" "")
  (COMMAND "._line" pt1 pt2 "")
  (PRINC)
)

[whipshamazin]

ШОУ!15.1BettBettClif