Lisp de subtração
Olá gesiel,
se postares o código que tens é mais fácil alterar...
Não sei se queres colocar o resultado num texto novo, ou editar um existente.
Henrique
Gesiel,
um código rápido, sem grandes testes, se otexto selecionado não for um texto válido para uma operação de subtração, vai errar...
(defun c:- ( / PT TXT1 TXT2 TXTVAL1 TXTVAL2 TXTVAL3)
(if (and (setq txt1 (car (entsel "\nSelecione o primeiro texto: ")))
(setq txt2 (car (entsel "\nSelecione o segundo texto: ")))
(setq pt (getpoint "\nPique o ponto a colocar o texto con o resultado: "))
);; and
(progn
(setq txtval1 (atof (cdr (assoc 1 (entget txt1)))))
(setq txtval2 (atof (cdr (assoc 1 (entget txt2)))))
(setq txtval3 (- txtval1 txtval2))
(entmake
(list
(cons 0 "TEXT")
(cons 100 "AcDbText")
(cons 10 (trans pt 1 0))
(cons 40 (getvar 'TEXTSIZE))
(cons 1 (rtos txtval3 2 2))
(cons 50 (angle (list 0 0)(getvar "ucsxdir")))
(cons 100 "AcDbText")
)
);; entmake
);; progn
);; if
(princ)
)
Espero que ajude
Henrique
Solução aceita
Uma modificação rápida...
(defun c:test (/ A ADI AR_TOTAL B1 B2 C D
HT I N OBJS OLDECHO POSICAO QUANT
SS TEXTO VALOR
)
(if (and (not (prompt "\nSelecione o texto Aditivo: "))
(setq ss (ssget "_+.:E:S" '((0 . "TEXT"))))
(not (prompt "\nSelecione os textos Subtrativos: "))
(setq OBJS (ssget '((0 . "TEXT"))))
);; and
(progn
(princ "\nAguarde...")
(setvar "luprec" 2)
(setq AR_TOTAL 0.
adi (entget (ssname ss 0))
valor (atof (cdr (assoc 1 adi)))
QUANT (sslength OBJS)
POSICAO 0
);; setq
(repeat QUANT
(setq TEXTO (cdr (assoc 1 (entget (ssname OBJS POSICAO))))
VALOR (- VALOR (atof TEXTO))
POSICAO (+ POSICAO 1)
);; setq
);; repeat
(princ (strcat "\nSubtração dos valores : " (rtos VALOR 2)))
(prompt "\nSELECCIONE O VALOR DA SUBTRAÇÃO A SER ACTUALIZADO: ")
(if (setq a (ssget))
(progn
(setq oldecho (getvar 'CMDECHO))
(setvar "cmdecho" 0)
(setq ht (rtos VALOR 2)
n (sslength a)
i 0
);; setq
(repeat n
(setq b1 (entget (ssname a i))
i (1+ i)
c (assoc 1 b1)
d (cons (car c) ht)
b2 (subst d c b1)
);; setq
(entmod b2)
);; repeat
(setvar "cmdecho" oldecho)
);; progn
(prompt "\nNão foi selecionado texto para actualizar o valor! ")
);; if
);; progn
(princ "\nNenhum texto foi selecionado! ")
);; if
(princ)
);; defun
É apenas uma ajuda, o código tinha que ser escrito de principio para cobrir todos os possiveis erros, mas não tenho muito tempo livre...
Henrique
Olá Jederson, e bem vindo à Comunidade Autodesk!
O código respeita o numero de casas decimais definidos em 'UNITS'.
Para teres três casas decimais, muda
(rtos VALOR 2)
para
(rtos VALOR 2 3)
se for o código que postei primeiro, muda
(cons 1 (rtos txtval3 2 2))
para
(cons 1 (rtos txtval3 2 3))
espero que ajude
Henrique
jedersonlobo escreveu:
Bom dia Henrique.
Corrigi o código com (rtos VALOR 2 3), e funcionou perfeitamente!
Enquanto eu postei a dúvida aqui, fui tentar procurar em outros lugares, e vi que a alteração do código
(setvar "luprec" 2)
para
(setvar "luprec" 3)
também faz o texto resultante ter 3 casas decimais após a virgula.
Existe alguma diferença ou ambas as alterações são válidas?
Agradeço a recepção e a presteza para responder!
'LUPREC' é a variavel de sistema que define o numero de casas decimais para a distancia, volume e área.
Se escreveres na linha de comando UNITS, vai abrir um quadro com a configuração da unidades, o numero de casas decimais é a 'LUPREC'....
Como tinha anteriormente dito, com (rtos VALOR 2), não estamos a expecificar o numero de casas decimais, portanto vai usar as que estiverem definidas no commando units (em luprec), mas com (rtos VALOR 2 3), está a definir o resultado com três casas decimais...
Henrique
alexlibrelon escreveu:
Tem esta:
Simples e coloca o resultado entre parênteses e outra, onde você clicar, o resultado é inserido.
Olá Alex, e obrigado por partlhares o teu código conosco!
Espero que não te importes que faça algumas sugestões em relação ao código, aqui vão...
Em relação ao 'Simples', eu concordo, mas por vezes os codigos não podem ser tão simples como nós pretendiamos.
Convem garantir a seleção da entidade correta (TEXTm MTEXT), caso contrario vai dar um erro como:
Command: sb Selecione o primeiro valor : Selecione o segundo : ; error: bad
argument type: stringp nil
Quando corres o teu código, recebes um 'echo' na linha de comandos
Command: SB Unknown command "SB". Press F1 for help.
A causa disso é um 'enter' a mais em
(command "._text" Pkt1 "" "" Txt3 "" )
se utilizares
(command "._text" Pkt1 "" "" Txt3)
o 'echo' desaparece.
Ao utilizar o comando 'text' na rotina, e se o 'Current Text Style' tiver altura definida no 'Style' o comando vai dar um erro como:
Command: sb
Selecione o primeiro valor : Selecione o segundo : Clique no ponto para inserir
o resultado: ._text
Current text style: "style1" Text height: 2.5000 Annotative: No
Specify start point of text or [Justify/Style]:
Specify rotation angle of text <0>:
Enter text:
Command: (82) LISP command is not available.
Para não acontecer isto, substitui
(command "._text" Pkt1 "" "" Txt3)
por
(if (zerop (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
(command "_.text" Pkt1 "" "" Txt3)
(command "_text" Pkt1 "" Txt3)
)
Mas eu perfiro utilizar a função 'entmake' na criação do texto.
O que eu sugiro não é assim tão 'Simples', mas é algo assim:
(defun c:sb (/ pt s s1)
(if (and (princ "\nSelecione o primeiro valor : ")
(setq s (ssget "_+.:E:S" '((0 . "TEXT,MTEXT") (1 . "#*"))))
(princ "\nSelecione o segundo : ")
(setq s1 (ssget "_+.:E:S" '((0 . "TEXT,MTEXT") (1 . "#*"))))
(setq pt (getpoint "Clique no ponto para inserir o resultado: "))
);; and
(entmake
(list
(cons 0 "TEXT")
(cons 100 "AcDbText")
(cons 10 (trans pt 1 0))
(cons 40 (getvar 'TEXTSIZE))
(cons 1
(strcat "("
(rtos (- (atof (cdr (assoc 1 (entget (ssname s 0)))))
(atof (cdr (assoc 1 (entget (ssname s1 0)))))
)
2
2
)
")"
)
)
(cons 50 (angle (list 0 0) (getvar "ucsxdir")))
)
);; entmake
);; if
(princ)
)
Espero que ajude
Henrique
Alex,
muito obrigado pelas simpaticas palavras!
É com prazer que tento ajudar.
Abraço
Henrique