Jump to content

LISP for adding a letter inside text


Jakub

Recommended Posts

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?

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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))
)

Link to comment
Share on other sites

  • 3 weeks later...
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 !

Link to comment
Share on other sites

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)
)

Link to comment
Share on other sites

  • 2 years later...

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 by BIGAL
  • Like 1
Link to comment
Share on other sites

  • 9 months later...

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

Please please please

Link to comment
Share on other sites

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)
	    )
	  )
	)
      )
    )
  )

 

  • Like 1
Link to comment
Share on other sites

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")))

 

image.png.e43808c204c6a8a23e008aaf295a1ff4.png

 

I just write everything now with the multi's.

Edited by BIGAL
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...