求冒泡程序（ALISP或VLISP）

kmust_tang 发表于 2007-9-11 14:30:00

请各位大虾赐教！谢谢

Andyhon 发表于 2007-9-11 15:31:00

Here you are

kmust_tang 发表于 2007-9-11 22:39:00

求高手解决

打开后是乱码,整理\运行后没啥效果.。。。图上有N个点。。。取得这些点后，存在表lst里，怎么将里面的点坐标按给定的顺序排列？？？请高手赐教！谢谢！！！比如顺序是：纵坐标小的（先）
且
横坐标小（后）的排在表前面。。。

Andyhon 发表于 2007-9-11 22:48:00

; 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.

(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 ListTYPE "
 "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 发表于 2007-9-12 06:17:00

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

kmust_tang 发表于 2007-9-12 09:47:00

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

明27662 发表于 2021-3-27 14:32:20

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

文件损坏打不开

Andyhon 发表于 2021-4-27 15:04:12

@明27662

页: [1]

明经CAD社区's Archiver

求冒泡程序（ALISP或VLISP）

求高手解决