如何修改MTEXT的文字宽度比例系数?

lisp_beginner · 发表于 2017-5-13 11:28:39

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

TEXT的我会了，MTEXT的宽度系数怎么修改？请大师赐教。

marting · 发表于 2017-5-13 12:16:26

MTEXT的文字宽度系数里面可以分开，多段的设置，用格式码："{\\Wxxxx; ，所以修改这个宽度系数，整体都改的话
1、搜索已经有的宽度格式化的代码，去掉
2、增加新的 "{\\Wxxxx;

(defun c:tt (/ elst ent i joindatosxp ss str)
(setq *datosxp* (cond
((getreal (strcat "\n输入MTEXT的文字宽度比例系数 <"
(rtos (setq *datosxp* (cond
(*datosxp*)
(0.75)
)
)
2 2
) ">: "
)
)
)
(*datosxp*)
)
)
(setq joindatosxp (strcat "{\\W" (rtos *datosxp* 2 2) ";"))
(if (setq i -1
ss (ssget "_:L" '((0 . "MTEXT")))
)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq str (cdr (assoc 1 (setq elst (entget ent)))))
(while (wcmatch str "{\\W*")
(setq str (vl-string-right-trim "}" (substr str (+ 2
(vl-string-search ";" str)
)
)
)
)
)
(entmod (subst
(cons 1 (strcat joindatosxp str "}"))
(assoc 1 elst)
elst
)
)
)
)
(princ)
)

(defun c:tt (/ elst ent i joindatosxp ss str) 
  (setq *datosxp* (cond 
                    ((getreal (strcat "\n输入MTEXT的文字宽度比例系数 <" 
                                      (rtos (setq *datosxp* (cond 
                                                              (*datosxp*) 
                                                              (0.75) 
                                                            ) 
                                            ) 
                                            2 2 
                                      ) ">: " 
                              ) 
                     ) 
                    ) 
                    (*datosxp*) 
                  ) 
  ) 
  (setq joindatosxp (strcat "{\\W" (rtos *datosxp* 2 2) ";")) 
  (if (setq i -1 
            ss (ssget "_:L" '((0 . "MTEXT"))) 
      ) 
    (while (setq ent (ssname ss (setq i (1+ i)))) 
      (setq str (cdr (assoc 1 (setq elst (entget ent))))) 
      (while (wcmatch str "{\\W*") 
        (setq str (vl-string-right-trim "}" (substr str (+ 2 
                                                           (vl-string-search ";" str) 
                                                        ) 
                                            ) 
                  ) 
        ) 
      ) 
      (entmod (subst 
                (cons 1 (strcat joindatosxp str "}")) 
                (assoc 1 elst) 
                elst 
              ) 
      ) 
    ) 
  ) 
  (princ) 
)

sh_h · 发表于 2017-5-13 13:12:10

marting 发表于 2017-5-13 12:16

大师，我就把您这段代码粘贴的cad里，然后加载这段代码，好像只能改部分段落！不能全改！
另外，您为什么不在自己的代码里留下自己的信息呀？
最后感谢大师的无私奉献！

marting · 发表于 2017-5-13 14:30:16

本帖最后由 marting 于 2017-5-13 14:31 编辑

sh_h 发表于 2017-5-13 13:12

谢谢建议，我贴的代码有些是自己码的，有些是以前的收集，时间都很长远，大都没出处了，所以我贴的代码就不写我自己的信息了，代码共享，谁写的无所谓。

-----------------------------------------------------------------------------------------------------------

2楼的代码仅仅对没有格式的MTEXT有效修改了代码，用下面的，修改整体的文字宽度比例，不影响其它设置好的格式。

需要的函数

xd::string:regexps 见： http://bbs.xdcad.net/thread-669166-1-1.html
xd::string:regexpr 见： http://bbs.xdcad.net/thread-669167-1-1.html

或者加载晓东通用函数库就都有了。

(defun c:tt (/ elst ent i joindatosxp ss str)
(setq *datosxp* (cond
((getreal (strcat "\n输入MTEXT的文字宽度比例系数 <"
(rtos (setq *datosxp* (cond
(*datosxp*)
(0.75)
)
)
2 2
) ">: "
)
)
)
(*datosxp*)
)
)
(setq joindatosxp (strcat "\\W" (rtos *datosxp* 2 2) ";"))
(if (setq i -1
ss (ssget "_:L" '((0 . "MTEXT")))
)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq str (cdr (assoc 1 (setq elst (entget ent)))))
(if (xd::string:regexps "\\\\W[0-9.]+;" str "")
(setq str (xd::string:regexpr "\\\\W[0-9.]+;" str "" ""))
)
(entmod (subst
(cons 1 (if (xd::string:regexps "{\\\\(.*);" str "")
(strcat "{" joindatosxp (substr str 2))
(strcat "{" joindatosxp str "}"))
)
(assoc 1 elst)
elst
)
)
)
)
(princ)
)

(defun c:tt (/ elst ent i joindatosxp ss str) 
  (setq *datosxp* (cond 
                    ((getreal (strcat "\n输入MTEXT的文字宽度比例系数 <" 
                                      (rtos (setq *datosxp* (cond 
                                                              (*datosxp*) 
                                                              (0.75) 
                                                            ) 
                                            ) 
                                            2 2 
                                      ) ">: " 
                              ) 
                     ) 
                    ) 
                    (*datosxp*) 
                  ) 
  ) 
  (setq joindatosxp (strcat "\\W" (rtos *datosxp* 2 2) ";")) 
  (if (setq i -1 
            ss (ssget "_:L" '((0 . "MTEXT"))) 
      ) 
    (while (setq ent (ssname ss (setq i (1+ i)))) 
      (setq str (cdr (assoc 1 (setq elst (entget ent))))) 
      (if (xd::string:regexps "\\\\W[0-9.]+;" str "") 
        (setq str (xd::string:regexpr "\\\\W[0-9.]+;" str "" "")) 
      ) 
      (entmod (subst 
                (cons 1 (if (xd::string:regexps "{\\\\(.*);" str "") 
                           (strcat "{" joindatosxp (substr str 2)) 
                           (strcat "{" joindatosxp str "}")) 
                        ) 
                (assoc 1 elst) 
                elst 
              ) 
      ) 
    ) 
  ) 
  (princ) 
)

sh_h · 发表于 2017-5-13 16:58:54

marting 发表于 2017-5-13 14:30

谢谢大师指点！！！

lisp_beginner · 发表于 2017-5-13 21:51:17

marting 发表于 2017-5-13 14:30

学习了，谢谢大师。

创佳 · 发表于 2021-8-13 15:34:39

非常实用啊

muwind · 发表于 2021-8-13 23:13:17

一直以来，都直接在编辑器里面修改，有个宽度因子可以修改，选中谁就改谁的，还没试过用lisp干，学习下

账号		自动登录	找回密码
密码			立即注册

[求助] 如何修改MTEXT的文字宽度比例系数?

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子