Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Urgent Help required : LISP for deleting last line of a MText

26 REPLIES 26
Reply
Message 1 of 27
bireshwar.mallick
1695 Views, 26 Replies

Urgent Help required : LISP for deleting last line of a MText

Good morning!! We are requiring a lisp to delete last line of any MText on a click. I have a one that deletes last word of an MText on a click but the issue is that I cannot make the last line to delete instead it deletes the last word. Can you please help me out. I am a regular java programmer and not so expertise in lisp. It will be of a good gesture if you please help me out as it is really required for a project in which last line of a MText can be deleted. I am here by stating the lsp for your reference.

Best Regards,

Bireshwar Mallick

/*Deletes the last word instead of the last line*/

(defun c:33 ( / ss)
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    ((lambda (i / e ed s)
       (while (setq e (ssname ss (setq i (1+ i))))
         (setq ed (entget e))
         (setq s (assoc 1 ed))
         (setq ed (subst (cons 1 (substr (cdr s) 1 (1- (strlen (cdr s))))) s ed))
         (entmod ed)))
        
      -1)
    (prompt "\n** Nothing selected ** "))
  (princ))

Bireshwar
26 REPLIES 26
Message 2 of 27

 

Seems to me that your program deletes the last character, not the last word.

 

Anyway, the contents of the Mtext are handled as an ordinary Lisp string, with line breaks marked by \P (shown as \\P in a string).

 

So, write something that finds the location of the last \P in the string and cut it there.

 

--

 

Message 3 of 27

Dear Martti,

Thanks a lot for the update. I tried but I am finding difficult to code the logic as stated by you. Though I am a java developer professionally I have a fresh hand with Autolisps and your help will be indeed very fruitful for futher learning.

Best Regards,

Bireshwar

Bireshwar
Message 4 of 27

Try this routine that I have just written it for your request Smiley Happy

 

(defun c:Test (/ s in en st str x i)
  ;; 	--=={ Tharwat 22.11.2013 }==--	;;
  (if (setq s (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq in (sslength s))
      (setq en  (entget (ssname s (setq in (1- in))))
            st  (cdr (assoc 1 en))
            str st
            x   0
      )
      (while (setq i (vl-string-search "\\P" st))
        (setq x  (1+ x)
              st (substr st (+ i 3))
        )
      )
      (if (> x 0)
        (entmod
          (subst
            (cons 1 (substr str 1 (- (strlen str) (+ 2 (strlen st)))))
            (assoc 1 en)
            en
          )
        )
      )
    )
  )
  (princ)
)

 

Message 5 of 27

Thanks a lot it worked.
Bireshwar
Message 6 of 27


@bireshwar.mallick wrote:
Thanks a lot it worked.

Excellent , You're welcome .

 

You can mark the thread as SOLVED now . Smiley Happy

Message 7 of 27


@bireshwar.mallick wrote:

....We are requiring a lisp to delete last line of any MText on a click. I have a one that deletes last word of an MText on a click but the issue is that I cannot make the last line to delete instead it deletes the last word. ....


By the "last line" of an Mtext entity, do you mean everything after the last actual Enter [or hard return or line break] in it?  That is the \\P that Martti mentioned, and what Tharwat's routine uses, removing the last one of those and everything after it.

 

Or might you want to remove the last line as the Mtext is displayed?  Whenever that is the last line not because of an Enter, it can of course be altered by changing the width of the Mtext's defining box so that lines wrap in different places.  A routine will not be able to find the last line-wrapping point from the entity data string content or from VLA properties.  It could find the width of the box, but where the lines wrap will depend on the relationship between that and the particular characters in the string and the font and the height and any overrides of those in the content.  Whether there's some more esoteric way of calculating the locations of line breaks, I couldn't say, but I'm doubtful [now someone prove me wrong!].

Kent Cooper, AIA
Message 8 of 27
pbejse
in reply to: Kent1Cooper

Would you settle for a workaround?

  • Select MTEXT
  • copy the MTEXT,
  • explode ,
  • grab the lowest level string
  • Remove string from selected MTEXT
  • Delete copied TEXT

 

Not thorougly tested

 

(defun c:demo ( / ss i en el s2 str2rem )
(setvar 'cmdecho 0)  
  	(setq ss (ssget "_:L" '((0 . "MTEXT"))))
  		(repeat (setq i (sslength ss))
			(setq en (ssname ss (setq i (1- i)))
			      el (entlast)
			      s2 (ssadd)
			)
		  	(command "_copy" en "" '(0.0 0.0) "@")
			(command "_.explode" "_last")
			(while (setq el (entnext el))
			  (ssadd el s2)
			)
		  	(setq str2rem (cdr (assoc 1 (entget (ssname s2 (1- (sslength s2)))))))
		  	(vla-put-textstring (setq en (vlax-ename->vla-object en))
			  (vl-string-right-trim (strcat "\\P" str2rem) (vla-get-textstring en)))
		  	(command "_erase" s2 "")
		  )(princ)
  )

 HTH

 

Message 9 of 27
_Tharwat
in reply to: pbejse

pBe , that does not work on formated mtext entities .

Message 10 of 27
marko_ribar
in reply to: _Tharwat

Just a little more experimenting and you'd get I did...

 

(defun c:remlastmtxtline ( / ss i mt )
  (while
    (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
      (progn
        (setq i -1)
        (while (setq mt (ssname ss (setq i (1+ i))))
          (command "_.explode" mt "")
          (entdel (ssname (ssget "_X" '((0 . "TEXT"))) 0))
          (command "_.txt2mtxt" (ssget "_P") "")
        )
        nil
      )
      (progn (prompt "\nEmpty sel. set... Try again...") t)
    )
  )
  (princ)
)

(defun c:rlmtxtl nil (c:remlastmtxtline))
(prompt "\n...Run with : 'RLMTXTL'...")
(princ)

 

HTH, M.R.

 

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 11 of 27
_Tharwat
in reply to: marko_ribar

Marko . you'd have a very odd result if the Mtext entitiy has any underline string , besides that if you run your code on a single Mtext it would be removed entirely .

Message 12 of 27
marko_ribar
in reply to: _Tharwat

Yes, Tharwat you're right for underline mtext, but if that's the case, I would use the same code I posted with just removed line for converting text to mtext... And yes, if mtext has only one line it would be removed entirely, but that was last line and OP's initial reqest... So perhaps, variant of code that will check for %%U characters in front of text strings, and converting to mtext only text that don't have preceeding %%U prefix...

 

(defun c:remlastmtxtline ( / ss i mt sss ii txt tst ssss )
  (while
    (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
      (progn
        (setq i -1)
        (while (setq mt (ssname ss (setq i (1+ i))))
          (command "_.explode" mt "")
          (entdel (ssname (ssget "_X" '((0 . "TEXT"))) 0))
          (setq sss (acet-ss-remove ssss (ssget "_P")))
          (setq ii -1)
          (while (setq txt (ssname sss (setq ii (1+ ii))))
            (if (eq (substr (cdr (assoc 1 (entget txt))) 1 3) "%%U") (setq tst (cons t tst)) (setq tst (cons nil tst)))
          )
          (if (not (eval (cons 'or tst)))
            (command "_.txt2mtxt" sss "")
          )
          (setq tst nil)
          (setq ssss (acet-ss-union (list sss ssss)))
        )
        nil
      )
      (progn (prompt "\nEmpty sel. set... Try again...") t)
    )
  )
  (princ)
)

(defun c:rlmtxtl nil (c:remlastmtxtline))
(prompt "\n...Run with : 'RLMTXTL'...")
(princ)

 

HTH, M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 13 of 27
marko_ribar
in reply to: marko_ribar

My apology, it won't remove last line if lines have words that are underlined or overlined... Explode command will turn this line to separate text entities, and therefore those last sintagmas (underlined or overlined) will be removed... I think OP's request must be related only to Mtexts that doesn't have any underline or overline text, or to Mtexts that are completely underlined, or Mtexts that are completely overlined, or Mtexts that are completely both underlined and overlined... Otherwise last line will actually be last sintagma with this markers... Furthere more just mentioned types of Mtexts won't be converted back to Mtexts except the case when Mtexts are completely non-underlined and non-overlined - normal ordinary Mtext... What is lack even more is the fact that other Mtext properties like Bold ans Italic will be lost as text entities don't have them... Only way is through usage of textstyles witch are used while creating Mtexts, so that after explode command new text entities overtake textstyle defined while creating Mtexts... So my code is therefore slightly changed - used (wcmatch) instead of (eq (substr ...) "%%U")

 

(defun c:remlastmtxtline ( / ss i mt sss ii txt tst ssss )
  (while
    (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
      (progn
        (setq i -1)
        (while (setq mt (ssname ss (setq i (1+ i))))
          (command "_.explode" mt "")
          (entdel (ssname (ssget "_X" '((0 . "TEXT"))) 0))
          (setq sss (acet-ss-remove ssss (ssget "_P")))
          (setq ii -1)
          (while (setq txt (ssname sss (setq ii (1+ ii))))
            (if (or (wcmatch (cdr (assoc 1 (entget txt))) "*%%U*") (wcmatch (cdr (assoc 1 (entget txt))) "*%%O*"))
              (setq tst (cons t tst)) 
              (setq tst (cons nil tst))
            )
          )
          (if (not (eval (cons 'or tst)))
            (command "_.txt2mtxt" sss "")
          )
          (setq tst nil)
          (setq ssss (acet-ss-union (list sss ssss)))
        )
        nil
      )
      (progn (prompt "\nEmpty sel. set... Try again...") t)
    )
  )
  (princ)
)

(defun c:rlmtxtl nil (c:remlastmtxtline))
(prompt "\n...Run with : 'RLMTXTL'...")
(princ)

 M.R.

If the code is useless than, OP may consider these above stated remarks in order to make future tasks possible to realize...

IMHO

HTH

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 14 of 27
pbejse
in reply to: marko_ribar


@marko_ribar wrote:

Just a little more experimenting and you'd get I did...

 

.... (command "_.txt2mtxt" (ssget "_P") "")....

 

HTH, M.R.

 


That is to assume user have Express Tools installed.

 

@ tharwat 

 

The purpose of the test code is to capture the last line of Mtext line wrapping by an altered width. [not using "Enter" or "\\P"]

 

Message 15 of 27
marko_ribar
in reply to: pbejse


@pbejse wrote:

@marko_ribar wrote:

Just a little more experimenting and you'd get I did...

 

.... (command "_.txt2mtxt" (ssget "_P") "")....

 

HTH, M.R.

 


That is to assume user have Express Tools installed.

 

@ tharwat 

 

The purpose of the test code is to capture the last line of Mtext line wrapping by an altered width. [not using "Enter" or "\\P"]

 


@pbejse, if user, OP, or you don't have installed Express Tools, than you may assume that I am Mickey Mouse... Your version is good, except it doesn't remove line if Mtext properties are set like Bold/Italic/Underline/Overline... My version will remove it, but will loose this properties Bold/Italic, so I said that textstyles must be used to compensate this lack, and as I already suggested Underline/Overline must be used completely on all Mtext text in order for last line to be removed properly (those texts will remain text entities, bucause after converting them back to Mtext entity, strange prefixes will occur (%%U for underline and %%O for overline)...

 

So if I may coclude : your code is more standard, but won't operate and on Mtexts that have exotic properties settings; my code will deal with them all, but expect that if Mtexts aren't uniformly set with Mtext properties, result may be removing last sintagmas instead of last line of Mtext...

 

My suggestion is my code, if apsolutelu sure you want to remove all Mtexts last line for uniformly set properties and deal afterwards with textstyles options text properties Bold/Italic/Bold&Italic...

 

If the situation is likewise that only unique uniformly unset Mtexts without properties : Bold/Italic/Unerline/Overline are to be processed than both my and your version (c:demo) is useful... So these 2 codes may be solution... Let's leave to OP to decide witch one will be marked as solved problem... My kudos to you pbejse for firstly applying method of exploding Mtexts...

 

M.R.

Marko Ribar, d.i.a. (graduated engineer of architecture)
Message 16 of 27
hmsilva
in reply to: bireshwar.mallick

It looked fun to code, so, here it is my attempt...


With the help of a Lee Mac's subroutine... Thanks Lee! Smiley Wink

 

(defun c:rlmtl (/ E EN I MTEXT N N1 N2 NX SS STR STR1);;Remove Last MText Line
  (if (setq ss (ssget "_:L" '((0 . "MTEXT"))))
    (repeat (setq i (sslength ss))
      (setq e (ssname ss (setq i (1- i))))
      (if (and (setq n (mattrib-number-of-lines e))
	       (> n 1)
	  );; and
	(progn
	  (setq	mtext (vlax-ename->vla-object e)
		nx    (1- n)
	  )
	  (while (/= n nx)
	    (setq str (vla-get-TextString mtext)
		  n1  1
		  n2  1
	    )
	    (while (vl-string-search "\\P" str n1)
	      (setq n1 (1+ n1))
	    )
	    (while (vl-string-search " " str n2)
	      (setq n2 (1+ n2))
	    )
	    (if	(> n2 n1)
	      (setq str1 (substr str 1 (- n2 1)))
	      (setq str1 (substr str 1 (- n1 1)))
	    )
	    (vla-put-TextString mtext str1)
	    (vla-update mtext)
	    (setq n (mattrib-number-of-lines e))
	    (if (< n nx)(setq n nx))
	  );; while
	);; progn
      );; if
    );; repeat
  );; if

  ;; -- auxiliary functions --

  (vl-load-com)

  ;; by Lee Mac
  ;; http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Determining-the-number-of-lines-in-a-...
  (defun mattrib-number-of-lines (ent / box enx)
    (setq enx (entget ent)
	  box (textbox (list '(1 . "A") (assoc 7 enx) (assoc 40 enx)))
    )
    (1+ (fix (/ (cdr (assoc 43 enx)) (* 1.66 (- (cadadr box) (cadar box))))))
  )
  ;; mattrib-number-of-lines
  (princ)
);; rlmtl
(princ "\nType \"rlmtl\" to Run : ")

 

HTH

Henrique

EESignature

Message 17 of 27
pbejse
in reply to: hmsilva

@hmsilva wrote:

.... here it is my attempt...

 

HTH

Henrique


 

Clever approach Henrique, one word at a time 'til  . Smiley Happy 

 


@marko_ribar wrote:

@pbejse wrote:

That is to assume user have Express Tools installed. 

 


@pbejse, if user, OP, or you don't have installed Express ...

 

M.R.


I'm just saying with more "experimenting" you can do away with ET functions. 

 

Nice workaround nonetheless M.R.

 

EDIT: I see that LM use the 1/3 rule. 1.66 <--- nice

Message 18 of 27
hmsilva
in reply to: pbejse


@pbejse wrote:

 

Clever approach Henrique, one word at a time 'til  . Smiley Happy 

 


Thank you! pbejse Smiley Happy

 

Cheers

Henrique

EESignature

Message 19 of 27
Lee_Mac
in reply to: hmsilva

Very good Henrique! Smiley Happy

 

For what it's worth, here are my suggestions for the code based on your idea:

 

(defun c:rlmtl ( / ent idx no1 no2 obj pos sel str tmp )
    (if (setq sel (ssget "_:L" '((0 . "MTEXT"))))
        (repeat (setq idx (sslength sel))
            (setq ent (ssname sel (setq idx (1- idx)))
                  no1 (mattrib-number-of-lines ent)
            )
            (if (< 1 no1)
                (progn
                    (setq obj (vlax-ename->vla-object ent)
                          no2 (1- no1)
                    )
                    (while (< no2 no1)
                        (setq str (vla-get-textstring obj)
                              pos 0
                        )
                        (while (setq tmp (vl-string-search "\\P" str pos))
                            (setq pos (+ tmp 2))
                        )
                        (vla-put-textstring obj (substr str 1 (max (- pos 2) (cond ((vl-string-position 32 str nil t)) (0)))))
                        (vla-update obj)
                        (setq no1 (mattrib-number-of-lines ent))
                    )
                )
            )
        )
    )
    (princ)
)

;; by Lee Mac
;; http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/Determining-the-number-of-lines-in-a-...
(defun mattrib-number-of-lines (ent / box enx)
    (setq enx (entget ent)
          box (textbox (list '(1 . "A") (assoc 7 enx) (assoc 40 enx)))
    )
    (1+ (fix (/ (cdr (assoc 43 enx)) (* 1.66 (- (cadadr box) (cadar box))))))
)

(vl-load-com)
(princ "\nType \"rlmtl\" to Run : ")
(princ)
Message 20 of 27
hmsilva
in reply to: Lee_Mac


@Lee_Mac wrote:

Very good Henrique! Smiley Happy

 


Thank you! Lee

 

Nice modification! Smiley Happy

Cheers

Henrique

EESignature

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost