Aplicación para modificar textos automaticamente

Dudas y consultas sobre CAD. AutoCAD, Microstation y resto de aplicaciones CAD

Moderador: Moderadores

Responder
Afga
Jefe
Mensajes: 886
Registrado: Lun Sep 04, 2006 4:10 pm
Contactar:

Aplicación para modificar textos automaticamente

Mensaje por Afga »

Wenas a todos,

Dejo una pequeña aplicación para modificar textos que permite añadir préfijos y súfijos, con la particularidad de que estos pueden ser fijos o numéricos, siendo en este último incremetado su valor de forma automática una cifra dada, cada vez que designemos un texto, pudiéndose establecer un valor máximo, para que el valor retorne al inicial, cada vez que cumple el ciclo. Entre las posibles utilidades, designación de estancias, puntos, leyendas como en un detalle constructivo, y un largo etc....

Espero impresiones y posibles mejoras que se os ocurran. Buen provecho y saludos :wink: :wink: :wink:

;;  ======================================================================================
;;                                                                                        
;;  Comando que la ejecuta -> ATXT                              
;;                                               
;;  Número de versión      -> ATXT_V.1 - 3 de Julio de 2007.                  
;;  Desarrollada y Diseñada por; Javier Santos Rodríguez " santos_jsr@hotmail.com "      
;;                                              
;;  ======================================================================================

;; //////////////////////////////////////////////////////////////////////////


(defun err_atxt (msg)
  
     (
if msg
       (princ (strcat " Error - " msg))
     )
      (
setq *error* atxterr atxterr nil)
      (
princ)
      (
princ "\n\n\n* Teclee ATXT o pulse ENTER para repetir el comando *")

)
 ;_end defun errcsup


;; ///////////////////////////////////////////////////////////////////////////


(defun select_text ()

  (
all_text)
  (
setq num_sset nil)
  (
prompt "\nSeleccione entidades a las que añadir texto: "
  (
setq num_sset (ssget (list (cons -4 "<or") (cons 0 "TEXT") (cons 0 "MTEXT") (cons -4 "or>"))))
  
  (
while (= num_sset nil)
  (
alert "Debe seleccionar un conjunto de textos")
  (
prompt "\nSeleccione entidades a las que añadir texto: "
  (
setq num_sset (ssget (list (cons -4 "<or") (cons 0 "TEXT") (cons 0 "MTEXT") (cons -4 "or>"))))
  )
 ;_end while
  (setq num_sset_lon (sslength num_sset))
  
)
 ;_end defun select_text


;; ///////////////////////////////////////////////////////////////////////////


(defun all_text ()

  (
setq num_sset nil)
  (
setq num_sset (ssget "X" (list (cons -4 "<or") (cons 0 "TEXT") (cons 0 "MTEXT") (cons -4 "or>"))))
  
  (
if (= num_sset nil)
  (
progn
  (alert "No hay textos que poder cambiar en el dibujo")
  (
err_atxt)))
  (
setq num_sset_lon (sslength num_sset))

)
 ;_end defun all_text

;; //////////////////////////////////////////////////////////////////////////


(defun txt_position ()

  (
or txtpost (setq txtpost "Prefijo"))
  (
initget "Prefijo Súfijo")
  (
setq textpost (getkword (strcat "\nIndique posición del texto a añadir [Prefijo/Súfijo] <" txtpost ">: ")))
  (
if (or (= textpost txtpost) (= textpost nil)) (setq txtpost txtpost) (setq txtpost textpost))

)
 ;_end defun txt_position


;; //////////////////////////////////////////////////////////////////////////


(defun incr_txt_sel ()

  (
or incrtxt (setq incrtxt "Fijo"))
  (
initget "Fijo Numérico")
  (
setq incrsel (getkword (strcat "\nIndique el tipo de " txtpost " a añadir [Fijo/Numérico] <" incrtxt ">: ")))
  (
if (or (= incrsel incrtxt) (= incrsel nil)) (setq incrtxt incrtxt) (setq incrtxt incrsel))

)
 ;_end defun incr_txt_sel



;; //////////////////////////////////////////////////////////////////////////


(defun incr_txt_opt ()

  (
if (=  txt2added nil) (setq txt2added 1) (setq txt2added txt2added))
  (
setq txtaddsel (getint (strcat "\nIndique el TEXTO numérico de inicio que desea añadir <" (rtos txt2added 2 0) ">: ")))
  (
if (or (= txtaddsel txt2added) (= txtaddsel nil)) (setq txt2added txt2added) (setq txt2added txtaddsel))

  (
if (=  incrval nil) (setq incrval 1) (setq incrval incrval))
  (
setq incrvalsel (getint (strcat "\nIndique el VALOR numérico de incremento <" (rtos incrval 2 0) ">: ")))
  (
if (or (= incrvalsel incrval) (= incrvalsel nil)) (setq incrval incrval) (setq incrval incrvalsel))

  (
or maxval (setq maxval "Si"))
  (
initget "Si No")
  (
setq maxvalsel (getkword (strcat "\nDesea establecer un valor MÁXIMO y cíclico [Si/No] <" maxval ">: ")))
  (
if (or (= maxvalsel maxval) (= maxvalsel nil)) (setq maxval maxval) (setq maxval maxvalsel))

  (
if (= maxval "Si") (progn
              (if (=  maxys nil) (setq maxys 10) (setq maxys maxys))
                (
setq maxyssel (getint (strcat "\nIndique el VALOR máximo de incremento <" (rtos maxys 2 0) ">: ")))
                (
if (or (= maxyssel maxys) (= maxyssel nil)) (setq maxys maxys) (setq maxys maxyssel))
              ))
 ;_end if

) ;_end defun incr_txt_opt



;; //////////////////////////////////////////////////////////////////////////


(defun incr_txt_calc ()

  (
if (= maxval "No")
  (
progn
  (setq ent_select nil)
  (
while (= ent_select nil)
      (
if (= num_incr nil) (setq num_incr 0) (setq num_incr num_incr))

      (
setq ent_select (entget (car (entsel "\nSeleccione entidades a las que añadir texto: "))))

      (
if (or (equal (cdr (assoc 0 ent_select)) "TEXT") (equal (cdr (assoc 0 ent_select)) "MTEXT"))
      (
progn
          (if (= txtpost "Prefijo") (setq form_txt (strcat (rtos (+ txt2added num_incr) 2 0) " " (cdr (assoc 1 ent_select))))
                           (
setq form_txt (strcat (cdr (assoc 1 ent_select)) " " (rtos (+ txt2added num_incr) 2 0))))

          (
entmod (setq ent_select (subst (cons 1 form_txt) (cons 1 (cdr (assoc 1 ent_select))) ent_select)))
          (
setq num_incr (+ incrval num_incr))
      (
setq ent_select nil)
      )
 ;_end progn

      (progn
      (alert "La entidad seleccionada no es un texto \n     Por favor, designe al menos uno.")
      (
setq ent_select nil)
          )
 ;_end progn
      ) ;_end if
    


  ) ;_end while
  ) ;_end progn
  

  (progn
  (setq ent_select nil)
  (
while (= ent_select nil)
    (
if (or (> num_incr (- maxys 1)) (= num_incr nil)) (setq num_incr 0) (setq num_incr num_incr))
    
      (
setq ent_select (entget (car (entsel "\nSeleccione entidades a las que añadir texto: "))))

      (
if (or (equal (cdr (assoc 0 ent_select)) "TEXT") (equal (cdr (assoc 0 ent_select)) "MTEXT"))
      (
progn
          (if (= txtpost "Prefijo") (setq form_txt (strcat (rtos (+ txt2added num_incr) 2 0) " " (cdr (assoc 1 ent_select))))
                           (
setq form_txt (strcat (cdr (assoc 1 ent_select)) " " (rtos (+ txt2added num_incr) 2 0))))

          (
entmod (setq ent_select (subst (cons 1 form_txt) (cons 1 (cdr (assoc 1 ent_select))) ent_select)))
          (
setq num_incr (+ incrval num_incr))
      (
setq ent_select nil)
      )
 ;_end progn

      (progn
      (alert "La entidad seleccionada no es un texto \n     Por favor, designe al menos uno.")
      (
setq ent_select nil)
          )
 ;_end progn
      ) ;_end if
    


  ) ;_end while
  ) ;_end progn
  ) ;_end if

) ;end defun

;; //////////////////////////////////////////////////////////////////////////


(defun heigh_txt_sel ()

  (
setq txt2add (getstring "\nIndique el TEXTO que desea añadir: "))

  (
or txtsel (setq txtsel "Selección"))
  (
initget "Todos Selección")
  (
setq textsel (getkword (strcat "\nIndique textos a cambiar [Todos/Selección] <" txtsel ">: ")))
  (
if (or (= textsel txtsel) (= textsel nil)) (setq txtsel txtsel) (setq txtsel textsel))
  (
if (= txtsel "Selección") (select_text) (all_text))

)
 ;_end defun heigh_txt_sel

;; ////////// - funcion principal - /////////////////////////////////////////


(defun c:atxt (/ num_sset atxterr txt2add txt2added num_cont num_sset_lon ent_ent textpost form_txt num_sset textsel num_incr
            incrsel txtaddsel incrvalsel incrval maxvalsel maxys ent_select
)

  (
setq atxterr *error* *error* err_atxt)
  (
all_text)
  (
command "_undo" "_begin")

  (
txt_position)
  (
incr_txt_sel)
  (
if (= incrtxt "Fijo")
  (
progn
  (heigh_txt_sel)
  (
setq num_cont 0
  (
while (< num_cont num_sset_lon)

         (
setq ent_ent (entget (ssname num_sset num_cont)))
    
         (
if (= txtpost "Prefijo") (setq form_txt (strcat txt2add " " (cdr (assoc 1 ent_ent))))
                           (
setq form_txt (strcat (cdr (assoc 1 ent_ent)) " " txt2add)))

         (
entmod (setq ent_ent (subst (cons 1 form_txt) (cons 1 (cdr (assoc 1 ent_ent))) ent_ent)))
         (
setq num_cont (1+ num_cont))
    
  )
 ;_end while
  ) ;_end progn

  (progn
  (incr_txt_opt)
  (
incr_txt_calc)
  )
 ;_end progn
  ) ;_end if

  (command "_undo" "_end")
  (
princ "\n\n\n* Teclee ATXT o pulse ENTER para repetir el comando *")
  (
prin1)

)
 ;_end defun atxt.

(prompt "\n\n\n* Nuevo comando \"ATXT\" cargado - Realizado por J.S.R./santos_jsr@hotmail.com *")
(
prin1)

Plannerly ™ La plataforma de gestión BIM ™ SmartLeanBIM® © 2021
Plantillas para crear el Plan de Ejecución BIM (BEP). Cumplimiento de la norma ISO-19650
Plan gratuito en el que puedes acceder a todas las plantillas y si al comprarlo introduces el código DELINEACION obtendrás un 10% de descuento
Avatar de Usuario
Big Boss
Jefe
Mensajes: 592
Registrado: Sab Abr 14, 2007 11:49 pm
Ubicación: Llinars del Valles
Contactar:

Mensaje por Big Boss »

mu bueno Afga! :D
...be water my friend...
Avatar de Usuario
Julio
Jefe
Mensajes: 315
Registrado: Mié Abr 25, 2007 5:44 pm
Ubicación: BILBAO
Contactar:

G nial

Mensaje por Julio »

Afga, te has lucido otra vez.

Creo que te lo dije cuando lo de los pilares.

Cuando sea mayor, (aún soy niño) quiero ser como tu. :D

Desde ahora ya no me va ha dar pereza numerar parcelas de garaje.
Un saludo de......Julio

Delineando, ando.
Responder

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 54 invitados