单行文字转换为属性实体

Lisphk

1. (defun c:txt2att ( / StringSubst RemovePairs ss ent eLst str dx73 )
   
2.   (vl-load-com)
   
3. 
   
4.   (defun StringSubst ( new pat str )
   
5.     (while (vl-string-search pat str)
   
6.       (setq str (vl-string-subst new pat str))
   
7.     )
   
8.     str
   
9.   )
   
10. 
    
11.   (defun RemovePairs ( lst pairs )
    
12.     (vl-remove-if
    
13.       (function
    
14.         (lambda ( pair )
    
15.           (vl-position (car pair) pairs)
    
16.         )
    
17.       )
    
18.       lst
    
19.     )
    
20.   )
    
21. 
    
22.   (if (setq ss (ssget "_:L" '((0 . "TEXT"))))
    
23.    
    
24.     ( (lambda ( i )
    
25.         
    
26.         (while (setq ent (ssname ss (setq i (1+ i))))
    
27.           (setq eLst (entget ent)
    
28.                 str  (StringSubst "_" " " (cdr (assoc 1 eLst)))
    
29.                 dx73 (cdr (assoc 73 eLst)))
    
30. 
    
31.           (setq eLst (RemovePairs eLst '( 0 100 1 73 )))
    
32. 
    
33.           (if (entmake (append '( (0 . "ATTDEF") ) eLst (list (cons 70    0)
    
34.                                                               (cons 74 dx73)
    
35.                                                               (cons 1   str)
    
36.                                                               (cons 2   str)
    
37.                                                               (cons 3   str))))
    
38.             (entdel ent)
    
39.           )
    
40.         )
    
41.       )
    
42.       -1
    
43.     )
    
44.   )
    
45. 
    
46.   (princ))
    

(defun c:txt2att ( / StringSubst RemovePairs ss ent eLst str dx73 )<br />   (vl-load-com)<br /> <br />   (defun StringSubst ( new pat str )<br />     (while (vl-string-search pat str)<br />       (setq str (vl-string-subst new pat str))<br />     )<br />     str<br />   )<br /> <br />   (defun RemovePairs ( lst pairs )<br />     (vl-remove-if<br />       (function<br />         (lambda ( pair )<br />           (vl-position (car pair) pairs)<br />         )<br />       )<br />       lst<br />     )<br />   )<br /> <br />   (if (setq ss (ssget "_:L" '((0 . "TEXT"))))<br />     <br />     ( (lambda ( i )<br />         <br />         (while (setq ent (ssname ss (setq i (1+ i))))<br />           (setq eLst (entget ent)<br />                 str  (StringSubst "_" " " (cdr (assoc 1 eLst)))<br />                 dx73 (cdr (assoc 73 eLst)))<br /> <br />           (setq eLst (RemovePairs eLst '( 0 100 1 73 )))<br /> <br />           (if (entmake (append '( (0 . "ATTDEF") ) eLst (list (cons 70    0)<br />                                                               (cons 74 dx73)<br />                                                               (cons 1   str)<br />                                                               (cons 2   str)<br />                                                               (cons 3   str))))<br />             (entdel ent)<br />           )<br />         )<br />       )<br />       -1<br />     )<br />   )<br /> <br />   (princ))<br />

330774521lhq

yzhyxh

Michael527

这个还比较实用，谢谢分享