恳请大师帮忙优化一下能框选问题

tianbob

恳请大师帮忙优化一下框选问题：
源码是本论坛上的，在此谢过作者。此程序只能对单独的一行文本进行拆分，不能框选多行文本，特请求大师帮忙优化和修改，感激不尽。

2. (defun tiao ()
   
3. (setq ang1 (atan y x))
   
4. (setq d (distance pt pt1))
   
5. (setq pt1 (polar pt (+ ang ang1) d))
   
6. )
   
7. (defun nextt (n /)
   
8. (setq post (+ post n))
   
9. (if (= hsc 0.8)
   
10. (setq pt (polar pt angle_ (* distxt 0.9)))
    
11. (setq pt (polar pt angle_ distxt))
    
12. )
    
13. )
    
14. (defun C:exstr (/ styelay ent sel ellayt sty txt pt
    
15. highscale angle_ angpost distxt stxt
    
16. dxdy dxx dyy pt1p txt1 stxt1 ang1
    
17. xy n
    
18. )
    
19. (setq stye (getvar "textstyle"))
    
20. (setq lay (getvar "clayer"))
    
21. (setvar "CMDECHO" 0)
    
22. (setq ent (car (entsel "\n选择文字:")))
    
23. (if (/= ent nil)
    
24. (progn
    
25. (setq sel (entget ent))
    
26. (if (= "TEXT" (cdr (assoc 0 sel)))
    
27. (progn
    
28. (setq el (cdr (assoc -1 sel)))
    
29. (command "erase" el "")
    
30. (setq layt (cdr (assoc 8 sel)))
    
31. (setq sty (cdr (assoc 7 sel)))
    
32. (setq txt (cdr (assoc 1 sel)))
    
33. (setq pt (cdr (assoc 10 sel)))
    
34. (setq high (cdr (assoc 40 sel)))
    
35. (setq scale (cdr (assoc 41 sel)))
    
36. (setq angle_ (cdr (assoc 50 sel)))
    
37. (setq ang (/ (* angle_ 180) pi))
    
38. (setq post 1)
    
39. 
    
40. (setq distxt (* high scale))
    
41. (princ
    
42. (strcat "\n文字间隔 : <" (rtos distxt 2 3) ">")
    
43. )
    
44. (setq distxt (getreal))
    
45. (if (= distxt nil)
    
46. (setq distxt (* high scale))
    
47. )
    
48. 
    
49. (command "style" sty "" "0" scale "0" "" "" "")
    
50. (command "layer" "s" layt "")
    
51. (setq p 1);
    
52. (setq hsc 1);
    
53. (setq txt1 (substr txt p 1)); 判断文字串中
    
54. (repeat (strlen txt); 是否有汉字,
    
55. (if(> (ascii txt1) 160)
    
56. (setq hsc 0.8)
    
57. );; 汉字ASCII大
    
58. (setq p (1+ p));; 于160
    
59. (setq txt1 (substr txt p 1)) ;
    
60. );
    
61. (setq stxt nil)
    
62. (while (/= stxt "")
    
63. (setq stxt (substr txt post 1))
    
64. (if(<= (ascii stxt) 160)
    
65. ;; 文字是西文
    
66. (progn
    
67. (setq dx (car pt))
    
68. (setq dy (cadr pt))
    
69. ;; 处理以%开始的扩展字符
    
70. (cond ((= (ascii stxt) 37) ; 文字是: %
    
71. (progn
    
72. (setq stxt1 (substr txt (+ post 1) 1))
    
73. (if (= (ascii stxt1) 37)
    
74. ;;判断下一个文字是否也是: %
    
75. (progn
    
76. (setq stxt (substr txt post 5))
    
77. (if (= hsc 0.8)
    
78. (progn
    
79. (setq x (* high 0.188))
    
80. (setq dxx (+ dx x))
    
81. (setq y (* high scale 0.1))
    
82. (setq dyy (+ dy y))
    
83. )
    
84. (progn
    
85. (setq dxx dx)
    
86. (setq dyy dy)
    
87. )
    
88. )
    
89. (setq pt1 (list dxx dyy))
    
90. ;;(if (= hsc 0.8) (tiao)) ;如果有汉字, 调整pt1
    
91. (command "text" pt1 (* high hsc) ang stxt)
    
92. (nextt 5)
    
93. )
    
94. (progn
    
95. (if (= hsc 0.8)
    
96. (progn
    
97. (setq x (* high 0.188))
    
98. (setq dxx (+ dx x))
    
99. )
    
100. (setq dxx dx)
     
101. )
     
102. (if (= hsc 0.8)
     
103. (progn
     
104. (setq y (* high scale 0.1))
     
105. (setq dyy (+ dy y))
     
106. )
     
107. (setq dyy dy)
     
108. )
     
109. (setq pt1 (list dxx dyy))
     
110. ; (if (= hsc 0.8) (tiao)) ;如果有汉字, 调整pt1
     
111. (command "text" pt1 (* high hsc) ang stxt)
     
112. (nextt 1)
     
113. )
     
114. )
     
115. )
     
116. )
     
117. ; 处理以%开始的扩展字符结束
     
118. ; 处理其它的字母和数字
     
119. (T
     
120. (progn
     
121. (if (= hsc 0.8)
     
122. (progn
     
123. (setq x (* high 0.188))
     
124. (setq dxx (+ dx x))
     
125. )
     
126. (setq dxx dx)
     
127. )
     
128. (if (= hsc 0.8)
     
129. (progn
     
130. (setq y (* high scale 0.1))
     
131. (setq dyy (+ dy y))
     
132. )
     
133. (setq dyy dy)
     
134. )
     
135. (setq pt1 (list dxx dyy))
     
136. (if (= hsc 0.8)
     
137. (tiao)
     
138. );如果有汉字, 调整pt1
     
139. (command "text" pt1 (* high hsc) ang stxt)
     
140. (nextt 1)
     
141. )
     
142. )
     
143. ; 处理其它的字母和数字结束
     
144. )
     
145. )
     
146. ; 处理汉字
     
147. (progn
     
148. (setq stxt (substr txt post 2))
     
149. (command "text" pt high ang stxt)
     
150. (setq post (+ post 2))
     
151. (setq pt (polar pt angle_ distxt))
     
152. )
     
153. ; 处理汉字结束
     
154. )
     
155. )
     
156. (command "style" stye "" "" "" "" "" "" "")
     
157. (command "layer" "s" lay "")
     
158. (redraw)
     
159. )
     
160. (princ "\nObject is not a TEXT !")
     
161. )
     
162. )
     
163. )
     
164. (princ)
     
165. )
     

(defun tiao ()<br /> (setq ang1 (atan y x))<br /> (setq d (distance pt pt1))<br /> (setq pt1 (polar pt (+ ang ang1) d))<br /> )<br /> (defun nextt (n /)<br /> (setq post (+ post n))<br /> (if (= hsc 0.8)<br /> (setq pt (polar pt angle_ (* distxt 0.9)))<br /> (setq pt (polar pt angle_ distxt))<br /> )<br /> )<br /> (defun C:exstr (/ styelay ent sel ellayt sty txt pt<br /> highscale angle_ angpost distxt stxt<br /> dxdy dxx dyy pt1p txt1 stxt1 ang1<br /> xy n<br /> )<br /> (setq stye (getvar "textstyle"))<br /> (setq lay (getvar "clayer"))<br /> (setvar "CMDECHO" 0)<br /> (setq ent (car (entsel "\n选择文字:")))<br /> (if (/= ent nil)<br /> (progn<br /> (setq sel (entget ent))<br /> (if (= "TEXT" (cdr (assoc 0 sel)))<br /> (progn<br /> (setq el (cdr (assoc -1 sel)))<br /> (command "erase" el "")<br /> (setq layt (cdr (assoc 8 sel)))<br /> (setq sty (cdr (assoc 7 sel)))<br /> (setq txt (cdr (assoc 1 sel)))<br /> (setq pt (cdr (assoc 10 sel)))<br /> (setq high (cdr (assoc 40 sel)))<br /> (setq scale (cdr (assoc 41 sel)))<br /> (setq angle_ (cdr (assoc 50 sel)))<br /> (setq ang (/ (* angle_ 180) pi))<br /> (setq post 1)<br /> <br /> (setq distxt (* high scale))<br /> (princ<br /> (strcat "\n文字间隔 : <" (rtos distxt 2 3) ">")<br /> )<br /> (setq distxt (getreal))<br /> (if (= distxt nil)<br /> (setq distxt (* high scale))<br /> )<br /> <br /> (command "style" sty "" "0" scale "0" "" "" "")<br /> (command "layer" "s" layt "")<br /> (setq p 1); <br /> (setq hsc 1); <br /> (setq txt1 (substr txt p 1)); 判断文字串中<br /> (repeat (strlen txt); 是否有汉字,<br /> (if(> (ascii txt1) 160)<br /> (setq hsc 0.8)<br /> );; 汉字ASCII大<br /> (setq p (1+ p));; 于160<br /> (setq txt1 (substr txt p 1)) ;<br /> );<br /> (setq stxt nil)<br /> (while (/= stxt "")<br /> (setq stxt (substr txt post 1))<br /> (if(<= (ascii stxt) 160)<br /> ;; 文字是西文<br /> (progn<br /> (setq dx (car pt))<br /> (setq dy (cadr pt))<br /> ;; 处理以%开始的扩展字符<br /> (cond ((= (ascii stxt) 37) ; 文字是: %<br /> (progn<br /> (setq stxt1 (substr txt (+ post 1) 1))<br /> (if (= (ascii stxt1) 37)<br /> ;;判断下一个文字是否也是: %<br /> (progn<br /> (setq stxt (substr txt post 5))<br /> (if (= hsc 0.8)<br /> (progn<br /> (setq x (* high 0.188))<br /> (setq dxx (+ dx x))<br /> (setq y (* high scale 0.1))<br /> (setq dyy (+ dy y))<br /> )<br /> (progn<br /> (setq dxx dx)<br /> (setq dyy dy)<br /> )<br /> )<br /> (setq pt1 (list dxx dyy))<br /> ;;(if (= hsc 0.8) (tiao)) ;如果有汉字, 调整pt1<br /> (command "text" pt1 (* high hsc) ang stxt)<br /> (nextt 5)<br /> )<br /> (progn<br /> (if (= hsc 0.8)<br /> (progn<br /> (setq x (* high 0.188))<br /> (setq dxx (+ dx x))<br /> )<br /> (setq dxx dx)<br /> )<br /> (if (= hsc 0.8)<br /> (progn<br /> (setq y (* high scale 0.1))<br /> (setq dyy (+ dy y))<br /> )<br /> (setq dyy dy)<br /> )<br /> (setq pt1 (list dxx dyy))<br /> ; (if (= hsc 0.8) (tiao)) ;如果有汉字, 调整pt1<br /> (command "text" pt1 (* high hsc) ang stxt)<br /> (nextt 1)<br /> )<br /> )<br /> )<br /> )<br /> ; 处理以%开始的扩展字符结束<br /> ; 处理其它的字母和数字<br /> (T<br /> (progn<br /> (if (= hsc 0.8)<br /> (progn<br /> (setq x (* high 0.188))<br /> (setq dxx (+ dx x))<br /> )<br /> (setq dxx dx)<br /> )<br /> (if (= hsc 0.8)<br /> (progn<br /> (setq y (* high scale 0.1))<br /> (setq dyy (+ dy y))<br /> )<br /> (setq dyy dy)<br /> )<br /> (setq pt1 (list dxx dyy))<br /> (if (= hsc 0.8)<br /> (tiao)<br /> );如果有汉字, 调整pt1<br /> (command "text" pt1 (* high hsc) ang stxt)<br /> (nextt 1)<br /> )<br /> )<br /> ; 处理其它的字母和数字结束<br /> )<br /> )<br /> ; 处理汉字<br /> (progn<br /> (setq stxt (substr txt post 2))<br /> (command "text" pt high ang stxt)<br /> (setq post (+ post 2))<br /> (setq pt (polar pt angle_ distxt))<br /> )<br /> ; 处理汉字结束<br /> )<br /> )<br /> (command "style" stye "" "" "" "" "" "" "")<br /> (command "layer" "s" lay "")<br /> (redraw)<br /> )<br /> (princ "\nObject is not a TEXT !")<br /> )<br /> )<br /> )<br /> (princ)<br /> ) <br />

tianbob

各位大神麻烦帮帮忙！谢谢谢谢

llsheng_73

如果这是你自己写的，你完全能够把它改成你需要的，如果你是从别处拿来的，最好从哪得来的叫谁改
这么长的"长篇大论",很少会有人有兴趣去下这个苦力先去读懂它，除非刚好有类似需要或者实在很闲并且心情相当不错
原程序中以ascii值160来分界汉字，实在不知道依据是什么，(vl-list->string'(145 210))，(vl-list->string'(129 68 ))难道它们都是一个单字节符号?
(vl-list->string'(169 183))得到的难道会是汉字？

yxp

llsheng_73 发表于 2018-7-2 23:36
如果这是你自己写的，你完全能够把它改成你需要的，如果你是从别处拿来的，最好从哪得来的叫谁改
这么长的 ...

确实这样，我宁愿重写也不愿读一大堆别人的代码。如果是高手的代码，可以学习借鉴，但是大部分无法理解的问题乱麻型代码。

masterlong

别人的代码不说修改
阅读都很累
一个是排版和书写习惯
一个是参数命名习惯
比如llsheng_73就习惯不加空格
有人喜欢每个反括号后面加";cond"之类
我则喜欢使用tab对齐上下行文字

某些真心不错的代码或程序需要借鉴学习时
首先要做的是重新排版、替换参数
然后是阅读消化理解
最后才是改造之后应用到自己的程序中
正如yxp所说
宁愿重写也不愿读别人的代码
所以这也是论坛里同类程序如此之多的原因

对小白来说
来到这个论坛找程序
要么努力适应别人的操作习惯
要么搜遍所有同类程序
一个一个试用找到自己习惯的
还有就是多少学习点编程的知识
不说自己编出来
起码能修改简单的程序为自己所用

Andyhon

有些程序是套件中的一环
有其针对性必需得有相应的图纸中的特定 图元/元素
缺了这dwg时则无从调试验证

(if(> (ascii txt1) 160)
或许就是如此搭配着滴...

oistre

看到版主的教程，慢慢研究，谢谢谢谢