LISP for adding a letter inside text

[Jakub]

Hi,

 

I found a lisp for adding suffix or prefix to text but I need a function that allows me to add some letter only after text (not digit).

 

For examle:

 

I add letter "D" to "g400" and as the result I get "gD400" etc.

 

The second way is just to add letter in certain place of string: adding D on second place of word "g400" (that consists of 4 letters): g-1, D-2, 4-3, 0-4, 0-5 etc

 

Is something like that possible to process?

[Hippe013]

Yes, this is possible. Though I would recommend that you look into string handling functions for AutoLisp. Unless of course, this is something that you want somebody else to just write for you.

[Grrr]

Try this:

(defun C:test ( / newstr lt SS i enx str )
 (defun newstr ( str lt / foo n r )
   (defun foo ( str / cnt )
     (setq cnt -1)
     (vl-some 
       '(lambda (x) (setq cnt (1+ cnt)) (if (member x (mapcar 'chr (vl-string->list "1234567890"))) cnt))
       (mapcar 'chr (vl-string->list str))
     )
   )
   (and
     (setq n (foo str))
     (setq r (apply 'strcat (LM:insertnth lt n (mapcar 'chr (vl-string->list str)))))
   )
   r
 )  
 (and
   (setq lt (GetLetter))
   (setq SS (ssget "_:L-I" (list (cons 0 "*TEXT"))))
   (repeat (setq i (sslength SS))
     (setq enx (entget (ssname SS (setq i (1- i)))))
     (if (setq str (newstr (cdr (assoc 1 enx)) lt))
       (entmod (subst (cons 1 str) (assoc 1 enx) enx))
     )
   )
 )
 (princ)
) (vl-load-com) (princ)

; wrote this on the fly, nice, huh?:
(defun GetLetter ( / grr x )
 (setvar 'errno 0)
 (while (/= 52 (getvar 'errno))
   (princ "\nInput letter, [ENTER] to exit: ")
   (setq grr (grread T))
   (and
     (= (car grr) 2)
     (setq x (chr (cadr grr)))
     (if (= x "\r") (progn (setvar 'errno 52) (setq x nil)) x)
     (not (member x (list "\t" "\r" " ")))
     (setvar 'errno 52)  
   )
 ); while
 x
); defun GetLetter

;; Insert Nth  -  Lee Mac
;; Inserts an item at the nth position in a list.
;; x - [any] Item to be inserted
;; n - [int] Zero-based index at which to insert item
;; l - [lst] List in which item is to be inserted

(defun LM:insertnth ( x n l / i )
 (setq i -1)
 (apply 'append (mapcar '(lambda ( a ) (if (= n (setq i (1+ i))) (list x a) (list a))) l))
)

[Jakub]

Try this:

(defun C:test ( / newstr lt SS i enx str )
 (defun newstr ( str lt / foo n r )
   (defun foo ( str / cnt )
     (setq cnt -1)
     (vl-some 
       '(lambda (x) (setq cnt (1+ cnt)) (if (member x (mapcar 'chr (vl-string->list "1234567890"))) cnt))
       (mapcar 'chr (vl-string->list str))
     )
   )
   (and
     (setq n (foo str))
     (setq r (apply 'strcat (LM:insertnth lt n (mapcar 'chr (vl-string->list str)))))
   )
   r
 )  
 (and
   (setq lt (GetLetter))
   (setq SS (ssget "_:L-I" (list (cons 0 "*TEXT"))))
   (repeat (setq i (sslength SS))
     (setq enx (entget (ssname SS (setq i (1- i)))))
     (if (setq str (newstr (cdr (assoc 1 enx)) lt))
       (entmod (subst (cons 1 str) (assoc 1 enx) enx))
     )
   )
 )
 (princ)
) (vl-load-com) (princ)

; wrote this on the fly, nice, huh?:
(defun GetLetter ( / grr x )
 (setvar 'errno 0)
 (while (/= 52 (getvar 'errno))
   (princ "\nInput letter, [ENTER] to exit: ")
   (setq grr (grread T))
   (and
     (= (car grr) 2)
     (setq x (chr (cadr grr)))
     (if (= x "\r") (progn (setvar 'errno 52) (setq x nil)) x)
     (not (member x (list "\t" "\r" " ")))
     (setvar 'errno 52)  
   )
 ); while
 x
); defun GetLetter

;; Insert Nth  -  Lee Mac
;; Inserts an item at the nth position in a list.
;; x - [any] Item to be inserted
;; n - [int] Zero-based index at which to insert item
;; l - [lst] List in which item is to be inserted

(defun LM:insertnth ( x n l / i )
 (setq i -1)
 (apply 'append (mapcar '(lambda ( a ) (if (= n (setq i (1+ i))) (list x a) (list a))) l))
)

 

I have no idea how to thank you. I'd like to be able to create lisp routines the same like you do. I believe I will some day. Fantastic !

[BIGAL]

Just a thought the other way is just using substr function and strcat

 

(defun c:Text-x-end ( / tex tstr tnew num begin newtxt)
(setq tex (vlax-ename->vla-object (car (entsel "\nPick Text"))))
(setq tstr (vla-get-textstring tex))
(setq tnew (Getstring "\nEnter additional text ")) 
(setq num (getint "\nEnter start position"))
(setq begin (substr tstr 1 num))
(setq tend (substr tstr (+ 1 num)))
(setq newtxt (strcat begin tnew tend))
(vla-put-textstring tex newtxt)
)

[mohammad jazayeri]

its very good 

can i select multiple texts?

[BIGAL]

Yes !

 

(defun c:Text-x-add ( / ss tex tstr tnew num begin newtxt ans)
(setq ss (ssget (list (cons 0 "*text"))))
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Enter values" "Enter additional text" 20 18 "-" "Enter start position" 5 4 "2")))
(setq tnew (nth 0 ans))
(setq num (atoi (nth 1 ans)))
(repeat (setq x (sslength ss))
(setq tex (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq tstr (vla-get-textstring tex))
(setq begin (substr tstr 1 num))
(setq tend (substr tstr (+ 1 num)))
(setq newtxt (strcat begin tnew tend))
(vla-put-textstring tex newtxt)
)
)
(c:text-x-add)

 

Make sure you save the multi getvals also

 

 

Multi GETVALS.lsp

Edited June 14, 2019 by BIGAL

[Speedster2]

Thanks bigal. This lisp helps me a lot. Can it be modified to "Enter Last position" and count from last? 

Please please please

[Jonathan Handojo]

Not as fancy as bigal by using dcl, but here's my go:

(defun c:textlast ( / ent i ins newtxt pos ss txt)
  (if (setq ss (ssget "_:L" '((0 . "TEXT,MTEXT"))))
    (progn
      (setq newtxt (getstring T "\nSpecify text to append: ")
	    ins (progn (initget 5) (getint "\nSpecify position from end: "))
	    )
      (repeat (setq i (sslength ss))
	(setq txt (cdr (assoc 1 (entget (setq ent (ssname ss (setq i (1- i)))))))
	      pos ((lambda (x) (if (< x 0) 0 x)) (- (strlen txt) ins))
	      )
	(entmod
	  (subst
	    (cons 1 (strcat (substr txt 1 pos) newtxt (substr txt (1+ pos))))
	    (assoc 1 (entget ent))
	    (entget ent)
	    )
	  )
	)
      )
    )
  )

 

[Speedster2]

Thanks, thanks, thanks man.... working like a charm

[BIGAL]

Your welcome to use my multi getvals their here at "Downloads",  for this why not use Multi radio buttons and maybe make a bigger routine.

 

(setq ans (ah:butts but "v"  '("Text add" "  Prefix    "  Suffix " "   From Start" "   From End")))

 

 

I just write everything now with the multi's.

Edited April 12, 2020 by BIGAL