Lisp to Copy Mtext but paste only the first line
Are the "remaining bottom lines" separate lines as a result of Enter(s) being used to move down to a next line? If so, I can imagine a way to do what you want. Or are they subsequent lines because of word wrapping resulting from the width of the defining box? If so, I'm not sure how one would approach the problem, but there may be a way.
@tiwari1211 wrote:
....Yes, the remaining bottom lines are result of Enter(s). So what i need is to copy only the first line.
Also before doing paste if i have option to enter the text height. this will be great. ....
Here's a fairly quickie approach, lightly tested:
;| CopyMTextLine1.lsp [command name: CMTL1]
To Copy Mtext only up to the first Enter [if any] encountered, with
specification of [new] height, offering current height as default.
Creates new Mtext with [if containing Enter(s)] truncated content,
on same Layer, with same justification, etc., and leaves User in
Move command to specify new location.
If Mtext contains no Enter(s), simply Copies it [with new height if
specified].
NOTE: Width of defining Mtext box is NOT changed, so if height
is increased, word wrapping can occur in result, or if original had
new lines from word wrapping before Enter(s), word wrapping
can change.
Kent Cooper, 9 March 2021
|;
(defun C:CMTL1 ; = Copy MText Line 1 only
(/ mt mtdata mtht ht txt hard soft newtxt)
(if
(and
(setq mt (car (entsel "\nMText object to Copy 1st line of: ")))
(member '(0 . "MTEXT") (setq mtdata (entget mt)))
); and
(progn ; then
(initget 6); no zero, no negative
(setq ht
(cond
( (getdist ; nil on Enter
(strcat
"\nText height <"
(rtos (setq mtht (cdr (assoc 40 mtdata)))); current height default
">: "
); strcat
); getdist
); User-input condition
(mtht); User Enter -- keep current height
); cond
); setq
(if (wcmatch (setq txt (cdr (assoc 1 mtdata))) "*\\P*,*\n*"); contains Enter(s)
(setq ; then
hard (vl-string-search "\\P" txt) ; first "hard" Enter if any
soft (vl-string-search "\n" txt) ; first "soft" Enter [Shift+Enter] if any
newtxt (substr txt 1 (apply 'min (vl-remove nil (list hard soft))))
; from beginning to first type of Enter encountered
); setq
(setq newtxt txt); no Enter(s) -- keep
); if
(entmake
(append
(subst (cons 1 newtxt) (assoc 1 mtdata) mtdata); new content
(list (cons 40 ht)); new height
); append
); entmake
(command "_.move" (entlast) "" "_none" (cdr (assoc 10 mtdata)))
); progn
); if
); defun
Note the NOTE. If it's important to have the remaining first line "look" the same even at a different size, i.e. to also adjust the Mtext defining box width, it could be altered to use a SCALE command, rather than assigning the new height in entity data.
The height is about that of the "outer" Mtext object. Anything like a height override inside the Mtext will remain, though since that is assigned proportionally in the text-string formatting, not as an absolute height, the proportion will remain relative to the new height.
Note also that if there is word wrapping from the width of the MText defining box before an Enter is encountered, all content up to the Enter will remain even though wrapped to more than one line.
@john.uhden wrote:
Pretty good, Moshe, but Kent covered the soft returns also (he's learning quite well). 😁
I thought you'd appreciate that. [And the height request.]
@tiwari1211 wrote:
.... What to change in your code, if i want to keep Text height 10 as default ?
In that case i do not need the Text height option too. ....
If you want the new Mtext always at a height of 10 units, regardless of the source Mtext's height, and without asking the User, this should do [minimally tested]:
;| CopyMTextLine1-ht10.lsp [command name: CMTL1]
To Copy Mtext only up to the first Enter [if any] encountered, with
height of 10 units regardless of current height.
Creates new Mtext with [if containing Enter(s)] truncated content,
on same Layer, with same justification, etc., and leaves User in
Move command to specify new location.
If Mtext contains no Enter(s), simply Copies it [with new height if
not originally 10 units].
NOTE: Width of defining Mtext box is NOT changed, so word
wrapping can occur in result if height is increased, or if original had
new lines from word wrapping before first Enter, word wrapping
can change.
Kent Cooper, 10 March 2021
|;
(defun C:CMTL1 ; = Copy MText Line 1 only
(/ mt mtdata txt hard soft newtxt)
(if
(and
(setq mt (car (entsel "\nMText object to Copy 1st line of: ")))
(member '(0 . "MTEXT") (setq mtdata (entget mt)))
); and
(progn ; then
(initget 6); no zero, no negative
(if (wcmatch (setq txt (cdr (assoc 1 mtdata))) "*\\P*,*\n*"); contains Enter(s)
(setq ; then
hard (vl-string-search "\\P" txt) ; first "hard" Enter if any
soft (vl-string-search "\n" txt) ; first "soft" Enter [Shift+Enter] if any
newtxt (substr txt 1 (apply 'min (vl-remove nil (list hard soft))))
; from beginning to first type of Enter encountered
); setq
(setq newtxt txt); no Enter(s) -- keep
); if
(entmake
(append
(subst (cons 1 newtxt) (assoc 1 mtdata) mtdata); truncated text
'((40 . 10.0)); fixed height
); append
); entmake
(command "_.move" (entlast) "" "_none" (cdr (assoc 10 mtdata)))
); progn
); if
); defunIt could also be made to always offer 10 units as the default, but still allow the User to call for something else if they want, or to keep the source Mtext's height.
@tiwari1211 wrote:
... i need the new text with height 10 in Layer "0". will it be possible. ....
Change this line:
'((40 . 10.0)); fixed height
to this:
'((8 . "0") (40 . 10.0)); Layer 0 & fixed height
A followup question:
Do these ever have a lot of content, like a heading followed by an Enter [or two] and a long paragraph of text, where you want to Copy only the heading? A content entry can hold only up to 250 characters, so if it's longer than that, the text content will start in an (assoc 3) entry in entity data, and maybe more of those if needed, with the (assoc 1) entry [never more than one of those] being the last content container, holding only the end of the overall content, beyond some multiple of 250 characters. So in my example situation, if you want to take only the heading, that will need to be pulled from the first (assoc 3) entry [when there are any], not from the (assoc 1) entry. And the revised entity data would need to have any (assoc 3) entries removed, leaving only the (assoc 1) entry with the truncated content in it.
Is that a possible situation that should be accounted for, in the kinds of things you would use this on?
@tiwari1211 wrote:
Dear Lisp experts. I hope you all are doing well.
Do we have any Lisp to copy only the first line of MTEXT. I have many drawings where i need to copy only the first line to other position. presently i use copy command and then manually delete the remaining bottom lines. I dont want to explode the MTEXT.
Can anyone help me in this. Thank you very much
Also works on altered width: [ no "\\P" found on string ]
;;; Lee Mac | 11-25-2013 ;;;
(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))))))
)
(defun c:tfs ( / ent no1 remain obj pos str tmp )
;; pBe | Mar 2021 hmsilva | 11-24-2013 ;;
(if (setq ent (car (entsel "\nMText object to Copy 1st line of: ")))
(progn
(setq no1 (mattrib-number-of-lines ent)
)
(setq remain (vlax-invoke (vlax-ename->vla-object ent) 'Copy ))
(while (> no1 1)
(setq str (vla-get-textstring remain) pos 0 )
(while (setq tmp (vl-string-search "\\P" str pos))
(setq pos (+ tmp 2))
)
(vla-put-textstring
remain (substr str
1 (max (- pos 2)
(cond ((vl-string-position 32 str nil t))
(0)
)
)
)
)
(vla-update remain)
(setq no1 (mattrib-number-of-lines (vlax-vla-object->ename remain)))
)
(mapcar '(lambda (d)
(vlax-put remain (car d) (cadr d))
)
'(("Layer" 0) ("Height" 10.0))
)
(vl-cmdf "_.move"
(vlax-vla-object->ename remain)
""
"_none"
(Vlax-get remain 'Insertionpoint)
)
)
)
(princ)
)
Take First Stringline
command: TFS
HTH
