[LISP程序]：超级文本格式刷，欢迎大家使用及测试！

Dallas_whu

(Defun C:Mt (/ Oldblp Oldech Key I Ent1        En Ss Nel Val_List J List_Len
             Val El N)
   (Initget "N G Q T Y X C A")
  (Setq
    Key
     (Getkword
       "\N/内容(N)/高度(G)/图层(C)/样式(Y)/倾斜角(Q)/旋转角(X)/高宽比(W)/全部(A)/(默认A): "
     )
  )
  (Cond
    ((= Key "N") (Setq I 1))
    ((= Key "G") (Setq I 40))
    ((= Key "C") (Setq I 8))
    ((= Key "Y") (Setq I 7))
    ((= Key "Q") (Setq I 51))
    ((= Key "X") (Setq I 50))
    ((= Key "W") (Setq I 41))
    ((= Key "A") (Setq I 0))
    (T (Setq I 0))
  )
  (Setq Ent1 (Car (Entsel "\N先点选源文本:")))
  (While (= Ent1 Nil)
    (Princ "\N没有选中文本对象！")
    (Setq Ent1 (Car (Entsel "\先点选源文本:")))
    )
  (Setq En (Entget Ent1))
  (While (/= "Text" (Cdr (Assoc 0 En)))
    (Progn
      (Princ "对象不是文本，重新选择！")
      (Setq Ent1 (Car (Entsel "\N先点选源文本:")))
      (Setq En (Entget Ent1))
    )
  )
  (Princ "\N再选择目标文本：")
  (If (Setq Ss (Ssget '((0 . "Text"))))
    (Progn
      (Setq N 0)
      (While (< N (Sslength Ss))
        (Setq El (Entget (Ssname Ss N)))
        (If (= I 0)
          (Progn
            (Setq J 0)
            (Setq Val_List (List 1 40 8 7 50 51 41))
            (Setq List_Len (Length Val_List))
            (While (< J List_Len)
              (Setq Val (Nth J Val_List))
              (Setq El
                     (Entmod (Subst
                               (Cons Val (Cdr (Assoc Val En)))
                               (Assoc Val El)
                               El
                             )
                     )
              )
              (Setq J (1+ J))
            )
          )
          (Progn
            (Setq Val I)
            (Setq El
                   (Entmod (Subst
                             (Cons Val (Cdr (Assoc Val En)))
                             (Assoc Val El)
                             El
                           )
                   )
            )
          )
        )
        (Setq N (1+ N))
      )
    )
  )
    (Princ)
)