这个“lxdz443“，提供的代码，我现加到我的常用工具菜单中，非常好用。
我这里用你的公式炸开之后，怎么文字完全没有了？
我好像也不能用..不知道为啥..
Here is an old LISP routine from 1998 that can be used for learning
I hope it helps
~Greg
Tip1455.LSP: MMTEXT.LSP Mtext to Text (c) 1998, Jim Houser
(defun C: MTT (/ en ent nent lyr ipt tsz txt sty elv spc ts pt pty npty
ptx ptz npt)
(setq en (car (entsel "\ nSelect MTEXT to change to regular text"))
ent (entget en)
nent (car ent)
)
(setq lyr (assoc 8 ent)
ipt (assoc 10 ent)
tsz (assoc 40 ent)
txt (assoc 1 ent)
sty (assoc 7 ent)
elv (assoc 210 ent)
spc (assoc 67 ent)
)
(setq ts (cdr tsz)
pt (cdr ipt)
pty (cadr pt)
npty (- pty ts)
ptx (car pt)
ptz (caddr pt)
npt (list ptx npty ptz)
ipt (cons 10 npt)
)
(setq nent
(list nent
(cons 0 "TEXT")
(cons 100 "AcDbEntity")
spc
lyr
(cons 100 "AcDbText")
ipt
tsz
txt
(cons 50 0.0)
(cons 41 1.0)
(cons 51 0.0)
sty
(cons 71 0)
(cons 72 0)
(cons 11 (list 0.0 0.0 0.0))
elv
(cons 73 0)
)
)
(entdel en)
(entmake nent)
(princ)
)[/ code]
谢谢分享,正需要呢。
直接炸开不香吗
zhangcan0515 发表于 2020-9-23 13:59
直接炸开不香吗
昨天看到一行代码不见了
;;;;;;;分解法取多行文字
(defun c:text()
(setq f (open "C:/aaa.txt" "w"))
(setq e (ssget "X" '((0 . "MTEXT"))))
(setq n (sslength e) m 0 strb '())
(repeat n
(setq e1 (ssname e m) m (1+ m) d1 nil d2 nil)
(setq e2 (entget e1))
(setqp (cdr(assoc 10 e2)));;;左上角坐标
(setq d1 (cdr(assoc 42 e2)));;;宽度
(setq d2 (cdr(assoc 43 e2)));;;高度
(setq p1 (polar p 4.71238898 d2))
(setq p2 (polar p 0.0 d1))
(command"_.explode" e1)
(setqs (ssget "c" p1 p2 '((0 . "TEXT"))))
(setq nn (sslength s) mm 0 hh '())
(repeat nn
(setq s1 (entget(ssname s mm)) mm (1+ mm))
(setq h1 (cdr(assoc 1 s1)))
(setq hh (cons (list h1) hh))
)
(setq str "")
(foreach z hh
(setq str (strcat str (car z)))
)
(setq strb (cons (list str) strb))
(command "_.undo" 1)
);;;;;;end n
(foreach z strb
(setq pp (car z))
(write-line pp f)
)
(close f)
)
;;;;;;取多行文字函数（e---多行文字图元对象名称，调用:(MtoT e)）
(defun MtoT(e / ee str n n1 nn str0 str1 stra)
(vl-load-com)
(setq n nil nn 0 str0 "" str1 "" stra "")
(setq ee (entget e))
(setqstr (cdr(assoc 1 ee)))
(while
(setq n (vl-string-search ";" str))
(setq str (substr str (+ n 2))) ;;;;;;取格式符以后的字符串,无格式符则忽略
)
(setqstr (vl-string-subst "" "}" str)) ;;;;;去掉尾符号，无格式符则忽略
(setq nn (strlen str) n1 1 stra "")
;;;;;以下循环去除换行符"\P"但保留不属于换行的大写字符P——高手们可将下面的代码简化或优化
(repeat nn
(setq str1 "" str0 "")
(setq str0 (substr str n1 1) n1 (1+ n1))
(if (and(> n1 2)(<= n1 nn))(setq str1 (substr str (- n1 2) 1)))
(cond ((and(= str0 "P")(/= str1 "\\"))(setq stra (strcat stra str0)))
((and(/= str0 "\\")(/= str0 "P"))(setq stra (strcat stra str0)))
)
)
stra ;;;;;单行文字全字符串
)
这个要试一下，谢谢分享