Lisp to Copy Mtext but paste only the first line
@tiwari1211 wrote:
.... will it be possible for you to add option for text rotation too in your code ?
So, when i copy the Mtext it ask for rotation angle. by default 0 deg. ....
Try this [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, and at User-specified
rotation [default 0].
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, 15 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
(initget 4); no negative
(setq rot
(cond
((getangle "\nText rotation <0>: ")); nil on Enter
(0.0); User Enter
); cond
); setq
(entmake
(append
(subst (cons 1 newtxt) (assoc 1 mtdata) mtdata); truncated text
'((8 . "0") (40 . 10.0)); Layer 0 & fixed height
(list (cons 50 rot))
); append
); entmake
(command "_.move" (entlast) "" "_none" (cdr (assoc 10 mtdata)))
); progn
); if
); defun
I suppose it could be altered to offer the current rotation as an option, or to save your latest rotation choice as the default, instead of always 0.
@tiwari1211 wrote:
... i am saving solidworks drawings to Autocad. In solidworks if the text is single line then it save to Mtext in Acad and Multiple line text to Block. .... I dont know if there is any way to save the solidworks multiple line text to MTEXT in autocad. Hence i am planning to change my text in solidworks to Single line eg. 9384-001.1b/1.4404/316L-1x
Now my new requirement is to copy only bold text and not -1x
....
What happens if you EXPLODE the Block that Solidworks exports from Multi-line Text? Does it result in Mtext or in multiple plain Text objects?
What are the criteria for differentiating what you want to copy and what you want omitted? Copy everything until the last hyphen found, and leave out the rest? Copy everything except the last three characters? Copy everything except characters connected with an 'x'? If hyphen-based, since there are more than one hyphen in your example, might the cut-off ever need to be at one other than the last one? Etc.
Try this [untested]:
(defun C:CMTNQ; = Copy MText with No Quantity suffix
(/ mt mtdata txt newtxt rot)
(command "_.layer" "_make" "YourLayerName" "_color" 2 "" "")
(if
(and
(setq mt (car (entsel "\nMText object to Copy with No Quantity suffix: ")))
(member '(0 . "MTEXT") (setq mtdata (entget mt)))
); and
(progn ; then
(if (wcmatch (setq txt (cdr (assoc 1 mtdata))) "*-*"); contains hyphen(s)
(setq newtxt (substr txt 1 (vl-string-position 44 txt) T))
; from beginning to last hyphen encountered
(setq newtxt txt); else [no Enter(s)] -- keep
); if
(initget 4); no negative
(setq rot
(cond
((getangle "\nText rotation <0>: ")); nil on Enter
(0.0); User Enter
); cond
); setq
(entmake
(append
(subst (cons 1 newtxt) (assoc 1 mtdata) mtdata); truncated text
'((8 . "YourLayerName") (40 . 10.0)); Layer 0 & fixed height
(list (cons 50 rot))
); append
); entmake
(command "_.move" (entlast) "" "_none" (cdr (assoc 10 mtdata)))
); progn
); if
); defun
@tiwari1211 wrote:
... it is giving error as below in Autocad and stop-
Can you please have a look and suggest. Thank you very much!!
....
MText object to Copy with No Quantity suffix: ; error: too many arguments
....
It looks like I had a parenthesis in the wrong place. Try changing this line:
(setq newtxt (substr txt 1 (vl-string-position 44 txt) T))to this:
(setq newtxt (substr txt 1 (vl-string-position 44 txt T)))
One more try, same line:
(setq newtxt (substr txt 1 (vl-string-position 44 txt 1 T)))
@tiwari1211 wrote:
.... Now it copy the complete Mtext and not only till the *-* hyphen. ....
Sorry about that.... The where-to-stop code came from something that was looking for commas, and I forgot to change the ASCII index number. Change the 44 to 45.
@tiwari1211 wrote:
.... the color changed to ByBlock (White) and in not in Bylayer (yellow). ....
There wasn't anything about color before, so I expect it wasn't "changed" but came that way. But it's easily fixed -- add the '((62 . 256)) line for "ByLayer" color:
(entmake
(append
(subst (cons 1 newtxt) (assoc 1 mtdata) mtdata); truncated text
'((8 . "YourLayerName") (40 . 10.0)); Layer 0 & fixed height
(list (cons 50 rot))
'((62 . 256))
); append
); entmake
Try:
(if (wcmatch (setq txt (cdr (assoc 1 mtdata))) "*/*"); contains slash(es)
(setq newtxt (substr txt 1 (vl-string-position 47 txt 1))) ;; without the T
; from beginning to first slash encountered
Hi Kent,
Thanks this works very well.
Also, I generate a part list using this text (1497-1/1.4000/410S-2x) using a excel macro. Macro reads all the Mtext available in model space in "E-text" layer and creates table as shown below. After that i copy this table in Autocad.
Is it possible to generate this table directly in Autocad ?
I can share the excel macro if require.
Would be great if i get your help in this.
Many thanks
