Ajuda para modificar rotina

Moderador: Moderadores

Responder
felipemessara
Novato
Novato
Mensagens: 5
Registrado em: Seg 17 Mai 2021 12:29:55 pm

Ajuda para modificar rotina

Mensagem por felipemessara »

Boa tarde, não sou programador, trabalho a muitos anos como projetista civil e tenho uma rotina lisp que gerava automaticamente a tabela de ferros em um desenho de concreto armado, ela lia as configurações do texto e gerava a tabela. Porém, hoje trabalho em uma nova empresa de concreto armado que usa uma configuração diferente na chamada das barras de ferros, gostaria de saber se tem como trocar.

Precisava manter o lisp como é, mudando apenas a forma como ele lê a diagramação das barras de ferro.

A lisp em anexo atualmente lê a ferragem desta maneira: "N1- 4 ∅8 - C=230". E precisava que ela mudasse para este modelo de escrita: ""2 N1 ∅10 C=462"" assim mantendo as configurações de geração e apontamentos da tabela de ferros.

Não consegui postar a lisp aqui, como faço?
Aldo Cavalcante
Madeira
Madeira
Mensagens: 12
Registrado em: Ter 07 Nov 2017 11:17:35 am

Re: Ajuda para modificar rotina

Mensagem por Aldo Cavalcante »

Olá, felipemessara!
Para anexar o código, clique em responder, acesse os botões acima e clique o botão "código" e logo, vai aparecer colchetes.
Daí então, você escreve o seu código entre os colchetes, e envia para o pessoal aqui avaliar.

Código: Selecionar todos

O seu código que você escreveu ou colou, vai aparecer aqui dessa forma, depois que você apertar o botão "enviar"...
felipemessara
Novato
Novato
Mensagens: 5
Registrado em: Seg 17 Mai 2021 12:29:55 pm

Re: Ajuda para modificar rotina

Mensagem por felipemessara »

Obrigado Aldo, consegui!


Segue o codigo da rotina lisp que preciso alterar.

Código: Selecionar todos

                                         ;****************************************
                                        ;listFer.LSP sistema
                                        ;Edson Tadeu Moreira
                                        ;Mar/98
                                        ;****************************************

(vmon)                                  ;****************************************
                                        ;Tratamento de erro
                                        ;se ocorrer algum erro os valores das
                                        ;variaveis do autocad sao restauradas
                                        ;****************************************

(defun *error* (msg)
  (princ "\n\tERRO: ")
  (princ msg "\n")
  (if (= FlagVarOk 1) RestauraVar)
  (prin1)
)                                       ;**************************************
                                        ;Ajusta variaveis apos load
                                        ;**************************************

(defun AjustaVarInicial ()
  (setvar "Menuecho" 3)                 ;desliga echo do menu/sistema/toggle
  (setvar "cmdecho" 0)                  ;nao ecoa na tela
  (setq FlagVarOk 0)
  (prin1)
)
                                        ;**************************************
                                        ;Ajusta variaveis apos chamada de rf
                                        ;**************************************

(defun AjustaVar ()
  (setq FlagVarOk 0)                    ;nao tenta restaurar variaveis se der erro
  (setq Sangbase (getvar "angbase"))
  (setvar "angbase" 0)                  ;0 graus a leste
  (setq Saunits (getvar "aunits"))
  (setvar "aunits" 0)                   ;sistema de medida do angulo graus
  (setq Sangdir (getvar "angdir"))
  (setvar "angdir" 0)                   ;direcao do angulo antihorario
  (setq Sauprec (getvar "auprec"))
  (setvar "auprec" 1)                   ; angulo com 1 casa decimal
  (setq Sblipmode (getvar "blipmode"))
  (setvar "blipmode" 0)                 ;desliga blip
  (setq Sclayer (getvar "clayer"))      ;salva layer corrente
  (setq Scecolor (getvar "cecolor"))    ;salva cor corrente
  (setq Scoords (getvar "coords"))
  (setvar "coords" 2)                   ;liga indicacao de coordenada
  (setq Sdimtih (getvar "dimtih"))
  (setvar "dimtih" 0)                   ;texto alinhado com a linha de dimensao
  (setq Sdimtsz (getvar "dimtsz"))
  (setvar "dimtsz" 2.55)                ;tamanho do tique da cota
  (setq Sdimtxt (getvar "dimtxt"))
  (setvar "dimtxt" 1.8)                 ;tamanho do texto da cota 1.8
  (setq Sdragmode (getvar "dragmode"))
  (setvar "dragmode" 2)                 ;mostra sempre o desenho no drag
  (setq Sfillmode (getvar "fillmode"))
  (setvar "fillmode" 1)                 ;mostra preenchimento da poliline
  (setq Shighlight (getvar "highlight"))
  (setvar "HIGHLIGHT" 1)                ;mostra em highlight objetos selecionados
  (setq SLimcheck (getvar "limcheck"))
  (setvar "Limcheck" 0)                 ;nao verifica espaco corrente
  (setq Sluprec (getvar "luprec"))
  (setvar "luprec" 2)                   ;2 casas decimais
  (setq Sorthomode (getvar "orthomode"))
  (setvar "orthomode" 0)                ;desliga ortho
  (setq Sosmode (getvar "osmode"))
  (setvar "osmode" 0)                   ;desliga osnap <- nao ligar
  (setq FlagVarOk 1)                    ;Ativa flag de restauracao
  (prin1)
)
                                        ;**************************************
                                        ;Restaura variaveis apos execucao de rf
                                        ;**************************************

(defun RestauraVar ()
  (if (= FlagVarOk 1)
      (progn
        (setq FlagVarOk 0)
        (setvar "angbase" Sangbase)
        (setvar "angdir" SAngdir)
        (setvar "aunits" Saunits)
        (setvar "auprec" Sauprec)
        (setvar "blipmode" Sblipmode)
        (setvar "coords" Scoords)
        (setvar "dimtih" Sdimtih)
        (setvar "dimtsz" Sdimtsz)
        (setvar "dimtxt" Sdimtxt)
        (setvar "dragmode" Sdragmode)
        (setvar "fillmode" Sfillmode)
        (setvar "highlight" Shighlight)
        (setvar "limcheck" Slimcheck)
        (setvar "luprec" Sluprec)
        (setvar "orthomode" Sorthomode)
        (setvar "osmode" Sosmode)
        (command "layer" "ON" Sclayer "")
        (command "color" "bylayer")
        (setq FlagVarOk 1)
      )
  )
  (prin1)
)                                       ;****************************************
                                        ;Cria e ativa um layer
                                        ;****************************************

(defun AtivaLayer (LaNome LaTipo LaCor / LayerCor)
  (cond
        ((= LaTipo "Err") (setq LayerCor "5"))
        ((= LaTipo "Tab") (setq LayerCor "4"))
        ((= LaTipo "Rpt") (setq LayerCor LaCor))
        (T (setq LayerCor "7"))
  )
  (if (tblsearch "Layer" LaNome)
      (command "Layer" "t" LaNome "")
  )
  (command "Layer" "m" LaNome "")
  (command "Layer" "c" LayerCor LaNome "")
  (prin1)
)                                       ;****************************************
                                        ;Este modulo le as strings na tela
                                        ;e agrupa em uma tabela de ferros
                                        ;****************************************

(defun c:RF (/	      CNum     CNumLst	Cont	 Col1X	  Col2X
	     Col3X    Col4X    DiaLst	DiaAux	 DiaList1 DiaMax
	     DiaPos   DisTab   DrawX	EntDat	 EntNom	  Escala
	     ErrCnt   FerLay   FCmp	FCmpLst	 FPos	  FPosAux
	     FPosLst  FPosLst1 FNum	FNumAux	 FNumLst  FNumLst1
	     FerStr   FDiam    FQuant	FTotal	 Flag1	  i
	     j	      LayStr   Lin1Y	Lin2Y	 LinWdt	  LinOfs
	     LixLay   LixTxt   MaisPos	n	 NPos	  NumCmp
	     NumTxt   NumRpt   NumTot	OlhBlk	 OlhDwg	  Oper1
	     Oper2    NomStr   PesoUni	PesoTot	 PtoTab	  PtoRes
	     Pto0     Pto1     Pto2	Pto3	 Pto4	  Pto5
	     RNumLst  RQnt     RQntLst	S	 S1	  ss1
	     ss2      ss3      ss4	ss5	 SpcPos	  TabLay
	     Tablayr  TitleY   Title1Y	TextX	 TextY	  TabWdt
	     TotAux   TotalY   TotLst	TotLst1	 LetraG	  LetraP
	     VezLay   VezStr   VezesPos
	    )
  (AjustaVar)

  (SETVAR "TEXTSTYLE" "romans")
  (princ "\nCalculo das tabelas de ferro e resumo")
					;****************************************
					; inicializacoes
					;****************************************
  (Initget 5)
  (setq Col1X 60)			;Col1X    = Coluna 1 da tabela de ferro
  (setq Col2X 125)			;Col2X    = Coluna 2 da tabela de ferro
  (setq Col3X 215)			;Col3X    = Coluna 3 da tabela de ferro
  (setq Col4X 325)			;Col4X    = Coluna 4 da tabela de ferro
  (setq Col5X 90)			;Col5X    = Coluna 1 da tabela resumo
  (setq Col6X 150)			;Col6X    = Coluna 2 da tabela resumo
  (setq Col7X 260)			;Col7X    = Coluna 3 da tabela resumo
  (setq Cont 0)				;Cont     = contador
  (setq DiaPos 0)			;DiaPos   = Posicao do caracter ] na string
  (setq DiaAux 0.0)			;DiaAux   = Posicao do caracter ] na string
  (setq DiaLst (list))			;DiaLst   = diametro da ferragem
  (setq DiaMax 32.0)			;DiaMax   = diametro maior possivel para ferragem
  (setq DiaLst1 (list))			;DiaLst1  = diametro da ferragem (auxiliar)
  (setq DisTab 30)			;DisTab   = Distancia entre as tabelas
  (setq DrawX 500)			;DrawX    = Posicao do desenho de alerta de error
  (setq EntDat "")			;EntDat   = dados da entidade
  (if (= e nil)
    (progn
      (Initget 4)
      (setq e (getint "\nDigite o valor da escala <50>: "))
      (if (or (= e nil) (= e 0))
	(setq e 50)
      )
      (Initget 5)
    )
  )
  (princ (strcat "\nEscala: 1/" (itoa e)))
  (setq Escala (/ e 50.))		;Escala   = fator de escala
  (setq ErrCnt 0)			;ErrCnt   = Contador Errors
  (setq FerStr "")			;FerStr   = descricao da ferrgem
  (setq FCmp 0)				;FCmp     = elemento na lista FCmpLst
  (setq FCmpLst (list))			;FCmpLst  = comprimento da ferragem
  (setq FerLay "FerrVar")		;FerLay   = Nome do layer ferro variavel
  (setq FNum 0)				;FNum     = elemento n na lista FNumLst
  (setq FNumAux 0)			;FNumAux  = elemento n-1 na lista FNumLst
  (setq FNumLst (list))			;FNumLst  = numero da ferragem na selecao
  (setq FNumLst1 (list))		;FNumLst1 = numero da ferragem na selecao (auxiliar)
  (setq FDiam 0.0)			;FDiam    = Diamentro da ferragem
  (setq FPos 0)				;FPos     = elemento na lista FPosLst
  (setq FPosAux 0)			;FPosAux  = elemento n-1 na lista FPosLst
  (setq FPosLst (list))			;FPosLst  = posicao da ferragem na selecao
  (setq FPosLst1 (list))		;FPosLst1 = posicao da ferragem na selecao (auxiliar)
  (setq FQuant 0)			;FQuant   = Quantidade da ferragem
  (setq FTotal 0)			;FTotal   = Quantidade da ferragem Total
  (setq LetraP 12.5)			;LetraP   = Letra menor da tabela
  (setq LetraG 15)			;LetraG   = Letra maior da tabela
  (setq Lin1Y 36.25)			;Lin1Y    = posicao da linha horizontal 1
  (setq Lin2Y 67)			;Lin2Y    = posicao da linha horizontal 2
  (setq LinOfs 15)			;LinOfs   = Linha do texto em relacao ao texto
  (setq LinWdt 30)			;LinWdt   = Altura da linha da tabela
  (setq LixLay "LixoArmacao")		;LixLay   = Nome do layer lixo de armacao desenho
  (setq LixTxt "LixoTexto")		;LixLay   = Nome do layer lixo de armacao texto
  (setq MaisPos 0)			;MaisPos  = posicao do caracter mais
  (setq NumCmp 0)			;NumCmp   = contador de comprimentos variaveis
  (setq NumTxt 0)			;NumTxt   = contador de textos
  (setq NumTot 0)			;NumTot   = contador de totais da tab ferragem
  (setq NumRpt 0)			;NumRpt   = contador de repetidos
  (setq OlhBlk "Olho")			;OlhBlk   = Nome do bloco do olho
  (setq OlhDwg "Olho.dwg")		;OlhDwg   = Nome do desenho do olho
  (setq Oper1 "")			;Oper1    = Operando 1
  (setq Oper2 "")			;Oper2    = Operando 2
  (setq PesoUni 0)			;PesoUni  = peso unitario do resumo
  (setq PesoTot 0)			;PesoTot  = peso total geral
  (setq RNumLst (list))			;RNumLst  = numero da ferragem na selecao (repetido)
  (setq RQnt 0)				;RQnt     = elemento na lista RQntLst
  (setq RQntLst (list))			;RQntLst  = quantidade da ferragem (repetido)
  (setq S "")				;S        = string generica
  (setq S1 "")				;S1       = string generica
  (setq TitleY 15)			;TitleY   = posicao vertical do titulo
  (setq Title1Y 52.5)			;Title1Y  = posicao vertical do titulo
  (setq TextX 12)			;TextX    = Posicao do texto Horizontal
  (setq TextY 85)			;TextY    = Posicao do texto Vertical inicial
  (setq TabWdt 450)			;TabWdt   = Largura da Tabela
  (setq TabLay "LF100")		        ;TabLay   = Nome do layer da Tabela
  (setq TabLayr "LF120")		;TabLayr  = Nome do layer da Tabela Resumo
  (setq TotAux 0)			;TotAux   = total da ferragem (auxiliar)
  (setq TotLst (list))			;TotLst   = total da ferragem
  (setq TotLst1 (list))			;TotLst1  = total da ferragem (auxiliar)
  (setq TotalY 14)			;TotalY   = ajuste da posicao do total do resumo
  (setq CNum 0)				;CNum     = elemento n na lista CNum
  (setq CNumLst (list))			;CNumLst  = Numero da ferragem da lista FCmpLst
  (setq VezLay 0)			;VezLay   = Multiplicativo do layer
  (setq VezStr "")			;VezStr   = String de vezes
  (setq VezesPos 0)			;VezesPos = posicao do caracter vezes
                                        ;****************************************
  (AtivaLayer TabLay "Tab" "0")         ; Cria e ativa layer ListaF para a tabela
                                        ; Limpa as tabelas anteriores, seleciona
                                        ; todas as entidades em listaf e as apaga
                                        ;****************************************
  (princ "\nApagando a tabela anterior, aguarde ")
  (setq ss1 (ssget "X" (list (cons 8 TabLay))))
  (if (/= ss1 NIL)
    (progn
      (setq Cont (sslength ss1))
      (setq n 0)
      (while (< n Cont)
        (progn
          (setq EntNom (ssname ss1 n))
          (entdel EntNom)
          (setq n (+ n 1))
        )
      )
    )
  )
                                        ;****************************************
                                        ; Apaga os blocos olho anteriores
  (setq ss1 (ssget "X" (list (cons 2 OlhBlk))))
  (if (/= ss1 NIL)
    (progn
      (setq Cont (sslength ss1))
      (setq n 0)
      (while (< n Cont)
        (progn
          (setq EntNom (ssname ss1 n))
          (entdel EntNom)
          (setq n (+ n 1))
        )
      )
    )
  )                                     ;****************************************
                                        ;Cria selecao com layers X1..n e FerrVar
                                        ;ss1      = set de selecao de entidades
  (setq ss1 (ssget "X" (list (cons 8 "X*"))))
  (setq ss3 (ssget "X" (list (cons 8 FerLay))))
  (setq Cont -1)
  (if ss3
    (progn
      (setq n (sslength ss3))
      (repeat n
        (setq Cont (1+ Cont))
        (setq EntNom (ssname ss3 Cont))     ;le os nomes das entidades de ss1
        (setq EntDat (entget EntNom))       ;le a entidade
        (ssadd (cdr (assoc -1 EntDat)) ss1) ;acrescenta o nome de EntDat em ss1
      )
    )
  )
  (setq PtoTab (getpoint "\nMarque o local da tabela : " ))
                                        ;****************************************
                                        ;desenha os contornos da tabela de ferro
                                        ;****************************************
  (Mudatxt ss1 "%%c" "]")
  (Mudatxt ss1 "%%C" "]")
  (princ "\nGerando a tabela de ferros ")
  (setq Pto0 (list (+ (car PtoTab) (* (/ TabWdt 2.0) Escala)) (- (cadr PtoTab) (* TitleY Escala)) 0))
  (command "COLOR" "3")
;;;  (command "TEXT" "MC" Pto0 (* Escala LetraG) "0" "TABELA DE FERROS")
  (setq Pto0 (list (car PtoTab) (-(cadr PtoTab) (* Lin1Y Escala)) 0))
  (setq Pto1 (list (+ (car Pto0) (* Escala TabWdt)) (cadr Pto0) 0))
  (command "COLOR" "2")
  (command "PLINE" Pto0 "W" "0" "" Pto1 "")
  (setq Pto1 (list (- (+ (car PtoTab) (* Escala Col1X)) (* Escala TextX))
                   (-(cadr PtoTab) (* Escala Title1Y)) 0))
  (command "color" "3")
  (command "TEXT" "MR" Pto1 (* (* Escala LetraP) ) "0" "N")
  (setq Pto1 (list (- (+ (car PtoTab) (* Escala Col2X)) (* Escala TextX))
                   (cadr Pto1) 0))
  (command "TEXT" "MR" Pto1 (* Escala LetraG) "0" "%%C")
  (setq Pto1 (list (- (+ (car PtoTab) (* Escala Col3X)) (* Escala TextX))
                   (cadr Pto1) 0))
  (command "TEXT" "MR" Pto1 (* (* Escala LetraP) ) "0" "Q")
  (setq Pto1 (list (- (+ (car PtoTab) (* Escala Col4X)) (* Escala TextX))
                   (cadr Pto1) 0))
  (command "TEXT" "MR" Pto1 (* (* Escala LetraP) ) "0" "UNIT.(cm)")
  (setq Pto1 (list (- (+ (car PtoTab) (* Escala TabWdt)) (* Escala TextX))
                   (cadr Pto1) 0))
  (command "TEXT" "MR" Pto1 (* (* Escala LetraP) ) "0" "TOT.(m)")
  (setq Pto0 (list (car PtoTab) (- (cadr PtoTab) (* Lin2Y Escala)) 0))
  (setq Pto1 (list (+ (car Pto0) (* Escala TabWdt)) (cadr Pto0) 0))
  (command "COLOR" "2")
  (command "PLINE" Pto0 "W" "0" "" Pto1 "")
  (setq Cont -1)
  (setq NumTxt -1)
  (setq NumTot -1)
  (setq NumRpt -1)
  (setq NumCmp -1)
  (setq n (sslength ss1))               ;****************************************
                                        ;Acertando a selecao ss1 e gerando FPosLst
                                        ;FerList e RNumLst
                                        ;****************************************
  (setq ss2 (ssadd))                    ;inicializa ss2 p/ elementos a serem
                                        ;movidos para LixoTexto
  (setq ss4 (ssadd))                    ;inicializa ss4 p/ elementos a serem
                                        ;movidos para LixoArmacao
  (setq ss5 (ssadd))                    ;inicializa ss5 p/ elementos a serem
                                        ;movidos para FerrVar
  (AtivaLayer TabLay "Tab" "0")
  (repeat n
      (setq Cont (1+ Cont))
      (setq EntNom (ssname ss1 Cont))   ;le os nomes das entidades de ss1
      (setq EntDat (entget EntNom))     ;le a entidade
      (setq LayStr (cdr (assoc 8 EntDat))) ; layer do elemento
                                        ;***************************************
                                        ; so elementos dos layers X1..n e ferrvar
      (if (or (= "X" (strcase (substr LayStr 1 1)))
              (= (strcase LayStr) (strcase FerLay)))
        (progn
          (if (= (strcase LayStr) (strcase FerLay))
            (setq VezStr "1")
            (setq VezStr (substr LayStr 2))
          )
          (setq VezLay (atoi VezStr))
          (if (> VezLay 0)
            (progn
              (setq EntNom (cdr (assoc 2 EntDat)))  ; nome do elemento
              (if (= EntNom nil)
                (progn
                  (setq NomStr (cdr (assoc 0 EntDat))) ; tipo de elemento
                  (if (= "TEXT" NomStr) ; ve se entidade e' text e processa
                    (progn
                      (setq FerStr (strcase (cdr (assoc 1 EntDat)))) ; Descricao da estrutura
                      (setq i (strLen FerStr))
                      (setq NPos 1)    ;****************************************
                                       ; o numero da ferragem nos layouts
                                       ; N9 99]99 C=999
                                       ; 9 N9 ‚ apos a letra N
                      (while (and (/= (substr FerStr NPos 1) "N") (> i NPos))
                        (setq NPos (+ NPos 1))
                      )
                      (if (< NPos i)
                        (progn
                          (setq SpcPos (+ NPos 1))
                          (setq S "Ok")
                          (while (and (/= (substr FerStr SpcPos 1) " ") (>= i SpcPos))
                            (progn
                              (if (= (substr FerStr SpcPos 1) "]")
                                (setq S "Erro")
                              )
                              (setq SpcPos (+ SpcPos 1))
                            )
                          )            ;****************************************
                                       ; nao pode haver o caracter ] antes de
                                       ; ter encontrado  o espaco na string
                                       ; acrescenta a entidade em ss2 que sera
                                       ; movida para lixo_texto
                          (if (= S "Erro" )
                            (progn
                              (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                              (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                               0))
                              (setq S1 (strcat "---> falta espaco entre N e ]: " FerStr ", verifique"))
                              (command "COLOR" "BYLAYER")
                              (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S1 )
                              (setq ErrCnt (1+ ErrCnt))
                              (ssadd (cdr (assoc -1 EntDat)) ss2)
                            )
                          )            ;****************************************
                                       ; nao pode haver duplo espaco nas strings
                                       ; acrescenta a entidade em ss2 que sera
                                       ; movida para lixo_texto
                          (if (= (wcmatch FerStr "*  *" ) T)
                            (progn
                              (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                              (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                               0))
                              (setq S (strcat "---> texto com espaco duplo: " FerStr ", verifique"))
                              (command "COLOR" "BYLAYER")
                              (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S )
                              (setq ErrCnt (1+ ErrCnt))
                              (ssadd (cdr (assoc -1 EntDat)) ss2)
                            )
                          )            ;****************************************
                                       ; de acordo com a definicao do layout nao
                                       ; pode haver espaco depois de N
                                       ; acrescenta a entidade em ss2 que sera
                                       ; movida para lixo_texto
                                       ;****************************************
                          (if (= SpcPos (+ NPos 1))
                            (progn
                              (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                              (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                               0))
                              (setq S (strcat "---> definicao irreconhecivel: " FerStr ", verifique"))
                              (command "COLOR" "BYLAYER")
                              (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S )
                              (setq ErrCnt (1+ ErrCnt))
                              (ssadd (cdr (assoc -1 EntDat)) ss2)
                            )
                          )
                          (setq S (substr FerStr (+ Npos 1) (- SpcPos NPos 1)))
                                       ;****************************************
                                       ; Consistencia para sequencia na numeracao
                                       ; da ferragem >= 1000
                                       ; acrescenta a entidade em ss2 que sera
                                       ; movida para lixo_texto
                                       ;****************************************
                          (if (>= (atoi S) 1000)
                            (progn
                              (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                                           (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                                           0))
                              (setq S1 (strcat "---> Numero da ferragem muito grande " FerStr ", verifique"))
                              (command "COLOR" "BYLAYER")
                              (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S1 )
                              (setq ErrCnt (1+ ErrCnt))
                              (ssadd (cdr (assoc -1 EntDat)) ss2)
                            )
                          )
                                       ;****************************************
                                       ; definicao da ferragem
                                       ;****************************************
                          (if (= NPos 1)
                            (progn
                              (setq NumTxt (1+ NumTxt))
                              (setq FPosLst (append FPosLst (list Cont)))
                              (setq FNumLst (append FNumLst (list (atoi S))))
                            )
                            (progn     ;****************************************
                                       ; ferragens repetidos
                                       ;****************************************
                                       ; de acordo com a definicao do layout
                                       ; deve existir um espaco antes de N,
                                       ; caso nao exista
                                       ; acrescenta a entidade em ss2 que sera
                                       ; movida para lixo_texto
                                       ;****************************************
                              (if (/= (substr FerStr (1- NPos) 1) " ")
                                (progn
                                  (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                                  (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                                   0))
                                  (setq S (strcat "---> definicao irreconhecivel: " FerStr ", verifique"))
                                  (command "COLOR" "BYLAYER")
                                  (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S )
                                  (setq ErrCnt (1+ ErrCnt))
                                  (ssadd (cdr (assoc -1 EntDat)) ss2)
                                )
                              )
                              (setq NumRpt (1+ NumRpt))
                              (setq RQnt (atoi (substr FerStr 1 (- SpcPos 1))))
                                        ;**************************************
                                        ;testa os multiplicativos do tipo
                                        ;99+99 e 99X99
                              (setq S1 (substr FerStr 1 (- SpcPos 1)))
                              (setq MaisPos 1)
                              (setq j (strlen S1))
                              (while (and (/= (substr S1 MaisPos 1) "+") (>= j MaisPos))
                                (setq MaisPos (+ MaisPos 1))
                              )
                              (if (< MaisPos j)
                                (progn
                                  (setq Oper1 (substr S1 1 (1- MaisPos)))
                                  (setq Oper2 (substr S1 (1+ MaisPos)))
                                  (setq RQnt (+ (atoi Oper1) (atoi Oper2)))
                                )
                                (progn
                                  (setq VezesPos 1)
                                  (while (and (/= (substr S1 VezesPos 1) "X") (>= j VezesPos))
                                    (setq VezesPos (+ VezesPos 1))
                                  )
                                  (if (< VezesPos j)
                                    (progn
                                      (setq Oper1 (substr S1 1 (1- VezesPos)))
                                      (setq Oper2 (substr S1 (1+ VezesPos)))
                                      (setq RQnt (* (atoi Oper1) (atoi Oper2)))
                                    )
                                    (setq RQnt (atoi S1))
                                   )
                                )
                              )
                              (setq RQntLst (append RQntLst (list (* VezLay RQnt))))
                              (setq RNumLst (append RNumLst (list (atoi S))))
                            )
                          )
                        )
                                         ;****************************************
                        (progn           ; ferragens de comprimento variaveis
                          (setq NPos 1)
                          (while (and (/= (substr FerStr NPos 1) "-") (> i NPos))
                            (setq NPos (+ NPos 1))
                          )
                          (if (< NPos i)
                            (progn
                              (setq NumCmp (1+ NumCmp))
                              (setq CNum (atoi (substr FerStr 1 (- NPos 1))))
                              (setq FCmp (atoi (substr FerStr (+ NPos 1))))
                              (setq FCmpLst (append FCmpLst (list FCmp)))
                              (setq CNumLst (append CNumLst (list CNum)))
                                       ;****************************************
                                       ;acrescenta o nome de EntDat em ss5 para
                                       ;se certificar que os variaveis estao em
                                       ;Ferrvar
                              (if (/= (strcase FerLay) (strcase LayStr))
                                (progn
                                  (ssadd (cdr (assoc -1 EntDat)) ss5)
                                  (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                                                   (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                                                    0))
                                  (setq S (strcat "---> " FerStr ", estava no layer " LayStr))
                                  (command "COLOR" "BYLAYER")
                                  (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S )
                                  (setq ErrCnt (1+ ErrCnt))
                                )
                              )
                            )          ;o "N" esta na ultima posicao ou nao existe
                            (progn
                              (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                              (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                               0))
                              (setq S (strcat "---> definicao irreconhecivel: " FerStr ", verifique"))
                              (command "COLOR" "BYLAYER")
                              (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S )
                              (setq ErrCnt (1+ ErrCnt))
                              (ssadd (cdr (assoc -1 EntDat)) ss2)
                            )
                          )
                        )
                      )
                    )                   ;****************************************
                                        ; se entidade nao ‚ text acrescenta o nome
                                        ; em ss4 que sera movido para lixo_armacao
                    (progn
                      (ssdel (ssname ss1 Cont) ss1)
                      (setq Cont (1- Cont))
                      (ssadd (cdr (assoc -1 EntDat)) ss4) ;acrescenta o nome de EntDat em ss4
                    )
                  )
                )
              )
            )
                                        ;****************************************
            (progn                      ; retira o elemento da selecao, layer nao ‚ Xn
              (ssdel (ssname ss1 Cont) ss1)
              (setq Cont (1- Cont))
            )
          )
        )
                                        ;****************************************
        (progn                          ; retira o elemento da selecao, layer nao e X..
          (ssdel (ssname ss1 Cont) ss1)
          (setq Cont (1- Cont))
        )
      )
  )
                                       ;****************************************
                                       ; Ordenando FPosLst = lista de posicao da
                                       ; selecao em ordem de numero de ferragem
                                       ;****************************************
  (princ "\nOrdenando a tabela de ferros ")
  (setq n NumTxt)
  (setq Flag1 T)
  (while (= Flag1 T)
    (progn
      (setq Flag1 F)
      (setq Cont -1)
      (while (< Cont NumTxt)
        (progn
          (setq Cont (1+ Cont))
          (setq FNum (nth Cont FNumLst))
          (setq FPos (nth Cont FPosLst))
          (setq FNumAux (nth (+ Cont 1) FNumLst))
          (if (< Cont NumTxt)
            (progn
              (setq FNumAux (nth (+ Cont 1) FNumLst))
              (if (>= FNumAux FNum)
                (progn
                  (setq FNumLst1 (append FNumLst1 (list FNum)))
                  (setq FPosLst1 (append FPosLst1 (list FPos)))
                )
                (progn
                  (setq FPosAux (nth (+ Cont 1) FPosLst))
                  (setq FNumLst1 (append FNumLst1 (list FNumAux)))
                  (setq FPosLst1 (append FPosLst1 (list FPosAux)))
                  (setq FNumLst1 (append FNumLst1 (list FNum)))
                  (setq FPosLst1 (append FPosLst1 (list FPos)))
                  (setq Flag1 T)
                  (setq Cont (1+ Cont))
                )
              )
            )
            (progn
              (setq FNumLst1 (append FNumLst1 (list FNum)))
              (setq FPosLst1 (append FPosLst1 (list FPos)))
            )
          )
        )
      )
      (setq FNumLst (append FNumLst1))
      (setq FPosLst (append FPosLst1))
      (setq FNumLst1 (list))
      (setq FPosLst1 (list))
      (princ ".")
    )
  )
                                       ;****************************************
                                       ;Preenchendo a tabela de ferros
                                       ;****************************************
  (princ "\nImprimindo a tabela de ferros ")
  (AtivaLayer TabLay "Tab" "0")
  (setq n NumTxt)
  (setq n (+ 1 n))
  (setq Cont -1)
  (setq FNumAux 0)
  (repeat n
    (setq Cont (1+ Cont))
    (setq FPos (nth Cont FPosLst))
    (setq FNum (nth Cont FNumLst))
    (setq EntNom (ssname ss1 FPos))      ;le os nomes das entidades de ss1
    (setq EntDat (entget EntNom))        ;le a entidade
                                       ;****************************************
                                       ; Consistencia para ferragem duplamente
                                       ; definida
                                       ;****************************************
    (if (<= FNum FNumAux)
      (progn
        (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                     (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                     0))
        (setq S (strcat "---> definicao de ferragem repetida: N" (itoa FNum) ", verifique"))
        (command "COLOR" "BYLAYER")
        (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S )
        (setq ErrCnt (1+ ErrCnt))
        (ssadd (cdr (assoc -1 EntDat)) ss2)
        (ssadd (cdr (assoc -1 (entget (ssname ss1 FPosAux)))) ss2)
      )                                ;****************************************
                                       ; Consistencia para sequencia na numeracao
                                       ; da ferragem faltando
                                       ;****************************************
      (if (/= FNum (1+ FNumAux))
        (progn
          (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                       (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                       0))
          (setq S (strcat "---> Nao existem posicoes N" (itoa (1+ FNumAux))
                          " ... N" (itoa (1- FNum)) ", verifique"))
          (command "COLOR" "BYLAYER")
          (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S )
          (setq ErrCnt (1+ ErrCnt))
        )
      )
    )
    (setq FNumAux FNum)
    (setq FPosAux FPos)
    (setq LayStr (cdr (assoc 8 EntDat))) ; layer do elemento
    (if (= (strcase LayStr) (strcase FerLay))
      (setq VezStr "1")
      (setq VezStr (substr LayStr 2))
    )
    (setq VezLay (atoi VezStr))
    (setq FerStr (strcase (cdr (assoc 1 EntDat)))) ; string da ferragem
    (setq i (strLen FerStr))
                                       ;****************************************
                                       ; escreve numero da ferragem
    (princ ".")
    (setq Pto1 (list (- (+ (car PtoTab) (* Escala Col1X)) (* Escala TextX))
                        (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt Cont) Escala)))
                           0))
    (setq S (itoa (nth Cont FNumLst)))
    (command "color" "3")
    (command "Text" "MR" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" S)
                                       ;*****************************************
                                       ; escreve quantidade da ferragem
                                       ; a quantidade no layout
                                       ; N9 99]99 C=999 ‚ entre 1§ espaco e ]
    (setq SpcPos 1)
    (while (and (/= (substr FerStr SpcPos 1) " ") (>= i SpcPos))
      (setq SpcPos (+ SpcPos 1))
    )
    (setq DiaPos (+ SpcPos 1))
    (while (and (/= (substr FerStr DiaPos 1) "]") (>= i DiaPos))
      (setq DiaPos (+ DiaPos 1))
    )
                                        ;**************************************
                                        ;testa os multiplicativos do tipo
                                        ;99+99 e 99X99
    (setq S (substr FerStr (+ SpcPos 1) (- DiaPos SpcPos 1)))
    (setq MaisPos 1)
    (setq j (strlen S))
    (while (and (/= (substr S MaisPos 1) "+") (>= j MaisPos))
      (setq MaisPos (+ MaisPos 1))
    )
    (if (< MaisPos j)
      (progn
        (setq Oper1 (substr S 1 (1- MaisPos)))
        (setq Oper2 (substr S (1+ MaisPos)))
        (setq FQuant (* (+ (atoi Oper1) (atoi Oper2)) VezLay))
      )
      (progn
        (setq VezesPos 1)
        (while (and (/= (substr S VezesPos 1) "X") (>= j VezesPos))
          (setq VezesPos (+ VezesPos 1))
        )
        (if (< VezesPos j)
          (progn
            (setq Oper1 (substr S 1 (1- VezesPos)))
            (setq Oper2 (substr S (1+ VezesPos)))
            (setq FQuant (* (atoi Oper1) (atoi Oper2) VezLay))
          )
          (setq FQuant (* VezLay (atoi S)))
        )
      )
    )
    (setq Pto1 (list (- (+ (car PtoTab) (* Escala Col3X)) (* Escala TextX))
                     (cadr Pto1)
                     0))
    (setq j -1)
    (repeat (+ NumRpt 1)
        (setq j (1+ j))
        (setq RNum (nth j RNumLst))
        (if (= RNum (nth Cont FNumLst))
          (setq FQuant (+ FQuant (nth j RQntLst)))
        )
    )
    (setq S (itoa FQuant))
    (command "Text" "MR" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" S)
                                       ;*****************************************
                                       ; Escreve diamento da ferragem
                                       ; e grava lista DiaLst.
                                       ; O diamento no layout
                                       ; N9 99]99 C=999 ‚ entre ] e o 2§ espaco
    (setq SpcPos (+ DiaPos 1))
    (while (and (/= (substr FerStr SpcPos 1) " ") (>= i SpcPos))
      (setq SpcPos (+ SpcPos 1))
    )
    (setq S (substr FerStr (+ DiaPos 1) (- SpcPos DiaPos 1)))
    (setq FDiam (atof S))
                                       ;*****************************************
                                       ; consiste a ferragem para diametro maximo
    (if (> FDiam DiaMax)
      (progn
        (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                     (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                     0))
        (setq S1 (strcat "---> diametro da ferragem : N" (itoa FNum) " = "
                         (rtos FDiam) " maior que " (rtos DiaMax) ", verifique"))
        (command "COLOR" "BYLAYER")
        (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S1 )
        (setq ErrCnt (1+ ErrCnt))
        (ssadd (cdr (assoc -1 EntDat)) ss2)
      )
    )
    (setq DiaLst (append DiaLst (list FDiam)))
    (setq Pto1 (list (- (+ (car PtoTab) (* Escala Col2X)) (* Escala TextX))
                     (cadr Pto1)
                     0))
    (command "Text" "MR" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" S)
                                       ;*****************************************
                                       ; escreve comprimento da ferragem
                                       ; comprimento no layout
                                       ; N9 99]99 C=999 ‚ apos o c=
    (setq IglPos (+ DiaPos 1))
    (while (and (/= (substr FerStr IglPos 1) "=") (>= i IglPos))
      (setq IglPos (+ IglPos 1))
    )
    (setq S (substr FerStr (+ IglPos 1)))
                                       ;****************************************
                                       ; Consiste a string para ter espaco antes
                                       ; de c= e nao ter espaco depois
    (if (> IglPos 2)
      (if (or (/= (substr FerStr (- IglPos 2) 1) " ")
              (= (substr FerStr (1+ IglPos) 1) " ")
          )
        (progn
          (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                     (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                     0))
          (setq S1 (strcat "---> definicao de c= irreconhecivel: " FerStr ", verifique"))
          (command "COLOR" "BYLAYER")
          (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" S1 )
          (setq ErrCnt (1+ ErrCnt))
          (ssadd (cdr (assoc -1 EntDat)) ss2)
        )
      )
    )
                                       ;****************************************
                                       ; Se ferragem for variavel procura na
                                       ; lista CNumLst e FCmpLst
    (if (or (= S "CORR") (= S "VAR"))
      (progn
        (setq j 0)
        (while (and (>= NumCmp j) (/= FNum (nth j CNumLst)))
          (setq j (1+ j))
        )
        (if (> j NumCmp)
          (progn
            (setq Pto2 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                       (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                       0))
            (command "TEXT"  "ML" Pto2 (* Escala LetraP) "0"
            (strcat "---> comprimento indefinido: N" (itoa FNum) ", verifique"))
            (setq ErrCnt (1+ ErrCnt))
            (setq FCmp 0)
          )
          (progn
            (setq FCmp (nth j FCmpLst))
          )
        )
      )
      (progn                          ; dividido por 100 so o resultado
        (setq FCmp (atoi S))
      )
    )
    (setq Pto1 (list (- (+ (car PtoTab) (* Escala Col4X)) (* Escala TextX))
                     (cadr Pto1)
                     0))
    (command "Text" "MR" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" S)
                                       ;*****************************************
                                       ; escreve total e gera lista TotLst
    (setq NumTot (1+ NumTot))
    (setq FTotal (* FCmp FQuant))
    (setq TotLst (append TotLst (list FTotal)))
    (setq S (rtos (/ FTotal 100.0) 2 0))
    (setq Pto1 (list (- (+ (car PtoTab) (* Escala TabWdt)) (* Escala TextX))
                     (cadr Pto1)
                     0))
    (command "Text" "MR" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" S)
                                       ;*****************************************
                                       ; imprime linha separadora
    (setq Pto1 (list (car PtoTab) (- (cadr Pto1) (* LinOfs Escala)) 0))
    (setq Pto2 (list (+ (car PtoTab) (* Escala TabWdt)) (cadr Pto1) 0))
    (command "COLOR" "2")
    (command "PLINE" Pto1 "W" "0" "" Pto2 "")
  )                                    ;***************************************
                                       ;Contorno da tabela de ferros
                                       ;****************************************
  (AtivaLayer TabLay "Tab" "0")
  (setq Pto1 (list (car PtoTab) (- (cadr PtoTab) (+ (* TextY Escala) (* (+ LinOfs (* LinWdt NumTxt)) Escala))) 0))
  (setq PtoRes Pto1)                   ;salva o valor do fim da tabela de ferro
  (setq Pto2 (list (+ (car PtoTab) (* Escala TabWdt)) (cadr PtoTab) 0))
  (setq Pto3 (list (+ (car PtoTab) (* Escala TabWdt)) (cadr Pto1) 0))
  (command "COLOR" "2")
  (command "PLINE" Pto1 "W" "0" "" PtoTab Pto2 Pto3 "")
                                        ;****************************************
                                        ;divisao da coluna 1
  (command "COLOR" "2")
  (setq Pto1 (list (+ (car PtoTab) (* Escala Col1X))  (- (cadr PtoTab) (* Lin1Y Escala)) 0))
  (setq Pto2 (list (car Pto1) (cadr Pto3) 0))
  (command "PLINE" Pto1 "W" "0" "" Pto2 "")
                                        ;****************************************
                                        ;divisao da coluna 2
  (setq Pto1 (list (+ (car PtoTab) (* Escala Col2X))  (- (cadr PtoTab) (* Lin1Y Escala)) 0))
  (setq Pto2 (list (car Pto1) (cadr Pto3) 0))
  (command "PLINE" Pto1 "W" "0" "" Pto2 "")
                                        ;****************************************
                                        ;divisao da coluna 3
  (setq Pto1 (list (+ (car PtoTab) (* Escala Col3X))  (- (cadr PtoTab) (* Lin1Y Escala)) 0))
  (setq Pto2 (list (car Pto1) (cadr Pto3) 0))
  (command "PLINE" Pto1 "W" "0" "" Pto2 "")
                                        ;****************************************
                                        ;divisao da coluna 4
  (setq Pto1 (list (+ (car PtoTab) (* Escala Col4X))  (- (cadr PtoTab) (* Lin1Y Escala)) 0))
  (setq Pto2 (list (car Pto1) (cadr Pto3) 0))
  (command "PLINE" Pto1 "W" "0" "" Pto2 "")
                                        ;***************************************
  (AtivaLayer LixTxt "Err" "0")         ; move ss2 p/ LixoTexto
  (if (> (sslength ss2) 0)
    (command "Change" ss2 "" "p" "LA" LixTxt "")
  )                                     ;****************************************
  (AtivaLayer LixLay "Err" "0")         ; move ss4 p/ LixoArmacao
  (if (> (sslength ss4) 0)
      (command "Change" ss4 "" "p" "LA" LixLay "")
  )                                     ;****************************************
                                        ; consiste layer LixoArmacao p/ lixos anteriores
  (setq ss2 (ssget "X" (list (cons 8 LixLay))))
  (AtivaLayer TabLay "Tab" "0")
  (if (/= ss2 NIL)
    (progn
      (setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
                       (- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
                       0))
      (command "COLOR" "BYLAYER")
      (command "TEXT"  "ML" Pto1 (* Escala LetraP) "0" "---> existe lixo de armacao (desenho), verifique")
      (setq ErrCnt (1+ ErrCnt))
      (AtivaLayer LixLay "Err" "0")
      (setq Pto1 (list (+ (+ (car PtoTab) (* Escala DrawX)) (* Escala TabWdt))
                       (cadr Pto1)
                       0))
                                        ;****************************************
                                        ; insere o desenho do olho, se ele existir
                                        ; como bloco interno, ou externo, senao
                                        ; insere um circulo
      (if (tblsearch "Block" OlhBlk)
        (progn
          (command "INSERT" OlhBlk "protate" "0" "scale" "1" Pto1 0)
        )
        (progn
          (if (findfile OlhDwg)
            (command "INSERT" OlhDwg "protate" "0" "scale" Escala Pto1 0)
            (command "CIRCLE" Pto1 (* Escala 25))
          )
        )
      )
    )
  )                                    
***Continua abaixo:
Aldo Cavalcante
Madeira
Madeira
Mensagens: 12
Registrado em: Ter 07 Nov 2017 11:17:35 am

Re: Ajuda para modificar rotina

Mensagem por Aldo Cavalcante »

Boa Tarde, felipemessara!

Tem certeza que anexou todo o código?
No final do seu anexo, esta escrito:
***Continua abaixo:
Também tentei rodar o lisp, e sempre para em um erro...
Você consegue rodar o lisp até o final?

Sds!
felipemessara
Novato
Novato
Mensagens: 5
Registrado em: Seg 17 Mai 2021 12:29:55 pm

Re: Ajuda para modificar rotina

Mensagem por felipemessara »

;****************************************
; consiste layer LixoTexto p/ lixos anteriores
(setq ss4 (ssget "X" (list (cons 8 LixTxt))))
(AtivaLayer TabLay "Tab" "0")
(if (/= ss4 NIL)
(progn
(setq Pto1 (list (+ (+ (car PtoTab) (* Escala TextX)) (* Escala TabWdt))
(- (cadr PtoTab) (+ (* TextY Escala) (* (* LinWdt ErrCnt) Escala)))
0))
(command "COLOR" "BYLAYER")
(command "TEXT" "ML" Pto1 (* Escala LetraP) "0" "---> existe lixo de armacao (texto), verifique")
(setq ErrCnt (1+ ErrCnt))
(AtivaLayer LixTxt "Err" "0")
(setq Pto1 (list (+ (+ (car PtoTab) (* Escala DrawX)) (* Escala TabWdt))
(cadr Pto1)
0))
;****************************************
; insere o desenho do olho, se ele existir
; como bloco interno, ou externo, senao
; insere um circulo
(if (tblsearch "Block" OlhBlk)
(progn
(command "INSERT" OlhBlk "protate" "0" "scale" "1" Pto1 0)
)
(progn
(if (findfile OlhDwg)
(command "INSERT" OlhDwg "protate" "0" "scale" Escala Pto1 0)
(command "CIRCLE" Pto1 (* Escala 25))
)
)
)
)
) ;***************************************
(AtivaLayer FerLay "Tab" "0") ; move ss5 p/ FerrVar
(if (> (sslength ss5) 0)
(command "Change" ss5 "" "p" "LA" FerLay "")
)
;****************************************
;desenha os contornos da tabela resumo
;****************************************
(AtivaLayer TabLay "Tab" "0")
(princ "\nGerando a tabela resumo ")
(setq PtoRes (list (car PtoRes) (- (cadr PtoRes) (* DisTab Escala)) 0))
(setq Pto0 (list (+ (car PtoRes) (* (/ TabWdt 2.0) Escala)) (- (cadr PtoRes) (* TitleY Escala)) 0))
(command "COLOR" "4")
(command "TEXT" "MC" Pto0 (* Escala LetraG) "0" "RESUMO AÇO")
(command "COLOR" "2")
(setq Pto0 (list (car PtoRes) (- (cadr PtoRes) (* Lin1Y Escala)) 0))
(setq Pto1 (list (+ (car Pto0) (* Escala TabWdt)) (cadr Pto0) 0))
(command "PLINE" Pto0 "W" "0" "" Pto1 "")
(setq Pto1 (list (+ (car PtoRes) (* Escala TextX))
(-(cadr PtoRes) (* Escala Title1Y)) 0))
(command "color" "3")
(command "TEXT" "ML" Pto1 (* (* Escala LetraP) 1.05) "0" "AÇO")
(setq Pto1 (list (- (+ (car PtoRes) (* Escala Col6X)) (* Escala TextX))
(cadr Pto1) 0))
(command "TEXT" "MR" Pto1 (* Escala LetraG) "0" "%%C")
(setq Pto1 (list (- (+ (car PtoRes) (* Escala Col7X)) (* Escala TextX))
(cadr Pto1) 0))
(command "TEXT" "MR" Pto1 (* (* Escala LetraP) 1.05) "0" "TOT.(m)")
(setq Pto1 (list (- (+ (car PtoRes) (* Escala TabWdt)) (* Escala TextX))
(cadr Pto1) 0))
(command "TEXT" "MR" Pto1 (* (* Escala LetraP) 1.05) "0" " MASSA(kg)")
(command "COLOR" "2")
(setq Pto0 (list (car PtoRes) (- (cadr PtoRes) (* Lin2Y Escala)) 0))
(setq Pto1 (list (+ (car Pto0) (* Escala TabWdt)) (cadr Pto0) 0))
(command "PLINE" Pto0 "W" "0" "" Pto1 "")
;****************************************
; Ordenando e agrupando as listas
; TotLst DiaLst
;****************************************
(setq Flag1 T)
(while (= Flag1 T)
(progn
(setq Flag1 F)
(setq Cont -1)
(setq n NumTot)
(while (< Cont n)
(progn
(setq Cont (1+ Cont))
(setq FDiam (nth Cont DiaLst))
(setq Tot (nth Cont TotLst))
(setq DiaAux (nth (+ Cont 1) DiaLst))
(if (< Cont n)
(progn
(setq DiaAux (nth (+ Cont 1) DiaLst))
(if (> DiaAux FDiam) ; a ordem ja esta correta
(progn
(setq DiaLst1 (append DiaLst1 (list FDiam)))
(setq TotLst1 (append TotLst1 (list Tot)))
)
(progn
(if (< DiaAux FDiam) ; inverte a ordem
(progn
(setq TotAux (nth (+ Cont 1) TotLst))
(setq DiaLst1 (append DiaLst1 (list DiaAux)))
(setq TotLst1 (append TotLst1 (list TotAux)))
(setq DiaLst1 (append DiaLst1 (list FDiam)))
(setq TotLst1 (append TotLst1 (list Tot)))
)
(progn ; diametros iguais soma total
(setq TotAux (nth (+ Cont 1) TotLst))
(setq Tot (+ Tot TotAux))
(setq DiaLst1 (append DiaLst1 (list FDiam)))
(setq TotLst1 (append TotLst1 (list Tot)))
(setq NumTot (1- NumTot))
)
)
(setq Flag1 T)
(setq Cont (1+ Cont))
)
)
)
(progn
(setq DiaLst1 (append DiaLst1 (list FDiam)))
(setq TotLst1 (append TotLst1 (list Tot)))
)
)
)
)
(setq DiaLst (append DiaLst1))
(setq TotLst (append TotLst1))
(setq DiaLst1 (list))
(setq TotLst1 (list))
)
)
;****************************************
;Preenchendo a tabela de resumo
;****************************************
(setq NumTxt 0)
(setq n (+ NumTot 1))
(repeat n
(setq Tot (nth NumTxt TotLst))
(setq FDiam (nth NumTxt DiaLst))
(setq PesoUni (/ (* FDiam FDiam Tot) 16220.0))
(setq PesoTot (+ PesoTot PesoUni))
;****************************************
(if (<= FDiam 6.0) ; imprime aco
(setq S "CA60")
(setq S "CA50")
)
(setq Pto1 (list (+ (car PtoRes) (* Escala TextX))
(- (cadr PtoRes) (+ (* TextY Escala) (* (* LinWdt NumTxt) Escala)))
0))
(command "color" "3")
(princ ".")
(command "Text" "ML" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" S)
;****************************************
; imprime diametro
(setq Pto1 (list (- (+ (car PtoRes) (* Escala Col6X)) (* Escala TextX))
(cadr Pto1)
0))
(command "Text" "MR" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" (rtos FDiam))
;****************************************
; imprime total
(setq Pto1 (list (- (+ (car PtoRes) (* Escala Col7X)) (* Escala TextX))
(cadr Pto1)
0))
(command "Text" "MR" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" (rtos (/ Tot 100.0) 2 0))
;****************************************
; imprime peso
(setq Pto1 (list (- (+ (car PtoRes) (* Escala TabWdt)) (* Escala TextX))
(cadr Pto1)
0))
(command "Text" "MR" (list (car Pto1) (cadr Pto1) 0) (* Escala LetraP) "0" (rtos PesoUni 2 0))
(setq Pto1 (list (car PtoRes) (- (cadr Pto1) (* LinOfs Escala)) 0))
(setq Pto2 (list (+ (car PtoRes) (* Escala TabWdt)) (cadr Pto1) 0))
(command "COLOR" "2")
(command "PLINE" Pto1 "W" "0" "" Pto2 "")
(setq NumTxt (1+ NumTxt))
) ;****************************************
;Contorno da tabela de resumo
;****************************************
(setq Pto1 (list (car PtoRes) (- (cadr PtoRes) (+ (* TextY Escala) (* (+ LinOfs (* LinWdt (1- NumTxt))) Escala))) 0))
(setq Pto2 (list (+ (car PtoRes) (* Escala TabWdt)) (cadr PtoRes) 0))
(setq Pto3 (list (+ (car PtoRes) (* Escala TabWdt)) (cadr Pto1) 0))
(setq Pto4 (list (car Pto1) (- (cadr Pto1) (* Escala Lin1Y)) 0))
(setq Pto5 (list (car Pto3) (cadr Pto4) 0))
(command "COLOR" "2")
(command "PLINE" Pto4 "W" "0" "" PtoRes Pto2 Pto5 Pto4"")
;****************************************
;imprime total geral
(setq Pto0 (list (- (+ (car PtoRes) (* Escala Col7X)) (* Escala TextX))
(- (cadr Pto1) (* TotalY Escala))
0))
(command "color" "3")
(command "TEXT" "MR" Pto0 (* (* Escala LetraP) 1.25) "0" "TOTAL (kg)")
(setq Pto0 (list (- (+ (car PtoRes) (* Escala TabWdt)) (* Escala TextX))
(cadr Pto0) 0))
(command "color" "3")
(command "TEXT" "MR" Pto0 (* Escala LetraP) "0" (rtos PesoTot 2 0))
;****************************************
;divisao da coluna 1 (Col5X)
(setq Pto1 (list (+ (car PtoRes) (* Escala Col5X)) (- (cadr PtoRes) (* Lin1Y Escala)) 0))
(setq Pto2 (list (car Pto1) (cadr Pto3) 0))
(command "COLOR" "2")
(command "PLINE" Pto1 "W" "0" "" Pto2 "")
;****************************************
;divisao da coluna 2 (Col6X)
(setq Pto1 (list (+ (car PtoRes) (* Escala Col6X)) (- (cadr PtoRes) (* Lin1Y Escala)) 0))
(setq Pto2 (list (car Pto1) (cadr Pto3) 0))
(command "PLINE" Pto1 "W" "0" "" Pto2 "")
;****************************************
;divisao da coluna 3 (Col7X)
(setq Pto1 (list (+ (car PtoRes) (* Escala Col7X)) (- (cadr PtoRes) (* Lin1Y Escala)) 0))
(setq Pto2 (list (car Pto1) (cadr Pto4) 0))
(command "PLINE" Pto1 "W" "0" "" Pto2 "")
;****************************************
;seleciona todos os textos do desenho
(setq ss1 (ssget "X" (list (cons 0 "TEXT"))))
(Mudatxt ss1 "]" "%%C")
(princ "\nTabelas geradas com sucesso!")
(RestauraVar)
(command "layer" "OFF" FerLay "")
(prin1)
)
;****************************************
;Mudatxt substitui a string antiga o_str
;por uma nova string n_str para todos os
;textos da selecao objs

(defun Mudatxt (objs o_str n_str / last_o tot_o ent st s_temp
n_slen o_slen si chf chm cont ans)
(princ (strcat "\nSubstituindo " o_str " para " n_str))
(setq chm 0)
(if objs
(progn ; If any objects selected
(if (= (type objs) 'ENAME)
(progn
(setq ent (entget objs))
(princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
)
(if (= (sslength objs) 1)
(progn
(setq ent (entget (ssname objs 0)))
(princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))
)
)
)
(setq o_slen (strlen o_str))
(if (/= o_slen 0)
(progn
(setq n_slen (strlen n_str))
(setq last_o 0
tot_o (if (= (type objs) 'ENAME)
1
(sslength objs)
)
)
(while (< last_o tot_o) ; For each selected object...
(if (= "TEXT" ; Look for TEXT entity type (group 0)
(cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))
(progn
(setq chf nil si 1)
(setq s_temp (cdr (assoc 1 ent)))
(while (= o_slen (strlen (setq st (substr s_temp si o_slen))))
(if (= st o_str)
(progn
(setq s_temp (strcat
(if (> si 1)
(substr s_temp 1 (1- si))
""
)
n_str
(substr s_temp (+ si o_slen))
)
)
(setq chf t) ; Found old string
(setq si (+ si n_slen))
)
(setq si (1+ si))
)
)
(if chf
(progn ; Substitute new string for old
; Modify the TEXT entity
(entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))
(setq chm (1+ chm))
)
)
)
)
(setq last_o (1+ last_o))
)
)
;; else go on to the next line...
)
)
)
(if (/= (type objs) 'ENAME)
(if (/= (sslength objs) 1) ; Print total lines changed
(princ (strcat " --> "
(rtos chm 2 0)
" textos substituidos."
)
)
)
)
)
;****************************************
; Conf seta a cor do layer Xn para n
; se n for menor que 7
;****************************************
(defun C:Confere ()
(command "layer" "m" "X7" "COLOR" "7" ""
"m" "X6" "COLOR" "6" ""
"m" "X5" "COLOR" "5" ""
"m" "X4" "color" "3" ""
"m" "X3" "COLOR" "3" ""
"m" "X2" "COLOR" "2" ""
"m" "X1" "COLOR" "1" "" "")
(prin1)
)
;****************************************
; Volta seta a cor do layer X1..7 para 7
;****************************************
(defun C:VC ()
(command "layer" "m" "X20" "color" "3" ""
"m" "X19" "color" "3" ""
"m" "X18" "color" "3" ""
"m" "X17" "color" "3" ""
"m" "X16" "color" "3" ""
"m" "X15" "color" "3" ""
"m" "X14" "color" "3" ""
"m" "X13" "color" "3" ""
"m" "X12" "color" "3" ""
"m" "X11" "color" "3" ""
"m" "X10" "color" "3" ""
"m" "X9" "color" "3" ""
"m" "X8" "color" "3" ""
"m" "X7" "color" "3" ""
"m" "X6" "color" "3" ""
"m" "X5" "color" "3" ""
"m" "X4" "color" "3" ""
"m" "X3" "color" "3" ""
"m" "X2" "color" "3" ""
"m" "X1" "color" "3" "" "")
(prin1)
)
;*************************************
;Calculadora - Rotina principal
;*************************************

(defun c:Calc (/ N1 V0 What_Next VA1 SI1 SalvaCasa)
(setq DCL_1 (load_dialog "CALC1.DCL"))
(if (not (new_dialog "CALC" DCL_1)) (exit))
(setq What_next 5)
(setq N1 0)
(while (< 2 What_Next)
(action_tile "1" "(Calc_Valor (setq V0 $key))")
(action_tile "2" "(Calc_Valor (setq V0 $key))")
(action_tile "3" "(Calc_Valor (setq V0 $key))")
(action_tile "4" "(Calc_Valor (setq V0 $key))")
(action_tile "5" "(Calc_Valor (setq V0 $key))")
(action_tile "6" "(Calc_Valor (setq V0 $key))")
(action_tile "7" "(Calc_Valor (setq V0 $key))")
(action_tile "8" "(Calc_Valor (setq V0 $key))")
(action_tile "9" "(Calc_Valor (setq V0 $key))")
(action_tile "0" "(Calc_Valor (setq V0 $key))")
(action_tile "." "(Calc_Valor (setq V0 $key))")
(action_tile "+" "(Calc_Operador (setq SI $key))")
(action_tile "-" "(Calc_Operador (setq SI $key))")
(action_tile "X" "(Calc_Operador (setq SI $key))")
(action_tile "D" "(Calc_Operador (setq SI $key))")
(action_tile "=" "(Calc_Operador (setq SI $key))")
(action_tile "C" "(Calc_limpa)")
(action_tile "Q" "(Calc_Imed (setq SI $key))")
(action_tile "R" "(Calc_Imed (setq SI $key))")
(action_tile "I" "(Calc_Imed (setq SI $key))")
(action_tile "S" "(Calc_Imed (setq SI $key))")
(action_tile "E" "(Calc_Operador (setq SI $key))")
(action_tile "cancel" "(done_dialog 0)")
(setq What_Next (start_dialog))
)
(unload_dialog DCL_1) ; (setvar "luprec" SalvaCasa)
(princ)
) ;*************************************
;Calculadora - Limpa visor
;*************************************

(defun Calc_Limpa ()
(setq VA1 nil)
(setq SI1 nil)
(setq N1 1)
(set_tile "TOTAL" "")
) ;*************************************
;Calculadora - Atualiza Visor
;*************************************

(defun Calc_Valor (V0 / V1 V2)
(if (= N1 1) (set_tile "TOTAL" ""))
(setq N1 0)
(setq V1 (get_tile "TOTAL"))
(setq V2 (strcat V1 V0))
(set_tile "TOTAL" V2)
) ;*************************************
;Calculadora - Operador imediato
;*************************************

(defun Calc_Imed (SI / V1 V2)
(if (= N1 1)
(set_tile "TOTAL" "")
(progn
(setq V1 (atof (get_tile "TOTAL")))
(cond ((= SI "Q") (setq V2 (* V1 V1)))
((= SI "R") (if (> V1 0.) (setq V2 (sqrt V1))))
((= SI "I") (if (/= V1 0.) (setq V2 (/ 1. V1))))
((= SI "S") (setq V2 (* -1. V1)))
)
(set_tile "TOTAL" (rtos V2))
)
)
) ;*************************************
;Calculadora - Operador
;*************************************

(defun Calc_Operador (SI / VA2 VA3)
(if (/= VA1 nil)
(progn
(setq VA2 (atof (get_tile "TOTAL")))
(cond ((= SI1 "+") (setq VA3 (+ VA1 VA2)))
((= SI1 "-") (setq VA3 (- VA1 VA2)))
((= SI1 "X") (setq VA3 (* VA1 VA2)))
((= SI1 "D") (setq VA3 (/ VA1 VA2)))
((= SI1 "E") (setq VA3 (expt VA1 VA2)))
)
(setq VA1 VA3)
(set_tile "TOTAL" (rtos VA1 2 4))
(if (= SI "=") (setq VA1 nil SI1 nil) (setq SI1 SI))
(setq N1 1)
)
(progn
(if (/= SI "=")
(progn (setq VA1 (atof (get_tile "TOTAL"))) (setq SI1 SI))
)
(setq N1 1)
)
)
)
;****************************************
; Este modulo informa o maior numero
; existente da ferragem
;****************************************

(defun c:uf (/ Cont EntNom EntDat FerLay FerStr i
LayStr MaiorL MaiorN MaiorS NomSTr NPos
n S SpcPos ss1 ss3
)
(AjustaVar)
(princ "\nProcura da ultima ferragem")
; inicializacoes
(Initget 5)
(setq Cont 0) ;Cont = contador
(setq EntDat "") ;EntDat = dados da entidade
(setq FerLay "FerrVar") ;FerLay = Nome do layer ferro variavel
(setq MaiorL "") ;MaiorL = Layer do maior N
(setq MaiorN 0) ;MaiorN = numero do maior N
(setq MaiorS "") ;MaiorS = Texto do maior N
;****************************************
;Cria selecao com layers X1..n e FerrVar
;ss1 = set de selecao de entidades
(setq ss1 (ssget "X" (list (cons 8 "X*"))))
(setq ss3 (ssget "X" (list (cons 8 FerLay))))
(setq Cont -1)
(if ss3
(progn
(setq n (sslength ss3))
(repeat n
(setq Cont (1+ Cont))
(setq EntNom (ssname ss3 Cont)) ;le os nomes das entidades de ss1
(setq EntDat (entget EntNom)) ;le a entidade
(ssadd (cdr (assoc -1 EntDat)) ss1) ;acrescenta o nome de EntDat em ss1
)
)
)
(setq Cont -1)
(setq n (sslength ss1))
(repeat n
(setq Cont (1+ Cont))
(setq EntNom (ssname ss1 Cont)) ;le os nomes das entidades de ss1
(setq EntDat (entget EntNom)) ;le a entidade
(setq LayStr (cdr (assoc 8 EntDat))) ; layer do elemento
; so elementos dos layers X1..n e ferrvar
(if (or (= "X" (strcase (substr LayStr 1 1)))
(= (strcase LayStr) (strcase FerLay)))
(progn
(setq EntNom (cdr (assoc 2 EntDat))) ; nome do elemento
(if (= EntNom nil)
(progn
(setq NomStr (cdr (assoc 0 EntDat))) ; tipo de elemento
(if (= "TEXT" NomStr) ; ve se entidade e' text e processa
(progn
(setq FerStr (strcase (cdr (assoc 1 EntDat)))) ; Descricao da estrutura
(setq i (strLen FerStr))
(setq NPos 1) ;****************************************
; o numero da ferragem nos layouts
; N9 99]99 C=999
; 9 N9 ‚ apos a letra N
(while (and (/= (substr FerStr NPos 1) "N") (> i NPos))
(setq NPos (+ NPos 1))
)
(if (< NPos i)
(progn
(setq SpcPos (+ NPos 1))
(while (and (/= (substr FerStr SpcPos 1) " ") (>= i SpcPos))
(setq SpcPos (+ SpcPos 1))
)
;verifica o maior
(setq S (substr FerStr (+ Npos 1) (- SpcPos NPos 1)))
(if (> (atoi S) MaiorN)
(progn
(setq MaiorN (atoi S))
(setq MaiorL LayStr)
(setq MaiorS FerStr)
)
)
)
)
)
)
)
)
)
)
)
(setq S (strcat "\nMaior N = " (itoa MaiorN) " em " MaiorL " - " MaiorS))
(princ S)
(RestauraVar)
(princ)
)
;****************************************
; Este modulo move uma selecao para
; o layer Xn, gerando assim a repeticao
;****************************************

(defun c:rp (/ Cont EntNom EntDat LayArm
LayStr NomSTr
n S ss1 ss3 XLay Vez
)
(AjustaVar)
(repeat 100 ; coloca em loop a repeticao
(princ "\nRepeticao (n vezes) para a selecao: move selecao para o layer Xn ")
; inicializacoes
(Initget 5)
(setq Cont 0) ;Cont = contador
(setq EntDat "") ;EntDat = dados da entidade
(setq LayArm "ARMACAO") ;LayArm = nome do layer armacao
(setq ss3 (ssadd)) ;inicializa ss2 p/ elementos a serem
(setq Vez 0) ;Vez = numero de vezes do layer
(setq XLay "") ;XLay = nome do layer destino
;****************************************
;ss1 = set de selecao de entidades
(setq ss1 (ssget))
(if ss1
(progn
(while (<= Vez 0)
(setq Vez (getint "Digite o numero de vezes: " ))
)
(setq Cont -1)
(setq n (sslength ss1))
(repeat n
(setq Cont (1+ Cont))
(setq EntNom (ssname ss1 Cont)) ;le os nomes das entidades de ss1
(setq EntDat (entget EntNom)) ;le a entidade
(setq LayStr (cdr (assoc 8 EntDat))) ; layer do elemento
; so elementos dos layers X1..n e Armacao
(if (or (= "X" (strcase (substr LayStr 1 1)))
(= LayStr LayArm)
)
(progn
(setq EntNom (cdr (assoc 2 EntDat))) ; nome do elemento
(if (= EntNom nil)
(progn
(setq NomStr (cdr (assoc 0 EntDat))) ; tipo de elemento
(if (= "TEXT" NomStr) ; ve se entidade e' text e processa
(ssadd (cdr (assoc -1 EntDat)) ss3) ;acrescenta o nome de EntDat em ss3
)
)
)
)
)
)
(setq n (sslength ss3))
(if (> n 0)
(progn
(setq XLay (strcat "X" (itoa Vez)))
(if (> Vez 7)
(setq Vez 7)
)
(AtivaLayer XLay "Rpt" (itoa Vez)) ; move ss3 p/ Xn
(command "Change" ss3 "" "p" "LA" XLay "")
(princ (strcat "\n" (itoa n) " textos movidos para " XLay))
)
)
)
)
)
(RestauraVar)
(princ)
)
;****************************************
; Este modulo define uma ferragem para
; uma linha, circulo ou poliline
;****************************************

(defun c:df ( Direct / AngAux Angul d0 d1 d2 d3
EntNom EntDat Escala LetraP NomSTr Ok Pto0
Pto1 PtoSel S ss1 TxtOff
)
; inicializacoes
(AjustaVar)
(princ "\nDefinicao de ferragem no layer X1 ")
(while (and (/= (strcase Direct) "A") (/= (strcase Direct) "D"))
(setq Direct (getstring "Escrever <A>cima ou <D>ebaixo da linha? :"))
)
(if (= e nil)
(progn
(Initget 4)
(setq e (getint "\nDigite o valor da escala <50>: "))
(if (or (= e nil) (= e 0))
(setq e 50)
)
(Initget 5)
)
)
(princ (strcat "\nEscala: 1/" (itoa e)))
(setq Escala (/ e 50.)) ;Escala = fator de escala
(setq EntDat "") ;EntDat = dados da entidade
(setq S "") ;S = string generica
(setq LetraP 12) ;LetraP = Letra menor da tabela
(setq TxtOff 12.0) ;TxtOff = Offset entre a reta e o texto
(if (= (strcase Direct) "D")
(setq TxtOff (* TxtOff -1.0))
)
(Initget 5)
(AtivaLayer "X1" "Rpt" "1")
(setq Ok T)
(while (= Ok T)
(setq ss1 (entsel "\nSelecione a ferragem (nenhuma=fim): "))
(if ss1
(progn
(setq EntNom (car ss1)) ;le o nome da entidade
(setq PtoSel (cadr ss1))
(setq EntDat (entget EntNom)) ;le a entidade
(setq NomStr (cdr (assoc 0 EntDat))) ; tipo de elemento
(if (= "LINE" NomStr) ; ve se entidade e' line
(progn
(setq S (getstring T "\nDigite a definicao da ferragem :"))
(setq Pto0 (cdr (assoc 10 EntDat))) ; ponto inicial da linha
(setq Pto1 (cdr (assoc 11 EntDat))) ; ponto final da linha
; Calcula as distancias de entre os pontos
; para se calcular o ponto mais proximo do
; local clicado que pertence a reta
(setq d1 (distance PtoSel Pto0))
(setq d2 (distance PtoSel Pto1))
(setq d3 (distance Pto0 Pto1))
(setq d0 (/ (+ (* d1 d1) (* d2 d2 -1.0) (* d3 d3)) (* 2.0 d3)))
(if (> (car Pto0) (car Pto1))
(progn
(setq AngAux (angle Pto1 Pto0))
(setq Ptosel (list (+ (car Pto1) (* d0 (cos Angaux)))
(+ (cadr Pto1) (* d0 (sin AngAux))) 0))
)
(progn
(setq AngAux (angle Pto0 Pto1))
(setq Ptosel (list (+ (car Pto0) (* d0 (cos Angaux)))
(+ (cadr Pto0) (* d0 (sin AngAux))) 0))
)
)
(setq Angul (angtos AngAux 0)) ; AngAux radianos p/ Angul string em graus
(setq AngAux (atof Angul)) ; AngAux em graus
(command "TEXT" "ML" PtoSel (* Escala LetraP) Angul S)
(setq EntDat (entlast))
(setq AngAux (+ AngAux 90.0))
(command "move" EntDat "" PtoSel (strcat "@" (rtos (* TxtOff Escala)) "<" (rtos AngAux)))
)
)
)
(setq Ok F)
)
)
(RestauraVar)
(princ)
)

(AjustaVarInicial)

(princ "\nListfer versao 1.7 carregado\n")

(princ "\nRf = gerar tabela, Confere = conferir por cores")
(princ "\nVC = restaurar cores, Uf = mostrar maior ferragem")
(princ "\nRp = gerar layer de repeticao, Calc = calculadora")
(princ "\nDf = Definir ferragens")
(princ "\n---")

(prin1)
Aldo Cavalcante
Madeira
Madeira
Mensagens: 12
Registrado em: Ter 07 Nov 2017 11:17:35 am

Re: Ajuda para modificar rotina

Mensagem por Aldo Cavalcante »

Boa Tarde!
Vou tentar rodar a rotina e ver se dá para modificar do jeito que você falou, ok?

Sds!
felipemessara
Novato
Novato
Mensagens: 5
Registrado em: Seg 17 Mai 2021 12:29:55 pm

Re: Ajuda para modificar rotina

Mensagem por felipemessara »

Aldo Cavalcante escreveu: Ter 18 Mai 2021 2:56:18 pm
Se precisar posso enviar o arquivo da lisp para vc com um arquivo cad onde ela funciona e onde ela nao funciona.
Aldo Cavalcante
Madeira
Madeira
Mensagens: 12
Registrado em: Ter 07 Nov 2017 11:17:35 am

Re: Ajuda para modificar rotina

Mensagem por Aldo Cavalcante »

Bom dia!
Se quiser enviar os arquivos em *lsp e *dwg, pode enviar pelo e-mail registrado aqui mesmo no fórum.
Para enviar, faça o seguinte:
Clique no balão de contato a direita;

Sds!
felipemessara
Novato
Novato
Mensagens: 5
Registrado em: Seg 17 Mai 2021 12:29:55 pm

Re: Ajuda para modificar rotina

Mensagem por felipemessara »

Boa tarde Aldo, envio mensagem aqui pois no email não sei se esta recebendo, aceito e aguardo. Favor verificar o email.
Responder