urgent help need in 2line mtex

[pmadhwal7]

Hi all,

anyone can modify this lisp for me, actually i have 2line mtext and i want to join them as it appears, the lisp i found working only on one text after that i again giving command and joining them is their any way to join all mtext one go and in 2line paragraph like in screenshot and sample file, kindly help me i need this in very shot time.

   

pole.dwg

JoinMtext.lsp

Edited August 24, 2023 by pmadhwal7

[Steven P]

We'll need to see the LISP to modify it.....

[hosneyalaa]

see this 

http://www.lee-mac.com/text2mtext.html

[pmadhwal7]

2 hours ago, Steven P said:

We'll need to see the LISP to modify it.....

yes lisp also attached

[pmadhwal7]

2 minutes ago, hosneyalaa said:

see this 

http://www.lee-mac.com/text2mtext.html

actually picking one by one text taking time and i need to join many text separately u can check my file 

[Steven P]

There is also the AutoCAD command txt2mtxt (was an express tool) though of course, Lee Mac has added a little extra.

 

txt2mtxt will allow you to select text via a window, works nicely if the text is stacked like your example with a window but if it is offset left or right the results might not be what you expected

[Steven P]

It would be possible to make something up selecting al the 2 line texts and joining them - something like join all the texts where the x coordinates are similar, and you could do a shortcut so you don't need to type txt2mtxt every time (example via LISP (defun ttm ( / ) (command "txt2mtxt")) but you can just make a shortcut up anyway)

[hosneyalaa]

try

 

(defun c:tessstjtxt2 (/ CNT C_DOC DXFDT DXFOLD DXFSTR ENT SSET SS_LST STROLD)



  (setq c_doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq t_obj (vlax-ename->vla-object
                (car (entsel "\nSelect Text Entity on Layer 1 : "))
              ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq

  (setq SSET (ssget "X"
                    (list (cons 0 "MTEXT")
                          (cons 8 (vla-get-layer t_obj))
                          (cons 410 "Model")
                    ) ;_ end of list
             ) ;_ end of ssget
  ) ;_ end of setq

  (setq t_objF (vlax-ename->vla-object
                 (car (entsel "\nSelect Text Entity on Layer 2 : "))
               ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq

  (setq ss_lst (ssget "X"
                      (list (cons 0 "MTEXT")
                            (cons 8 (vla-get-layer t_objF))
                            (cons 410 "Model")
                      ) ;_ end of list
               ) ;_ end of ssget
  ) ;_ end of setq





  (if (not ss_lst)
    (progn (alert "Empty Selection Set") (exit))
  ) ;_ end of if


  (setq CNT 0)

  (repeat (sslength SSET)

    (progn

      
      (setq ENT (ssname SSET CNT))
      (setq DXFDT (entget ENT))
      (setq DXFOLD (cdr (assoc 10 DXFDT)))
      (setq STROLD (cdr (assoc 1 DXFDT)))
      
      (setq ptLst
             (LAST (CAR(vl-sort
               (mapcar
                 '(lambda (x) (list (distance (list (car (car x))  (cadr (car x))) (list (car DXFOLD)  (cadr DXFOLD ))) (cadr x)))  
                 (mapcar '(lambda (x)
                            (list (cdr (assoc 10 x)) (cdr (assoc -1 x)))
                          ) ;_ end of lambda
                         (mapcar 'entget
                                 (vl-remove-if
                                   'listp
                                   (mapcar 'cadr (ssnamex ss_lst))  
                                 ) ;_ end of vl-remove-if
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
               ) ;_ end of mapcar
               '(lambda (a b) (< (car a) (car b)))
             ) ;_ end of vl-sort
                 ))
            
      ) ;_ end of setq

      
      (if ptLst
        (progn
          (vla-put-textstring
            (vlax-ename->vla-object ENT)
            (strcat STROLD "\\P" (vla-get-textstring (vlax-ename->vla-object ptLst)))
          ) ;_ end of vla-put-textstring
          (vla-put-width (vlax-ename->vla-object ENT) 40)

          (vla-Update (vlax-ename->vla-object ENT))
          
          ;(vla-delete DXFSTR)
       

        (setq ptLst NIL )



       
           ) ;_ end of progn
      ) ;_ end of if


  (setq CNT (+ 1 CNT))
      
    )                                             ;RE

   
    )
    

    
    (princ)
  ) ;_ end of repeat                                                 ;end_defun

;|«Visual LISP© Format Options»
(72 2 50 2 T "end of " 60 9 1 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;

 

[CyberAngel]

2 hours ago, Steven P said:

There is also the AutoCAD command txt2mtxt (was an express tool) though of course, Lee Mac has added a little extra.

 

txt2mtxt will allow you to select text via a window, works nicely if the text is stacked like your example with a window but if it is offset left or right the results might not be what you expected

 

TXT2MTXT has some quirks that I only recently found out about. If you run it without selecting anything, you can access the settings dialog, where you can specify how it runs. There you can specify what order to use when assembling your new mtext. One regrettable feature is that it always changes the justification to top, regardless of the original text.

 

So you can select your text in the order you want it to appear in the mtext. You can even create a single mtext for each text.

[pmadhwal7]

15 hours ago, hosneyalaa said:

try

 

(defun c:tessstjtxt2 (/ CNT C_DOC DXFDT DXFOLD DXFSTR ENT SSET SS_LST STROLD)



  (setq c_doc (vla-get-activedocument (vlax-get-acad-object)))
  (setq t_obj (vlax-ename->vla-object
                (car (entsel "\nSelect Text Entity on Layer 1 : "))
              ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq

  (setq SSET (ssget "X"
                    (list (cons 0 "MTEXT")
                          (cons 8 (vla-get-layer t_obj))
                          (cons 410 "Model")
                    ) ;_ end of list
             ) ;_ end of ssget
  ) ;_ end of setq

  (setq t_objF (vlax-ename->vla-object
                 (car (entsel "\nSelect Text Entity on Layer 2 : "))
               ) ;_ end of vlax-ename->vla-object
  ) ;_ end of setq

  (setq ss_lst (ssget "X"
                      (list (cons 0 "MTEXT")
                            (cons 8 (vla-get-layer t_objF))
                            (cons 410 "Model")
                      ) ;_ end of list
               ) ;_ end of ssget
  ) ;_ end of setq





  (if (not ss_lst)
    (progn (alert "Empty Selection Set") (exit))
  ) ;_ end of if


  (setq CNT 0)

  (repeat (sslength SSET)

    (progn

      
      (setq ENT (ssname SSET CNT))
      (setq DXFDT (entget ENT))
      (setq DXFOLD (cdr (assoc 10 DXFDT)))
      (setq STROLD (cdr (assoc 1 DXFDT)))
      
      (setq ptLst
             (LAST (CAR(vl-sort
               (mapcar
                 '(lambda (x) (list (distance (list (car (car x))  (cadr (car x))) (list (car DXFOLD)  (cadr DXFOLD ))) (cadr x)))  
                 (mapcar '(lambda (x)
                            (list (cdr (assoc 10 x)) (cdr (assoc -1 x)))
                          ) ;_ end of lambda
                         (mapcar 'entget
                                 (vl-remove-if
                                   'listp
                                   (mapcar 'cadr (ssnamex ss_lst))  
                                 ) ;_ end of vl-remove-if
                         ) ;_ end of mapcar
                 ) ;_ end of mapcar
               ) ;_ end of mapcar
               '(lambda (a b) (< (car a) (car b)))
             ) ;_ end of vl-sort
                 ))
            
      ) ;_ end of setq

      
      (if ptLst
        (progn
          (vla-put-textstring
            (vlax-ename->vla-object ENT)
            (strcat STROLD "\\P" (vla-get-textstring (vlax-ename->vla-object ptLst)))
          ) ;_ end of vla-put-textstring
          (vla-put-width (vlax-ename->vla-object ENT) 40)

          (vla-Update (vlax-ename->vla-object ENT))
          
          ;(vla-delete DXFSTR)
       

        (setq ptLst NIL )



       
           ) ;_ end of progn
      ) ;_ end of if


  (setq CNT (+ 1 CNT))
      
    )                                             ;RE

   
    )
    

    
    (princ)
  ) ;_ end of repeat                                                 ;end_defun

;|«Visual LISP© Format Options»
(72 2 50 2 T "end of " 60 9 1 0 0 nil T nil T)
;*** DO NOT add text below the comment! ***|;

 

 

thanks very closed what i want but just one thing actually i want to join Cable length and pole to pole length in on text and this code join both separately, can you modify  

 

[pmadhwal7]

13 hours ago, CyberAngel said:

 

TXT2MTXT has some quirks that I only recently found out about. If you run it without selecting anything, you can access the settings dialog, where you can specify how it runs. There you can specify what order to use when assembling your new mtext. One regrettable feature is that it always changes the justification to top, regardless of the original text.

 

So you can select your text in the order you want it to appear in the mtext. You can even create a single mtext for each text.

actually i used TXT2MTXT but i didn't get proper result what i want

[pmadhwal7]

16 hours ago, Steven P said:

It would be possible to make something up selecting al the 2 line texts and joining them - something like join all the texts where the x coordinates are similar, and you could do a shortcut so you don't need to type txt2mtxt every time (example via LISP (defun ttm ( / ) (command "txt2mtxt")) but you can just make a shortcut up anyway)

problem is i want 2 line text first is cable length and second is pole to pole and TXT2MTXT not giving me proper result

[SLW210]

See if this works for you. Combine text strings - AutoLISP, Visual LISP & DCL - AutoCAD Forums (cadtutor.net)

[hosneyalaa]

6 hours ago, pmadhwal7 said:

thanks very closed what i want but just one thing actually i want to join Cable length and pole to pole length in on text and this code join both separately, can you modify  

Can you attach example text

[pmadhwal7]

30 minutes ago, hosneyalaa said:

Can you attach example text

 

 

YOU CAN CHECK MY ATTAHCED SAMPLE DWG ALSO AND SCREENSHOT ARE BELOW

 

 

 

Edited August 25, 2023 by pmadhwal7

[pmadhwal7]

1 hour ago, SLW210 said:

See if this works for you. Combine text strings - AutoLISP, Visual LISP & DCL - AutoCAD Forums (cadtutor.net)

No not working

[SLW210]

Try Kent Cooper's and other LISPs -- Combine Multiple Mtext into 1 Mtext - Autodesk Community - AutoCAD

 

 

[Steven P]

Ahh, I think I understand: 

Each text selected is on a new line:

 

Cable Length

Pole to Pole

 

and not

cable length pole to pole

 

 

Pulled apart my textjoin lisp for the below. It might refer to other functions, let me know if it does. It is a bit long winded perhaps but it's parent does other stuff such as attributes and dimensions.

 

if you want to spend the time it could do with the text selection being checked or an ssget, single selection with a filter for text, mtext.

This will retain the type of text of the first line selected, in your example drawing it is mtexts and so creating mtexts afterwards.

 

(defun c:test ( / oldvars entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter)
  (defun addinnewtext (newtext newentlist newent / )
  (if (/= newtext nil)
    (progn
      (cond
        ( (= (cdr (assoc 0 newentlist)) "DIMENSION")
          (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist)))
          (entupd newent)
        );end condition

        ( (= (cdr (assoc 0 newentlist)) "RTEXT")
          (princ "\nRtext: Unwilling to update source file (")
          (princ (cdr (assoc 1 newentlist)) )
          (princ ")")
        );end condition
        (t ;everything else
        ;;vla-put-text string for large text blocks + 2000 characters?
          (vla-put-textstring (vlax-ename->vla-object newent) newtext)
        );end condition
      ) ;end cond
    ) ;end progn
    (princ "\nSource text is not 'text'")
  );end if
  ) ; end defum

  (setq deliminator "\n") ;; can adjust this to others later if you want, tab, spaces etc

  (setq ent1 (car (entsel "\nSelect text to retain")))
  (setq entlist1 (entget ent1))
  (setq text1 (cdr (assoc 1 entlist1)))
  (setq txtwidth1 (cdr (assoc 41 entlist1)))

;;loop till cancelled
  (while (setq ent2 (car (entsel "\nSelect text to join")))
    (setq text1 (cdr (assoc 1 (entget ent1))))
    (setq txtwidth1 (cdr (assoc 41 (entget ent1))))
    (setq text2 (cdr (assoc 1 (entget ent2))))
    (setq txtwidth2 (cdr (assoc 41 (entget ent2))))
    (setq entlist2 (entget ent2))

    (if (> txtwidth2 txtwidth1)(setq txtwidth1 txtwidth2))

;;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 text1 deliminator))
    (setq texta (strcat texta text2))

;;;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, new width
    (addinnewtext texta entlist1 ent1)
    (if (= (cdr (assoc 0 entlist1)) "MTEXT")
      (progn
        (setq entlist1 (entget ent1))
        (entmod (setq entlist1 (subst (cons 41 txtwidth1) (assoc 41 entlist1) entlist1)))
        (entupd ent1)
      ) ; end progn
    ) ; end if

    (command "redraw")
    (command "regen") ;;update it all
  );end while
  (princ)
)

 

[pmadhwal7]

12 hours ago, Steven P said:

Ahh, I think I understand: 

Each text selected is on a new line:

 

Cable Length

Pole to Pole

 

and not

cable length pole to pole

 

 

Pulled apart my textjoin lisp for the below. It might refer to other functions, let me know if it does. It is a bit long winded perhaps but it's parent does other stuff such as attributes and dimensions.

 

if you want to spend the time it could do with the text selection being checked or an ssget, single selection with a filter for text, mtext.

This will retain the type of text of the first line selected, in your example drawing it is mtexts and so creating mtexts afterwards.

 

(defun c:test ( / oldvars entcodes ent1 ent2 entlist1 entlist2 text01 text02 text11 text12 entcodes1 entcodes2 acount acounter)
  (defun addinnewtext (newtext newentlist newent / )
  (if (/= newtext nil)
    (progn
      (cond
        ( (= (cdr (assoc 0 newentlist)) "DIMENSION")
          (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist)))
          (entupd newent)
        );end condition

        ( (= (cdr (assoc 0 newentlist)) "RTEXT")
          (princ "\nRtext: Unwilling to update source file (")
          (princ (cdr (assoc 1 newentlist)) )
          (princ ")")
        );end condition
        (t ;everything else
        ;;vla-put-text string for large text blocks + 2000 characters?
          (vla-put-textstring (vlax-ename->vla-object newent) newtext)
        );end condition
      ) ;end cond
    ) ;end progn
    (princ "\nSource text is not 'text'")
  );end if
  ) ; end defum

  (setq deliminator "\n") ;; can adjust this to others later if you want, tab, spaces etc

  (setq ent1 (car (entsel "\nSelect text to retain")))
  (setq entlist1 (entget ent1))
  (setq text1 (cdr (assoc 1 entlist1)))
  (setq txtwidth1 (cdr (assoc 41 entlist1)))

;;loop till cancelled
  (while (setq ent2 (car (entsel "\nSelect text to join")))
    (setq text1 (cdr (assoc 1 (entget ent1))))
    (setq txtwidth1 (cdr (assoc 41 (entget ent1))))
    (setq text2 (cdr (assoc 1 (entget ent2))))
    (setq txtwidth2 (cdr (assoc 41 (entget ent2))))
    (setq entlist2 (entget ent2))

    (if (> txtwidth2 txtwidth1)(setq txtwidth1 txtwidth2))

;;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 text1 deliminator))
    (setq texta (strcat texta text2))

;;;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, new width
    (addinnewtext texta entlist1 ent1)
    (if (= (cdr (assoc 0 entlist1)) "MTEXT")
      (progn
        (setq entlist1 (entget ent1))
        (entmod (setq entlist1 (subst (cons 41 txtwidth1) (assoc 41 entlist1) entlist1)))
        (entupd ent1)
      ) ; end progn
    ) ; end if

    (command "redraw")
    (command "regen") ;;update it all
  );end while
  (princ)
)

 

exactly like this but not picking one by one want to join all by selecting them without moving their position, like Mr. hosneyalaa's lisp  

[pmadhwal7]

13 hours ago, SLW210 said:

Try Kent Cooper's and other LISPs -- Combine Multiple Mtext into 1 Mtext - Autodesk Community - AutoCAD

 

 

actually i used this and only negative point for me is the lisp is that join text one by one and in my dwg i have too many text like that and joining them one by one is taking very long time,