多行文字转单行文字

zlzxtfl

这个“lxdz443“，提供的代码，我现加到我的常用工具菜单中，非常好用。

zyceder

我这里用你的公式炸开之后，怎么文字完全没有了？

19xy19

我好像也不能用..不知道为啥..

greg.battin

Here is an old LISP routine from 1998 that can be used for learning
I hope it helps
~Greg
[code = lisp]
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]

zhulei

谢谢分享,正需要呢。

zhangcan0515

直接炸开不香吗

wmz

zhangcan0515 发表于 2020-9-23 13:59
直接炸开不香吗

昨天看到一行代码不见了

wmz

2. ;;;;;;;分解法取多行文字
   
3. (defun c:text()
   
4.     (setq f (open "C:/aaa.txt" "w"))
   
5.     (setq e (ssget "X" '((0 . "MTEXT"))))
   
6.     (setq n (sslength e) m 0 strb '())
   
7.   (repeat n
   
8.     (setq e1 (ssname e m) m (1+ m) d1 nil d2 nil)
   
9.     (setq e2 (entget e1))
   
10.     (setq  p (cdr(assoc 10 e2)));;;左上角坐标
    
11.     (setq d1 (cdr(assoc 42 e2)));;;宽度
    
12.     (setq d2 (cdr(assoc 43 e2)));;;高度
    
13.     (setq p1 (polar p 4.71238898 d2))
    
14.     (setq p2 (polar p 0.0 d1))
    
15.     (command  "_.explode" e1)
    
16.     (setq  s (ssget "c" p1 p2 '((0 . "TEXT"))))
    
17.     (setq nn (sslength s) mm 0 hh '())
    
18.     (repeat nn
    
19.       (setq s1 (entget(ssname s mm)) mm (1+ mm))
    
20.       (setq h1 (cdr(assoc 1 s1)))
    
21.       (setq hh (cons (list h1) hh))
    
22.     )
    
23.        (setq str "")
    
24.      (foreach z hh
    
25.        (setq str (strcat str (car z)))
    
26.      )
    
27.        (setq strb (cons (list str) strb))
    
28.        (command "_.undo" 1)
    
29.   );;;;;;end n
    
30.      (foreach z strb
    
31.         (setq pp (car z))
    
32.         (write-line pp f)
    
33.      )
    
34.      (close f)
    
35. )  

;;;;;;;分解法取多行文字<br /> (defun c:text()<br />     (setq f (open "C:/aaa.txt" "w"))<br />     (setq e (ssget "X" '((0 . "MTEXT"))))<br />     (setq n (sslength e) m 0 strb '())<br />   (repeat n<br />     (setq e1 (ssname e m) m (1+ m) d1 nil d2 nil)<br />     (setq e2 (entget e1))<br />     (setq  p (cdr(assoc 10 e2)));;;左上角坐标<br />     (setq d1 (cdr(assoc 42 e2)));;;宽度<br />     (setq d2 (cdr(assoc 43 e2)));;;高度<br />     (setq p1 (polar p 4.71238898 d2))<br />     (setq p2 (polar p 0.0 d1))<br />     (command  "_.explode" e1)<br />     (setq  s (ssget "c" p1 p2 '((0 . "TEXT"))))<br />     (setq nn (sslength s) mm 0 hh '())<br />     (repeat nn<br />       (setq s1 (entget(ssname s mm)) mm (1+ mm))<br />       (setq h1 (cdr(assoc 1 s1)))<br />       (setq hh (cons (list h1) hh))<br />     )<br />        (setq str "")<br />      (foreach z hh<br />        (setq str (strcat str (car z)))<br />      )<br />        (setq strb (cons (list str) strb))<br />        (command "_.undo" 1)<br />   );;;;;;end n<br />      (foreach z strb<br />         (setq pp (car z))<br />         (write-line pp f)<br />      )<br />      (close f)<br /> )  

wmz

;;;;;;取多行文字函数（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))
    (setq  str (cdr(assoc 1 ee)))
    (while
         (setq   n (vl-string-search ";" str))
         (setq str (substr str (+ n 2))) ;;;;;;取格式符以后的字符串,无格式符则忽略
    )
    (setq  str (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 "")(/= str1 "\\"))(setq stra (strcat stra str0)))
            ((and(/= str0 "\\")(/= str0 ""))(setq stra (strcat stra str0)))
      )
    )
       stra ;;;;;单行文字全字符串
)  

wgij007

这个要试一下，谢谢分享