Txtinc.lsp
;;; Início
Txtinc.lsp
;;; Ver 1.3
;;; J.A.
;;; www.cadtom.com
;;; Ver 1.0 - 2001-10-24
;;; Ver 1.1 - 2006-05-06
;;; Ver 1.2 - 2006-05-07
;;; Ver 1.3 - 2007-01-29
;;; Txt_Inc.lsp - Aplicação para alterar textos numéricos existentes, somando-os a um número dado pelo utilizador
(defun C:TXTINC (/ ADECH ADMZ CDEC INC SSET
SSLEN TEMP ENTGT TXTENT TEMPINT TXTNOVTP
TXTNOV ENTNAM
)
(setq ADECH (getvar "cmdecho"))
(setq ADMZ (getvar "dimzin"))
(setvar "dimzin" 0)
(setvar "cmdecho" 0)
(command "_.undo" "begin")
(setq
CDEC (getint
"\n»» Digite número de casas decimais a apresentar [2]:"
)
)
(if (not CDEC)
(setq CDEC 2)
)
(setq INC (getreal "\n»» Digite incremento:"))
(princ "\n»» Seleccione textos a alterar:")
(setq SSET (ssget '((0 . "TEXT"))))
(setq SSLEN (sslength SSET))
(while (> SSLEN 0)
(setq TEMP (ssname SSET (setq SSLEN (1- SSLEN)))
ENTGT (entget TEMP)
TXTENT (cdr (assoc 1 ENTGT))
TEMPINT (atof TXTENT)
TXTNOVTP (rtos (+ TEMPINT INC) 2 CDEC)
TXTNOV (cons 1 TXTNOVTP)
ENTNAM (car GTXT)
TXTOLD (assoc 1 ENTGT)
)
(entmod (subst TXTNOV TXTOLD ENTGT))
)
(command "_.undo" "end")
(setvar "dimzin" ADMZ)
(setvar "cmdecho" ADECH)
(terpri)
)
(terpri)
(princ "\n»» Inicie aplicação digitando TXTINC")
(terpri)
;;; Fim Txtinc.lsp
;;; Ver 1.3
;;; J.A.
;;; www.cadtom.com
;;; Ver 1.0 - 2001-10-24
;;; Ver 1.1 - 2006-05-06
;;; Ver 1.2 - 2006-05-07
;;; Ver 1.3 - 2007-01-29
;;; Txt_Inc.lsp - Aplicação para alterar textos numéricos existentes, somando-os a um número dado pelo utilizador
(defun C:TXTINC (/ ADECH ADMZ CDEC INC SSET
SSLEN TEMP ENTGT TXTENT TEMPINT TXTNOVTP
TXTNOV ENTNAM
)
(setq ADECH (getvar "cmdecho"))
(setq ADMZ (getvar "dimzin"))
(setvar "dimzin" 0)
(setvar "cmdecho" 0)
(command "_.undo" "begin")
(setq
CDEC (getint
"\n»» Digite número de casas decimais a apresentar [2]:"
)
)
(if (not CDEC)
(setq CDEC 2)
)
(setq INC (getreal "\n»» Digite incremento:"))
(princ "\n»» Seleccione textos a alterar:")
(setq SSET (ssget '((0 . "TEXT"))))
(setq SSLEN (sslength SSET))
(while (> SSLEN 0)
(setq TEMP (ssname SSET (setq SSLEN (1- SSLEN)))
ENTGT (entget TEMP)
TXTENT (cdr (assoc 1 ENTGT))
TEMPINT (atof TXTENT)
TXTNOVTP (rtos (+ TEMPINT INC) 2 CDEC)
TXTNOV (cons 1 TXTNOVTP)
ENTNAM (car GTXT)
TXTOLD (assoc 1 ENTGT)
)
(entmod (subst TXTNOV TXTOLD ENTGT))
)
(command "_.undo" "end")
(setvar "dimzin" ADMZ)
(setvar "cmdecho" ADECH)
(terpri)
)
(terpri)
(princ "\n»» Inicie aplicação digitando TXTINC")
(terpri)
;;; Fim Txtinc.lsp
