求助：单行文字批量转成多行文字时，多行文字的宽度根据单行文字的内容自动调整
本帖最后由 微笑忘记过去 于 2016-7-19 17:49 编辑在工作中，有时需要对单行文字批量遮罩，由于不想用ET自带的那个【文字遮罩】的功能（因为遮罩不能根据文字的移动而移动），故想通过把单行文字批量转换为多行文字之后，再利用多行文字的背景遮罩来实现，但是通过贱人工具箱将单行文字批量转换为多行文字时，转换后的多行文字背景宽度比文字内容多很多，有没有办法实现单行文字批量转成多行文字时，转换后的多行文字的宽度根据单行文字的内容自动调整为最小遮罩背景呢？想实现的效果如下图所示：
本帖最后由 springwillow 于 2015-12-14 16:34 编辑
修改了一版供试用。
感谢 springwillow 分享学习!!! springwillow 发表于 2015-12-14 15:36 static/image/common/back.gif
修改了一版供试用。
谢谢您的大作，我想实现的效果是转换的多行文字不是自动换行的效果，而是各行之间还是独立的，单行文字转换后文字的位置不变。 springwillow 发表于 2015-12-14 15:36 static/image/common/back.gif
修改了一版供试用。
谢谢您的大作，我想实现的效果是转换的多行文字不是自动换行的效果，而是各行之间还是独立的，单行文字转换后文字的位置不变。 ;;Text1MtextJust.lsp
;http://cadtips.cadalyst.com/multiline-text/convert-text-mtext-without-changing-justification
;;TXT2MTXT command does not preserve all aspects of justification.For
;; one selected Text/Attribute-definition entity, retains horizontal component
;; , but always imposes Top for
;; vertical component, regardless of Text entity's original justification.
;;T1MJ converts each selected Text or Attribute-Definition entity separately
;; to Mtext with same or equivalent justification as original Text, including
;; vertical component.
;;"Equivalent" for Text/Attribute justifications not used with Mtext:
;; Left/Center/Right become Bottom-Left/Bottom-Center/Bottom-Right;
;; Middle becomes Middle-Center;
;; Aligned/Fit become Bottom-Center with new insertion point half-way
;; between original Text entity's baseline alignment/fit points, so that
;; any positional change is minimized.
;;Will sometimes result in slight positional change, depending on specific
;; justification involved, text font, and/or whether text content includes
;; characters extending above or below height of capital letters [e.g. lower-
;; case letters with descenders, parentheses/brackets/braces, slashes, etc.].
;;Fit-justified object will retain original height, but lose width adjustment.
;;Kent Cooper, last edited 27 August 2014
;单行文本转多行文本，并且保留对齐方式
(defun C:T1MJ ; = Text or Attribute Definition to 1-line Mtext, retaining Justification
(/ *error* cmde doc tss inc tent tobj tins tjust)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(vla-endundomark doc)
(setvar 'cmdecho cmde)
(princ)
); defun - *error*
(setq
cmde (getvar 'cmdecho)
doc (vla-get-activedocument (vlax-get-acad-object))
); setq
(vla-startundomark doc)
(setvar 'cmdecho 0)
(prompt "\nTo change Text/Attribute to 1-line Mtext, preserving Justification,")
(if (setq tss (ssget "_:L" '((0 . "TEXT"))))
(repeat (setq inc (sslength tss))
(setq
tent (ssname tss (setq inc (1- inc)))
tobj (vlax-ename->vla-object tent)
tins (vlax-get tobj 'TextAlignmentPoint)
tjust (vla-get-Alignment tobj)
); setq
(cond
((= tjust 0) (setq tjust 7 tins (vlax-get tobj 'InsertionPoint))); Left
((< tjust 3) (setq tjust (+ tjust 7))); 1/2 to 8/9
((= tjust 4) (setq tjust 5)); Middle to Middle-Center
((member tjust '(3 5)); Aligned/Fit
(setq
tjust 8 ; to Bottom-Center
tins (mapcar '/ (mapcar '+ (vlax-get tobj 'InsertionPoint) tins) '(2 2 2))
; with new insertion point
); setq
); Aligned/Fit
((setq tjust (- tjust 5))); all vertical-horizontal pair justifications
); cond
(if (= (vla-get-TextString tobj) "") (vla-put-TextString tobj (vla-get-TagString tobj)))
;; if no default content, disappears after TXT2MTXT: impose Tag value for it
;;
(command "_.txt2mtxt" tent ""); convert, then
(setq tobj (vlax-ename->vla-object (entlast))); replace Text as object with new Mtext
(vla-put-AttachmentPoint tobj tjust); original Text's justification
(vlax-put tobj 'InsertionPoint tins); original Text's insertion
); repeat
); if
(setvar 'cmdecho cmde)
(vla-endundomark doc)
(princ)
); defun -- T1MJ
(vl-load-com)
(prompt "\nType T1MJ to change Text/Attribute-Definitions to 1-line Mtext, preserving Justification.")
https://cadtips.cadalyst.com/multiline-text/convert-text-mtext-without-changing-justification?q=multiline-text/convert-text-mtext-without-changing-justification 支持一下，顶起，谢谢各位大佬的分享 xiaomm250 发表于 2020-5-7 14:10
这个好，刚好解决了我，单行转多行的疑问，感谢 xiaomm250 发表于 2020-5-7 14:12
https://cadtips.cadalyst.com/multiline-text/convert-text-mtext-without-changing-justification?q=mult ...
下载不了，能给个附件？
页:
[1]