Jump to content

Recommended Posts

Posted (edited)

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.

   image.thumb.png.df2f874a6d0a4a68c3be7e985043aff4.png

pole.dwg

JoinMtext.lsp

Edited by pmadhwal7
  • Replies 24
  • Created
  • Last Reply

Top Posters In This Topic

  • pmadhwal7

    13

  • Steven P

    4

  • hosneyalaa

    3

  • Tsuky

    2

Posted

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

Posted
2 hours ago, Steven P said:

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

yes lisp also attached

Posted

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

Posted

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)

Posted

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! ***|;

 

99.gif

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

Posted
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! ***|;

 

99.gif

 

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  

 

Posted
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

Posted
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

Posted
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

Posted (edited)
30 minutes ago, hosneyalaa said:

Can you attach example text

 

 

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

 

image.thumb.png.95598c28b18c4076a367bcf85f9c9cbc.png

 

image.thumb.png.119c18bbf1c2bd4541149807cd6c7560.png

 

Edited by pmadhwal7
Posted

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

 

Posted
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  

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