Jump to content

Copies content from multiple texts to multiple texts


Recommended Posts

;; Copies content from multiple texts to multiple texts. - exceed 2022.01.12

(defun c:MTX (/ *error* ss1 ss1count ss1index ss1y ss1list ss1stacklist ss1ent ss1text ss2 ss2count ss2index ss2y ss2list ss2stacklist ss2ent ss2index2 ss1textfromstacklist ss2obj ss1notusedlist ss1notusedstacklist ss1notusedlength ss1notusedindex ss1notusedtextstr )
  (setvar 'cmdecho 0)
  (LM:startundo (LM:acdoc))
  ;error control
    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\n Error: " msg))

  (princ "\n Copies content from multiple texts to multiple texts.\n Select the original texts to be copied (only 1 column vertically)\n")

  ;select original texts
  (setq ss1 (ssget (list (cons 0 "*TEXT"))))
  (setq ss1count (sslength ss1))
  (setq ss1index 0)
  (setq ss1y 0)
  (setq ss1list nil)
  (setq ss1stacklist nil)

  ;get list of original texts ( y-coordinate textcontents )
  (repeat ss1count
    (setq ss1ent (entget (ssname ss1 ss1index)))
    (setq ss1text (cdr (assoc 1 ss1ent)))
    (setq ss1y (* (nth 2 (assoc 10 ss1ent)) -1))  ; * -1 for reverse y coordinates (for sorting)
    (setq ss1list (list ss1y ss1text))
    (setq ss1stacklist (cons ss1list ss1stacklist))
    (setq ss1index (+ ss1index 1))
  );end repeat

  ;(princ "\n original list : ")
  ;(princ ss1stacklist)

  ;sort original list
  (setq ss1stacklist (vl-sort ss1stacklist
                                      (lambda (x1 x2)(< (car x1) (car x2)))

  ;(princ "\n sorted original list : ")
  ;(princ ss1stacklist)

  (princ "\n Select the object texts to be pasted (only 1 column vertically)\n")

  ;select object texts
  (setq ss2 (ssget '((0 . "*TEXT"))) ) 
  (setq ss2count (sslength ss2))
  (setq ss2index 0)
  (setq ss2y 0)
  (setq ss2list nil)
  (setq ss2stacklist nil)

  ;get list of object texts ( y-coordinate index )
  (repeat ss2count
    (setq ss2ent (entget (ssname ss2 ss2index)))
    (setq ss2y (* (nth 2 (assoc 10 ss2ent)) -1)) ; * -1 for reverse y coordinates (for sorting)
    (setq ss2list (list ss2y ss2index))
    (setq ss2stacklist (cons ss2list ss2stacklist))
    (setq ss2index (+ ss2index 1)) 
  ;(princ "\n objectlist = ")
  ;(princ ss2stacklist)

  ;sort object list
  (setq ss2stacklist (vl-sort ss2stacklist
                                      (lambda (x1 x2)(< (car x1) (car x2)))

  ;(princ "\n sorted objectlist = ")
  ;(princ ss2stacklist)

  ;(princ "\n before adding missing things list : ")
  ;(princ ss1stacklist)
  ;if object list has more member than original list, add "___" at the end of original list, 
  ;to avoid errors, this part should precede the put-text loop.
  (if (> ss2count ss1count) 
         (repeat (- ss2count ss1count)
             (setq ss1stacklist (append ss1stacklist (list (list 0 "___")) ))
  ;(princ "\n after adding missing things list : ")
  ;(princ ss1stacklist)

  ;put the value 
  (setq ss2index2 0)
  (setq ss1textfromstacklist nil)

  (repeat ss2count
    (setq ss1textfromstacklist (cadr (nth ss2index2 ss1stacklist))) ;to Paste
    (setq ss2obj (vlax-ename->vla-object (ssname ss2 (cadr (nth ss2index2 ss2stacklist)) )))
    (vla-put-textstring ss2obj ss1textfromstacklist)
    (setq ss2index2 (+ ss2index2 1)) 
  );end repeat

  ;make not used list (if original members more than object members)
  (setq ss1notusedlist nil)
  (setq ss1notusedstacklist nil)
  (if (< ss2count ss1count) 
         (repeat (- ss1count ss2count)
             (setq ss1notusedlist (nth ss2index2 ss1stacklist))
             (setq ss1notusedstacklist (cons ss1notusedlist ss1notusedstacklist))
             (setq ss2index2 (+ ss2index2 1))

  ;sort not used list
  (setq ss1notusedstacklist (vl-sort ss1notusedstacklist
                                         (lambda (x1 x2)(< (car x1) (car x2)))

 ;make string for not used list
 (setq ss1notusedlength (length ss1notusedstacklist))
 (setq ss1notusedindex 0)
 (setq ss1notusedtextstr "\n Not used original texts = ")
 (repeat ss1notusedlength
     (setq ss1notusedtext (vl-princ-to-string (cadr (nth ss1notusedindex ss1notusedstacklist))))
     (setq ss1notusedtextstr (strcat ss1notusedtextstr ss1notusedtext ", " ))
     (setq ss1notusedindex (+ ss1notusedindex 1))
 ;delete ", " end of str 
 (setq ss1notusedtextstrlen (strlen ss1notusedtextstr))
 (setq ss1notusedtextstr (substr ss1notusedtextstr 1 (- ss1notusedtextstrlen 2)))

 ;result message
  (princ (strcat "\n Original Texts : " (vl-princ-to-string ss1count) " ea / Object Texts : " (vl-princ-to-string ss2count) " ea \n"))
    ((> ss1count ss2count) (princ (strcat "\n Copying the contents of " (vl-princ-to-string ss2count) " texts is Complete. / " (vl-princ-to-string (- ss1count ss2count)) " ea original texts are not used." ss1notusedtextstr )))
    ((< ss1count ss2count) (princ (strcat "\n Copying the contents of " (vl-princ-to-string ss1count) " texts is Complete. / " (vl-princ-to-string (- ss2count ss1count)) " ea object texts are left. not enough original texts. they are replaced by ___")))
    ((= ss1count ss2count) (princ (strcat "\n Copying the contents of " (vl-princ-to-string ss2count) " texts is Complete. / The number of object and original is the same.")))
  (LM:endundo (LM:acdoc))
  (setvar 'cmdecho 1)
); end defun

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))


this is for practice vl-sort function. 

Copies contents from multiple texts to multiple texts in vertical 1 column

Someone must have made it, but I couldn't find it so made it.



This is useful for editing old-style tables (consisting of text and lines).

in example, when the text pasted from outside of AutoCAD, but it has a different form ... etc.






typo : object texts are not enough -> object texts are left. not enough original texts. 

I fixed in code, but I can't take screenshots again😅





Since it was built using y-value comparison, it's easy to create for x-values as well.

However, the reason why this lisp uses the y value

is the same as the reason why vlookup is used more than hlookup in excel. 😄


Edited by exceed
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.

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