多行文字炸开法速度很慢，不知这个咋样

wmz

2. ;;;;;;;将多行文字转换为单行文字
   
3. (defun c:MtoTa(/ f e e0 ee m str p0 pp h H0 KD n n1 nn str0 str1 stra)
   
4.     (vl-load-com)
   
5.    ; (setq    f (open "C:/10.txt" "w"))
   
6.     (setq    e (ssget "X" '((0 . "MTEXT"))))
   
7.   (if e (progn
   
8.     (setq    m 0 n nil nn 0 str0 "" str1 "" stra "")
   
9.   (repeat (sslength e)
   
10.     (setq   e0 (ssname e m) m (1+ m))
    
11.     (setq   ee (entget e0))
    
12.     (setq  str (cdr(assoc 1 ee)))
    
13.     (setq   p0 (cdr(assoc 10 ee)))
    
14.     (setq    H (cdr(assoc 40 ee)))
    
15.     (setq   H0 (cdr(assoc 43 ee)))
    
16.     (setq   KD (cdr(assoc 42 ee)))
    
17.     (setq   pp (list (+(car p0)(/ KD 2.0))(-(cadr p0)(/ H0 2.0))))
    
18.     (while
    
19.          (setq   n (vl-string-search ";" str))
    
20.          (setq str (substr str (+ n 2)))
    
21.     )
    
22.     (setq  str (vl-string-subst "" "}" str))
    
23.     (setq   nn (strlen str) n1 1 stra "")
    
24.     (repeat nn
    
25.          (setq str1 "" str0 "")
    
26.          (setq str0 (substr str n1 1) n1 (1+ n1))
    
27.          (if (and(> n1 2)(<= n1 nn))(setq str1 (substr str (- n1 2) 1)))
    
28.       (cond ((and(= str0 "P")(/= str1 "\"))(setq stra (strcat stra str0)))
    
29.                ((and(/= str0 "\")(/= str0 "P"))(setq stra (strcat stra str0)))
    
30.       )        
    
31.     );;;;;;end nn
    
32.       (command "erase" e0 "")
    
33.       (command "TEXT" "M" pp h "360" stra)
    
34.       ;(write-line stra f)
    
35.       (print "stra=")(princ stra)(princ)
    
36.   )
    
37.   ));;;;;end (if e  
    
38.       ;(close f)
    
39. )

;;;;;;;将多行文字转换为单行文字<br /> (defun c:MtoTa(/ f e e0 ee m str p0 pp h H0 KD n n1 nn str0 str1 stra)<br />     (vl-load-com)<br />    ; (setq    f (open "C:/10.txt" "w"))<br />     (setq    e (ssget "X" '((0 . "MTEXT"))))<br />   (if e (progn<br />     (setq    m 0 n nil nn 0 str0 "" str1 "" stra "")<br />   (repeat (sslength e)<br />     (setq   e0 (ssname e m) m (1+ m))<br />     (setq   ee (entget e0))<br />     (setq  str (cdr(assoc 1 ee)))<br />     (setq   p0 (cdr(assoc 10 ee)))<br />     (setq    H (cdr(assoc 40 ee)))<br />     (setq   H0 (cdr(assoc 43 ee)))<br />     (setq   KD (cdr(assoc 42 ee)))<br />     (setq   pp (list (+(car p0)(/ KD 2.0))(-(cadr p0)(/ H0 2.0)))) <br />     (while<br />          (setq   n (vl-string-search ";" str))<br />          (setq str (substr str (+ n 2)))<br />     )<br />     (setq  str (vl-string-subst "" "}" str))<br />     (setq   nn (strlen str) n1 1 stra "")<br />     (repeat nn<br />          (setq str1 "" str0 "")<br />          (setq str0 (substr str n1 1) n1 (1+ n1))<br />          (if (and(> n1 2)(<= n1 nn))(setq str1 (substr str (- n1 2) 1))) <br />       (cond ((and(= str0 "P")(/= str1 "\"))(setq stra (strcat stra str0)))<br />                ((and(/= str0 "\")(/= str0 "P"))(setq stra (strcat stra str0)))<br />       )        <br />     );;;;;;end nn<br />       (command "erase" e0 "")<br />       (command "TEXT" "M" pp h "360" stra)<br />       ;(write-line stra f)<br />       (print "stra=")(princ stra)(princ)<br />   )<br />   ));;;;;end (if e  <br />       ;(close f)<br /> )

wmz

;;;;;;;将多行文字转换为单行文字
(defun c:MtoTa(/ f e e0 ee m str p0 pt h H0 KD n n1 nn str0 str1 stra)
    (vl-load-com)
    (setq    e (ssget "X" '((0 . "MTEXT"))))
  (if e (progn
    (setq    m 0 n nil nn 0 str0 "" str1 "" stra "")
  (repeat (sslength e)
    (setq   e0 (ssname e m) m (1+ m))
    (setq   ee (entget e0))
    (setq  str (cdr(assoc 1 ee)))
    (setq  sty (cdr(assoc 7 ee)))
    (setq  ply (cdr(assoc 8 ee)))
    (setq   p0 (cdr(assoc 10 ee)))
    (setq    H (cdr(assoc 40 ee)))
    (setq   H0 (cdr(assoc 43 ee)))
    (setq   KD (cdr(assoc 42 ee)))
    (setq   pt (list (+(car p0)(/ KD 2.0))(-(cadr p0)(/ H0 2.0)) 0.0))
    (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 "")
    (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 ((= str0 "\\")(setq stra (strcat stra "")))
;            ((and(= str0 "P")(= str1 "\\"))(setq stra (strcat stra "")))
      (cond ((and(= str0 "P")(/= str1 "\\"))(setq stra (strcat stra str0)))
            ((and(/= str0 "\\")(/= str0 "P"))(setq stra (strcat stra str0)))
      )             
    );;;;;;end nn
      (command "erase" e0 "")
    ;  (command "layer" "s" ply "")
    ;  (command "TEXT" "M" pt "3.0" "360" stra)
   (entmake (list
           '(0 . "TEXT")
           (cons 1 stra)
           (cons 7 sty)
           (cons 8 ply)
           (cons 10 pt)
           (cons 11 pt)
           (cons 40 h)
           (cons 41 0.9)
           (cons 50 0.0)
           '(72 . 4)
           '(73 . 0)
          )
    )
  )
  ));;;;;end (if e  
)
用这个看看

huxu823

wmz 发表于 2020-10-24 13:58
;;;;;;;将多行文字转换为单行文字
(defun c:MtoTa(/ f e e0 ee m str p0 pt h H0 KD n n1 nn str0 str1 st ...

好用，(setq    e (ssget "X" '((0 . "MTEXT"))))改为(setq    e (ssget '((0 . "MTEXT"))))
即可由自动选择图形中所有的多行文字 改为 手动选择要转换的多行文字

广易精通

wmz 发表于 2020-10-15 12:44
我是须要你上传DWG图幅，便于我调试程序。不是上传PNG图像文件。再说这个文件我也打不开（不知什么原因） ...

图上传了，跟图没关系吧，主要是程序不能启动

999999

顶一下，，谢谢楼主的分享

huxu823

不能用啊

sunwei2009

顶一下，，谢谢楼主的分享

广易精通

(setq   n (vl-string-search ";" str))这句好像有问题

广易精通

; 错误: 参数类型错误: numberp: nil

wmz

广易精通 发表于 2020-10-13 18:00
; 错误: 参数类型错误: numberp: nil

请发一幅遇到问题的图，我测试一下！谢谢！（acad2012版本以下，我没有装更高版本的CAD）

广易精通

2010CAD加载也是这个错误提示，感觉还是程序有问题

广易精通

wmz 发表于 2020-10-14 13:56
请发一幅遇到问题的图，我测试一下！谢谢！（acad2012版本以下，我没有装更高版本的CAD）

图片已上传

wmz

广易精通 发表于 2020-10-15 11:26
图片已上传

我是须要你上传DWG图幅，便于我调试程序。不是上传PNG图像文件。再说这个文件我也打不开（不知什么原因），麻烦你了！