[求助]：關於正航大大的一個程序

ljs026

如果使它第一個選擇的目標顯亮？如果我只要替換一次文字，而不是批量修改，該如何修正？

;;本程序用目標文字替換需改變的文字。可以是TEXT和屬性塊中的屬性文字
(defun c:th1(/ a b ent ent2 elist etype oldval bltxt entdata btxt ostr pt oltxt )
(princ "\n ******* 文字替換程序 ******* Writen by 正航")
(princ "\n請選擇複製源文字目標:")
(setq ent (nentsel))
(if (= ent nil)(setq oldval (getstring "\n請輸入文字:"))
(progn
(setq ent2 ent elist (entget (car ent)) etype (cdr (assoc 0 elist))
)
(setq oldval (cdr (assoc 1 elist)))
(princ "\n ")
(princ "\n複製文字內容為: ") (princ oldval)
)
)
(setq q 9)
(while q
(princ "\n ")
(setq bltxt (nentsel "\n請選擇需要替換的文字目標:"))
(if (= bltxt nil)(setq q nil)
(progn
(setq entdata (entget (car bltxt)) btxt (cdr (assoc 1 entdata)) ostr btxt)
(setq elist (entget (car bltxt)))
(setq etype (cdr (assoc 0 elist)))
;;(setq oltxt (car (assoc 1 elist)))
(setq oltxt (cdr (assoc 1 elist)))
(if (= etype "ATTRIB")
(progn
(setq pt (cadr bltxt))
(command ".attedit" "" "" "" "" pt "" "V" "R" oldval "n")
)
(progn
(setq btxt oldval)
(entmod (subst (cons 1 btxt)(assoc 1 entdata) entdata))
(if (setq bltxt (car (reverse (cadddr bltxt)))) (entupd bltxt))
))))
(princ "\n原文字為:")(princ oltxt)(princ ". 已被替換為: ")(princ oldval)(princ " .")
)
(princ)
)

xgwl

此程序可这么小改一下! 第二点要求没有意义,多按次回车不就行了?  原程序还方便了许多!

xgwl

代码

2. 
   
3.   [FONT=courier new]
   
4. 
   
5. (defun c:thh (/ a b ent ent2 elist etype oldval bltxt entdata btxt ostr pt oltxt )
   
6. 
   
7. (princ "\n ******* 文字替换程序 ******* Writen by 正航")
   
8. 
   
9. (princ "\n 请选择复制源文字目标:")
   
10. 
    
11. (setq ent (nentsel))
    
12. 
    
13. (if (= ent nil)(setq oldval (getstring "\n 请输入文字:"))
    
14. 
    
15. (progn
    
16. 
    
17. (setq bb (car ent))
    
18. 
    
19. (redraw bb 3)
    
20. 
    
21. (setq
    
22. 
    
23. ent2 ent
    
24. 
    
25. elist (entget bb)
    
26. 
    
27. etype (cdr (assoc 0 elist))
    
28. 
    
29. )
    
30. 
    
31. (setq oldval (cdr (assoc 1 elist)))
    
32. 
    
33. (princ "\n ")
    
34. 
    
35. (princ "\n复制文字内容为: ") (princ oldval)
    
36. 
    
37. )
    
38. 
    
39. )
    
40. 
    
41. (setq q 9)
    
42. 
    
43. (while q
    
44. 
    
45. (princ "\n ")
    
46. 
    
47. (setq bltxt (nentsel "\n请选择需要替换的文字目标:"))
    
48. 
    
49. (if (= bltxt nil)(setq q nil)
    
50. 
    
51. (progn
    
52. 
    
53. (setq entdata (entget (car bltxt)) btxt (cdr (assoc 1 entdata)) ostr btxt)
    
54. 
    
55. (setq elist (entget (car bltxt)))
    
56. 
    
57. (setq etype (cdr (assoc 0 elist)))
    
58. 
    
59. ;; (setq oltxt (car (assoc 1 elist)))
    
60. 
    
61. (setq oltxt (cdr (assoc 1 elist)))
    
62. 
    
63. (if (= etype "ATTRIB")
    
64. 
    
65. (progn
    
66. 
    
67. (setq pt (cadr bltxt))
    
68. 
    
69. (command ".attedit" "" "" "" "" pt "" "V" "R" oldval "n")
    
70. 
    
71. )
    
72. 
    
73. (progn
    
74. 
    
75. (setq btxt oldval)
    
76. 
    
77. (entmod (subst (cons 1 btxt)(assoc 1 entdata) entdata))
    
78. 
    
79. (if (setq bltxt (car (reverse (cadddr bltxt)))) (entupd bltxt))
    
80. 
    
81. ))))
    
82. 
    
83. (princ "\n原文字为:")(princ oltxt)(princ ". 已被替换为: ")(princ oldval)(princ " .")
    
84. 
    
85. )
    
86. 
    
87. (redraw bb 4)
    
88. 
    
89. (princ)
    
90. )
    
91. 
    
92. 
    
93. 
    
94. 
    
95.   [/FONT]
    

<br />   [FONT=courier new]<br /> <br /> (defun c:thh (/ a b ent ent2 elist etype oldval bltxt entdata btxt ostr pt oltxt ) <br /> <br /> (princ "\n ******* 文字替换程序 ******* Writen by 正航") <br /> <br /> (princ "\n 请选择复制源文字目标:") <br /> <br /> (setq ent (nentsel)) <br /> <br /> (if (= ent nil)(setq oldval (getstring "\n 请输入文字:")) <br /> <br /> (progn <br /> <br /> (setq bb (car ent))<br /> <br /> (redraw bb 3)<br /> <br /> (setq <br /> <br /> ent2 ent <br /> <br /> elist (entget bb) <br /> <br /> etype (cdr (assoc 0 elist)) <br /> <br /> ) <br /> <br /> (setq oldval (cdr (assoc 1 elist))) <br /> <br /> (princ "\n ") <br /> <br /> (princ "\n复制文字内容为: ") (princ oldval) <br /> <br /> ) <br /> <br /> ) <br /> <br /> (setq q 9) <br /> <br /> (while q <br /> <br /> (princ "\n ") <br /> <br /> (setq bltxt (nentsel "\n请选择需要替换的文字目标:")) <br /> <br /> (if (= bltxt nil)(setq q nil) <br /> <br /> (progn <br /> <br /> (setq entdata (entget (car bltxt)) btxt (cdr (assoc 1 entdata)) ostr btxt) <br /> <br /> (setq elist (entget (car bltxt))) <br /> <br /> (setq etype (cdr (assoc 0 elist))) <br /> <br /> ;; (setq oltxt (car (assoc 1 elist))) <br /> <br /> (setq oltxt (cdr (assoc 1 elist))) <br /> <br /> (if (= etype "ATTRIB") <br /> <br /> (progn <br /> <br /> (setq pt (cadr bltxt)) <br /> <br /> (command ".attedit" "" "" "" "" pt "" "V" "R" oldval "n") <br /> <br /> ) <br /> <br /> (progn <br /> <br /> (setq btxt oldval) <br /> <br /> (entmod (subst (cons 1 btxt)(assoc 1 entdata) entdata)) <br /> <br /> (if (setq bltxt (car (reverse (cadddr bltxt)))) (entupd bltxt)) <br /> <br /> )))) <br /> <br /> (princ "\n原文字为:")(princ oltxt)(princ ". 已被替换为: ")(princ oldval)(princ " .") <br /> <br /> ) <br /> <br /> (redraw bb 4)<br /> <br /> (princ) <br /> )<br /> <br /> <br /> <br /> <br />   [/FONT]<br />

ljs026

謝謝大大，但小弟的第二點要求是小弟急需的，卻不知如何修改，求大大幫幫忙！

xgwl

去掉
(setq q 9)

(while q

(princ "\n ")


还有  (redraw bb 4)   上面的  " )"  右括号!

ljs026

請問大大，照大大的指示修改後，為何執行過一次後，再選取其他文字就不會再顯亮了，這是什麼原因？

xgwl

不明白你的意思! 修改过的代码,执行过一次后!程序就退出了! 要想再去改文字, 就再启动程序一遍!  第一次能显亮, 第二次启动程序还是会显亮啊!  不知你怎么改的!