求冒泡程序（ALISP或VLISP）

kmust_tang

请各位大虾赐教！谢谢

Andyhon

Here you are

kmust_tang

打开后是乱码,整理\运行后没啥效果.。。。

图上有N个点。。。取得这些点后，存在表lst里，怎么将里面的点坐标按给定的顺序排列？？？请高手赐教！谢谢！！！

比如顺序是：纵坐标小的（先） 且 横坐标小（后）的 排在表前面。。。

Andyhon

; SORTS.LSP
; A comparison of two of the 'classic' sort routines - the Bubble and Shell
: from http://ourworld.compuserve.com/homepages/pshan/acptrick.htm
;
; In each case the sort is performed on the 2nd member of a three member list
; in the following format   ("string" REAL REAL)
;
; it Returns the sorted list.

3. (defun Shell ( ALIST / BEGSORT CTR EXCH ELAPSE ENDSORT HEAD N NEWLIST TAIL)
4. ;;
5. ;; The Shell Sort (ascending)
6. ;;
7.    (defun EXCH ( / EX_FLAG HEAD MID NEW1ST NEW2ND TAIL)
8.       (setq EX_FLAG 1)
9.          (while EX_FLAG
10.             (setq
11.                   NEW1st (list (nth (+ CTR D ) NEWLIST))                                   ; Switch value at D interval to CURRENT
12.                   NEW2nd (list (nth CTR NEWLIST))                                          ; Switch CURRENT value to D interval
13.                   HEAD (reverse (cdr (member (nth CTR NEWLIST) (reverse NEWLIST))))        ; First part of list
14.                   MID (member (nth (1+ CTR) NEWLIST) (reverse
15.                       (member (nth (1- (+ CTR D)) NEWLIST) (reverse NEWLIST))))            ; Between CURRENT and D interval
16.                   TAIL (cdr (member (nth (+ CTR D) NEWLIST) NEWLIST))                      ; Remainder of list
17.                   NEWLIST (append HEAD NEW1st MID NEW2nd TAIL)                             ; Revised list
18.                   CTR (- CTR D)
19.              )
20.              (if (>= CTR 0)
21.                 (progn
22.                    (if (<= (cadr (nth CTR NEWLIST)) (cadr (nth (+ CTR D) NEWLIST)))        ; Add Jump Dist to Current location
23.                        (setq EX_FLAG nil))
24.                 );progn
25.                 (setq EX_FLAG nil)
26.             )
27.          );WHILE
28.    )
29.   (if (or (null ALIST)
30.           (not (= (type ALIST) 'LIST ))
31.       )
32.     (progn
33.        (princ "Argument is not a valid list")(print)
34.     )
35.     (progn
36.        (setq
37.              NEWLIST ALIST                                                                 ; Make a copy to work on
38.              D (abs (/ (length NEWLIST) 2))                                                ; D will be an integer
39.              N (1- (length NEWLIST))                                                       ; first member of list is 0
40.              BEGSORT (getvar "CDATE")                                                      ; Get starting time
41.        )
42.        (repeat 3 (print))
43.        (princ "\nSorting...please wait")
44.        (while (> D 0)                                                                      ; Do the sorting
45.           (setq L (- N D)
46.                 J 0
47.           )
48.           (while (<= J L)
49.              (if (> (cadr (nth J NEWLIST)) (cadr (nth (+ J D) NEWLIST)))
50.                  (progn
51.                       (setq CTR J)
52.                       (EXCH)
53.                  )
54.              )
55.              (setq J (1+ J))
56.           )
57.           (setq D (abs (/ D 2)))
58.        )
59.        (setq ENDSORT (getvar "CDATE"))                                                     ; Get ending time
60.        (RPT_TIME)                                                                          ; Calculate and report elapsed time
61.        (textpage)                                                                          ; Clear screen
62.        NEWLIST                                                                             ; Return sorted list
63.     );progn
64.   );if
65. );Shell
67. (defun BubSort ( ALIST / BEGSORT CTR ELAPSE ENDSORT EXCHNG HEAD N NEWLIST TAIL)
68. ;;;
69. ; Bubble sort (ascending)
70. ;;;
71.    (defun EXCHNG ( / NEW1ST NEW2ND HEAD TAIL)
72.       (repeat (length NEWLIST)
73.          (repeat (- (length NEWLIST) 1)
74.             (if (> (cadr (nth CTR NEWLIST)) (cadr (nth (1+ CTR) NEWLIST)))                ; Compare CURRENT to NEXT
75.               (progn
76.                  (setq NEW1st (list (nth (1+ CTR) NEWLIST))                               ; Switch NEXT to CURRENT
77.                        NEW2nd (list (nth CTR NEWLIST))                                    ; Switch CURRENT to NEXT
78.                        HEAD (reverse (cdr (member (nth CTR NEWLIST) (reverse NEWLIST))))  ; First part of list
79.                        TAIL (cdr (member (nth (1+ CTR) NEWLIST) NEWLIST))                 ; Remainder of list
80.                        NEWLIST (append HEAD NEW1st NEW2nd TAIL))                          ; Revised list
81.               );progn
82.            );if
83.            (setq CTR (1+ CTR))
84.          );repeat
85.          (setq CTR 0)
86.        );repeat
87.    );EXCHNG
88.   (if (or (null ALIST)
89.          (not (= (type ALIST) 'LIST ))
90.       )
91.     (progn
92.        (princ "Argument is not a valid list")(print)
93.     )
94.     (progn
95.        (repeat 3 (print))
96.        (princ "\nSorting...please wait")
97.        (setq CTR 0                                                                        ; Initialize Counter
98.              N (length ALIST)                                                             ; Number of records (sublists)
99.              NEWLIST ALIST                                                                ; Make a copy to work on
100.              BEGSORT (getvar "CDATE")                                                     ; Get starting time
101.        )
102.        (EXCHNG)                                                                           ; Do the sorting
103.        (setq ENDSORT (getvar "CDATE"))                                                    ; Get ending time
104.        (RPT_TIME)                                                                         ; Calculate and report elapsed time
105.        (textpage)                                                                         ; Clear screen
106.        NEWLIST                                                                            ; Return sorted list
107.     );progn
108.   );if
109. );BubSort
110. (defun C:SORT ()
111.    (SEL-OPT "Short Long"
112.             "\nSelect List  TYPE "
113.             "Short"
114.             "Short Long<")
115.    (cond ((= OPTION "Short")
116.          (setq LST '(
117.              ("string1" 5.41 11.05)
118.              ("string2" 2.42 45.09)
119.              ("string3" 4.13 19.25)
120.              ("string4" 9.24 34.75)
121.              ("string5" 5.15 42.05)
122.              ("string6" 2.36 13.35)
123.              ("string7" 0.67 21.05)
124.              ("string8" 7.68 11.55)
125.              ("string8a" 7.68 11.55)
126.              ("string9" 5.09 11.05)
127.              ("string10" 2.71 45.09)
128.              ("string11" 4.92 19.25)
129.              ("string12" 9.33 34.75)
130.              ("string13" 5.04 42.05)
131.              ("string14" 2.25 13.35)
132.              ("string15" 0.66 21.05)
133.              ("string16" 7.57 11.55)
134.              ("string17" 3.78 45.09)
135.              ("string18" 7.99 19.25)
136.              ("string19" 1.31 34.75)
137.              ("string20" 9.02 42.05)
138.              ("string21" 5.23 13.35)
139.              ("string22" 3.64 21.05)
140.              ("string23" 0.55 11.55)
141.              ("string24" 32.76 45.09)
142.              ("string25" 44.97 19.25)
143.              )
144.           );setq
145.          );option
146.          ((= OPTION "Long")
147.            (setq LST '(("string1" 5.41 11.05)("string2" 2.42 45.09)("string3" 4.13 19.25)("string4" 9.24 34.75)("string5" 5.15 42.05)("string6" 2.36 13.35)("string7" 0.67 21.05)("string8" 7.68 11.55)("string9" 5.09 11.05)("string10" 2.71 45.09)("string11" 4.92 19.25)("string12" 9.33 34.75)("string13" 5.04 42.05)("string14" 2.25 13.35)("string15" 0.66 21.05)("string16" 7.57 11.55)("string17" 3.78 45.09)("string18" 7.99 19.25)("string19" 1.31 34.75)("string20" 7.68 11.55)("string21" 4.93 19.25)("string22" 9.3
149. 4 34.75)("string23" 5.05 42.05)("string24" 2.26 13.35)("string25" 7.68 21.05)("string26" 7.58 11.55)("string27" 3.79 45.09)("string28" 7.10 19.25)("string29" 1.32 34.75)("string30" 7.69 11.55)("string31" 4.94 19.25)("string32" 9.35 34.75)("string33" 5.06 42.05)("string34" 2.27 13.35)("string35" 7.69 21.05)("string36" 7.59 11.55)("string37" 3.80 45.09)("string38" 7.11 19.25)("string39" 1.33 34.75)("string40" 7.70 11.55)("string41" 4.95 19.25)("string42" 9.36 34.75)("string43" 5.07 42.05)("string44" 2.28 13.3
151. 5)("string45" 7.70 21.05)("string46" 7.60 11.55)("string47" 3.81 45.09)("string48" 7.12 19.25)("string49" 1.34 34.75)("string40" 7.71 11.55)("string51" 4.96 19.25)("string52" 9.37 34.75)
152.            )))
153.           (t)
154.    );cond
155.    (SEL-OPT "Bubble Shell X"
156.             "\nSelect Sort TYPE... "
157.             "Bubble"
158.             "Bubble/Shell/eXit<")
159.    (cond ((= OPTION "Bubble")(BubSort lst))
160.          ((= OPTION "Shell")(Shell lst))
161.          (t)
162.    )
163. )
164. (defun CONVERT ( MOMENT / HR MN SEC DIFF )
165.       (setq HR  (/ (atof (substr MOMENT 1 2)) 24.0)
166.             MN (/ (/ (atof (substr MOMENT 3 2)) 60.0) 24.0)
167.             SEC (/ (/ (/ (atof (substr MOMENT 5 2)) 60.0) 60.0) 24.0)
168.             DIFF (+ HR MN SEC))
169. );CONVERT
170. (defun RPT_TIME ( / START STOP )
171.      (setq
172.            START (CONVERT (substr (rtos BEGSORT 2 10) 10 8))
173.            STOP  (CONVERT (substr (rtos ENDSORT 2 10) 10 8))
174.            ELAPSE (* 100000 (- STOP START)))
175.           (repeat 3 (print))
176.           (getstring (strcat "\n" (itoa N) " sublists sorted in "
177.                              (rtos ELAPSE 2 2)
178.                              " seconds. "
179.                              "\nPress any key to continue."))
180. );RPT_TIME
181. (defun SEL-OPT (IG PS DF OL / HOLD);InitGet, PromptString,DeFault, OptionLine
182.    (initget IG)
183.    (repeat 24 (print))(princ PS)(print)(princ "\n")
184.    (setq OPTION DF
185.          HOLD OPTION
186.          OPTION (getkword (strcat OL OPTION ">: ")))
187.    (if (null OPTION)
188.        (setq OPTION HOLD))
189.    (repeat 5 (print))(prin1)
190. );SEL-OPT
191. (princ "\nSORTS loaded. Enter SORT to begin.")(print)(princ)

(defun Shell ( ALIST / BEGSORT CTR EXCH ELAPSE ENDSORT HEAD N NEWLIST TAIL) ;; ;; The Shell Sort (ascending) ;;    (defun EXCH ( / EX_FLAG HEAD MID NEW1ST NEW2ND TAIL)       (setq EX_FLAG 1)          (while EX_FLAG             (setq                   NEW1st (list (nth (+ CTR D ) NEWLIST))                                   ; Switch value at D interval to CURRENT                   NEW2nd (list (nth CTR NEWLIST))                                          ; Switch CURRENT value to D interval                   HEAD (reverse (cdr (member (nth CTR NEWLIST) (reverse NEWLIST))))        ; First part of list                   MID (member (nth (1+ CTR) NEWLIST) (reverse                       (member (nth (1- (+ CTR D)) NEWLIST) (reverse NEWLIST))))            ; Between CURRENT and D interval                   TAIL (cdr (member (nth (+ CTR D) NEWLIST) NEWLIST))                      ; Remainder of list                   NEWLIST (append HEAD NEW1st MID NEW2nd TAIL)                             ; Revised list                   CTR (- CTR D)              )              (if (>= CTR 0)                 (progn                    (if (<= (cadr (nth CTR NEWLIST)) (cadr (nth (+ CTR D) NEWLIST)))        ; Add Jump Dist to Current location                        (setq EX_FLAG nil))                 );progn                 (setq EX_FLAG nil)             )          );WHILE    )   (if (or (null ALIST)           (not (= (type ALIST) 'LIST ))       )     (progn        (princ "Argument is not a valid list")(print)     )     (progn        (setq              NEWLIST ALIST                                                                 ; Make a copy to work on              D (abs (/ (length NEWLIST) 2))                                                ; D will be an integer              N (1- (length NEWLIST))                                                       ; first member of list is 0              BEGSORT (getvar "CDATE")                                                      ; Get starting time        )        (repeat 3 (print))        (princ "\nSorting...please wait")        (while (> D 0)                                                                      ; Do the sorting           (setq L (- N D)                 J 0           )           (while (<= J L)              (if (> (cadr (nth J NEWLIST)) (cadr (nth (+ J D) NEWLIST)))                  (progn                       (setq CTR J)                       (EXCH)                  )              )              (setq J (1+ J))           )           (setq D (abs (/ D 2)))        )        (setq ENDSORT (getvar "CDATE"))                                                     ; Get ending time        (RPT_TIME)                                                                          ; Calculate and report elapsed time        (textpage)                                                                          ; Clear screen        NEWLIST                                                                             ; Return sorted list     );progn   );if );Shell (defun BubSort ( ALIST / BEGSORT CTR ELAPSE ENDSORT EXCHNG HEAD N NEWLIST TAIL) ;;; ; Bubble sort (ascending) ;;;    (defun EXCHNG ( / NEW1ST NEW2ND HEAD TAIL)       (repeat (length NEWLIST)          (repeat (- (length NEWLIST) 1)             (if (> (cadr (nth CTR NEWLIST)) (cadr (nth (1+ CTR) NEWLIST)))                ; Compare CURRENT to NEXT               (progn                  (setq NEW1st (list (nth (1+ CTR) NEWLIST))                               ; Switch NEXT to CURRENT                        NEW2nd (list (nth CTR NEWLIST))                                    ; Switch CURRENT to NEXT                        HEAD (reverse (cdr (member (nth CTR NEWLIST) (reverse NEWLIST))))  ; First part of list                        TAIL (cdr (member (nth (1+ CTR) NEWLIST) NEWLIST))                 ; Remainder of list                        NEWLIST (append HEAD NEW1st NEW2nd TAIL))                          ; Revised list               );progn            );if            (setq CTR (1+ CTR))          );repeat          (setq CTR 0)        );repeat    );EXCHNG   (if (or (null ALIST)          (not (= (type ALIST) 'LIST ))       )     (progn        (princ "Argument is not a valid list")(print)     )     (progn        (repeat 3 (print))        (princ "\nSorting...please wait")        (setq CTR 0                                                                        ; Initialize Counter              N (length ALIST)                                                             ; Number of records (sublists)              NEWLIST ALIST                                                                ; Make a copy to work on              BEGSORT (getvar "CDATE")                                                     ; Get starting time        )        (EXCHNG)                                                                           ; Do the sorting        (setq ENDSORT (getvar "CDATE"))                                                    ; Get ending time        (RPT_TIME)                                                                         ; Calculate and report elapsed time        (textpage)                                                                         ; Clear screen        NEWLIST                                                                            ; Return sorted list     );progn   );if );BubSort (defun C:SORT ()    (SEL-OPT "Short Long"             "\nSelect List  TYPE "             "Short"             "Short Long<")    (cond ((= OPTION "Short")          (setq LST '(              ("string1" 5.41 11.05)              ("string2" 2.42 45.09)              ("string3" 4.13 19.25)              ("string4" 9.24 34.75)              ("string5" 5.15 42.05)              ("string6" 2.36 13.35)              ("string7" 0.67 21.05)              ("string8" 7.68 11.55)              ("string8a" 7.68 11.55)              ("string9" 5.09 11.05)              ("string10" 2.71 45.09)              ("string11" 4.92 19.25)              ("string12" 9.33 34.75)              ("string13" 5.04 42.05)              ("string14" 2.25 13.35)              ("string15" 0.66 21.05)              ("string16" 7.57 11.55)              ("string17" 3.78 45.09)              ("string18" 7.99 19.25)              ("string19" 1.31 34.75)              ("string20" 9.02 42.05)              ("string21" 5.23 13.35)              ("string22" 3.64 21.05)              ("string23" 0.55 11.55)              ("string24" 32.76 45.09)              ("string25" 44.97 19.25)              )           );setq          );option          ((= OPTION "Long")            (setq LST '(("string1" 5.41 11.05)("string2" 2.42 45.09)("string3" 4.13 19.25)("string4" 9.24 34.75)("string5" 5.15 42.05)("string6" 2.36 13.35)("string7" 0.67 21.05)("string8" 7.68 11.55)("string9" 5.09 11.05)("string10" 2.71 45.09)("string11" 4.92 19.25)("string12" 9.33 34.75)("string13" 5.04 42.05)("string14" 2.25 13.35)("string15" 0.66 21.05)("string16" 7.57 11.55)("string17" 3.78 45.09)("string18" 7.99 19.25)("string19" 1.31 34.75)("string20" 7.68 11.55)("string21" 4.93 19.25)("string22" 9.3 4 34.75)("string23" 5.05 42.05)("string24" 2.26 13.35)("string25" 7.68 21.05)("string26" 7.58 11.55)("string27" 3.79 45.09)("string28" 7.10 19.25)("string29" 1.32 34.75)("string30" 7.69 11.55)("string31" 4.94 19.25)("string32" 9.35 34.75)("string33" 5.06 42.05)("string34" 2.27 13.35)("string35" 7.69 21.05)("string36" 7.59 11.55)("string37" 3.80 45.09)("string38" 7.11 19.25)("string39" 1.33 34.75)("string40" 7.70 11.55)("string41" 4.95 19.25)("string42" 9.36 34.75)("string43" 5.07 42.05)("string44" 2.28 13.3 5)("string45" 7.70 21.05)("string46" 7.60 11.55)("string47" 3.81 45.09)("string48" 7.12 19.25)("string49" 1.34 34.75)("string40" 7.71 11.55)("string51" 4.96 19.25)("string52" 9.37 34.75)            )))           (t)    );cond    (SEL-OPT "Bubble Shell X"             "\nSelect Sort TYPE... "             "Bubble"             "Bubble/Shell/eXit<")    (cond ((= OPTION "Bubble")(BubSort lst))          ((= OPTION "Shell")(Shell lst))          (t)    ) ) (defun CONVERT ( MOMENT / HR MN SEC DIFF )       (setq HR  (/ (atof (substr MOMENT 1 2)) 24.0)             MN (/ (/ (atof (substr MOMENT 3 2)) 60.0) 24.0)             SEC (/ (/ (/ (atof (substr MOMENT 5 2)) 60.0) 60.0) 24.0)             DIFF (+ HR MN SEC)) );CONVERT (defun RPT_TIME ( / START STOP )      (setq            START (CONVERT (substr (rtos BEGSORT 2 10) 10 8))            STOP  (CONVERT (substr (rtos ENDSORT 2 10) 10 8))            ELAPSE (* 100000 (- STOP START)))           (repeat 3 (print))           (getstring (strcat "\n" (itoa N) " sublists sorted in "                              (rtos ELAPSE 2 2)                              " seconds. "                              "\nPress any key to continue.")) );RPT_TIME (defun SEL-OPT (IG PS DF OL / HOLD);InitGet, PromptString,DeFault, OptionLine    (initget IG)    (repeat 24 (print))(princ PS)(print)(princ "\n")    (setq OPTION DF          HOLD OPTION          OPTION (getkword (strcat OL OPTION ">: ")))    (if (null OPTION)        (setq OPTION HOLD))    (repeat 5 (print))(prin1) );SEL-OPT (princ "\nSORTS loaded. Enter SORT to begin.")(print)(princ)

ivde

http://www.mjtd.com/object/autolisp/ALR.default.301.htm

kmust_tang

谢谢大家。。。

谢谢Andyhon，程序已调试好。。谢谢。

明27662

Andyhon 发表于 2007-9-11 15:31
Here you are

文件损坏打不开

Andyhon

@明27662