Ayuda con una rutina de SpeedCAD

Buen día a todos.
Espero que se encuentren pura vida.
De nuevo molestando.
En alguna parte encontré una rutina lisp de SpeedCAD.
Lo que hace es analizar una cadena de caracteres y si en ella se encuentra el simbolo "@", sustituye lo que se encuentre después de "@" por otros caracteres o textos.
Ahora bien, busco que en lugar de sustituir lo que está después de "@" se modifique o elimine lo que está antes.
Será posible?
Les agradezco desde ya su ayuda.
Este es el lisp de SpeedCAD que por cierto tiene ya más de 15 años, al menos eso indica la página en donde lo encontré.


https://es.comp.cad.autocad.narkive.com/vb4SbQi2/lisp-cambiar-una-trozo-de-cadena-string-ahora-creo-que-se-lee-mejor

Este es un ejemplo en dwg de lo que busco:

https://www.dropbox.com/s/2ccahgcy3ymjmtv/Ejemplo%201.dwg?dl=0

Código:

(defun c:@10 (/ sel-textos n entidad
lst-txt texto txt-inicio txt-a-reemplazar
nuevo-txt txt-completo
)
(prompt "\nSeleccione textos:")
(setq sel-textos (ssget (list '(0 . "TEXT"))))
(if sel-textos
(progn
(setq n 0)
(repeat (sslength sel-textos)
(setq entidad (ssname sel-textos n))
(setq lst-txt (entget entidad))
(setq texto (cdr (assoc 1 lst-txt)))
;; Verifica si los textos seleccionados tienen el caracter @
(if (vl-string-search "@" texto)
(progn
(setq txt-inicio
(substr texto
1
(vl-string-position (ascii "@") texto)
)
)
(setq txt-a-reemplazar
(substr texto
(+ (vl-string-position
(ascii "@")
texto
)
1
)
)
)
(setq nuevo-txt (vl-string-subst
"@10"
txt-a-reemplazar
txt-a-reemplazar
)
)
(setq txt-completo (strcat txt-inicio nuevo-txt))
(setq lst-txt (subst (cons 1 txt-completo)
(assoc 1 lst-txt)
lst-txt
)
)
(entmod lst-txt)
(entupd entidad)
) ;_progn
) ;_if
(setq n (1+ n))
) ;_repeat
) ;_progn
) ;_if
(prin1)
) ;_defun

Entiendo que quieres hacerte dos rutinas
Una para obtener solo la parte del texto de la @ en adelante que sería remplazar la asignación del nuevo texto por

Código:

(if (setq n (vl-string-position (ascii "@") texto))
 (setq nuevo-txt(substr texto (1+ n)))
)

y otra para cambiar la @ por un espacio mas la @  que sería

Código:

(if (vl-string-position (ascii "@") texto)
 (setq nuevo-txt(vl-string-subst " @" "@" texto) )
)

Un saludo

Buen día a todos.
Nolo, una vez más, muchas gracias por su ayuda.
Es lo que estaba buscando. Cualquiera de las dos opciones me sirve.
En verdad le agradezco.
Saludos.

Estimado Nolo, con respecto a tu ayuda.. en que parte tengo que cambiar la linea

(if (setq n (vl-string-position (ascii "@") texto))
(setq nuevo-txt(substr texto (1+ n)))
)

para que funcione en la rutina anterior. Estuve intentando pero lo la hallo.
Gracias desde ya tu ayuda

Carlos

Buen día para todos.
Con el permiso de Nolo.
Don Carlos, la solución de Nolo es la de eliminar del lisp original:

Código:

(setq nuevo-txt (vl-string-subst
"@10"
txt-a-reemplazar
txt-a-reemplazar
)
)
(setq txt-completo (strcat txt-inicio nuevo-txt))

y colocar en su lugar:

Código:

   (if (setq tx (vl-string-position (ascii "@") texto))
(setq nuevo-txt(substr texto (1+ tx)))
)
(setq txt-completo (strcat nuevo-txt))

El lisp adaptado a lo que quiero que haga es este:

Código:

   (defun c:@10 (/ sel-textos n entidad
    lst-txt texto txt-inicio txt-a-reemplazar
    nuevo-txt txt-completo
    )
    (prompt "\nSeleccione textos:")
    (setq sel-textos (ssget (list '(0 . "TEXT"))))
    (if sel-textos
    (progn
    (setq n 0)
    (repeat (sslength sel-textos)
    (setq entidad (ssname sel-textos n))
    (setq lst-txt (entget entidad))
    (setq texto (cdr (assoc 1 lst-txt)))
    ;; Verifica si los textos seleccionados tienen el caracter H
    (if (vl-string-search "H" texto)
    (progn
    (setq txt-inicio
    (substr texto
    1
    (vl-string-position (ascii "H") texto)
    )
    )
    (setq txt-a-reemplazar
    (substr texto
    (+ (vl-string-position
    (ascii "H")
    texto
    )
    1
    )
    )
    )
    (if (setq tx (vl-string-position (ascii "H") texto))
    (setq nuevo-txt(substr texto (1+ tx)))
    )
    (setq txt-completo (strcat nuevo-txt))
    (setq lst-txt (subst (cons 1 txt-completo)
    (assoc 1 lst-txt)
    lst-txt
    )
    )
    (entmod lst-txt)
    (entupd entidad)
    ) ;_progn
    ) ;_if
    (setq n (1+ n))
    ) ;_repeat
    ) ;_progn
    ) ;_if
    (prin1)
    ) ;_defun




Nolo, de nuevo, muchas gracias.
Saludos.

Bien Jose Francisco ahora a echarle mano para analizarlo.
Gracias
(y)

Buen día a todos.
Una vez más molestando.
El lisp siguiente elimina todos los caracteres que se encuentran antes de "H"
Ahora, por favor, será posible modificar el lisp para que también se elimine ese carácter "H". La verdad lo he intentado pero no lo consigo, no sé que debo modificar.
Les agradezco desde ya su ayuda.

Código:

 (defun c:@10 (/ sel-textos n entidad
    lst-txt texto txt-inicio txt-a-reemplazar
    nuevo-txt txt-completo
    )
    (prompt "\nSeleccione textos:")
    (setq sel-textos (ssget (list '(0 . "TEXT"))))
    (if sel-textos
    (progn
    (setq n 0)
    (repeat (sslength sel-textos)
    (setq entidad (ssname sel-textos n))
    (setq lst-txt (entget entidad))
    (setq texto (cdr (assoc 1 lst-txt)))
    ;; Verifica si los textos seleccionados tienen el caracter H
    (if (vl-string-search "H" texto)
    (progn
    (setq txt-inicio
    (substr texto
    1
    (vl-string-position (ascii "H") texto)
    )
    )
    (setq txt-a-reemplazar
    (substr texto
    (+ (vl-string-position
    (ascii "H")
    texto
    )
    1
    )
    )
    )
    (if (setq tx (vl-string-position (ascii "H") texto))
    (setq nuevo-txt(substr texto (1+ tx)))
    )
    (setq txt-completo (strcat nuevo-txt))
    (setq lst-txt (subst (cons 1 txt-completo)
    (assoc 1 lst-txt)
    lst-txt
    )
    )
    (entmod lst-txt)
    (entupd entidad)
    ) ;_progn
    ) ;_if
    (setq n (1+ n))
    ) ;_repeat
    ) ;_progn
    ) ;_if
    (prin1)
    ) ;_defun



Saludos

Prueba con esto .

Código:

 (defun c:sin-h (/
              sel-textos n entidad
    lst-txt texto txt-inicio txt-a-reemplazar
    nuevo-txt txt-completo TEXT<
    )
    (prompt "\nSeleccione textos:")
    (setq sel-textos (ssget (list '(0 . "TEXT"))))
    (if sel-textos
    (progn
    (setq n 0)
    (repeat (sslength sel-textos)
    (setq entidad (ssname sel-textos n))
    (setq lst-txt (entget entidad))
    (setq text< (cdr (assoc 1 lst-txt)))
      (setq texto ( strcase text<)); debes convertirlo a MAYUSCULAS
    ;; Verifica si los textos seleccionados tienen el caracter H
    (if (vl-string-search "H" texto)
      (progn
        (setq txt-inicio
              (substr texto
                      1
                      (vl-string-position (ascii "H") texto)
              ) ;_  substr
        ) ;_  setq
        (setq txt-a-reemplazar
              (substr texto
                      (+ (vl-string-position
                            (ascii "H")
                            texto
                          ) ;_  vl-string-position
                          1
                      ) ;_  +
              ) ;_  substr
        ) ;_  setq
        (if (setq tx (1+ (vl-string-position (ascii "H") texto))); aquí le agrgo 1 a índice , para que lo saque al H
          (setq nuevo-txt (substr texto (1+ tx)))
        ) ;_  if
        (setq txt-completo (strcase nuevo-txt t)); lo convirets a minusculas , tu tenias STRCAT , que es para encadenar textos
        ;y tiene que ser STRCASE , que convierte en mayusculas , o minusculas segun no tenta el argumento T
        (setq lst-txt
              (subst (cons 1 txt-completo)
                      (assoc 1 lst-txt)
                      lst-txt
              ) ;_  subst
        ) ;_  setq
        (entmod lst-txt)
        (entupd entidad)
      ) ;_progn
    ) ;_if
    (setq n (1+ n))
    ) ;_repeat
    ) ;_progn
    ) ;_if
    (prin1)
    ) ;_defun
;|«Visual LISP:copyright: Format Options»
(100 2 1 2 T " " 100 6 0 0 1 nil T nil T)
;*** DO NOT add text below the comment! ***|;


Buen día a todos.
Don Gabriel, en verdad, muchas gracias.
El código hace lo que busco.
Saludos

Gusto en que te sirva.
Saludos