匹配属性文本

Ocron · 发表于 2022-7-6 10:19:34

你好

我只是想知道是否有LISP例程，或者是否可以在ACAD中完成。我已经搜索了网站和ACAD帮助菜单（现在似乎没什么用），但也找不到任何改变设置以实现我想要的功能的方法。

我基本上需要的是为文本提供一个“匹配属性”命令，该命令将匹配除旋转之外的所有属性，就像普通命令一样。因此，如果我点击我的源文本，它以30度角旋转，我将其与45度角的文本匹配，它不会使新文本像原始文本一样处于30度角。在ACAD中有没有一种方法可以做到这一点，或者我还没有找到一个LISP例程可以帮我做到这一点？

非常感谢。

Lt Dan's l · 发表于 2022-7-6 10:24:59

copy

(defun c:Mt (/ *error* ent # a ss)
 (defun *error* (msg)
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **"))
   )
   (setvar 'nomutt 0)
   (if (not ent)(redraw)
     (redraw (cdr (car ent)) 4))
   (princ)
 )
 (while
   (not
     (and
(setq ent (car (entsel "\nSpecify text to copy: ")))
(or
         (eq "TEXT" (cdr (assoc 0 (setq ent (entget ent)))))
  (eq "MTEXT" (cdr (assoc 0 ent)))
  (eq "DIMENSION" (cdr (assoc 0 ent)))
)
     )
   )
   (prompt "\nPlease Select text!")
 )
 (redraw (cdr (car ent)) 3)
 (prompt "\nSpecify objects to modify: ")
 (setvar 'nomutt 1)
 (repeat (setq # (sslength (setq ss (ssget '((0 . "text,mtext,dimension"))))))
   (setq a (entget (ssname ss (setq # (1- #)))))
   (entmod (subst (cons 1 (cdr (assoc 1 ent)))(assoc 1 a) a))
 )
 (redraw (cdr (car ent)) 4)
 (setvar 'nomutt 0)
 (princ)
)