A LISP that copy or cut the text to selected text by clicking

[egilim123]

Hi all, i want to learn if there is a way with a lisp to cut any text to selected text by clicking on it . i tried to figure it on the attached file.

 

 

[tombu]

When pasting cut text with formatting into another Multiline Text right-click and select Paste Special → Paste without Character Formatting

[Steven P]

Probably long winded and maybe a there are more efficient ways to do this, try this, c:txtjoin - it should grab texts from most objects and join them together with a new line in between.

 

Also on there is

txtjointsp - which doesn't add a new line, separates texts with a space

txtjoint - as above but uses a tab

txtjoinnosp - no spaces and txtjoindash - with a dash between texts

 

 

- Select the text to remain

- Select the text to join to that 

- And loop to keep adding more to the 'remianing' text, escape to end / cancel

 

(defun getent ( aprompt / enta entb pt )
  (princ "\n")
  (setq enta (car (nentsel aprompt)))
  (setq pt (cdr (assoc 10 (entget enta))) )
;;;;fix for nenset or entsel requirements
  (setq entb (last (last (nentselp pt))))
  (if (and (/= entb nil) (/= (type entb) 'real) )
    (progn
      (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb))
    )
  )
  enta
)
;;;;;;;;;;;;;;;;;;;;;;
(defun gettextdxfcodes ( entlist1 / dxfcodes)
;;DXF codes containing texts
  (setq dxfcodes (list 3 4 1 172 304)) ;;general
  (if (= (cdr (assoc 0 entlist1)) "DIMENSION") ;;If Dimension
    (progn
      (if (= (cdr (assoc 1 entlist1)) nil)
        (setq dxfcodes (list 4 42 172 304)) ;;No 3, add 42 for dimension value
        (if (and (= (wcmatch "<>" (cdr (assoc 1 entlist1))) nil)(= (wcmatch "\"\"" (cdr (assoc 1 entlist1))) nil) )
          (setq dxfcodes (list 4 1 172 304)) ;;No 3, no 42 for dimension value
          (setq dxfcodes (list 4 1 42 172 304)) ;;Somehow combine 1 and 42 here, text replace and so on.
        ) ;end if
      ) ;end if
  ));end progn end if Dimensions
  (if (= (cdr (assoc 0 entlist1)) "MULTILEADER") ;;Is MultiLeader
    (progn
      (setq dxfcodes (list 304))
  ));end progn end if Dimensions
  dxfcodes
)
;;;;;;;;;;;;;;;;;;;;;;
(defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext)
;;get dotted pairs list
  (setq entlist (entget ent))
  (setq enttype (cdr (assoc 0 entlist)))
  (setq acount 0)
  (while (< acount (length entlist))
    (setq acounter 0)
    (while (< acounter (length entcodes))
      (setq entcode (nth acounter entcodes))
      (if (= (car (nth acount entlist)) entcode )
        (progn
          (setq newtext (cdr (nth acount entlist)))
          (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers
          (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) )
        );end progn
      );end if
      (setq acounter (+ acounter 1))
    );end while
    (setq acount (+ acount 1))
  );end while
;;get string from dotted pair lists
  (if (= listorstring "astring") ;convert to text
    (progn
      (if (> (length mytext) 0)
        (progn
          (setq acount 0)
          (setq temptext "")
          (while (< acount (length mytext))
            (setq temptext (cdr (nth acount mytext)) )
            (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text
            (if (= stringtext nil)
              (setq stringtext temptext)
              (setq stringtext (strcat stringtext temptext ))
            );end if
            (setq acount (+ acount 1))
          );end while
        );end progn
      );end if
      (if (= stringtext nil)(setq stringtext ""))
      (setq mytext stringtext)
    );end progn
  );end if
  mytext
)
;;;;;;;;;;;;;;;;;;;;;;
(defun dimensionfix ( ent1 entlist1 entlist2 text01 deldim / )
  (if (= "DIMENSION" (cdr (assoc 0 entlist1)))
    (progn
      (if (= deldim "del") (txtcleardim ent1 entlist1) )
      (if (and (/= "DIMENSION" (cdr (assoc 0 entlist2)))(= text01 nil))(setq text01 (gettextasstring ent1 (list 42))))
    )
  )
  text01
)
;;;;;;;;;;;;;;;;;;;;;;
(defun gettextasstring ( enta entcodes / texta )
  (if (= (getfroment enta "astring" entcodes) "")
    ()
      (setq texta (getfroment enta "astring" entcodes))
  )
  texta
)
;;;;;;;;;;;;;;;;;;;;;;
(defun deletelistitem (mylist itemtodelete / acounter nextitem)
;;delete a list item
  (setq acounter 0)
  (while (< acounter (length mylist) )
    (setq nextitem (car mylist))
    (setq mylist (cdr mylist)) ;;chop off first element
    (if (/= nextitem itemtodelete)
      (progn
        (setq mylist (append mylist (list nextitem))) ;stick next item to the back
      );end progn
    );end if
    (setq acounter (+ acounter 1))
  );end while
  (setq nextitem (car mylist))
  (setq mylist (cdr mylist))
  (setq mylist (append mylist (list nextitem)))
  mylist
)
;;;;;;;;;;;;;;;;;;;;;;
(defun deletedxfdata ( delent delentlist entcodes / acount acounter )
  (setq acounter 0)
  (setq acount 0)
  (while (< acount (length entcodes))
    (while (< acounter (length delentlist))
      (if (= (car (nth acounter delentlist) ) (nth acount entcodes) )
        (progn
          (entmod (setq delentlist (subst (cons (nth acount entcodes) "") (nth acounter delentlist) delentlist)))
          (entupd delent)
        )
      )
      (setq acounter (+ acounter 1))
    );end while
   (setq acount (+ acount 1))
  );end while
  delentlist
)
;;;;;;;;;;;;;;;;;;;;;;
(defun removemtextformats (texta / acount mtextformat mtextformatting)
;;Just for mtext to text conversions:
  (setq texta (LM:UnFormat texta "" ))
  texta
)
;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;
(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
("" . "5.0000LEADER_LINE2.0000")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)



(defun addinnewtext (newtext newentlist newent / )
  (if (/= newtext nil)
    (progn
      (if (= (cdr (assoc 0 newentlist)) "DIMENSION") 
        (progn
;;ent mod method, stops working at 2000-ish characters
          (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist)))
          (entupd newent)
        );end progn
;Fix here for attdef or attrib to be dxf code 2
        (progn
;;vla-put-text string for large text blocks + 2000 characters?
          (vla-put-textstring (vlax-ename->vla-object newent) newtext)
        );end progn
      ) ;end if
    ) ;end progn
    (princ "\nSource text is not 'text'")
  );end if
)
;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;
(defun c:txtjoin( / )(txtjoin "\n"))
(defun c:txtjoint( / )(txtjoin "\t"))
(defun c:txtjointsp( / )(txtjoin " "))
(defun c:txtjointnosp( / )(txtjoin ""))
(defun c:txtjointdash( / )(txtjoin " - "))

(defun txtjoin( deliminator / oldvars entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter)
;;get text
  (setq ent1 (getent "\nSelect Retained Text : "))
  (setq entlist1 (entget ent1))
  (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
  (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
  (setq entcodes1 (deletelistitem entcodes1 '1))

;;loop till cancelled
  (while (setq ent2 (getent "\nSelect Text to Add (or escape): "))

    (setq entlist1 (entget ent1))
    (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
    (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
    (setq entcodes1 (deletelistitem entcodes1 '1))

;;get text 2
    (setq entlist2 (entget ent2))
    (setq entcodes2 (gettextdxfcodes entlist2)) ;;reset entcodes
    (setq text02 (gettextasstring ent2 entcodes2) )
    (setq entcodes2 (deletelistitem entcodes2 '1))

;;delete text except for basic DXF code 1
;;Needed if using entmod method, not VLA-PUT-TEXTSTRING method
    (setq entlist1 (deletedxfdata ent1 entlist1 entcodes1))

;;fix for dimensions
    (Setq text01 (dimensionfix ent1 entlist1 entlist2 text01 "del"))

;;mtext to text formatting
    (if (and (= (cdr (assoc 0 entlist1)) "TEXT")(= (cdr (assoc 0 entlist2)) "MTEXT"))
      (setq text02 (removemtextformats text02))
    )

;;deliminator processing
    (if (and (= (cdr (assoc 0 entlist1)) "TEXT")(= deliminator "\n"))(setq deliminator " "))
    (if (and (= (cdr (assoc 0 entlist1)) "TEXT")(= deliminator "\t"))(setq deliminator "     "))
    (setq texta (strcat text01 deliminator))
    (setq texta (strcat texta text02))

;;Delete text 2
    (if (equal ent1 ent2)
      (princ "\n-- Text 1 and Text 2 are the same. Doubling text string. --")
      (if (= (cdr (assoc 0 entlist2)) "DIMENSION") ;;Retaining these texts
        ()
        (entdel ent2)
      )
    )

;;;put in new text
    (addinnewtext texta entlist1 ent1)
    (command "redraw")
    (command "regen") ;;update it all
  );end while
  (princ)
)

 

 

-EDIT- slight change to the code, it wasn't grabbing dimension texts quite right

Edited November 14, 2022 by Steven P
Corrected Code

[tombu]

This old lisp by Peter Jamtgaard in 2005 should do the trick.

; Written By: Peter Jamtgaard 2005
; Modified to work with Text or MText by: Tom Beauford

(defun C:TextJoin (/ intCount entSelection objSelection
                      objSelection1 ssSelections btwtxt)
; (vl-load-com)  ;no longer needed in Autocad 2005
 (princ "\nSelect First Text or MText Entity: ")
 (while (not (and (setq ssSelections (ssget ":S" (list (cons 0 "TEXT,MTEXT"))))
                  (setq entSelection (ssname ssSelections 0))
                  (setq objSelection1 (vlax-ename->vla-object entSelection))
             )
        )
  (princ "\nError with selection please select again: ")
 )
 (if(=(cdr(assoc 0 (entget entSelection))) "MTEXT")
  (setq btwtxt "\\P") ;Return in MText.
  (setq btwtxt " ")   ;Or space between Text selections.
 )
                  (vl-catch-all-apply 'vla-put-Layer (list objSelection1 "0"))
 (redraw(ssname(ssget "P")0)3) ;Highlight First selection.
 (princ "\nSelect text or mtext entities to add to first: ")
 (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))
       ssSelections (ssget (list (cons 0 "TEXT,MTEXT")))
       intCount 0 ;Start with first selection.
 )
 (if(ssmemb entSelection ssSelections)(ssdel entSelection ssSelections))
 ; Don't delete First selection if selected again.
 (repeat (sslength ssSelections)
  (vla-startundomark thisdrawing)
  (setq entSelection (ssname ssSelections intCOunt)
        objSelection (vlax-ename->vla-object entSelection)
        intCount     (1+ intCount) ;increment to next selection.
  )
  (if(= btwtxt " ")
   (while(vl-string-search "\\P" (vla-get-textstring objSelection))
    (vla-put-textstring objSelection
       (vl-string-subst " " "\\P" (vla-get-textstring objSelection))
    )
   )
  )
  (vla-put-textstring objSelection1
                      (strcat
                       (vla-get-textstring objSelection1)
                                             btwtxt
                       (vla-get-textstring objSelection)
                      )
  )
  (vla-delete objSelection)
  (vla-endundomark thisdrawing)
 )
 (princ)
)

Hadn't used it in 15 years but tested before posting with mtext and it worked.

[Jonathan Handojo]

Text2MText Upgraded, but this one doesn't remove the formatting.

[egilim123]

hi again i couldnt look at the forum for a few days and i just check the lisps you send , most of them works really good thx all for your help.

[egilim123]

Hello again, i want to ask one more thing , is there anyway to make all the combined text in the same format(text style,font style,size etc..) for example i combine 4 different texts and i want all to be in the first texts properties.

[Steven P]

EDITED (after checking...)

 

You might need to find the LISP SMT, strip Mtext or Lee Macs Unformat LISP and add that into the LISP,

 

I might ask whose version you are using above, Tombu or mine, (If it is Tombu, I'll let him edit his suggestion)

Edited November 11, 2022 by Steven P

[egilim123]

hi @Steven P, i m using  the attached lisp, and i want to combine 3 or more different text into one and make the output with your lisp (ST) and i want to have a big distance between them when i take the output with your lisp (ST) because i f i can have a greater distance in excel,word  i can arrange them into different excel columns easily.

t2m.rar SAMPLE.dwg

[egilim123]

and when i use the attached lisp (t2m) to combine them if the different text properties are different when i take the output with your (ST) lisp some other kind of words formings between them as in the picture but if all of them can be formatted into one same properties when i take the output with your (ST) lisp they dont occur.

[Steven P]

Couple of parts to my answer, first off this, SMT2 - strip Mtext without the dialogue box - just for reference for others. Credits to Strip Mtext are below the code,.

 

(defun c:SMT2 () (c:StripMtext2)) ;_shortcut
(defun c:StripMtext2 (/ ss ent1 ent2 tstr1 tstr2)
; Strips Mtext of certain formating

  (command "_.undo" "_end")
  (command "_.undo" "_group")
  (if (setq ss (ssget '((0 . "MTEXT"))))
   (while (/= (sslength ss) 0)
    (setq ent1 (ssname ss 0))
    (setq ent2 (vlax-ename->vla-object ent1))
    (setq tstr1 (vlax-get ent2 'TextString))
    (setq tstr2 (StripString tstr1))
    (vlax-put ent2 'TextString tstr2)
    (ssdel ent1 ss)
   ); while
  ); if
  (command "_.undo" "_end")
  (princ)
)





(defun StripString (String / cstr1 cstr2 nString cnt1 tstr1)
; Strips out formation for color, font, height and width.

  (setq cnt1 1)
  (while (and (setq cstr1 (substr String 1 1)) (> (strlen String) 0))
   (if (= cstr1 "\\")
    (progn
     (setq cstr2 (substr String 2 1))
     (if (member (strcase cstr2) '("C" "F" "H" "W"))
      (progn
       (while (/= (substr String cnt1 1) ";")
        (setq cnt1 (1+ cnt1))
       ); while
       (setq String (substr String (1+ cnt1) (strlen String)))
       (setq cnt1 1)
      ); progn
      (progn
       (if nString
        (setq nString (strcat nString (substr String 1 1)))
        (setq nString (substr String 1 1))
       ); if
       (setq String (substr String 2 (strlen String)))
      ); progn
     ); if
    ); progn
    (progn
     (if nString
      (setq nString (strcat nString (substr String 1 1)))
      (setq nString (substr String 1 1))
     ); if
     (setq String (substr String 2 (strlen String)))
    ); progn
   ); if
  ); while
  (setq tstr1 (vl-string->list nString))
  (if (and (not (member 92 tstr1)) (member 123 tstr1))
   (setq tstr1 (vl-remove-if '(lambda (x) (or (= x 123) (= x 125))) tstr1))
  ); if
  (vl-list->string tstr1)
)

 

 

 

 

 

Credits to:

StripMtext Version 5.0b for AutoCAD 2000 and above
Removes embedded Mtext formatting

 Copyright© Steve Doman and Joe Burke 2010

 Look for new stable releases at:
http://cadabyss.wordpress.com/
 
 More information may also be found at:
http://www.theswamp.org/

[Steven P]

Right, 3rd time I have written part 2 without posting......

 

So option 1 is to look at what I offered above,  and looking through it I have included Lee Macs Unformat code - which of course does everything as expected (he is frustratingly good at this LISP stuff). You can just use that and apply it to 'text02' in the code. Dead easy but not quite right - it also unformats the new line characters (which I needed to do to do text join, mtext to dtext).. however I added this in below and commented it out just because.

 

So use SMT2 (from above)_ instead which will remove colour, font, height and width - the main ones but not say, new lines, indents and a load of others

 

 

Anyway, try this version and let me know how it works

 

 

(defun StripString (String / cstr1 cstr2 nString cnt1 tstr1)
; Strips out formation for color, font, height and width.

  (setq cnt1 1)
  (while (and (setq cstr1 (substr String 1 1)) (> (strlen String) 0))
   (if (= cstr1 "\\")
    (progn
     (setq cstr2 (substr String 2 1))
     (if (member (strcase cstr2) '("C" "F" "H" "W"))
      (progn
       (while (/= (substr String cnt1 1) ";")
        (setq cnt1 (1+ cnt1))
       ); while
       (setq String (substr String (1+ cnt1) (strlen String)))
       (setq cnt1 1)
      ); progn
      (progn
       (if nString
        (setq nString (strcat nString (substr String 1 1)))
        (setq nString (substr String 1 1))
       ); if
       (setq String (substr String 2 (strlen String)))
      ); progn
     ); if
    ); progn
    (progn
     (if nString
      (setq nString (strcat nString (substr String 1 1)))
      (setq nString (substr String 1 1))
     ); if
     (setq String (substr String 2 (strlen String)))
    ); progn
   ); if
  ); while
  (setq tstr1 (vl-string->list nString))
  (if (and (not (member 92 tstr1)) (member 123 tstr1))
   (setq tstr1 (vl-remove-if '(lambda (x) (or (= x 123) (= x 125))) tstr1))
  ); if
  (vl-list->string tstr1)
)



(defun getent ( aprompt / enta entb pt )
  (princ "\n")
  (setq enta (car (nentsel aprompt)))
  (setq pt (cdr (assoc 10 (entget enta))) )
;;;;fix for nenset or entsel requirements
  (setq entb (last (last (nentselp pt))))
  (if (and (/= entb nil) (/= (type entb) 'real) )
    (progn
      (if (wcmatch (cdr (assoc 0 (entget entb))) "ACAD_TABLE,*DIMENSION,*LEADER")(setq enta entb))
    )
  )
  enta
)
;;;;;;;;;;;;;;;;;;;;;;
(defun gettextdxfcodes ( entlist1 / dxfcodes)
;;DXF codes containing texts
  (setq dxfcodes (list 3 4 1 172 304)) ;;general
  (if (= (cdr (assoc 0 entlist1)) "DIMENSION") ;;If Dimension
    (progn
      (if (= (cdr (assoc 1 entlist1)) nil)
        (setq dxfcodes (list 4 42 172 304)) ;;No 3, add 42 for dimension value
        (if (and (= (wcmatch "<>" (cdr (assoc 1 entlist1))) nil)(= (wcmatch "\"\"" (cdr (assoc 1 entlist1))) nil) )
          (setq dxfcodes (list 4 1 172 304)) ;;No 3, no 42 for dimension value
          (setq dxfcodes (list 4 1 42 172 304)) ;;Somehow combine 1 and 42 here, text replace and so on.
        ) ;end if
      ) ;end if
  ));end progn end if Dimensions
  (if (= (cdr (assoc 0 entlist1)) "MULTILEADER") ;;Is MultiLeader
    (progn
      (setq dxfcodes (list 304))
  ));end progn end if Dimensions
  dxfcodes
)
;;;;;;;;;;;;;;;;;;;;;;
(defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext)
;;get dotted pairs list
  (setq entlist (entget ent))
  (setq enttype (cdr (assoc 0 entlist)))
  (setq acount 0)
  (while (< acount (length entlist))
    (setq acounter 0)
    (while (< acounter (length entcodes))
      (setq entcode (nth acounter entcodes))
      (if (= (car (nth acount entlist)) entcode )
        (progn
          (setq newtext (cdr (nth acount entlist)))
          (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers
          (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) )
        );end progn
      );end if
      (setq acounter (+ acounter 1))
    );end while
    (setq acount (+ acount 1))
  );end while
;;get string from dotted pair lists
  (if (= listorstring "astring") ;convert to text
    (progn
      (if (> (length mytext) 0)
        (progn
          (setq acount 0)
          (setq temptext "")
          (while (< acount (length mytext))
            (setq temptext (cdr (nth acount mytext)) )
            (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text
            (if (= stringtext nil)
              (setq stringtext temptext)
              (setq stringtext (strcat stringtext temptext ))
            );end if
            (setq acount (+ acount 1))
          );end while
        );end progn
      );end if
      (if (= stringtext nil)(setq stringtext ""))
      (setq mytext stringtext)
    );end progn
  );end if
  mytext
)
;;;;;;;;;;;;;;;;;;;;;;
(defun gettextasstring ( enta entcodes / texta )
  (if (= (getfroment enta "astring" entcodes) "")
    ()
      (setq texta (getfroment enta "astring" entcodes))
  )
  texta
)
;;;;;;;;;;;;;;;;;;;;;;
(defun dimensionfix ( ent1 entlist1 entlist2 text01 deldim / )
  (if (= "DIMENSION" (cdr (assoc 0 entlist1)))
    (progn
      (if (= deldim "del") (txtcleardim ent1 entlist1) )
      (if (and (/= "DIMENSION" (cdr (assoc 0 entlist2)))(= text01 nil))(setq text01 (gettextasstring ent1 (list 42))))
    )
  )
  text01
)
;;;;;;;;;;;;;;;;;;;;;;
(defun deletelistitem (mylist itemtodelete / acounter nextitem)
;;delete a list item
  (setq acounter 0)
  (while (< acounter (length mylist) )
    (setq nextitem (car mylist))
    (setq mylist (cdr mylist)) ;;chop off first element
    (if (/= nextitem itemtodelete)
      (progn
        (setq mylist (append mylist (list nextitem))) ;stick next item to the back
      );end progn
    );end if
    (setq acounter (+ acounter 1))
  );end while
  (setq nextitem (car mylist))
  (setq mylist (cdr mylist))
  (setq mylist (append mylist (list nextitem)))
  mylist
)
;;;;;;;;;;;;;;;;;;;;;;
(defun deletedxfdata ( delent delentlist entcodes / acount acounter )
  (setq acounter 0)
  (setq acount 0)
  (while (< acount (length entcodes))
    (while (< acounter (length delentlist))
      (if (= (car (nth acounter delentlist) ) (nth acount entcodes) )
        (progn
          (entmod (setq delentlist (subst (cons (nth acount entcodes) "") (nth acounter delentlist) delentlist)))
          (entupd delent)
        )
      )
      (setq acounter (+ acounter 1))
    );end while
   (setq acount (+ acount 1))
  );end while
  delentlist
)
;;;;;;;;;;;;;;;;;;;;;;
(defun removemtextformats (texta / acount mtextformat mtextformatting)
;;Just for mtext to text conversions:
  (setq texta (LM:UnFormat texta "" ))
  texta
)
;;-------------------=={ UnFormat String }==------------------;;
;;                                                            ;;
;;  Returns a string with all MText formatting codes removed. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  str - String to Process                                   ;;
;;  mtx - MText Flag (T if string is for use in MText)        ;;
;;------------------------------------------------------------;;
;;  Returns:  String with formatting codes removed            ;;
;;------------------------------------------------------------;;
(defun LM:UnFormat ( str mtx / _replace rx )

    (defun _replace ( new old str )
        (vlax-put-property rx 'pattern old)
        (vlax-invoke rx 'replace str new)
    )
    (if (setq rx (vlax-get-or-create-object "VBScript.RegExp"))
        (progn
            (setq str
                (vl-catch-all-apply
                    (function
                        (lambda ( )
                            (vlax-put-property rx 'global     actrue)
                            (vlax-put-property rx 'multiline  actrue)
                            (vlax-put-property rx 'ignorecase acfalse) 
                            (foreach pair
                               '(
                                    ("\032"    . "\\\\\\\\")
                                    (" "       . "\\\\P|\\n|\\t")
                                    ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
                                    ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
                                    ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
                                    ("$1"      . "[\\\\]({)|{")
("" . "5.0000LEADER_LINE2.0000")
                                )
                                (setq str (_replace (car pair) (cdr pair) str))
                            )
                            (if mtx
                                (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
                                (_replace "\\"   "\032" str)
                            )
                        )
                    )
                )
            )
            (vlax-release-object rx)
            (if (null (vl-catch-all-error-p str))
                str
            )
        )
    )
)



(defun addinnewtext (newtext newentlist newent / )
  (if (/= newtext nil)
    (progn
      (if (= (cdr (assoc 0 newentlist)) "DIMENSION") 
        (progn
;;ent mod method, stops working at 2000-ish characters
          (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist)))
          (entupd newent)
        );end progn
;Fix here for attdef or attrib to be dxf code 2
        (progn
;;vla-put-text string for large text blocks + 2000 characters?
          (vla-put-textstring (vlax-ename->vla-object newent) newtext)
        );end progn
      ) ;end if
    ) ;end progn
    (princ "\nSource text is not 'text'")
  );end if
)
;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;
(defun c:txtjoin( / )(txtjoin "\n"))
(defun c:txtjoint( / )(txtjoin "\t"))
(defun c:txtjointsp( / )(txtjoin " "))
(defun c:txtjointnosp( / )(txtjoin ""))
(defun c:txtjointdash( / )(txtjoin " - "))

(defun txtjoin( deliminator / oldvars entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter)
;;get text
  (setq ent1 (getent "\nSelect Retained Text : "))
  (setq entlist1 (entget ent1))
  (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
  (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
  (setq entcodes1 (deletelistitem entcodes1 '1))

;;loop till cancelled
  (while (setq ent2 (getent "\nSelect Text to Add (or escape): "))

    (setq entlist1 (entget ent1))
    (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
    (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
    (setq entcodes1 (deletelistitem entcodes1 '1))

;;get text 2
    (setq entlist2 (entget ent2))
    (setq entcodes2 (gettextdxfcodes entlist2)) ;;reset entcodes
    (setq text02 (gettextasstring ent2 entcodes2) )
;;    (setq text02 (removemtextformats text02))  ;; This line will strip all text formating according to Lee Macs Unformat inc. new line characters
    (setq entcodes2 (deletelistitem entcodes2 '1))

;;delete text except for basic DXF code 1
;;Needed if using entmod method, not VLA-PUT-TEXTSTRING method
    (setq entlist1 (deletedxfdata ent1 entlist1 entcodes1))

;;fix for dimensions
    (Setq text01 (dimensionfix ent1 entlist1 entlist2 text01 "del"))

;;mtext to text formatting ;; This 'if' is not needed ig you are using the Lee Mac Unformat Line (commented out above)
    (if (and (= (cdr (assoc 0 entlist1)) "TEXT")(= (cdr (assoc 0 entlist2)) "MTEXT"))
      (setq text02 (removemtextformats text02))
      (setq text02 (StripString text02))
    )

;;deliminator processing
    (if (and (= (cdr (assoc 0 entlist1)) "TEXT")(= deliminator "\n"))(setq deliminator " "))
    (if (and (= (cdr (assoc 0 entlist1)) "TEXT")(= deliminator "\t"))(setq deliminator "     "))
    (setq texta (strcat text01 deliminator))
    (setq texta (strcat texta text02))

;;Delete text 2
    (if (equal ent1 ent2)
      (princ "\n-- Text 1 and Text 2 are the same. Doubling text string. --")
      (if (= (cdr (assoc 0 entlist2)) "DIMENSION") ;;Retaining these texts
        ()
        (entdel ent2)
      )
    )

;;;put in new text
    (addinnewtext texta entlist1 ent1)
    (command "redraw")
    (command "regen") ;;update it all
  );end while
  (princ)
)

 

 

 

 

Edited November 14, 2022 by Steven P

[egilim123]

hi @Steven P, i couldnt do with your first post "SMT2" and i am trying the second post which starts with "StripString" , but i failed to work the code what is the command to work it?

[egilim123]

i mean the command to run the "StripString"   code

[Steven P]

15 minutes ago, egilim123 said:

hi @Steven P, i couldnt do with your first post "SMT2" and i am trying the second post which starts with "StripString" , but i failed to work the code what is the command to work it?

 

Same as before, I updated what I made up first, txtjoin

[egilim123]

when i run txtjoin and click on any text it returns this error  "Select Retained Text : ; error: no function definition: GETTEXTASDOTTEDPAIRS"

SAMPLE2.dwg

[Steven P]

1 hour ago, egilim123 said:

when i run txtjoin and click on any text it returns this error  "Select Retained Text : ; error: no function definition: GETTEXTASDOTTEDPAIRS"

 

 

No problem, I have amended my code above to fix that (problem of copy and paste, sometimes I don't notice everything).... let me know if it works now for you?

[egilim123]

this time it returns this error  ;

TXTJOINT
Select Retained Text :
Select Text to Add (or escape): ; error: no function definition: DIMENSIONFIX

TXTJOIN.lsp SAMPLE2.dwg

[Steven P]

the codes above should have that now..... not doing so well at my copying and pasting this week, 

[BIGAL]

I left the last bracket off the other day. We all do it.