0

我有以下代码。它可以在不移动 AutoCAD 中的文本块的情况下将文本创建为 mtext。我想要这个脚本，但将文本行组合成某个区域内的一个块。如在某个图层的文本块的南北 5 个单位内创建一个多行文本块。

(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,ATTDEF"))))
    (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 [Center/Right] 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
        ;; [to use Prompt value instead, change end to (vla-get-PromptString tobj).]
      (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 [or equiv.]
      (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.")
4

1 回答 1

0

我不是一个 lisp 程序员，所以我不能给你一个直接的答案，但我将向你描述一个你应该能够复制的概念。

如果您在此处查看此 Web 资源，则它讨论了Express 工具之一：TXT2MTXT

TXT2MTX

现在，这是一个命令行例程，它需要一个选择集并将TEXT转换为MTEX​​T对象：

文本

所以，我不明白为什么你不能使用 lisp 来制作文本对象的本地化选择集，然后将此选择集传递给TXT2MTXT命令。我知道用 lisp 可以做这种事情。我只是不懂机械。我知道VBA。

我希望这对您解决您的问题有所帮助。它没有显示代码，但它描述了如何做你想做的事情的概念。

于 2017-07-16T16:53:14.097 回答