Samples of power sorting in AutoLisp

st788796 · 发表于 2018-8-22 09:26:17

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

;;; File : lispsort.lsp
;;; Purpose : Samples of power sorting in AutoLisp
;;;
;;; Author : T.J. DiTullio Herman Goldner Co. Inc.
;;; (70214,3131)
;;;
;;; Date : 3-23-95 (complied from earlier files 1992)
;;;
;;; Desciption : Here are four sorting functions that implement
;;; sorting with pointers (Yes in AutoLisp).
;;; There are two shell sorts and two bubble sorts
;;; One of each for lists and one for list of lists
;;;
;;; After I developed these functions, I speed tested
;;; the shells against the bubbles. Since then I have not
;;; used the bubble sorts.
;;;
;;; All four functions use an integer list (ptr_lst) as
;;; pointers to the list to be sorted. One problem with
;;; sorting in AutoLisp is that the list to be sorted must
;;; be reconstructed each time a pair of items are swapped
;;; If the list (or list of lists) is very large, it can
;;; slow down the sort. By using a pointer list of type
;;; integer, this reconstruction will be much faster.
;;;
;;; At the start of each sort function, an integer list
;;; (ptr_lst) is constructed starting at 0 and ending at
;;; the number of items in list to be sorted (length lst).
;;; As items in the list to be sorted are compared, the
;;; pointer list is used to reference the list to be sorted.
;;; [ something like (nth (nth index ptr_lst) lst) ]
;;; [ meaning - The value of the list to be sorted is still
;;; in its original location. Used the integer
;;; (ptr_lst) value to determine where it is.
;;; ]
;;; Since the pointer list starts at 0, I used value of -1
;;; for the 1st (subst) call to avoid have duplicate values in
;;; the pointer list that would both be updated on the 2nd
;;; (subst) call. Then after the 2nd (subst) call, a 3rd call
;;; is made to replace the -1 value with the correct value.
;;; (setq t1 1st_item) - save 1st
;;; (setq t2 2nd_item) - save 2nd
;;; (subst -1 t1) - change t1 to -1
;;; (subst t1 t2) - change t2 to t1
;;; (subst t2 -1) - change -1 to t2
;;; - t1 and t2 are >= 0 always
;;;
;;; As items are swapped around, only the pointer list is
;;; modified. After the sorting is completed, the list to
;;; be sorted to rebuilt using the pointer list for the
;;; sorted location.
;;;
;;; This may seem like a lot of work to do some sorting. But
;;; the list of list that I sort get very large. (I use list
;;; of lists like an array of structures for anyone who knows
;;; the C language)
;;;
;;; Here is an example for a list of lists I might sort:
;;; ( ( "string" integer real integer real real "string"
;;; "string" real integer "string" real
;;; )
;;; ( "string" integer real integer real real "string"
;;; "string" real integer "string" real
;;; )
;;; etc ...
;;; )
;;;
;;; lisp call -> (setq mylist (l_ssort mylist 3))
;;; lisp retn -> sorted list
;;; description -> sort mylist bases on the 4th item (an integer)
;;;
;;;
;;; One thing I noticed when I wrote these sorts was that
;;; a shell sort is unable to sort completely if there are
;;; duplicate values. I could not find anything in writing
;;; to back this up. So I modified the algorithm to continue
;;; looping while the partition size is one until no swaps
;;; occurred.
;;;
;;; Sorry there are not a lot of comments!
;;;
;;; If you program in AutoLisp and are unfamiliar with these
;;; sorting methods, try looking at another language like
;;; Basic or C.
;;;
;;; Any comments or questions can be directed to me.
;;;
;;;
;;; THIS CODE IS THE PROPERTY OF T.J. DITULLIO AND THE HERMAN GOLDNER CO INC
;;; PERMISSION IS GRANTED TO USE, COPY, MODIFY, AND DISTRIBUTE WITHOUT FEE
;;; PROVIDED THAT THIS NOTICE IS DISTRIBUTED.
;;;
;;;* * * * * * * * * * * * * SORT FUNCTIONS * * * * * * * * * * * * * * *
;;;
;;; l_bsort
;;;
;;; Modified Bubble Sort of List of Lists
;;; Parameters llist -> list of lists
;;; key -> element in inner lists to sort by
;;;
;;; Returns -> Sorted list of lists
;;;
(defun l_bsort ( llist key / number_items count i
unsorted ptr_lst j
sorted_list t1 t2
)
(if (and llist key)
(progn
(setq i 1
number_items (length llist)
unsorted T
ptr_lst nil ;pointer list
count 0
)
(while (< count number_items)
(setq ptr_lst (append ptr_lst (list count)) ;built pointer list
count (1+ count)
)
) ;while
;-----------------------------------------------------------------------
(while (or unsorted (< i number_items))
(setq j 0
unsorted nil ;assume list is sorted
)
;loop thru and test (j) to (J+1) in pointer list
(while (< j (- number_items i))
(if (> (nth key (nth (nth j ptr_lst) llist))
(nth key (nth
(nth (1+ j) ptr_lst) llist)
)
)
; swap items in pointer list
(setq t1 (nth j ptr_lst)
t2 (nth (1+ j) ptr_lst)
ptr_lst (subst t2 -1
(subst t1 t2
(subst -1 t1 ptr_lst)
)
)
unsorted T
) ;setq
) ;if
(setq j (1+ j))
) ;while j
(setq i (1+ i))
) ;while i
;-----------------------------------------------------------------------
;Build new list using sorted pointers
(setq count 0 sorted_list nil)
(while (< count number_items)
(setq sorted_list
(append sorted_list ;build updated list
(list
(nth
(nth count ptr_lst) ;pointer
llist
)
)
)
count (1+ count)
) ;setq
) ;while
sorted_list ;return sorted list
) ;progn
;else
nil
) ;if
) ;defun
;;;=======================================================================
;;;
;;; l_ssort
;;;
;;; Modified Shell Sort of List of Lists
;;; Parameters llist -> list of lists
;;; key -> element in inner lists to sort by
;;;
;;; Returns -> Sorted list of lists
;;;
;;; Note: This custom shell sort algorithm will handle multiple
;;; occurrences of any items. The sort will continue looping
;;; when partition size is 1 until no swaps occur.
;;;
(defun l_ssort (llist key /
number_items partition_size
number_partitions first_index
last_index unsorted
count ptr_lst
sorted_list i j
t1 t2
)
(if (and llist key)
(progn
(setq number_items (length llist)
partition_size number_items
ptr_lst nil ;pointer list
count 0
unsorted T ;assume list is not sorted
)
(while (< count number_items)
(setq ptr_lst (append ptr_lst (list count)) ;built pointer list
count (1+ count)
)
) ;while
;------------------------------------------------------------------
(while unsorted
(setq partition_size (fix (/ (1+ partition_size) 2))
number_partitions (fix (/ number_items partition_size))
)
(if (= partition_size 1)
(setq unsorted nil) ;assume list is sorted
)
(if (/= (rem number_items partition_size) 0)
(setq number_partitions (1+ number_partitions))
)
(setq first_index 0
i 1
)
(while (< i number_partitions)
(setq last_index (+ first_index partition_size))
(if (> last_index (- number_items partition_size))
(setq last_index (- number_items partition_size))
)
;loop thru and test (j) to (j+offset) in pointer list
(setq j first_index)
(while (< j last_index)
(if (> (nth key (nth (nth j ptr_lst) llist))
(nth key (nth
(nth (+ j partition_size) ptr_lst) llist)
)
)
; then swap items in pointer list
(setq t1 (nth j ptr_lst)
t2 (nth (+ j partition_size) ptr_lst)
ptr_lst (subst t2 -1
(subst t1 t2
(subst -1 t1 ptr_lst)
)
)
unsorted T
) ;setq
) ;if
(setq j (1+ j))
) ;while j
(setq first_index (+ first_index partition_size)
i (1+ i)
)
) ;while i
) ;while unsorted
;------------------------------------------------------------------
;Build new list using sorted pointers
(setq count 0 sorted_list nil)
(while (< count number_items)
(setq sorted_list
(append sorted_list ;build updated list
(list
(nth
(nth count ptr_lst) ;pointer
llist
)
)
)
count (1+ count)
) ;setq
) ;while
sorted_list ;return sorted list
) ;progn
;else
nil
) ;if
) ;defun
;;;=======================================================================
;;;
;;; bsort
;;;
;;; Modified Bubble Sort of List of values
;;; Parameters lst -> list of values
;;;
;;; Returns -> Sorted list of values
;;;
(defun bsort ( lst / number_items count i
unsorted ptr_lst j
sorted_list t1 t2
)
(if lst
(progn
(setq i 1
number_items (length lst)
unsorted T
ptr_lst nil ;pointer list
count 0
)
(while (< count number_items)
(setq ptr_lst (append ptr_lst (list count)) ;built pointer list
count (1+ count)
)
) ;while
;-----------------------------------------------------------------------
(while (or unsorted (< i number_items))
(setq j 0
unsorted nil ;assume list is sorted
)
;loop thru and test (j) to (J+1) in pointer list
(while (< j (- number_items i))
(if (> (nth (nth j ptr_lst) lst)
(nth (nth (1+ j) ptr_lst) lst)
)
; swap items in pointer list
(setq t1 (nth j ptr_lst)
t2 (nth (1+ j) ptr_lst)
ptr_lst (subst t2 -1
(subst t1 t2
(subst -1 t1 ptr_lst)
)
)
unsorted T
) ;setq
) ;if
(setq j (1+ j))
) ;while j
(setq i (1+ i))
) ;while i
;-----------------------------------------------------------------------
;Build new list using sorted pointers
(setq count 0 sorted_list nil)
(while (< count number_items)
(setq sorted_list
(append sorted_list ;build updated list
(list
(nth
(nth count ptr_lst) ;pointer
lst
)
)
)
count (1+ count)
) ;setq
) ;while
sorted_list ;return sorted list
) ;progn
;else
nil
) ;if
) ;defun
;;;=======================================================================
;;;
;;; ssort
;;;
;;; Modified Shell Sort of List of Values
;;; Parameters lst -> list of values
;;;
;;; Returns -> Sorted list of values
;;;
;;; Note: This custom shell sort algorithm will handle multiple
;;; occurrences of any items. The sort will continue looping
;;; when partition size is 1 until no swaps occur.
;;;
(defun ssort (lst /
number_items partition_size
number_partitions first_index
last_index unsorted
count ptr_lst
sorted_list i j
t1 t2
)
(if lst
(progn
(setq number_items (length lst)
partition_size number_items
ptr_lst nil ;pointer list
count 0
unsorted T ;assume list is not sorted
)
(while (< count number_items)
(setq ptr_lst (append ptr_lst (list count)) ;built pointer list
count (1+ count)
)
) ;while
;------------------------------------------------------------------
(while unsorted
(setq partition_size (fix (/ (1+ partition_size) 2))
number_partitions (fix (/ number_items partition_size))
)
(if (= partition_size 1)
(setq unsorted nil) ;assume list is sorted
)
(if (/= (rem number_items partition_size) 0)
(setq number_partitions (1+ number_partitions))
)
(setq first_index 0
i 1
)
(while (< i number_partitions)
(setq last_index (+ first_index partition_size))
(if (> last_index (- number_items partition_size))
(setq last_index (- number_items partition_size))
)
;loop thru and test (j) to (j+offset) in pointer list
(setq j first_index)
(while (< j last_index)
(if (> (nth (nth j ptr_lst) lst)
(nth (nth (+ j partition_size) ptr_lst) lst)
)
; then swap items in pointer list
(setq t1 (nth j ptr_lst)
t2 (nth (+ j partition_size) ptr_lst)
ptr_lst (subst t2 -1
(subst t1 t2
(subst -1 t1 ptr_lst)
)
)
unsorted T
) ;setq
) ;if
(setq j (1+ j))
) ;while j
(setq first_index (+ first_index partition_size)
i (1+ i)
)
) ;while i
) ;while unsorted
;------------------------------------------------------------------
;Build new list using sorted pointers
(setq count 0 sorted_list nil)
(while (< count number_items)
(setq sorted_list
(append sorted_list ;build updated list
(list
(nth
(nth count ptr_lst) ;pointer
lst
)
)
)
count (1+ count)
) ;setq
) ;while
sorted_list ;return sorted list
) ;progn
;else
nil
) ;if
) ;defun
;;;========================================================================

;;; File       : lispsort.lsp 
;;; Purpose    : Samples of power sorting in AutoLisp 
;;; 
;;; Author     : T.J. DiTullio   Herman Goldner Co. Inc. 
;;;              (70214,3131) 
;;; 
;;; Date       : 3-23-95 (complied from earlier files 1992) 
;;; 
;;; Desciption : Here are four sorting functions that implement 
;;;              sorting with pointers (Yes in AutoLisp). 
;;;              There are two shell sorts and two bubble sorts 
;;;              One of each for lists and one for list of lists 
;;; 
;;;              After I developed these functions, I speed tested 
;;;              the shells against the bubbles. Since then I have not 
;;;              used the bubble sorts. 
;;; 
;;;              All four functions use an integer list (ptr_lst) as 
;;;              pointers to the list to be sorted. One problem with 
;;;              sorting in AutoLisp is that the list to be sorted must 
;;;              be reconstructed each time a pair of items are swapped 
;;;              If the list (or list of lists) is very large, it can 
;;;              slow down the sort. By using a pointer list of type 
;;;              integer, this reconstruction will be much faster. 
;;; 
;;;              At the start of each sort function, an integer list 
;;;              (ptr_lst) is constructed starting at 0 and ending at 
;;;              the number of items in list to be sorted (length lst). 
;;;              As items in the list to be sorted are compared, the 
;;;              pointer list is used to reference the list to be sorted. 
;;;              [ something like (nth (nth index ptr_lst) lst) ] 
;;;              [ meaning - The value of the list to be sorted is still 
;;;                          in its original location. Used the integer 
;;;                          (ptr_lst) value to determine where it is. 
;;;              ] 
;;;              Since the pointer list starts at 0, I used value of -1 
;;;              for the 1st (subst) call to avoid have duplicate values in 
;;;              the pointer list that would both be updated on the 2nd 
;;;              (subst) call. Then after the 2nd (subst) call, a 3rd call 
;;;              is made to replace the -1 value with the correct value. 
;;;                  (setq t1 1st_item) - save 1st 
;;;                  (setq t2 2nd_item) - save 2nd 
;;;                  (subst -1 t1)      - change t1 to -1 
;;;                  (subst t1 t2)      - change t2 to t1 
;;;                  (subst t2 -1)      - change -1 to t2 
;;;                                     - t1 and t2 are >= 0  always 
;;; 
;;;              As items are swapped around, only the pointer list is 
;;;              modified. After the sorting is completed, the list to 
;;;              be sorted to rebuilt using the pointer list for the 
;;;              sorted location. 
;;; 
;;;              This may seem like a lot of work to do some sorting. But 
;;;              the list of list that I sort get very large. (I use list 
;;;              of lists like an array of structures for anyone who knows 
;;;              the C language) 
;;; 
;;;              Here is an example for a list of lists I might sort: 
;;;              ( ( "string" integer real integer real real "string" 
;;;                  "string" real integer "string" real 
;;;                ) 
;;;                ( "string" integer real integer real real "string" 
;;;                  "string" real integer "string" real 
;;;                ) 
;;;                etc ... 
;;;              ) 
;;; 
;;;    lisp call   -> (setq mylist (l_ssort mylist 3)) 
;;;    lisp retn   -> sorted list 
;;;    description -> sort mylist bases on the 4th item (an integer) 
;;; 
;;; 
;;;              One thing I noticed when I wrote these sorts was that 
;;;              a shell sort is unable to sort completely if there are 
;;;              duplicate values. I could not find anything in writing 
;;;              to back this up. So I modified the algorithm to continue 
;;;              looping while the partition size is one until no swaps 
;;;              occurred. 
;;; 
;;;              Sorry there are not a lot of comments! 
;;; 
;;;              If you program in AutoLisp and are unfamiliar with these 
;;;              sorting methods, try looking at another language like 
;;;              Basic or C. 
;;; 
;;;              Any comments or questions can be directed to me. 
;;; 
;;; 
;;;  THIS CODE IS THE PROPERTY OF T.J. DITULLIO AND THE HERMAN GOLDNER CO INC 
;;;  PERMISSION IS GRANTED TO USE, COPY, MODIFY, AND DISTRIBUTE WITHOUT FEE 
;;;  PROVIDED THAT THIS NOTICE IS DISTRIBUTED. 
;;; 
 
 
;;;* * * * * * * * * * * * * SORT FUNCTIONS  * * * * * * * * * * * * * * * 
;;; 
;;; l_bsort 
;;; 
;;; Modified Bubble Sort of List of Lists 
;;; Parameters   llist ->  list of lists 
;;;              key   ->  element in inner lists to sort by 
;;; 
;;; Returns  ->  Sorted list of lists 
;;; 
 
(defun l_bsort ( llist key /   number_items  count     i 
                               unsorted      ptr_lst   j 
                               sorted_list   t1        t2 
               ) 
  (if (and llist key) 
    (progn 
      (setq i 1 
            number_items (length llist) 
            unsorted T 
            ptr_lst nil          ;pointer list 
            count 0 
      ) 
 
      (while (< count number_items) 
        (setq ptr_lst (append ptr_lst (list count))  ;built pointer list 
              count (1+ count) 
        ) 
      ) ;while 
 
    ;----------------------------------------------------------------------- 
 
      (while (or unsorted (
        (setq j 0 
              unsorted nil       ;assume list is sorted 
        ) 
 
        ;loop thru and test (j) to (J+1) in pointer list 
 
        (while (< j (- number_items i)) 
            (if (> (nth key (nth (nth j ptr_lst) llist)) 
                   (nth key (nth 
                      (nth (1+ j) ptr_lst) llist) 
                   ) 
                ) 
 
              ; swap items in pointer list 
              (setq t1 (nth j ptr_lst) 
                    t2 (nth (1+ j) ptr_lst) 
                    ptr_lst (subst t2 -1 
                              (subst t1 t2 
                                (subst -1 t1 ptr_lst) 
                              ) 
                            ) 
                    unsorted T 
              ) ;setq 
            ) ;if 
 
          (setq j (1+ j)) 
        ) ;while j 
 
        (setq i (1+ i)) 
      ) ;while i 
 
    ;----------------------------------------------------------------------- 
      ;Build new list using sorted pointers 
 
      (setq count 0 sorted_list nil) 
      (while (< count number_items) 
        (setq sorted_list 
                (append sorted_list        ;build updated list 
                  (list 
                    (nth 
                      (nth count ptr_lst)  ;pointer 
                      llist 
                    ) 
                  ) 
                ) 
              count (1+ count) 
        ) ;setq 
      ) ;while 
 
      sorted_list                          ;return sorted list 
    ) ;progn 
 
    ;else 
    nil 
  ) ;if 
 
) ;defun 
 
;;;======================================================================= 
;;; 
;;; l_ssort 
;;; 
;;; Modified Shell Sort of List of Lists 
;;; Parameters   llist ->  list of lists 
;;;              key   ->  element in inner lists to sort by 
;;; 
;;; Returns  ->  Sorted list of lists 
;;; 
;;; Note: This custom shell sort algorithm will handle multiple 
;;;       occurrences of any items. The sort will continue looping 
;;;       when partition size is 1 until no swaps occur. 
;;; 
 
(defun l_ssort (llist key / 
                              number_items       partition_size 
                              number_partitions  first_index 
                              last_index         unsorted 
                              count              ptr_lst 
                              sorted_list        i         j 
                              t1                 t2 
                 ) 
 
  (if (and llist key) 
    (progn 
      (setq number_items (length llist) 
            partition_size number_items 
            ptr_lst nil                  ;pointer list 
            count 0 
            unsorted T                   ;assume list is not sorted 
      ) 
 
      (while (< count number_items) 
        (setq ptr_lst (append ptr_lst (list count)) ;built pointer list 
              count (1+ count) 
        ) 
      ) ;while 
 
    ;------------------------------------------------------------------ 
 
      (while unsorted 
 
        (setq partition_size (fix (/ (1+ partition_size) 2)) 
              number_partitions (fix (/ number_items partition_size)) 
        ) 
 
        (if (= partition_size 1) 
          (setq unsorted nil)       ;assume list is sorted 
        ) 
 
        (if (/= (rem number_items partition_size) 0) 
          (setq number_partitions (1+ number_partitions)) 
        ) 
        (setq first_index 0 
              i 1 
        ) 
        (while (
          (setq last_index (+ first_index partition_size)) 
 
          (if (> last_index (- number_items partition_size)) 
            (setq last_index (- number_items partition_size)) 
          ) 
 
          ;loop thru and test (j) to (j+offset) in pointer list 
 
          (setq j first_index) 
          (while (< j last_index) 
            (if (> (nth key (nth (nth j ptr_lst) llist)) 
                   (nth key (nth 
                      (nth (+ j partition_size) ptr_lst) llist) 
                   ) 
                ) 
 
              ; then swap items in pointer list 
              (setq t1 (nth j ptr_lst) 
                    t2 (nth (+ j partition_size) ptr_lst) 
                    ptr_lst (subst t2 -1 
                              (subst t1 t2 
                                (subst -1 t1 ptr_lst) 
                              ) 
                            ) 
                    unsorted T 
              ) ;setq 
            ) ;if 
 
            (setq j (1+ j)) 
 
          ) ;while j 
 
          (setq first_index (+ first_index partition_size) 
                i (1+ i) 
          ) 
 
        ) ;while i 
 
 
      ) ;while unsorted 
 
    ;------------------------------------------------------------------ 
      ;Build new list using sorted pointers 
 
      (setq count 0 sorted_list nil) 
      (while (< count number_items) 
        (setq sorted_list 
                (append sorted_list        ;build updated list 
                  (list 
                    (nth 
                      (nth count ptr_lst)  ;pointer 
                      llist 
                    ) 
                  ) 
                ) 
              count (1+ count) 
        ) ;setq 
      ) ;while 
 
      sorted_list                          ;return sorted list 
    ) ;progn 
 
    ;else 
    nil 
  ) ;if 
 
) ;defun 
 
;;;======================================================================= 
;;; 
;;; bsort 
;;; 
;;; Modified Bubble Sort of List of values 
;;; Parameters   lst   ->  list of values 
;;; 
;;; Returns  ->  Sorted list of values 
;;; 
 
 
(defun bsort ( lst  /   number_items  count     i 
                        unsorted      ptr_lst   j 
                        sorted_list   t1        t2 
               ) 
  (if lst 
    (progn 
      (setq i 1 
            number_items (length lst) 
            unsorted T 
            ptr_lst nil          ;pointer list 
            count 0 
      ) 
 
      (while (< count number_items) 
        (setq ptr_lst (append ptr_lst (list count))  ;built pointer list 
              count (1+ count) 
        ) 
      ) ;while 
 
    ;----------------------------------------------------------------------- 
 
      (while (or unsorted (
        (setq j 0 
              unsorted nil       ;assume list is sorted 
        ) 
 
        ;loop thru and test (j) to (J+1) in pointer list 
 
        (while (< j (- number_items i)) 
            (if (> (nth (nth j ptr_lst) lst) 
                   (nth (nth (1+ j) ptr_lst) lst) 
                ) 
 
              ; swap items in pointer list 
              (setq t1 (nth j ptr_lst) 
                    t2 (nth (1+ j) ptr_lst) 
                    ptr_lst (subst t2 -1 
                              (subst t1 t2 
                                (subst -1 t1 ptr_lst) 
                              ) 
                            ) 
                    unsorted T 
              ) ;setq 
            ) ;if 
 
          (setq j (1+ j)) 
        ) ;while j 
 
        (setq i (1+ i)) 
      ) ;while i 
 
    ;----------------------------------------------------------------------- 
      ;Build new list using sorted pointers 
 
      (setq count 0 sorted_list nil) 
      (while (< count number_items) 
        (setq sorted_list 
                (append sorted_list        ;build updated list 
                  (list 
                    (nth 
                      (nth count ptr_lst)  ;pointer 
                      lst 
                    ) 
                  ) 
                ) 
              count (1+ count) 
        ) ;setq 
      ) ;while 
 
      sorted_list                          ;return sorted list 
    ) ;progn 
 
    ;else 
    nil 
  ) ;if 
 
) ;defun 
 
;;;======================================================================= 
;;; 
;;; ssort 
;;; 
;;; Modified Shell Sort of List of Values 
;;; Parameters   lst ->  list of values 
;;; 
;;; Returns  ->  Sorted list of values 
;;; 
;;; Note: This custom shell sort algorithm will handle multiple 
;;;       occurrences of any items. The sort will continue looping 
;;;       when partition size is 1 until no swaps occur. 
;;; 
 
(defun ssort (lst / 
                       number_items       partition_size 
                       number_partitions  first_index 
                       last_index         unsorted 
                       count              ptr_lst 
                       sorted_list        i         j 
                       t1                 t2 
                 ) 
 
  (if lst 
    (progn 
      (setq number_items (length lst) 
            partition_size number_items 
            ptr_lst nil                  ;pointer list 
            count 0 
            unsorted T                   ;assume list is not sorted 
      ) 
 
      (while (< count number_items) 
        (setq ptr_lst (append ptr_lst (list count)) ;built pointer list 
              count (1+ count) 
        ) 
      ) ;while 
 
    ;------------------------------------------------------------------ 
 
      (while unsorted 
 
        (setq partition_size (fix (/ (1+ partition_size) 2)) 
              number_partitions (fix (/ number_items partition_size)) 
        ) 
 
        (if (= partition_size 1) 
          (setq unsorted nil)       ;assume list is sorted 
        ) 
 
        (if (/= (rem number_items partition_size) 0) 
          (setq number_partitions (1+ number_partitions)) 
        ) 
        (setq first_index 0 
              i 1 
        ) 
        (while (
          (setq last_index (+ first_index partition_size)) 
 
          (if (> last_index (- number_items partition_size)) 
            (setq last_index (- number_items partition_size)) 
          ) 
 
          ;loop thru and test (j) to (j+offset) in pointer list 
 
          (setq j first_index) 
          (while (< j last_index) 
            (if (> (nth (nth j ptr_lst) lst) 
                   (nth (nth (+ j partition_size) ptr_lst) lst) 
                ) 
 
              ; then swap items in pointer list 
              (setq t1 (nth j ptr_lst) 
                    t2 (nth (+ j partition_size) ptr_lst) 
                    ptr_lst (subst t2 -1 
                              (subst t1 t2 
                                (subst -1 t1 ptr_lst) 
                              ) 
                            ) 
                    unsorted T 
              ) ;setq 
            ) ;if 
 
            (setq j (1+ j)) 
 
          ) ;while j 
 
          (setq first_index (+ first_index partition_size) 
                i (1+ i) 
          ) 
 
        ) ;while i 
 
 
      ) ;while unsorted 
 
    ;------------------------------------------------------------------ 
      ;Build new list using sorted pointers 
 
      (setq count 0 sorted_list nil) 
      (while (< count number_items) 
        (setq sorted_list 
                (append sorted_list        ;build updated list 
                  (list 
                    (nth 
                      (nth count ptr_lst)  ;pointer 
                      lst 
                    ) 
                  ) 
                ) 
              count (1+ count) 
        ) ;setq 
      ) ;while 
 
      sorted_list                          ;return sorted list 
    ) ;progn 
 
    ;else 
    nil 
  ) ;if 
 
) ;defun 
 
;;;========================================================================

q3_2006 · 发表于 2018-8-22 09:52:43

大师写个绘图顺序记录并恢复的函数吧..

xyccf · 发表于 2018-8-22 09:55:42

感谢楼主分享

st788796 · 发表于 2018-8-22 17:28:18

q3_2006 发表于 2018-8-22 09:52
大师写个绘图顺序记录并恢复的函数吧..

Autocad 的绘图顺序记录在 AcDbBlockTableRecord 的扩展词典中，名字是 ACAD_SORTENTS

To draw the last entity in the space first (or "behind" the others), five entries in the sortents table must be made, as follows:

Entity ID  Draw Order Handle
4E  4A
4A  4B
4B  4C
4C  4D
4D  4E

The order of the entries (represented as a row in the preceding table) is irrelevant; draw order processing ends up sorting the entries by the draw order handle when performing the draw. In other words, in a DXF file, the table entries might appear in the following order, but the resultant draw order is identical:

Entity ID  Draw Order Handle
4C  4D
4B  4C
4E  4A
4D  4E
4A  4B

As another example, the last entity in the space is moved "under" the next-to-last entity in the space, but the rest of the entities are drawn in "natural" order. In that case, the sortents table would only need two entries, as follows:

Entity ID  Draw Order Handle
4E  4D
4D  4E

Adding new entities to the block table record with an implicit draw order of "last" requires no new entry in the sortents table.

使用 ldata 记录实体句柄，然后使用 vla  进行恢复

q3_2006 · 发表于 2018-8-23 08:20:19

st788796 发表于 2018-8-22 17:28
Autocad 的绘图顺序记录在 AcDbBlockTableRecord 的扩展词典中，名字是 ACAD_SORTENTS

To draw the la ...

; IAcadSortentsTable: AutoCAD AcadSortentsTable 接口
;特性值:
; Application (RO) = #<VLA-OBJECT IAcadApplication 00d74d3c>
; Document (RO) = #<VLA-OBJECT IAcadDocument 0becabc0>
; Handle (RO) = "505552E"
; Ha**tensionDictionary (RO) = 0
; ObjectID (RO) = -1388368
; ObjectName (RO) = "AcDbSortentsTable"
; OwnerID (RO) = -1498640
;支持的方法:
; Block ()
; Delete ()
; GetExtensionDictionary ()
; GetFullDrawOrder (2)
; GetRelativeDrawOrder (2)
; GetXData (3)
; MoveAbove (2)
; MoveBelow (2)
; MoveToBottom (1)
; MoveToTop (1)
; SetRelativeDrawOrder (1)
; SetXData (2)
; SwapOrder (2)
怎么做..看不懂呢..大师指导下哈..

sicky111 · 发表于 2018-8-23 09:06:04

谢谢分享。

q3_2006 · 发表于 2018-8-23 10:34:45

st788796 发表于 2018-8-22 17:28
Autocad 的绘图顺序记录在 AcDbBlockTableRecord 的扩展词典中，名字是 ACAD_SORTENTS

To draw the la ...

用这个吗..SetRelativeDrawOrder

账号		自动登录	找回密码
密码			立即注册

[他山之石] Samples of power sorting in AutoLisp

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评