[LISP程序]：平法梁重编号程式源码公开

biechen

平法梁重编号程式源码公开
对话框下载:http://blog.mystruc.com/read.php/36.htm

2. 
   
3. ;|file:beamresort.lsp
   
4. -------------------------------------------------------------------------------------------------
   
5. Copyright (c) 2006 杨百朋, Eric Sure, [url]www.mystruc.com[/url]
   
6. 
   
7. This software is provided 'as-is', without any express or implied warranty.
   
8. In no event will the authors be held liable for any damages arising from the use of this software.
   
9. 
   
10. Permission is granted to anyone to use this software for any purpose,
    
11. including commercial applications, and to alter it and redistribute it freely,
    
12. subject to the following restrictions:
    
13. 
    
14.   1. The origin of this software must not be misrepresented;
    
15.      you must not claim that you wrote the original software.
    
16.      If you use this software in a product,
    
17.      an acknowledgment in the product documentation would be appreciated but is not required.
    
18. 
    
19.   2. Altered source versions must be plainly marked as such,
    
20.      and must not be misrepresented as being the original software.
    
21. 
    
22.   3. Redistributions of source code must retain the above copyright notice,
    
23.      this list of conditions and the following disclaimer.
    
24. 
    
25.   4. Redistributions in binary form must reproduce the above copyright notice,
    
26.      this list of conditions and the following disclaimer in the documentation
    
27.      and/or other materials provided with the distribution.
    
28. 
    
29.   5. This notice may not be removed or altered from any source distribution.
    
30. 
    
31. -------------------------------------------------------------------------------------------------
    
32. edited at 23:47 2006-06-21 by Eric Sure
    
33. |;
    
34. (defun c:fe_be ( / dcl_id
    
35.     KL KL1 KL2 WKL WKL1 WKL2 KZL KZL1 KZL2 L L1 L2 XL XL1 XL2 JSL JSL1 JSL2
    
36.     mode_resortx mode_resorty RESORT RESORT1 resort_mode mode_sortxy)
    
37. 
    
38. (my-cmdbegin 65)
    
39. 
    
40. (princ "Welcome to visit [url]http://www.mystruc.com,the[/url] codes by Eric Sure")
    
41.   (setq dcl_id (load_dialog "beamresort.dcl"))
    
42.   (if (not (new_dialog "dcl_beamresort" dcl_id)) (exit))
    
43. 
    
44.   (defun mode_resort()
    
45.       (if (= RESORT 1)
    
46.         (progn
    
47.           (mode_tile "resort1" 0)
    
48.           (if (= RESORT1 1)
    
49.       (progn
    
50.         (mode_tile "xysort"  1)
    
51.         (mode_tile "xresort" 1)
    
52.         (mode_tile "yresort" 1))
    
53.             ;else
    
54.             (progn
    
55.         (mode_tile "xysort"  0)
    
56.         (mode_tile "xresort" 0)
    
57.         (mode_tile "yresort" 0))
    
58.           )
    
59.        )
    
60.        ;else
    
61.        (progn
    
62.           (mode_tile "resort1" 1)
    
63.           (mode_tile "xysort"  1)
    
64.     (mode_tile "xresort" 1)
    
65.     (mode_tile "yresort" 1))
    
66.       )
    
67.         
    
68.   )
    
69. 
    
70.   (defun choose_resort ( resortmode )
    
71.     (setq RESORT (atoi resortmode)
    
72.           RESORT1 (atoi resortmode)
    
73.      ;mode_resortx (atoi resortmode)
    
74.      ;mode_resorty (atoi resortmode)
    
75.     )
    
76.   )
    
77.   (defun choose_resort1 ( resortmode )
    
78.     (setq RESORT1 (atoi resortmode)
    
79.      ;mode_resortx (atoi resortmode)
    
80.      ;mode_resorty (atoi resortmode)
    
81.     )
    
82.   )
    
83. 
    
84.   (defun choose_sortxy ( resortmode )
    
85.     (cond
    
86.       ((= resortmode "xtoy")(setq mode_sortxy 64))
    
87.       ((= resortmode "ytox")(setq mode_sortxy 128))
    
88.     )
    
89.    
    
90.   )
    
91. 
    
92.   (defun choose_resortx ( resortmode )
    
93.     (cond
    
94.       ((= resortmode "xminmax")(setq mode_resortx 2))
    
95.       ((= resortmode "xmaxmin")(setq mode_resortx 4))
    
96.     )
    
97.    
    
98.   )
    
99.   (defun choose_resorty ( resortmode )
    
100.     (cond
     
101.       ((= resortmode "yminmax")(setq mode_resorty 8))
     
102.       ((= resortmode "ymaxmin")(setq mode_resorty 16))
     
103.     )
     
104.   )
     
105.   
     
106. 
     
107.   (set_tile "KL1"  "KL") (setq KL1  "KL")
     
108.   (set_tile "WKL1" "WKL")(setq WKL1 "WKL")
     
109.   (set_tile "KZL1" "KZL")(setq KZL1 "KZL")
     
110.   (set_tile "L1"   "L")  (setq L1   "L")
     
111.   (set_tile "XL1"  "XL") (setq XL1  "XL")
     
112.   (set_tile "JSL1" "JSL")(setq JSL1 "JSL")
     
113. 
     
114.   (set_tile "KL2"  "KL") (setq KL2  "KL")
     
115.   (set_tile "WKL2" "WKL")(setq WKL2 "WKL")
     
116.   (set_tile "KZL2" "KZL")(setq KZL2 "KZL")
     
117.   (set_tile "L2"   "L")  (setq L2   "L")
     
118.   (set_tile "XL2"  "XL") (setq XL2  "XL")
     
119.   (set_tile "JSL2" "JSL")(setq JSL2 "JSL")
     
120. 
     
121.   (set_tile "KL"  "1")(setq KL  1)
     
122.   (set_tile "WKL" "1")(setq WKL 1)
     
123.   (set_tile "KZL" "1")(setq KZL 1)
     
124.   (set_tile "L"   "1")(setq L   1)
     
125.   (set_tile "XL"  "1")(setq XL  1)
     
126.   (set_tile "JSL" "1")(setq JSL 1)
     
127. 
     
128.   (set_tile "resort" "1") (setq RESORT 1)
     
129.   (set_tile "resort1" "1")(setq RESORT1 1)
     
130. 
     
131.   (set_tile "xtoy" "1")(setq mode_sortxy 64)
     
132. 
     
133.   (set_tile "xminmax" "1") (setq mode_resortx 2)
     
134.   (set_tile "yminmax" "1") (setq mode_resorty 8)
     
135. 
     
136.   (mode_resort)
     
137.   ;(mode_tile "xresort" 1)
     
138. 
     
139.   (action_tile "KL1"    "(setq KL1   $value)")
     
140.   (action_tile "WKL1"   "(setq WKL1  $value)")
     
141.   (action_tile "KZL1"   "(setq KZL1  $value)")
     
142.   (action_tile "L1"     "(setq L1    $value)")
     
143.   (action_tile "XL1"    "(setq XL1   $value)")
     
144.   (action_tile "JSL1"   "(setq JSL1  $value)")
     
145. 
     
146.   (action_tile "KL2"    "(setq KL2   $value)")
     
147.   (action_tile "WKL2"   "(setq WKL2  $value)")
     
148.   (action_tile "KZL2"   "(setq KZL2  $value)")
     
149.   (action_tile "L2"     "(setq L2    $value)")
     
150.   (action_tile "XL2"    "(setq XL2   $value)")
     
151.   (action_tile "JSL2"   "(setq JSL2  $value)")
     
152. 
     
153.   (action_tile "KL"    "(setq KL   (atoi $value))")
     
154.   (action_tile "WKL"   "(setq WKL  (atoi $value))")
     
155.   (action_tile "KZL"   "(setq KZL  (atoi $value))")
     
156.   (action_tile "L"     "(setq L    (atoi $value))")
     
157.   (action_tile "XL"    "(setq XL   (atoi $value))")
     
158.   (action_tile "JSL"   "(setq JSL  (atoi $value))")
     
159. 
     
160.   (action_tile "resort" "(choose_resort $value)(mode_resort)")
     
161.   (action_tile "resort1" "(choose_resort1 $value)(mode_resort)")
     
162. 
     
163.   (action_tile "xysort" "(choose_sortxy $value)")
     
164. 
     
165.   (action_tile "xresort" "(choose_resortx $value)")
     
166.   (action_tile "yresort" "(choose_resorty $value)")
     
167.    
     
168. 
     
169.   (action_tile "accept"  "(done_dialog)")
     
170.   (action_tile "cancel"  "(exit)")
     
171. 
     
172.   (start_dialog)
     
173. 
     
174. 
     
175.   (setq ss (ssget ' ((0 . "TEXT"))))
     
176. 
     
177.   (setq resort_mode 0)
     
178.   ;(princ "=")(princ RESORT)(princ RESORT1)(princ ";")(princ mode_resortx)(princ mode_resorty)
     
179.   (if (= 1 RESORT)
     
180.      (if (= 1 RESORT1)
     
181.    (setq resort_mode 1)
     
182.    (progn
     
183.      (if mode_resortx (setq resort_mode (+ resort_mode mode_resortx)))
     
184.      (if mode_resorty (setq resort_mode (+ resort_mode mode_resorty)))
     
185.      (setq resort_mode (+ resort_mode mode_sortxy))
     
186.    )
     
187.      )
     
188.      (setq resort_mode 0)
     
189.   )
     
190.   ;(princ "mode:") (princ resort_mode)
     
191.   (if (= KL 1)
     
192.     (beamresort ss KL1 KL2 resort_mode))
     
193.   (if (= WKL 1)
     
194.     (beamresort ss WKL1 WKL2 resort_mode))
     
195.   (if (= KZL 1)
     
196.     (beamresort ss KZL1 KZL2 resort_mode))
     
197.   (if (= L 1)
     
198.     (beamresort ss L1 L2  resort_mode))
     
199.   (if (= XL 1)
     
200.     (beamresort ss XL1 XL2 resort_mode))
     
201.   (if (= JSL 1)
     
202.     (beamresort ss JSL1 JSL2 resort_mode))
     
203. 
     
204. 
     
205.   (unload_dialog dcl_id)
     
206. (my-cmdend 65)
     
207. )
     
208. 
     
209. 
     
210. ;--- end interface------
     
211. ;|
     
212. 梁代号替换，按原序重排
     
213. |;
     
214. (defun beamresort( Seletionset Beamheader BeamheaderNew  SortType / Rexp ss1 lst1 i j en str str1 str2 n SortType1
     
215.       ss1x ss1y lst1x lst1y sslst1x sslst1y x)
     
216. (setq Beamheader (strcase Beamheader)
     
217.   BeamheaderNew (strcase BeamheaderNew))
     
218. (setq Rexp (strcat Beamheader "*")
     
219.   Startpos (+ 1 (strlen Beamheader)))
     
220. (setq ss1 (ssadd);梁号字符串选择集
     
221.   lst1 '()
     
222.   i -1)
     
223. ;形成梁号字符串选择集ss1
     
224. (repeat (sslength Seletionset)
     
225.    (setq en (ssname Seletionset (setq i (1+ i))))
     
226.    (setq str (dxf_read 1 en))
     
227.    (if (wcmatch str Rexp)
     
228.        (setq ss1 (ssadd en ss1))
     
229.    )
     
230. )
     
231. (if ss1
     
232.   (cond
     
233.    ((= SortType 0) ;不排序
     
234.             (setq i -1)
     
235.       (repeat (sslength ss1)
     
236.         (setq en (ssname ss1 (setq i (1+ i))))
     
237.         (setq str  (dxf_read 1 en))
     
238.         (setq n (get_beam_no str Beamheader))
     
239.         (setq str1 (strcat BeamheaderNew (itoa n)))
     
240.         (setq str2 (strcat Beamheader (itoa n)))
     
241.         (setq str1 (vl-string-subst str1 str2 str))
     
242.         (dxf_replace 1 str1 en)
     
243.       ))
     
244.    ((= SortType 1) ;原序重排
     
245.       ;形成梁号排序列表lst1
     
246.       (setq i -1)
     
247.       (repeat (sslength ss1)
     
248.         (setq en (ssname ss1 (setq i (1+ i))))
     
249.         (setq str (dxf_read 1 en))
     
250.         (setq lst1 (cons (get_beam_no str Beamheader) lst1))
     
251.       )
     
252.       ;梁号排序
     
253.       (if (> (length lst1) 0)
     
254.         ;按原序
     
255.         (setq lst1 (vl-sort lst1
     
256.       (function (lambda (i j) (<  i  j) ) ))  ;从小到大  
     
257.         )
     
258.       )
     
259.          ;从1开始编号
     
260.           (beamresortmain ss1 lst1 1))
     
261.    (T  
     
262.         ;形成X向(文字90度)梁号选择集ss1x和Y向(文字0度)梁号选择集ss1y
     
263.     (setq ss1x (ssadd)
     
264.     ss1y (ssadd))
     
265.     (setq i -1)
     
266.     (repeat (sslength ss1)
     
267.       (setq en (ssname ss1 (setq i (1+ i))))
     
268.       (setq ang (dxf_read 50 en))
     
269.       (if (and (< (* pi 0.25) ang) (> (* pi 1.5) ang))
     
270.         (setq ss1x (ssadd en ss1x))
     
271.         (setq ss1y (ssadd en ss1y))
     
272.       )
     
273.     )
     
274.          (setq SortType1 (logand 63 SortType))
     
275.         (cond
     
276.       ((= SortType1 10) ;左->右，下->上
     
277.              ;对选择集ss1x和ss1y进行排序
     
278.         (setq sslst1x (fevl-sort-text ss1x 4))
     
279.         (setq sslst1y (fevl-sort-text ss1y 2)))
     
280.     ((= SortType1 12) ;右->左，下->上
     
281.              ;对选择集ss1x和ss1y进行排序
     
282.         (setq sslst1x (fevl-sort-text ss1x 3))
     
283.         (setq sslst1y (fevl-sort-text ss1y 2)))
     
284.     ((= SortType1 18) ;左->右，上->下
     
285.              ;对选择集ss1x和ss1y进行排序
     
286.         (setq sslst1x (fevl-sort-text ss1x 4))
     
287.         (setq sslst1y (fevl-sort-text ss1y 1)))
     
288.     ((= SortType1 20) ;右->左，上->下
     
289.              ;对选择集ss1x和ss1y进行排序
     
290.         (setq sslst1x (fevl-sort-text ss1x 3))
     
291.         (setq sslst1y (fevl-sort-text ss1y 1)))
     
292.     )
     
293.     ;形成X和Y向梁号排序列表lst1x和lst1y
     
294.     (setq lst1x '()
     
295.     lst1y '()
     
296.     )
     
297.     (foreach x sslst1x
     
298.       (progn
     
299.         (setq en (cdr x))
     
300.         (setq str (dxf_read 1 en))
     
301.         (setq str (get_beam_no str Beamheader))
     
302.         (if (not (member str lst1x))
     
303.           (setq lst1x (cons str lst1x))
     
304.         )
     
305.       )
     
306.     )
     
307.     (foreach x sslst1y
     
308.       (progn
     
309.         (setq en (cdr x))
     
310.         (setq str (dxf_read 1 en))
     
311.         (setq str (get_beam_no str Beamheader))
     
312.         (if (not (member str lst1y))
     
313.           (setq lst1y (cons str lst1y))
     
314.         )
     
315.       )
     
316.     )
     
317.     (setq lst1x (reverse lst1x)
     
318.           lst1y (reverse lst1y))
     
319.          
     
320.     ;从1开始编号
     
321.          (setq SortType1 (logand 224 SortType))
     
322.          (cond
     
323.       ((= SortType1 64)
     
324.            (beamresortmain ss1x lst1x 1)
     
325.            (beamresortmain ss1y lst1y (+ 1 (length lst1x))))
     
326.       ((= SortType1 128)
     
327.            (beamresortmain ss1y lst1y 1)
     
328.            (beamresortmain ss1x lst1x (+ 1 (length lst1y))))
     
329.     )
     
330.       
     
331.     );end T
     
332.   );end cond
     
333. );end if ss1
     
334. )
     
335. 
     
336. ;;;;;;;;;;;;;;
     
337. (defun beamresortmain ( sset lstnsort nstart / i j en str str1 str2 n )
     
338. (if (> (length lstnsort) 0)
     
339.       (progn      
     
340.       ;梁号重排
     
341.       (setq i -1)
     
342.       (repeat (sslength sset)
     
343.         (setq en (ssname sset (setq i (1+ i))))
     
344.         (setq str  (dxf_read 1 en))
     
345.         ;(setq str (my-string-delete-space str));剔除空格
     
346.         (setq n (get_beam_no str Beamheader))
     
347.         (setq j -1)
     
348.         (repeat (length lstnsort)
     
349.           (setq j (1+ j))
     
350.           (if (= n (nth j lstnsort))
     
351.       (progn
     
352.         (setq str1 (strcat BeamheaderNew (itoa (+ j nstart))))
     
353.         (setq str2 (strcat Beamheader (itoa n)))
     
354.         (setq str1 (vl-string-subst str1 str2 str))
     
355.         (dxf_replace 1 str1 en)
     
356.       )
     
357.           )
     
358.         )
     
359.       )
     
360.       )
     
361.   )
     
362. )
     
363. 
     
364. 
     
365. ;取得梁号
     
366. (defun get_beam_no ( string Beamheader / n )
     
367. (setq n (vl-string-position 40 string))
     
368. (if (>= n 0) (setq string (substr str (+ (strlen Beamheader) 1) n)))
     
369. (atoi string)
     
370. )
     
371. 
     

<br /> ;|file:beamresort.lsp<br /> -------------------------------------------------------------------------------------------------<br /> Copyright (c) 2006 杨百朋, Eric Sure, [url]www.mystruc.com[/url]<br /> <br /> This software is provided 'as-is', without any express or implied warranty.<br /> In no event will the authors be held liable for any damages arising from the use of this software.<br /> <br /> Permission is granted to anyone to use this software for any purpose,<br /> including commercial applications, and to alter it and redistribute it freely,<br /> subject to the following restrictions:<br /> <br />   1. The origin of this software must not be misrepresented;<br />      you must not claim that you wrote the original software.<br />      If you use this software in a product,<br />      an acknowledgment in the product documentation would be appreciated but is not required.<br /> <br />   2. Altered source versions must be plainly marked as such,<br />      and must not be misrepresented as being the original software.<br /> <br />   3. Redistributions of source code must retain the above copyright notice,<br />      this list of conditions and the following disclaimer.<br /> <br />   4. Redistributions in binary form must reproduce the above copyright notice,<br />      this list of conditions and the following disclaimer in the documentation<br />      and/or other materials provided with the distribution.<br /> <br />   5. This notice may not be removed or altered from any source distribution.<br /> <br /> -------------------------------------------------------------------------------------------------<br /> edited at 23:47 2006-06-21 by Eric Sure<br /> |;<br /> (defun c:fe_be ( / dcl_id<br />     KL KL1 KL2 WKL WKL1 WKL2 KZL KZL1 KZL2 L L1 L2 XL XL1 XL2 JSL JSL1 JSL2<br />     mode_resortx mode_resorty RESORT RESORT1 resort_mode mode_sortxy)<br /> <br /> (my-cmdbegin 65)<br /> <br /> (princ "Welcome to visit [url]http://www.mystruc.com,the[/url] codes by Eric Sure")<br />   (setq dcl_id (load_dialog "beamresort.dcl"))<br />   (if (not (new_dialog "dcl_beamresort" dcl_id)) (exit))<br /> <br />   (defun mode_resort()<br />       (if (= RESORT 1)<br />         (progn<br />           (mode_tile "resort1" 0)<br />           (if (= RESORT1 1)<br />       (progn<br />         (mode_tile "xysort"  1)<br />         (mode_tile "xresort" 1)<br />         (mode_tile "yresort" 1))<br />             ;else<br />             (progn<br />         (mode_tile "xysort"  0)<br />         (mode_tile "xresort" 0)<br />         (mode_tile "yresort" 0))<br />           )<br />        )<br />        ;else<br />        (progn<br />           (mode_tile "resort1" 1)<br />           (mode_tile "xysort"  1)<br />     (mode_tile "xresort" 1)<br />     (mode_tile "yresort" 1))<br />       )<br />         <br />   )<br /> <br />   (defun choose_resort ( resortmode )<br />     (setq RESORT (atoi resortmode)<br />           RESORT1 (atoi resortmode)<br />      ;mode_resortx (atoi resortmode)<br />      ;mode_resorty (atoi resortmode)<br />     )<br />   )<br />   (defun choose_resort1 ( resortmode )<br />     (setq RESORT1 (atoi resortmode)<br />      ;mode_resortx (atoi resortmode)<br />      ;mode_resorty (atoi resortmode)<br />     )<br />   )<br /> <br />   (defun choose_sortxy ( resortmode )<br />     (cond<br />       ((= resortmode "xtoy")(setq mode_sortxy 64))<br />       ((= resortmode "ytox")(setq mode_sortxy 128))<br />     )<br />    <br />   )<br /> <br />   (defun choose_resortx ( resortmode )<br />     (cond<br />       ((= resortmode "xminmax")(setq mode_resortx 2))<br />       ((= resortmode "xmaxmin")(setq mode_resortx 4))<br />     )<br />    <br />   )<br />   (defun choose_resorty ( resortmode )<br />     (cond<br />       ((= resortmode "yminmax")(setq mode_resorty 8))<br />       ((= resortmode "ymaxmin")(setq mode_resorty 16))<br />     )<br />   )<br />   <br /> <br />   (set_tile "KL1"  "KL") (setq KL1  "KL")<br />   (set_tile "WKL1" "WKL")(setq WKL1 "WKL")<br />   (set_tile "KZL1" "KZL")(setq KZL1 "KZL")<br />   (set_tile "L1"   "L")  (setq L1   "L")<br />   (set_tile "XL1"  "XL") (setq XL1  "XL")<br />   (set_tile "JSL1" "JSL")(setq JSL1 "JSL")<br /> <br />   (set_tile "KL2"  "KL") (setq KL2  "KL")<br />   (set_tile "WKL2" "WKL")(setq WKL2 "WKL")<br />   (set_tile "KZL2" "KZL")(setq KZL2 "KZL")<br />   (set_tile "L2"   "L")  (setq L2   "L")<br />   (set_tile "XL2"  "XL") (setq XL2  "XL")<br />   (set_tile "JSL2" "JSL")(setq JSL2 "JSL")<br /> <br />   (set_tile "KL"  "1")(setq KL  1)<br />   (set_tile "WKL" "1")(setq WKL 1)<br />   (set_tile "KZL" "1")(setq KZL 1)<br />   (set_tile "L"   "1")(setq L   1)<br />   (set_tile "XL"  "1")(setq XL  1)<br />   (set_tile "JSL" "1")(setq JSL 1)<br /> <br />   (set_tile "resort" "1") (setq RESORT 1)<br />   (set_tile "resort1" "1")(setq RESORT1 1)<br /> <br />   (set_tile "xtoy" "1")(setq mode_sortxy 64)<br /> <br />   (set_tile "xminmax" "1") (setq mode_resortx 2)<br />   (set_tile "yminmax" "1") (setq mode_resorty 8)<br /> <br />   (mode_resort)<br />   ;(mode_tile "xresort" 1)<br /> <br />   (action_tile "KL1"    "(setq KL1   $value)")<br />   (action_tile "WKL1"   "(setq WKL1  $value)")<br />   (action_tile "KZL1"   "(setq KZL1  $value)")<br />   (action_tile "L1"     "(setq L1    $value)")<br />   (action_tile "XL1"    "(setq XL1   $value)")<br />   (action_tile "JSL1"   "(setq JSL1  $value)")<br /> <br />   (action_tile "KL2"    "(setq KL2   $value)")<br />   (action_tile "WKL2"   "(setq WKL2  $value)")<br />   (action_tile "KZL2"   "(setq KZL2  $value)")<br />   (action_tile "L2"     "(setq L2    $value)")<br />   (action_tile "XL2"    "(setq XL2   $value)")<br />   (action_tile "JSL2"   "(setq JSL2  $value)")<br /> <br />   (action_tile "KL"    "(setq KL   (atoi $value))")<br />   (action_tile "WKL"   "(setq WKL  (atoi $value))")<br />   (action_tile "KZL"   "(setq KZL  (atoi $value))")<br />   (action_tile "L"     "(setq L    (atoi $value))")<br />   (action_tile "XL"    "(setq XL   (atoi $value))")<br />   (action_tile "JSL"   "(setq JSL  (atoi $value))")<br /> <br />   (action_tile "resort" "(choose_resort $value)(mode_resort)")<br />   (action_tile "resort1" "(choose_resort1 $value)(mode_resort)")<br /> <br />   (action_tile "xysort" "(choose_sortxy $value)")<br /> <br />   (action_tile "xresort" "(choose_resortx $value)")<br />   (action_tile "yresort" "(choose_resorty $value)")<br />    <br /> <br />   (action_tile "accept"  "(done_dialog)")<br />   (action_tile "cancel"  "(exit)")<br /> <br />   (start_dialog)<br /> <br /> <br />   (setq ss (ssget ' ((0 . "TEXT"))))<br /> <br />   (setq resort_mode 0)<br />   ;(princ "=")(princ RESORT)(princ RESORT1)(princ ";")(princ mode_resortx)(princ mode_resorty)<br />   (if (= 1 RESORT)<br />      (if (= 1 RESORT1)<br />    (setq resort_mode 1)<br />    (progn<br />      (if mode_resortx (setq resort_mode (+ resort_mode mode_resortx)))<br />      (if mode_resorty (setq resort_mode (+ resort_mode mode_resorty)))<br />      (setq resort_mode (+ resort_mode mode_sortxy))<br />    )<br />      )<br />      (setq resort_mode 0)<br />   )<br />   ;(princ "mode:") (princ resort_mode)<br />   (if (= KL 1)<br />     (beamresort ss KL1 KL2 resort_mode))<br />   (if (= WKL 1)<br />     (beamresort ss WKL1 WKL2 resort_mode))<br />   (if (= KZL 1)<br />     (beamresort ss KZL1 KZL2 resort_mode))<br />   (if (= L 1)<br />     (beamresort ss L1 L2  resort_mode))<br />   (if (= XL 1)<br />     (beamresort ss XL1 XL2 resort_mode))<br />   (if (= JSL 1)<br />     (beamresort ss JSL1 JSL2 resort_mode))<br /> <br /> <br />   (unload_dialog dcl_id)<br /> (my-cmdend 65)<br /> )<br /> <br /> <br /> ;--- end interface------<br /> ;|<br /> 梁代号替换，按原序重排<br /> |;<br /> (defun beamresort( Seletionset Beamheader BeamheaderNew  SortType / Rexp ss1 lst1 i j en str str1 str2 n SortType1<br />       ss1x ss1y lst1x lst1y sslst1x sslst1y x)<br /> (setq Beamheader (strcase Beamheader)<br />   BeamheaderNew (strcase BeamheaderNew))<br /> (setq Rexp (strcat Beamheader "*")<br />   Startpos (+ 1 (strlen Beamheader)))<br /> (setq ss1 (ssadd);梁号字符串选择集<br />   lst1 '()<br />   i -1)<br /> ;形成梁号字符串选择集ss1<br /> (repeat (sslength Seletionset)<br />    (setq en (ssname Seletionset (setq i (1+ i))))<br />    (setq str (dxf_read 1 en))<br />    (if (wcmatch str Rexp)<br />        (setq ss1 (ssadd en ss1))<br />    )<br /> )<br /> (if ss1<br />   (cond<br />    ((= SortType 0) ;不排序<br />             (setq i -1)<br />       (repeat (sslength ss1)<br />         (setq en (ssname ss1 (setq i (1+ i))))<br />         (setq str  (dxf_read 1 en))<br />         (setq n (get_beam_no str Beamheader))<br />         (setq str1 (strcat BeamheaderNew (itoa n)))<br />         (setq str2 (strcat Beamheader (itoa n)))<br />         (setq str1 (vl-string-subst str1 str2 str))<br />         (dxf_replace 1 str1 en)<br />       ))<br />    ((= SortType 1) ;原序重排<br />       ;形成梁号排序列表lst1<br />       (setq i -1)<br />       (repeat (sslength ss1)<br />         (setq en (ssname ss1 (setq i (1+ i))))<br />         (setq str (dxf_read 1 en))<br />         (setq lst1 (cons (get_beam_no str Beamheader) lst1))<br />       )<br />       ;梁号排序<br />       (if (> (length lst1) 0)<br />         ;按原序<br />         (setq lst1 (vl-sort lst1<br />       (function (lambda (i j) (<  i  j) ) ))  ;从小到大  <br />         )<br />       )<br />          ;从1开始编号<br />           (beamresortmain ss1 lst1 1))<br />    (T  <br />         ;形成X向(文字90度)梁号选择集ss1x和Y向(文字0度)梁号选择集ss1y<br />     (setq ss1x (ssadd)<br />     ss1y (ssadd))<br />     (setq i -1)<br />     (repeat (sslength ss1)<br />       (setq en (ssname ss1 (setq i (1+ i))))<br />       (setq ang (dxf_read 50 en))<br />       (if (and (< (* pi 0.25) ang) (> (* pi 1.5) ang))<br />         (setq ss1x (ssadd en ss1x))<br />         (setq ss1y (ssadd en ss1y))<br />       )<br />     )<br />          (setq SortType1 (logand 63 SortType))<br />         (cond<br />       ((= SortType1 10) ;左->右，下->上<br />              ;对选择集ss1x和ss1y进行排序<br />         (setq sslst1x (fevl-sort-text ss1x 4))<br />         (setq sslst1y (fevl-sort-text ss1y 2)))<br />     ((= SortType1 12) ;右->左，下->上<br />              ;对选择集ss1x和ss1y进行排序<br />         (setq sslst1x (fevl-sort-text ss1x 3))<br />         (setq sslst1y (fevl-sort-text ss1y 2)))<br />     ((= SortType1 18) ;左->右，上->下<br />              ;对选择集ss1x和ss1y进行排序<br />         (setq sslst1x (fevl-sort-text ss1x 4))<br />         (setq sslst1y (fevl-sort-text ss1y 1)))<br />     ((= SortType1 20) ;右->左，上->下<br />              ;对选择集ss1x和ss1y进行排序<br />         (setq sslst1x (fevl-sort-text ss1x 3))<br />         (setq sslst1y (fevl-sort-text ss1y 1)))<br />     )<br />     ;形成X和Y向梁号排序列表lst1x和lst1y<br />     (setq lst1x '()<br />     lst1y '()<br />     )<br />     (foreach x sslst1x<br />       (progn<br />         (setq en (cdr x))<br />         (setq str (dxf_read 1 en))<br />         (setq str (get_beam_no str Beamheader))<br />         (if (not (member str lst1x))<br />           (setq lst1x (cons str lst1x))<br />         )<br />       )<br />     )<br />     (foreach x sslst1y<br />       (progn<br />         (setq en (cdr x))<br />         (setq str (dxf_read 1 en))<br />         (setq str (get_beam_no str Beamheader))<br />         (if (not (member str lst1y))<br />           (setq lst1y (cons str lst1y))<br />         )<br />       )<br />     )<br />     (setq lst1x (reverse lst1x)<br />           lst1y (reverse lst1y))<br />          <br />     ;从1开始编号<br />          (setq SortType1 (logand 224 SortType))<br />          (cond<br />       ((= SortType1 64)<br />            (beamresortmain ss1x lst1x 1)<br />            (beamresortmain ss1y lst1y (+ 1 (length lst1x))))<br />       ((= SortType1 128)<br />            (beamresortmain ss1y lst1y 1)<br />            (beamresortmain ss1x lst1x (+ 1 (length lst1y))))<br />     )<br />       <br />     );end T<br />   );end cond<br /> );end if ss1<br /> )<br /> <br /> ;;;;;;;;;;;;;;<br /> (defun beamresortmain ( sset lstnsort nstart / i j en str str1 str2 n )<br /> (if (> (length lstnsort) 0)<br />       (progn      <br />       ;梁号重排<br />       (setq i -1)<br />       (repeat (sslength sset)<br />         (setq en (ssname sset (setq i (1+ i))))<br />         (setq str  (dxf_read 1 en))<br />         ;(setq str (my-string-delete-space str));剔除空格<br />         (setq n (get_beam_no str Beamheader))<br />         (setq j -1)<br />         (repeat (length lstnsort)<br />           (setq j (1+ j))<br />           (if (= n (nth j lstnsort))<br />       (progn<br />         (setq str1 (strcat BeamheaderNew (itoa (+ j nstart))))<br />         (setq str2 (strcat Beamheader (itoa n)))<br />         (setq str1 (vl-string-subst str1 str2 str))<br />         (dxf_replace 1 str1 en)<br />       )<br />           )<br />         )<br />       )<br />       )<br />   )<br /> )<br /> <br /> <br /> ;取得梁号<br /> (defun get_beam_no ( string Beamheader / n )<br /> (setq n (vl-string-position 40 string))<br /> (if (>= n 0) (setq string (substr str (+ (strlen Beamheader) 1) n)))<br /> (atoi string)<br /> )<br /> <br />

eachy

其中使用了自定义函数，请说明功能或贴出相关函数

netbee

它的公共函数库FEPUB.VLX 下载：
http://blog.mystruc.com/attachment/200606/fepub.rar

BLOG:mystruc - Ericsure`s blog http://blog.mystruc.com/index.php?go=category_7

biechen 以后发帖要注意，支持文件或资源文件要齐全。
而且最关键的是若是转帖要注明出处。
若不是自已原创更应该注明作者。

biechen

很简单的两个函数：

2. 
   
3. ;-----------------------------------------
   
4. ;   function dxf_read
   
5. ;-----------------------------------------
   
6. ;返回dxf群码内组码号为code的点对内容
   
7. ;参数：ename -- 一个对象的id
   
8. ;         code  -- dxf组码号
   
9. ;-----------------------------------------
   
10. (defun dxf_read (code ename)
    
11.      (cdr (assoc code (entget ename)))
    
12. )
    
13. 
    
14. －－－－－－－－－－－－－
    
15. ;|
    
16. ---------------------------------------------------------------
    
17. Function: fevl-sort-text ( ssTxt nMode / )
    
18. ----------------------------------------------------------------
    
19. 功能：文本选择集按坐标排序，返回由(点坐标 . 文本对象名)组成的排序列表
    
20. 参数：ssTxt － 文本选择集
    
21.       nMode －
    
22.       1，按Y轴由上到下排序；
    
23.       2，按Y轴由下到上排序；
    
24.       3，按X轴由右到左排序；
    
25.       4，按X轴由左到右排序；
    
26. |;
    
27. (defun fevl-sort-text (ssTxt nMode / i lstSort s1 pt ename conpt e1 e2 )
    
28.   (setq     i   -1
    
29.             lstSort  '()
    
30.   )
    
31.   (repeat (sslength ssTxt)
    
32.     (setq s1 (ssname ssTxt (setq i (1+ i))))
    
33.     (setq pt          (dxf_read 10  s1)
    
34.           ename          (dxf_read -1  s1)               
    
35.           conPt          (cons pt ename)
    
36.           lstSort (cons conPt lstSort)
    
37.     )
    
38.   )
    
39.   (cond
    
40.     ((= nMode 1)
    
41.      (setq lstSort (vl-sort lstSort (function (lambda (e1 e2) (> (cadr (car e1)) (cadr (car e2))))))))
    
42.     ((= nMode 2)
    
43.      (setq lstSort (vl-sort lstSort (function (lambda (e1 e2) (< (cadr (car e1)) (cadr (car e2))))))))
    
44.     ((= nMode 3)
    
45.      (setq lstSort (vl-sort lstSort (function (lambda (e1 e2) (> (car (car e1))  (car (car e2))))))))
    
46.     ((= nMode 4)
    
47.      (setq lstSort (vl-sort lstSort (function (lambda (e1 e2) (< (car (car e1))  (car (car e2))))))))
    
48.     (t (princ "未根据坐标排序\n"))
    
49.   )
    
50.    lstSort
    
51. )
    

<br /> ;-----------------------------------------<br /> ;   function dxf_read<br /> ;-----------------------------------------<br /> ;返回dxf群码内组码号为code的点对内容<br /> ;参数：ename -- 一个对象的id<br /> ;         code  -- dxf组码号<br /> ;-----------------------------------------<br /> (defun dxf_read (code ename)<br />      (cdr (assoc code (entget ename)))<br /> ) <br /> <br /> －－－－－－－－－－－－－<br /> ;|<br /> ---------------------------------------------------------------<br /> Function: fevl-sort-text ( ssTxt nMode / )<br /> ----------------------------------------------------------------<br /> 功能：文本选择集按坐标排序，返回由(点坐标 . 文本对象名)组成的排序列表<br /> 参数：ssTxt － 文本选择集<br />       nMode －<br />       1，按Y轴由上到下排序；<br />       2，按Y轴由下到上排序；<br />       3，按X轴由右到左排序；<br />       4，按X轴由左到右排序；<br /> |;<br /> (defun fevl-sort-text (ssTxt nMode / i lstSort s1 pt ename conpt e1 e2 )<br />   (setq     i   -1<br />             lstSort  '()<br />   )<br />   (repeat (sslength ssTxt)<br />     (setq s1 (ssname ssTxt (setq i (1+ i))))<br />     (setq pt          (dxf_read 10  s1)<br />           ename          (dxf_read -1  s1)                <br />           conPt          (cons pt ename)<br />           lstSort (cons conPt lstSort)<br />     )<br />   )<br />   (cond<br />     ((= nMode 1)<br />      (setq lstSort (vl-sort lstSort (function (lambda (e1 e2) (> (cadr (car e1)) (cadr (car e2))))))))<br />     ((= nMode 2)<br />      (setq lstSort (vl-sort lstSort (function (lambda (e1 e2) (< (cadr (car e1)) (cadr (car e2))))))))<br />     ((= nMode 3)<br />      (setq lstSort (vl-sort lstSort (function (lambda (e1 e2) (> (car (car e1))  (car (car e2))))))))<br />     ((= nMode 4)<br />      (setq lstSort (vl-sort lstSort (function (lambda (e1 e2) (< (car (car e1))  (car (car e2))))))))<br />     (t (princ "未根据坐标排序\n"))<br />   )<br />    lstSort<br /> )<br />

(my-cmdbegin 65)和(my-cmdend 65)
为运行环境设置、恢复及自定义错误处理函数，可以注释调

snoopychen

能给个动画演示么

biechen

演示：
http://blog.mystruc.com/read.php/34.htm

dwg001

楼主：主程序和子程都加载了，怎么用不起来？
　　　而编译的.VLX版本则可以运行，请楼主瞧瞧。

lhg

缺少dcl文件？？？？？

biechen

把程序中的(my-cmdbegin 65)和(my-cmdend 65)注释掉就可以了，这两个函数是环境设置及自定义错误处理函数，下面是DCL文件

ywlhml

我是初学，对你的程序很感兴趣，单不知如何使用，是不是copy到lsp中，请赐教

vang8866

它的公共函数库FEPUB.VLX 下载：   公共函数库  有些什么能说明吗