Jump to content

Copy multiple text and paste automatically add alphabet.

Ish

By Ish
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Ish Rising Star

Ish

Posted
Posted

Dear Team,  Any lisp for incremental copy paste for multiple text selection.

If I copy text A1 to A5 and paste automatically add B, if I copy B series add next C,

If I am pasting continues then follow a, b,c...

 

See attached image 

Thanks

17447775879638876417124173380669.jpg

Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted

See if you're happy with this

 

 command cptib for Copy-Paste-Text-Increase-Beginletter

I assume 1 beginletter gets increased.

  

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
;; draw a TEXT
(defun drawText (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))
				 

;; Copy-Paste-Text-Increase-Beginletter
(defun c:cptib ( / i ss ent p2 ang_ dist_ val ip ht char newval)
	(princ "\nSelect Text entities: ")
	(setq ss (ssget (list (cons 0 "TEXT")) ))
	
	(setq i 0)
	(repeat (sslength ss)
		(setq ent (ssname ss i))
		;; get the properties of the entity. Contents, insertpoint, text height.  If needed we could add layer, rotation...
		(setq val (cdr (assoc 1 (entget ent))))
		(setq ip (cdr (assoc 10 (entget ent))))
		(setq ht (cdr (assoc 40 (entget ent))))
		
		(if (= i 0)
			(progn
				(setq p2 (getpoint ip "\nPaste to point 2: "))
				(setq ang_ (angle ip p2 ))
				(setq dist_ (distance ip p2 ))
			)
		)
		
		(setq char (ascii (substr val 1 1)))			;; gets the first character, then convert it to the ASCII number
		(setq newval (strcat (chr (+ 1 char)) (substr val 2) ))		;; make a new value: ASCII increased with 1, put back as a character, then add the rest of the old value
		
		
		(drawText (polar ip ang_ dist_) ht newval)
		(setq i (+ i 1))
	)
	(princ)
)

 

...

  • Like 1
GLAVCVS Proficient

GLAVCVS

Posted
Posted

Hi

Something like This?  

(defun c:GLVScopi (/ cj cj1 n e mx my)
  (if (setq cj (ssget '((0 . "*TEXT"))))
    (progn
      (setq cj1 (ssadd))
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
        (setq tx (cdr (assoc 1 (setq l (entget e))))
	      mx (if mx (min (cadr (assoc 10 l)) mx) (cadr (assoc 10 l)))
	      my (if my (min (caddr (assoc 10 l)) my) (caddr (assoc 10 l)))
	)
        (entmake (subst (cons 1 (strcat (chr (+ (ascii (substr tx 1 1)) 1)) (substr tx 2))) (assoc 1 l) l))
        (ssadd (entlast) cj1)
      )
      (command "_move" cj1 "" (list mx my))
    )
  )
  (princ)
)

 

  • Like 1
  • Thanks 1
BIGAL Grand Master

BIGAL

Posted
Posted

Just a comment, using ssget may end up with A1 A3 A2 as order as ssget gets in creation order, may still be better to do pick pick.

 

Does the number go above 26 ? If so this is helpful based on Excel columns. 

; Number2Alpha - Converts Number into Alpha string
; Function By: Gilles Chanteau from Marseille, France
; Arguments: 1
;   Num# = Number to convert
; Syntax example: (Number2Alpha 731) = "ABC"

  

(NUMBER2ALPHA 1)
"A"

(NUMBER2ALPHA 27)
"AA"

 

  • Like 1
Ish Rising Star

Ish

Posted
  • Author
Posted
On 4/16/2025 at 1:54 PM, GLAVCVS said:

Hi

Something like This?  

(defun c:GLVScopi (/ cj cj1 n e mx my)
  (if (setq cj (ssget '((0 . "*TEXT"))))
    (progn
      (setq cj1 (ssadd))
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
        (setq tx (cdr (assoc 1 (setq l (entget e))))
	      mx (if mx (min (cadr (assoc 10 l)) mx) (cadr (assoc 10 l)))
	      my (if my (min (caddr (assoc 10 l)) my) (caddr (assoc 10 l)))
	)
        (entmake (subst (cons 1 (strcat (chr (+ (ascii (substr tx 1 1)) 1)) (substr tx 2))) (assoc 1 l) l))
        (ssadd (entlast) cj1)
      )
      (command "_move" cj1 "" (list mx my))
    )
  )
  (princ)
)

 

Thanks sir, it's working nicely, only one issue every time I have to hit the enter and need to select objects. So it is possible to continue one time copy and then paste paste.

Thanks 

GLAVCVS Proficient

GLAVCVS

Posted
Posted (edited) 
(defun c:GLVScopi (/ cj cj1 n e mx my para)
  (if (setq cj (ssget '((0 . "*TEXT"))))
    (while (not para) 
      (setq cj1 (ssadd))
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
        (setq tx (cdr (assoc 1 (setq l (entget e))))
	      mx (if mx (min (cadr (assoc 10 l)) mx) (cadr (assoc 10 l)))
	      my (if my (min (caddr (assoc 10 l)) my) (caddr (assoc 10 l)))
	)
        (entmake (subst (cons 1 (strcat (chr (+ (ascii (substr tx 1 1)) 1)) (substr tx 2))) (assoc 1 l) l))
        (ssadd (entlast) cj1)
      )
      (command "_move" cj1 "" (list mx my))
      (setq cj cj1 cj1 nil n nil mx nil my nil)
    )
  )
  (princ)
)

@Ish

I edited it from my smartphone, so I couldn't test it.

Check it yourself if it works.

Edited by GLAVCVS
  • Like 1
  • Thanks 1
Ish Rising Star

Ish

Posted
  • Author
Posted
On 4/18/2025 at 12:13 PM, GLAVCVS said: 
(defun c:GLVScopi (/ cj cj1 n e mx my para)
  (if (setq cj (ssget '((0 . "*TEXT"))))
    (while (not para) 
      (setq cj1 (ssadd))
      (while (setq e (ssname cj (setq n (if n (1+ n) 0))))
        (setq tx (cdr (assoc 1 (setq l (entget e))))
	      mx (if mx (min (cadr (assoc 10 l)) mx) (cadr (assoc 10 l)))
	      my (if my (min (caddr (assoc 10 l)) my) (caddr (assoc 10 l)))
	)
        (entmake (subst (cons 1 (strcat (chr (+ (ascii (substr tx 1 1)) 1)) (substr tx 2))) (assoc 1 l) l))
        (ssadd (entlast) cj1)
      )
      (command "_move" cj1 "" (list mx my))
      (setq cj cj1 cj1 nil n nil mx nil my nil)
    )
  )
  (princ)
)

@Ish

I edited it from my smartphone, so I couldn't test it.

Check it yourself if it works.

Sir, Not working properly .

GLAVCVS Proficient

GLAVCVS

Posted
Posted (edited)
2 hours ago, Ish said:

Sir, Not working properly .

  

(defun c:GLVScopi (/ cj cj1 n e mx my para obtcad errores error0)
  (defun errores (mens / n e)
    (setq *error* error0)
    (if cj1
      (while (setq e (ssname cj1 (setq n (if n (1+ n) 0))))
	(entdel e)
      )
    )
    (prin1)
  )
  (defun obtcad (cad / v r l daleVuelta)
      (defun daleVuelta (a)
        (cond
          ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a))
          ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a))
          ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a))
        )
      )
      (foreach v (reverse (vl-string->list cad))
        (if (or (not r) (minusp r))
          (setq l (cons (abs (setq r (daleVuelta v))) l))
          (setq l (cons v l))
        )
      )
      (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l))
  )
  (setq	error0	*error*
	*error*	errores
  )
  (if (setq cj (ssget '((0 . "*TEXT"))))
    (while (not para)
      (setq cj1 (ssadd))
      (while (setq e (ssname cj
			     (setq n (if n
				       (1+ n)
				       0
				     )
			     )
		     )
	     )
	(setq tx (cdr (assoc 1 (setq l (entget e))))
	      mx (if mx
		   (min (cadr (assoc 10 l)) mx)
		   (cadr (assoc 10 l))
		 )
	      my (if my
		   (min (caddr (assoc 10 l)) my)
		   (caddr (assoc 10 l))
		 )
	)
	(entmake
	  (subst
	    (cons
	      1
	      (obtcad tx)
	    )
	    (assoc 1 l)
	    l
	  )
	)
	(ssadd (entlast) cj1)
      )
      (command "_move" cj1 "" (list mx my) pause)
      (setq cj	cj1
	    cj1	nil
	    n	nil
	    mx	nil
	    my	nil
      )
      (getstring "\nPush ENTER or Right click for next or Escape for exit...")
    )
  )
  (princ)
)

 

Try this one
I've improved the calculation method in the following text to support numbers, letters, or both at the same time.

Edited by GLAVCVS
Emmanuel Delay Proficient

Emmanuel Delay

Posted
Posted

I added a While loop to my code.

Now you select the texts once and you paste them as many times as you need.  It keeps increasing.

 

  

;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/
;; draw a TEXT
(defun drawText (pt hgt str)
 (entmakex (list (cons 0 "TEXT")
                 (cons 10  pt)
                 (cons 40 hgt)
                 (cons 1  str))))
				 

;; Copy-Paste-Text-Increase-Beginletter
(defun c:cptib ( / i ss ent p1 p2 delta ang_ dist_ val ip ht char newval)
	(princ "\nSelect Text entities: ")
	(setq ss (ssget (list (cons 0 "TEXT")) ))
	
	(setq p1 (getpoint "\nSelect base point: "))
	(setq delta 1)
	
	(while p1
		(setq i 0)
		(repeat (sslength ss)
			(setq ent (ssname ss i))
			;; get the properties of the entity. Contents, insertpoint, text height.  If needed we could add layer, rotation...
			(setq val (cdr (assoc 1 (entget ent))))
			(setq ip (cdr (assoc 10 (entget ent))))
			(setq ht (cdr (assoc 40 (entget ent))))
			
			(if (= i 0)
				(progn
					;;(setq p2 (getpoint ip "\nPaste to point 2: "))
					;;(setq ang_ (angle ip p2 ))
					;;(setq dist_ (distance ip p2 ))
					(setq p2 (getpoint p1 "\nPaste to point 2: "))
					(setq ang_ (angle p1 p2 ))
					(setq dist_ (distance p1 p2 ))
				)
			)
			
			
			(setq char (ascii (substr val 1 1)))			;; gets the first character, then convert it to the ASCII number
			(setq newval (strcat (chr (+ delta char)) (substr val 2) ))		;; make a new value: ASCII increased with 1, put back as a character, then add the rest of the old value
			
			
			(drawText (polar ip ang_ dist_) ht newval)
			(setq i (+ i 1))
			
		)
		(setq delta (+ delta 1))  ;; new letter.  A, then B, then C, ...
	)
	(princ)
)

 

....

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.

×
 Share
Go to topic listing
×
×
  • Create New...