[LISP程序]：replaces old text entity with new string

linshucai

;replaces old text entity with new string
;REPACES TEXT WITH ONLY SPACES (I.E. " ") WITH THE TEXT "space"
;AND NULL TEXT WITH THE WORD "NULL TEXT"

2. 
   
3. (defun c:CLEAN ( / spacetest ent space num count ans expl newen newlist newtext xx elist oldtxt oldlist)
   
4. (sETVAR "CMDECHO" 0)
   
5. ;********ERROR HANDLER**********************
   
6. (defun *Error* (msg)
   
7.   (if (/= msg "Function cancelled")
   
8.     (princ (strcat "\nError: " msg))
   
9.   )
   
10. (terpri)
    
11.                         
    
12.   (setq *error* olderr)        
    
13.   (princ)
    
14. )
    
15. ;***********************************************
    
16. 
    
17. (setq badd nil)
    
18. (SETQ SPACE (GETSTRING T "Press space bar for as many spaces to look for and fill in then enter: "))
    
19. (setq num (rtos  (strlen space) 2 0 ))
    
20. (setq newt "SPACE")
    
21. (setq newtxt (cons 1 newt))
    
22. (grtext -1 "Clean.lsp BY KWM '97")
    
23. (setq oldtxt (CONS 1 space))
    
24. (setq oldlist (list oldtxt))
    
25. 
    
26. (setq lists (list (cons 0 "TEXT") oldtxt))
    
27. 
    
28. (setq allents (ssget "X" lists))
    
29. (IF ALLENTS
    
30. (PROGN
    
31. (setq n 0)
    
32. (setq spacetest 1)
    
33. (setq total (sslength allents))
    
34. (setq ent (ssname allents 0))
    
35. (while ent
    
36. (setq elist (entget ent))
    
37. (setq elist (subst newtxt oldtxt elist))
    
38. (entmod elist)
    
39. (setq n (1+ n))
    
40. (setq ent (ssname allents n))
    
41. (princ (strcat "\rFound and changed " (rtos n 2 0) " of " (rtos total 2 0) " space entities."))
    
42. );END WHILE
    
43. );end progn
    
44. (PRINC (strcat "No text found consisting of only " num " spaces."))
    
45. );end if
    
46. (princ "\n")
    
47. (renul)
    
48. (if (or badd spacetest)
    
49.       (progn
    
50.         (initget 1 "Y YES N NO")
    
51.         (setq ans (getkword "\rNull text and/or space text was found in your drawing! Do you wish to globally remove these enitites?: "))
    
52.            (if (wcmatch (strcase ans) "Y*")
    
53.                  (progn
    
54.                    (if spacetest (res))
    
55.                    (princ "\n")
    
56.                     (if badd (ren))
    
57.                 );end progn
    
58.            );end if
    
59.        );end progn
    
60. );end if
    
61. (setq badd nil)
    
62. (princ)
    
63. );end funct
    
64. ;*X*X*X*X*X*X*X*X*X**X*X*X*X*X*X*X*X*X*X*X*X**X*X*X*X*X*X*X*X*X*X*X*X*X*X**X*X*X*X*X*X*X*X*X
    
65. (DEFUN RES ( / ent elist )
    
66. (setq n 0)
    
67. (setq lists (list (cons 0 "TEXT") (cons 1 "SPACE") ))
    
68. (setq allents (ssget "X" lists))
    
69. (setq ent (ssname allents 0))
    
70. (while ent
    
71. (entdel ent)
    
72. (setq n (1+ n))
    
73. (setq ent (ssname allents n))
    
74. (princ (strcat "\rErased " (rtos n 2 0) " of " (rtos total 2 0) " spaced out entities.                        "))
    
75. (princ)
    
76. )
    
77. )
    
78. ;*x*x*x*xx*x*x*x*x*xx**x*x*x*x*x*x*x*x*x*x*x*x**x*x*x*x*x*x*x**x*x*x*x*x*x*x*x**x*x*x*x*x*x*x
    
79. (defun renul ( / allents nxt elist niltx count)
    
80. (setq allents (ssget "X" (list (cons 0 "TEXT"))))
    
81.   (if allents
    
82.       (progn
    
83. (setq n 0 count 0 badd nil)
    
84. (setq nxt (ssname allents n))
    
85. (while nxt
    
86. (Setq elist (entget nxt))
    
87. (setq actxt (cdr(assoc 1 elist)))
    
88. 
    
89. (if (= actxt "")
    
90. (progn
    
91. (setq badd 1)
    
92. (setq count (1+ count))
    
93. (setq niltx (cons 1 "null text"))
    
94. (setq elist (subst niltx (assoc 1 elist) elist))
    
95. (entmod elist)
    
96. ));end if/progn
    
97. 
    
98. (setq n (1+ n))
    
99. (setq nxt (ssname allents n))
    
100. );end while
     
101.       (princ (strcat "\nFound " (rtos count 2 0) " null text entities!"))
     
102.       (princ "\n   ")
     
103.        );end progn
     
104.       (princ "\nNo null text found.")
     
105. );end if
     
106. );end renul
     
107. ;***************************************************************
     
108. (defun ren ( / notextt zobo nope)
     
109. (setvar "CMDECHO" 0)
     
110. (setq notextt (cons 1 "null text"))
     
111. (setq notextt (list notextt))
     
112. (setq nothing (ssget "X" notextt))
     
113. (setq zobo 0)
     
114. (setq nope (ssname nothing zobo))
     
115. (while nope
     
116. (command "erase" nope "")
     
117. (setq zobo (1+ zobo))
     
118. (setq nope (ssname nothing zobo))
     
119. )
     
120. (setvar "CMDECHO" 1)
     
121. (princ (strcat "\n" (rtos zobo 2 0)" null text entities erased") )
     
122. (princ)
     
123. );END

<br /> (defun c:CLEAN ( / spacetest ent space num count ans expl newen newlist newtext xx elist oldtxt oldlist)<br /> (sETVAR "CMDECHO" 0)<br /> ;********ERROR HANDLER**********************<br /> (defun *Error* (msg)<br />   (if (/= msg "Function cancelled")<br />     (princ (strcat "\nError: " msg))<br />   )<br /> (terpri)<br />                          <br />   (setq *error* olderr)        <br />   (princ)<br /> )<br /> ;***********************************************<br /> <br /> (setq badd nil)<br /> (SETQ SPACE (GETSTRING T "Press space bar for as many spaces to look for and fill in then enter: "))<br /> (setq num (rtos  (strlen space) 2 0 ))<br /> (setq newt "SPACE")<br /> (setq newtxt (cons 1 newt))<br /> (grtext -1 "Clean.lsp BY KWM '97")<br /> (setq oldtxt (CONS 1 space))<br /> (setq oldlist (list oldtxt))<br /> <br /> (setq lists (list (cons 0 "TEXT") oldtxt))<br /> <br /> (setq allents (ssget "X" lists))<br /> (IF ALLENTS<br /> (PROGN<br /> (setq n 0)<br /> (setq spacetest 1)<br /> (setq total (sslength allents))<br /> (setq ent (ssname allents 0))<br /> (while ent<br /> (setq elist (entget ent)) <br /> (setq elist (subst newtxt oldtxt elist))<br /> (entmod elist)<br /> (setq n (1+ n))<br /> (setq ent (ssname allents n))<br /> (princ (strcat "\rFound and changed " (rtos n 2 0) " of " (rtos total 2 0) " space entities."))<br /> );END WHILE<br /> );end progn<br /> (PRINC (strcat "No text found consisting of only " num " spaces."))<br /> );end if<br /> (princ "\n")<br /> (renul)<br /> (if (or badd spacetest)<br />       (progn<br />         (initget 1 "Y YES N NO")<br />         (setq ans (getkword "\rNull text and/or space text was found in your drawing! Do you wish to globally remove these enitites?: "))<br />            (if (wcmatch (strcase ans) "Y*")<br />                  (progn<br />                    (if spacetest (res))<br />                    (princ "\n")<br />                     (if badd (ren))<br />                 );end progn<br />            );end if<br />        );end progn<br /> );end if<br /> (setq badd nil)<br /> (princ)<br /> );end funct<br /> ;*X*X*X*X*X*X*X*X*X**X*X*X*X*X*X*X*X*X*X*X*X**X*X*X*X*X*X*X*X*X*X*X*X*X*X**X*X*X*X*X*X*X*X*X<br /> (DEFUN RES ( / ent elist )<br /> (setq n 0)<br /> (setq lists (list (cons 0 "TEXT") (cons 1 "SPACE") ))<br /> (setq allents (ssget "X" lists))<br /> (setq ent (ssname allents 0))<br /> (while ent<br /> (entdel ent)<br /> (setq n (1+ n))<br /> (setq ent (ssname allents n))<br /> (princ (strcat "\rErased " (rtos n 2 0) " of " (rtos total 2 0) " spaced out entities.                        "))<br /> (princ)<br /> )<br /> )<br /> ;*x*x*x*xx*x*x*x*x*xx**x*x*x*x*x*x*x*x*x*x*x*x**x*x*x*x*x*x*x**x*x*x*x*x*x*x*x**x*x*x*x*x*x*x<br /> (defun renul ( / allents nxt elist niltx count)<br /> (setq allents (ssget "X" (list (cons 0 "TEXT"))))<br />   (if allents<br />       (progn<br /> (setq n 0 count 0 badd nil)<br /> (setq nxt (ssname allents n))<br /> (while nxt<br /> (Setq elist (entget nxt))<br /> (setq actxt (cdr(assoc 1 elist)))<br /> <br /> (if (= actxt "")<br /> (progn<br /> (setq badd 1)<br /> (setq count (1+ count))<br /> (setq niltx (cons 1 "null text"))<br /> (setq elist (subst niltx (assoc 1 elist) elist))<br /> (entmod elist)<br /> ));end if/progn<br /> <br /> (setq n (1+ n))<br /> (setq nxt (ssname allents n))<br /> );end while<br />       (princ (strcat "\nFound " (rtos count 2 0) " null text entities!"))<br />       (princ "\n   ")<br />        );end progn<br />       (princ "\nNo null text found.")<br /> );end if<br /> );end renul<br /> ;***************************************************************<br /> (defun ren ( / notextt zobo nope)<br /> (setvar "CMDECHO" 0)<br /> (setq notextt (cons 1 "null text"))<br /> (setq notextt (list notextt))<br /> (setq nothing (ssget "X" notextt))<br /> (setq zobo 0)<br /> (setq nope (ssname nothing zobo))<br /> (while nope<br /> (command "erase" nope "")<br /> (setq zobo (1+ zobo))<br /> (setq nope (ssname nothing zobo))<br /> )<br /> (setvar "CMDECHO" 1)<br /> (princ (strcat "\n" (rtos zobo 2 0)" null text entities erased") )<br /> (princ)<br /> );END