求一小程序。

429014673

求一小程序。听闻ET工具箱有此功能，但本人想求单一程序，LSP格式。明经币不多，希望高手们出手相助，谢谢。

夏生生

写了个比较简单的

2. 
   
3. (defun c:ttomt (/ ss n lst en str h pt st lay)
   
4.   (setq ss (ssget '((0 . "text"))))
   
5.   (repeat (setq n (sslength ss))
   
6.     (setq lst (cons (list (setq en (ssname ss (1- n)))
   
7.      (cadr (cdr (assoc 10 (entget en))))
   
8.       )
   
9.       lst
   
10.        )
    
11.    n   (1- n)
    
12.     )
    
13.   )
    
14.   (setq
    
15.     lst (vl-sort lst
    
16.    (function (lambda (a1 a2) (> (cadr a1) (cadr a2))))
    
17. )
    
18.   )
    
19.   (setq str
    
20.   (apply
    
21.     'strcat
    
22.     (mapcar
    
23.       '(lambda (x) (strcat x "\\P"))
    
24.       (mapcar '(lambda (x) (cdr (assoc 1 (entget (car x))))) lst)
    
25.     )
    
26.   )
    
27.   )
    
28.   (setq str (substr str 1 (- (strlen str) 2)))
    
29.   (setq h  (cdr (assoc 40 (entget (car (car lst)))))
    
30. pt (polar (cdr (assoc 10 (entget (car (car lst))))) (/ pi 2) h)
    
31. st (cdr (assoc 7 (entget (car (car lst)))))
    
32. lay (cdr (assoc 8 (entget (car (car lst)))))
    
33.   )
    
34.   (entmake (list '(0 . "MTEXT")
    
35.    '(100 . "AcDbEntity")
    
36.    '(100 . "AcDbMText")
    
37.    (cons 8 lay)
    
38.    (cons 40 h)
    
39.    (cons 7 st)
    
40.    (cons 1 str)
    
41.    (cons 10 pt)
    
42.     )
    
43.   )
    
44.   (foreach n lst (entdel (car n)))
    
45.   (princ)
    
46. )

<br /> (defun c:ttomt (/ ss n lst en str h pt st lay)<br />   (setq ss (ssget '((0 . "text"))))<br />   (repeat (setq n (sslength ss))<br />     (setq lst (cons (list (setq en (ssname ss (1- n)))<br />      (cadr (cdr (assoc 10 (entget en))))<br />       )<br />       lst<br />        )<br />    n   (1- n)<br />     )<br />   )<br />   (setq<br />     lst (vl-sort lst<br />    (function (lambda (a1 a2) (> (cadr a1) (cadr a2))))<br /> )<br />   )<br />   (setq str<br />   (apply<br />     'strcat<br />     (mapcar<br />       '(lambda (x) (strcat x "\\P"))<br />       (mapcar '(lambda (x) (cdr (assoc 1 (entget (car x))))) lst)<br />     )<br />   )<br />   )<br />   (setq str (substr str 1 (- (strlen str) 2)))<br />   (setq h  (cdr (assoc 40 (entget (car (car lst)))))<br /> pt (polar (cdr (assoc 10 (entget (car (car lst))))) (/ pi 2) h)<br /> st (cdr (assoc 7 (entget (car (car lst)))))<br /> lay (cdr (assoc 8 (entget (car (car lst)))))<br />   )<br />   (entmake (list '(0 . "MTEXT")<br />    '(100 . "AcDbEntity")<br />    '(100 . "AcDbMText")<br />    (cons 8 lay)<br />    (cons 40 h)<br />    (cons 7 st)<br />    (cons 1 str)<br />    (cons 10 pt)<br />     )<br />   )<br />   (foreach n lst (entdel (car n)))<br />   (princ)<br /> )

lisp爱好者

单行文字转多行文字，多行单列的论坛有，多行多列的不行

lisp爱好者

多行多列，明经lsp群里有个“路人”，见过他有演示此程序，还有e派也有演示

xiabin68

这样的程序还是好啊，，，，

sunny20102

To 夏生生: well done
删除是否用 (command "_.erase" ss "")好些? 省得用foreach