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))
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.
--
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
Try this routine that I have just written it for your request
(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) )
@bireshwar.mallick wrote:
Thanks a lot it worked.
Excellent , You're welcome .
You can mark the thread as SOLVED now .
@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!].
Would you settle for a workaround?
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
pBe , that does not work on formated mtext entities .
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 . 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 .
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.
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 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 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.
It looked fun to code, so, here it is my attempt...
With the help of a Lee Mac's subroutine... Thanks Lee!
(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
@hmsilva wrote:
.... here it is my attempt...
HTH
Henrique
Clever approach Henrique, one word at a time 'til .
@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
Very good Henrique!
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)