Txt_Pref_Suf.lsp
;;; Início
Txt_Pref_Suf.lsp
;;; Ver 1.1
;;; J.A.
;;; www.cadtom.com
;;; Ver 1.0 - 2006-12-04
;;; Ver 1.1 - 2007-02-02
;;; Txt_Pref_Suf.lsp - Aplicação para alterar textos, acrecentado um prefixo ou sufixo
;;; Função Err
(defun *error* (msg)
(setq *error* AERR)
(setvar "cmdecho" ACMDCH)
(command "_.undo" "end")
(princ (strcat "»» Aplicação interrompida com erro: " msg))
)
(defun SETVRS ()
(setq ACMDCH (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "begin")
(setq AERR *error*)
)
(defun RESETVRS ()
(setq *error* AERR)
(command "_.undo" "end")
(setvar "cmdecho" ACMDCH)
)
;;; Função TPRX
;;; acrescentar um prefixo a um texto existente
(defun C:TPRX (/ TXTPREFX SSET SSLEN ENTEMP ENTIP
ENTNAM ENTGT TXTENT TXTSUBS TXTNOV TXTOLD
)
(SETVRS)
(prompt
"\n»» Acrescentar um prefixo a um texto existente. . . "
)
(princ "\n»» Digite prefixo:")
(setq TXTPREFX (getstring T))
(princ "\n»» Seleccione textos a alterar:")
(setq SSET (ssget)
SSLEN (sslength SSET)
)
(while (> SSLEN 0)
(setq ENTEMP (ssname SSET (setq SSLEN (1- SSLEN)))
ENTIP (cdr (assoc 0 (entget ENTEMP)))
)
(if (or (equal ENTIP "TEXT")
(equal ENTIP "MTEXT")
)
(progn
(setq ENTGT (entget ENTEMP)
TXTENT (cdr (assoc 1 ENTGT))
TXTSUBS (strcat TXTPREFX TXTENT)
TXTNOV (cons 1 TXTSUBS)
TXTOLD (assoc 1 ENTGT)
)
(entmod (subst TXTNOV TXTOLD ENTGT))
(entupd ENTEMP)
)
)
)
(RESETVRS)
)
;;; Função TSUX
;;; Acrescentar um sufixo a um texto existente
(defun C:TSUX (/ TXTSUFX SSET SSLEN ENTEMP ENTIP
ENTNAM ENTGT TXTENT TXTSUBS TXTNOV TXTOLD
)
(SETVRS)
(prompt
"\n»» Acrescentar um sufixo a um texto existente. . . "
)
(princ "\n»» Digite sufixo:")
(setq TXTSUFX (getstring T))
(princ "\n»» Seleccione textos a alterar:")
(setq SSET (ssget)
SSLEN (sslength SSET)
)
(while (> SSLEN 0)
(setq ENTEMP (ssname SSET (setq SSLEN (1- SSLEN)))
ENTIP (cdr (assoc 0 (entget ENTEMP)))
)
(if (or (equal ENTIP "TEXT")
(equal ENTIP "MTEXT")
)
(progn
(setq ENTNAM (car GTXT)
ENTGT (entget ENTEMP)
TXTENT (cdr (assoc 1 ENTGT))
TXTSUBS (strcat TXTENT TXTSUFX)
TXTNOV (cons 1 TXTSUBS)
TXTOLD (assoc 1 ENTGT)
)
(entmod (subst TXTNOV TXTOLD ENTGT))
(entupd ENTEMP)
)
)
)
(RESETVRS)
)
(terpri)
(princ
"\n»» Inicie aplicação digitando TPRX para prefixos ou TSUX para sufixos"
)
(terpri)
;;; Ver 1.1
;;; J.A.
;;; www.cadtom.com
;;; Ver 1.0 - 2006-12-04
;;; Ver 1.1 - 2007-02-02
;;; Txt_Pref_Suf.lsp - Aplicação para alterar textos, acrecentado um prefixo ou sufixo
;;; Função Err
(defun *error* (msg)
(setq *error* AERR)
(setvar "cmdecho" ACMDCH)
(command "_.undo" "end")
(princ (strcat "»» Aplicação interrompida com erro: " msg))
)
(defun SETVRS ()
(setq ACMDCH (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "begin")
(setq AERR *error*)
)
(defun RESETVRS ()
(setq *error* AERR)
(command "_.undo" "end")
(setvar "cmdecho" ACMDCH)
)
;;; Função TPRX
;;; acrescentar um prefixo a um texto existente
(defun C:TPRX (/ TXTPREFX SSET SSLEN ENTEMP ENTIP
ENTNAM ENTGT TXTENT TXTSUBS TXTNOV TXTOLD
)
(SETVRS)
(prompt
"\n»» Acrescentar um prefixo a um texto existente. . . "
)
(princ "\n»» Digite prefixo:")
(setq TXTPREFX (getstring T))
(princ "\n»» Seleccione textos a alterar:")
(setq SSET (ssget)
SSLEN (sslength SSET)
)
(while (> SSLEN 0)
(setq ENTEMP (ssname SSET (setq SSLEN (1- SSLEN)))
ENTIP (cdr (assoc 0 (entget ENTEMP)))
)
(if (or (equal ENTIP "TEXT")
(equal ENTIP "MTEXT")
)
(progn
(setq ENTGT (entget ENTEMP)
TXTENT (cdr (assoc 1 ENTGT))
TXTSUBS (strcat TXTPREFX TXTENT)
TXTNOV (cons 1 TXTSUBS)
TXTOLD (assoc 1 ENTGT)
)
(entmod (subst TXTNOV TXTOLD ENTGT))
(entupd ENTEMP)
)
)
)
(RESETVRS)
)
;;; Função TSUX
;;; Acrescentar um sufixo a um texto existente
(defun C:TSUX (/ TXTSUFX SSET SSLEN ENTEMP ENTIP
ENTNAM ENTGT TXTENT TXTSUBS TXTNOV TXTOLD
)
(SETVRS)
(prompt
"\n»» Acrescentar um sufixo a um texto existente. . . "
)
(princ "\n»» Digite sufixo:")
(setq TXTSUFX (getstring T))
(princ "\n»» Seleccione textos a alterar:")
(setq SSET (ssget)
SSLEN (sslength SSET)
)
(while (> SSLEN 0)
(setq ENTEMP (ssname SSET (setq SSLEN (1- SSLEN)))
ENTIP (cdr (assoc 0 (entget ENTEMP)))
)
(if (or (equal ENTIP "TEXT")
(equal ENTIP "MTEXT")
)
(progn
(setq ENTNAM (car GTXT)
ENTGT (entget ENTEMP)
TXTENT (cdr (assoc 1 ENTGT))
TXTSUBS (strcat TXTENT TXTSUFX)
TXTNOV (cons 1 TXTSUBS)
TXTOLD (assoc 1 ENTGT)
)
(entmod (subst TXTNOV TXTOLD ENTGT))
(entupd ENTEMP)
)
)
)
(RESETVRS)
)
(terpri)
(princ
"\n»» Inicie aplicação digitando TPRX para prefixos ou TSUX para sufixos"
)
(terpri)
