Author Topic: Search of Windows type Sort function  (Read 30285 times)

0 Members and 15 Guests are viewing this topic.

terrycadd

  • Guest
Search of Windows type Sort function
« on: May 16, 2007, 04:18:40 PM »
I’ve searched the forum for a sort function that sorts a list of files or part numbers the way windows sorts filenames. I didn’t have any luck, but I did find some very useful utilities, such as “getdir” by ronjonp.
The vl-directory-files functions sorts the files the same way that acad_strlsort would sort these filenames in a list.  Example:
(setq FileList@ (vl-directory-files Foldername$ "*.dwg" 1))
(setq SortList@ (acad_strlsort FileList@))
Both return the following list:
(list “PN375-A10.dwg”
      “PN375-A9.dwg”
      “PN375-D1.dwg”
      “PN375-D10.dwg”
      “PN375-D14.dwg”
      “PN375-D2.dwg”
      “PN375-D22.dwg”
      “PN375-D7r3.dwg”
      “PN375-DB.dwg”
      “PN375-DB10a.dwg”
      “PN375-DB9.dwg”)
The order that I’m wanting is:
(list “PN375-A9.dwg”
      “PN375-A10.dwg”
      “PN375-D1.dwg”
      “PN375-D2.dwg”
      “PN375-D7r3.dwg”
      “PN375-D10.dwg”
      “PN375-D14.dwg”
      “PN375-D22.dwg”
      “PN375-DB9.dwg”
      “PN375-DB10a.dwg”
      “PN375-DB.dwg”)
I can see the unique groups of PN375-A, PN375-D, PN375-DB. The sort is then based on the numbers that follow the unique groups.
If I missed this topic in my search, please point me to the right thread.
Thanks,
Terry
« Last Edit: May 17, 2007, 10:27:49 AM by Terry Cadd »

VVA

  • Newt
  • Posts: 166
Re: Search of Windows type Sort function
« Reply #1 on: May 17, 2007, 08:14:11 AM »
Try It
Code: [Select]
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05"))
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
  (defun NormalizeNumberInString (str / ch i pat ret count buf)
    (setq i     0
          pat   '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret   ""
          count 4 ;_Count normalize symbols
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  (vl-load-com)
  (mapcar '(lambda (x) (nth x ListOfString))
          (vl-sort-i (mapcar 'NormalizeNumberInString ListOfString)
                     '<
          ) ;_ end of VL-SORT-I
  ) ;_ end of mapcar
) ;_ end of defun
Usage
Code: [Select]
(setq lst (list "PN375-A10.dwg"
      "PN375-A9.dwg"
      "PN375-A04.dwg"
      "PN375-A555.dwg"               
      "PN375-D1.dwg"
      "PN375-D10.dwg"
      "PN375-D14.dwg"
      "PN375-D2.dwg"
      "PN375-D22.dwg"
      "PN375-D7r3.dwg"
      "PN375-DB.dwg"
      "PN375-DB10a.dwg"
      "PN375-DB9.dwg"))

(mapcar '(lambda(x)(terpri)(princ x))
        (SortStringWithNumberAsNumber lst))
Return
PN375-A04.dwg
PN375-A9.dwg
PN375-A10.dwg
PN375-A555.dwg
PN375-D1.dwg
PN375-D2.dwg
PN375-D7r3.dwg
PN375-D10.dwg
PN375-D14.dwg
PN375-D22.dwg
PN375-DB.dwg
PN375-DB9.dwg
PN375-DB10a.dwg


mkweaver

  • Bull Frog
  • Posts: 352
Re: Search of Windows type Sort function
« Reply #2 on: May 17, 2007, 08:45:37 AM »
Very nice!  Saved to my library.

Thanks,
Mike

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Search of Windows type Sort function
« Reply #3 on: May 17, 2007, 02:33:17 PM »
Excellent, I like it too.
 :-)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

GDF

  • Water Moccasin
  • Posts: 2081
Re: Search of Windows type Sort function
« Reply #4 on: May 17, 2007, 02:41:55 PM »
Kool

Like it...
Why is there never enough time to do it right, but always enough time to do it over?
BricsCAD 2020x64 Windows 10x64

terrycadd

  • Guest
Re: Search of Windows type Sort function
« Reply #5 on: May 18, 2007, 04:28:29 PM »
I just completed win_sort.  It was quite a challenge for a “Newt” with only 52 postings.  I also attached dependant files, number_sort, change_nth and delete_nth.  The win_sort function sorts a list of strings very similar to the way Windows sorts files in folders.  It may be used to display filenames in a dialog list, and may also be used in a plot script function to plot a folder of drawings in the Windows sorted order other than just the acad_strlsort order.  This is my first version, and it is a bit lengthy.  You are welcomed and challenged to find a shorter way to accomplish its’ tasks. 

Here are the results of the following functions using the FilesList@ for a test run.

(setq FilesList@ (list "1-C4.dwg" "7-b7.dwg" "11-C4.dwg" "2-b3.dwg" "2-c2.dwg" "22-b2.dwg" "pn374-x9.dwg" "pn374-z9.dwg" "Pn375-A10.dwg" "pN375-A9.dwg" "pn375-D1.dwg" "PN375-D10.dwg" "pN375-D2r3.dwg" "pn375-D22.dwg" "qr86-007.dwg" "pN375-DB.dwg" "pn375-DB10a.dwg" "PN375-DB9.dwg"))

SortStringWithNumberAsNumber  win_sort
          1-C4.dwg                      1-C4.dwg
          2-b3.dwg                      2-b3.dwg
          2-c2.dwg                      2-c2.dwg
          7-b7.dwg                      7-b7.dwg
          11-C4.dwg                    11-C4.dwg
          22-b2.dwg                     22-b2.dwg
          PN375-D10.dwg              pn374-x9.dwg
          PN375-DB9.dwg              pn374-z9.dwg
          Pn375-A10.dwg              pN375-A9.dwg
          pN375-A9.dwg                Pn375-A10.dwg
          pN375-D2r3.dwg             pn375-D1.dwg
          pN375-DB.dwg                pN375-D2r3.dwg
          pn374-x9.dwg                PN375-D10.dwg
          pn374-z9.dwg                pn375-D22.dwg
          pn375-D1.dwg                pN375-DB.dwg
          pn375-D22.dwg              PN375-DB9.dwg
          pn375-DB10a.dwg           pn375-DB10a.dwg
          qr86-007.dwg                 qr86-007.dwg
Code: [Select]
;-------------------------------------------------------------------------------
; win_sort - Windows type of sort function
; Arguments: 1
;   List@ = List of strings or filenames
; Returns: List of strings sorted similar to how Windows sorts files
;-------------------------------------------------------------------------------
(defun win_sort (Original@ / AlphaSort@ Cnt# Compare$ First Item List@ Loop
  Next$ Num# NumSort@ NumStrings@ Passed Prefix$ Prefixes@ PrefixList@
  PrefixSort@ Previous$ SortLenghts@ SortList@ Str$)
  (setq Passed t)
  (if (= (type Original@) 'LIST)
    (foreach Item Original@ (if (/= (type Item) 'STR) (setq Passed nil)))
    (setq Passed nil)
  );if
  (if (not Passed)
    (progn (princ "\nUsage: (win_sort <list of strings>)") (exit))
  );if
  (setq Original@ (acad_strlsort Original@))
  (setq AlphaSort@ (mapcar 'strcase Original@))
  (setq Num# 0 Next$ (chr 160));a unique character
  (repeat (length AlphaSort@)
    (setq Previous$ Next$
          Next$ (nth Num# AlphaSort@)
          Prefix$ nil
          Cnt# 1
    );setq
    (if (not (wcmatch (substr Next$ 1 1) "#"))
      (repeat (strlen Next$)
        (setq Str$ (substr Next$ 1 Cnt#)
              Compare$ (strcat Str$ "*")
        );setq
        (if (and (wcmatch Previous$ Compare$)(not (wcmatch (substr Str$ (strlen Str$)) "#")))
          (setq Prefix$ Str$)
        );if
        (setq Cnt# (1+ Cnt#))
      );repeat
    );if
    (if Prefix$
      (progn
        (setq Compare$ (strcat Prefix$ "#*"))
        (if (and (wcmatch Previous$ Compare$)(wcmatch Next$ Compare$))
          (setq Passed t)
          (setq Passed nil)
        );if
      );progn
    );if
    (if (and Passed Prefix$ (not (member Prefix$ Prefixes@)))
      (setq Prefixes@ (append Prefixes@ (list Prefix$)))
    );if
    (setq Num# (1+ Num#))
  );repeat
  (if Prefixes@
    (progn
      (if (> (length Prefixes@) 1)
        (progn
          (setq Num# 1 List@ (cons (nth 0 Prefixes@) (append Prefixes@ (list (last Prefixes@)))))
          (repeat (length Prefixes@)
            (setq Compare$ (strcat (nth Num# List@) "*"))
            (if (and (wcmatch (nth (1- Num#) List@) Compare$)(wcmatch (nth (1+ Num#) List@) Compare$))
              (setq Prefixes@ (vl-remove (nth Num# List@) Prefixes@))
            );if
            (setq Num# (1+ Num#))
          );repeat
        );progn
      );if
      (setq SortLenghts@ (reverse (number_sort (mapcar 'strlen Prefixes@))))
      (setq List@ Prefixes@)
      (foreach Num# SortLenghts@
        (setq First t)
        (foreach Str$ List@
          (if (and (= (strlen Str$) Num#) First)
            (setq First nil
                  List@ (vl-remove Str$ List@)
                  PrefixSort@ (append PrefixSort@ (list Str$))
            );setq
          );if
        );foreach
      );foreach
      (setq Prefixes@ (mapcar 'list PrefixSort@))
      (setq List@ AlphaSort@ Num# 0)
      (foreach Prefix$ PrefixSort@
        (setq Compare$ (strcat Prefix$ "#*")
              PrefixList@ (nth Num# Prefixes@)
              First t
        );setq
        (foreach Str$ List@
          (if (wcmatch Str$ Compare$)
            (progn
              (if First
                (setq PrefixList@ (append PrefixList@ (list (vl-position Str$ AlphaSort@)))
                      First nil
                );setq
              );if
              (setq List@ (vl-remove Str$ List@)
                    Str$ (substr Str$ (1+ (strlen Prefix$)))
                    PrefixList@ (append PrefixList@ (list Str$))
              );setq
            );if
          );if
        );foreach
        (setq Prefixes@ (change_nth Num# PrefixList@ Prefixes@))
        (setq Num# (1+ Num#))
      );foreach
      (foreach PrefixList@ Prefixes@
        (setq NumStrings@ (cddr PrefixList@)
              NumSort@ (number_sort (mapcar 'atoi NumStrings@))
              List@ nil
        );setq
        (foreach Num# NumSort@
          (setq Loop t Cnt# 0)
          (while Loop
            (setq Str$ (nth Cnt# NumStrings@))
            (if (= (atoi Str$) Num#)
              (setq NumStrings@ (delete_nth Cnt# NumStrings@)
                    Str$ (strcat (nth 0 PrefixList@) Str$)
                    List@ (append List@ (list Str$))
                    Loop nil
              );setq
            );if
            (setq Cnt# (1+ Cnt#))
          );while
        );foreach
        (setq Num# (nth 1 PrefixList@) SortList@ Original@)
        (foreach Str$ List@
          (setq Str$ (nth (vl-position Str$ AlphaSort@) Original@))
          (setq SortList@ (change_nth Num# Str$ SortList@))
          (setq Num# (1+ Num#))
        );foreach
        (setq Original@ SortList@)
      );foreach
    );progn
  );if
  (foreach Str$ AlphaSort@
    (if (wcmatch (substr Str$ 1 1) "#")
      (setq NumStrings@ (append NumStrings@ (list Str$)))
    );if
  );foreach
  (if NumStrings@
    (progn
      (setq NumSort@ (number_sort (mapcar 'atoi NumStrings@))
            List@ nil
      );setq
      (foreach Num# NumSort@
        (setq Loop t Cnt# 0)
        (while Loop
          (setq Str$ (nth Cnt# NumStrings@))
          (if (= (atoi Str$) Num#)
            (setq NumStrings@ (delete_nth Cnt# NumStrings@)
                  List@ (append List@ (list Str$))
                  Loop nil
            );setq
          );if
          (setq Cnt# (1+ Cnt#))
        );while
      );foreach
      (setq Num# 0 SortList@ Original@)
      (foreach Str$ List@
        (setq Str$ (nth (vl-position Str$ AlphaSort@) Original@))
        (setq SortList@ (change_nth Num# Str$ SortList@))
        (setq Num# (1+ Num#))
      );foreach
      (setq Original@ SortList@)
    );progn
  );if
  Original@
);defun win_sort
;-------------------------------------------------------------------------------
; number_sort - Sorts list of numbers
; Arguments: 1
;   List@ = List of numbers
; Returns: List of sorted numbers
;-------------------------------------------------------------------------------
(defun number_sort (List@ / High~ Item~ List1@ List2@ Low~ NewList@ Passed Swap~)
  (setq Passed t)
  (if (= (type List@) 'LIST)
    (foreach Item~ List@ (if (not (numberp Item~)) (setq Passed nil)))
    (setq Passed nil)
  );if
  (if (not Passed)
    (progn (princ "\nUsage: (number_sort <list of numbers>)") (exit))
  );if
  (repeat (/ (length List@) 2)
    (setq Low~ (car List@) High~ nil NewList@ nil)
    (foreach Item~ (cdr List@)
      (and (< Item~ Low~) (setq Swap~ Low~ Low~ Item~ Item~ Swap~))
      (and (> Item~ High~) (setq Swap~ High~ High~ Item~ Item~ Swap~))
      (setq NewList@ (cons Item~ NewList@))
    );foreach
    (setq List1@ (cons Low~ List1@) List2@ (cons High~ List2@) List@ (cdr (reverse NewList@)))
  );repeat
  (append (reverse List1@) List@ List2@)
);defun number_sort
;-------------------------------------------------------------------------------
; Change_nth - Changes the nth item in a list with a new item value.
; Arguments: 3
;   Num# = Nth number in list to change
;   Value = New item value to change to
;   OldList@ = List to change item value
; Returns: A list with the nth item value changed.
;-------------------------------------------------------------------------------
(defun Change_nth (Num# Value OldList@)
  (if (<= 0 Num# (1- (length OldList@)))
    (if (> Num# 0)
      (cons (car OldList@) (Change_nth (1- Num#) Value (cdr OldList@)))
      (cons Value (cdr OldList@))
    );if
    OldList@
  );if
);defun Change_nth
;-------------------------------------------------------------------------------
; Delete_nth - Deletes the nth item from a list.
; Arguments: 2
;   Num# = Nth number in list to delete
;   OldList@ = List to delete the nth item
; Returns: A list with the nth item deleted.
;-------------------------------------------------------------------------------
(defun Delete_nth (Num# OldList@)
  (setq Num# (1+ Num#))
  (vl-remove-if '(lambda (x) (zerop (setq Num# (1- Num#)))) OldList@)
);defun Delete_nth
;-------------------------------------------------------------------------------
« Last Edit: May 21, 2007, 04:20:50 PM by Terry Cadd »

VVA

  • Newt
  • Posts: 166
Re: Search of Windows type Sort function
« Reply #6 on: May 19, 2007, 06:36:17 AM »
Win_sort sort string with ignore case of none numeric char
Other variant
Code: [Select]
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05"))
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber1 (ListOfString)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
  (defun NormalizeNumberInString (str / ch i pat ret count buf)
    (setq i     0
          pat   '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret   ""
          count 4 ;_Count normalize symbols
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  (vl-load-com)
  (mapcar '(lambda (x) (nth x ListOfString))
          (vl-sort-i (mapcar 'NormalizeNumberInString (mapcar 'strcase ListOfString))
                     '<
          ) ;_ end of VL-SORT-I
  ) ;_ end of mapcar
) ;_ end of defun
Test
Code: [Select]
(setq Lst (list "1-C4.dwg" "7-b7.dwg" "11-C4.dwg" "2-b3.dwg" "2-c2.dwg" "22-b2.dwg" "pn374-x9.dwg" "pn374-z9.dwg" "Pn375-A10.dwg" "pN375-A9.dwg" "pn375-D1.dwg" "PN375-D10.dwg" "pN375-D2r3.dwg" "pn375-D22.dwg" "qr86-007.dwg" "pN375-DB.dwg" "pn375-DB10a.dwg" "PN375-DB9.dwg"))
(mapcar '(lambda(x)(terpri)(princ x))
        (SortStringWithNumberAsNumber1 lst))
Result
SortStringWithNumberAsNumber1   Win_Sort
1-C4.dwg                            1-C4.dwg
2-b3.dwg                                         2-b3.dwg
2-c2.dwg                                         2-c2.dwg
7-b7.dwg                                         7-b7.dwg
11-C4.dwg                           11-C4.dwg
22-b2.dwg                           22-b2.dwg
pn374-x9.dwg                           pn374-x9.dwg
pn374-z9.dwg                           pn374-z9.dwg
pN375-A9.dwg                           pN375-A9.dwg
Pn375-A10.dwg                           Pn375-A10.dwg
pn375-D1.dwg                           pn375-D1.dwg
pN375-D2r3.dwg                           pN375-D2r3.dwg
PN375-D10.dwg                           PN375-D10.dwg
pn375-D22.dwg                           pn375-D22.dwg
pN375-DB.dwg                           pN375-DB.dwg
PN375-DB9.dwg                           PN375-DB9.dwg
pn375-DB10a.dwg                           pn375-DB10a.dwg
qr86-007.dwg                           qr86-007.dwg


terrycadd

  • Guest
Re: Search of Windows type Sort function
« Reply #7 on: May 19, 2007, 02:34:01 PM »
VVA,
You have written a very nice and short program. It does everything that win_sort does in the sort. Good job! 
I've attached two demos that you and others can try out to test their own sort functions. SortDemo1 is using your SortStringWithNumberAsNumber1 function, and SortDemo2 is using the win_sort function.
Code: [Select]
;-------------------------------------------------------------------------------
(defun c:SortDemo1 (/ Filename$ OriginalList@ PathFilename$ SortedList@)
  (princ "\nSelect a drawing in a folder for Folder name:")(princ)
  (if (not *LastFolder$)
    (setq *LastFolder$ (getvar "DWGPREFIX"))
  );if
  (if (setq PathFilename$ (getfiled " Select a drawing in a folder for Folder name" *LastFolder$ "dwg" 2))
    (setq *LastFolder$ (strcat (vl-filename-directory PathFilename$) "\\"))
    (exit)
  );if
  (textscr)
  (princ (strcat "\n" *LastFolder$))
  (setq OriginalList@ (vl-directory-files *LastFolder$ "*.dwg" 1))
  (princ (strcat "\n" (chr 160) "\nOriginal list:\n--------------"))
  (foreach Filename$ OriginalList@
    (princ "\n")(princ Filename$)
  );foreach
  ;Here you can change the sort function name that you are testing
  (setq SortedList@ (SortStringWithNumberAsNumber1 (vl-directory-files *LastFolder$ "*.dwg" 1)))
  (princ (strcat "\n" (chr 160) "\nSorted list:\n------------"))
  (foreach Filename$ SortedList@
    (princ "\n")(princ Filename$)
  );foreach
  (princ)
);defun c:SortDemo1
;-------------------------------------------------------------------------------
(defun c:SortDemo2 (/ Filename$ OriginalList@ PathFilename$ SortedList@)
  (princ "\nSelect a drawing in a folder for Folder name:")(princ)
  (if (not *LastFolder$)
    (setq *LastFolder$ (getvar "DWGPREFIX"))
  );if
  (if (setq PathFilename$ (getfiled " Select a drawing in a folder for Folder name" *LastFolder$ "dwg" 2))
    (setq *LastFolder$ (strcat (vl-filename-directory PathFilename$) "\\"))
    (exit)
  );if
  (textscr)
  (princ (strcat "\n" *LastFolder$))
  (setq OriginalList@ (vl-directory-files *LastFolder$ "*.dwg" 1))
  (princ (strcat "\n" (chr 160) "\nOriginal list:\n--------------"))
  (foreach Filename$ OriginalList@
    (princ "\n")(princ Filename$)
  );foreach
  ;Here you can change the sort function name that you are testing
  (setq SortedList@ (win_sort (vl-directory-files *LastFolder$ "*.dwg" 1)))
  (princ (strcat "\n" (chr 160) "\nSorted list:\n------------"))
  (foreach Filename$ SortedList@
    (princ "\n")(princ Filename$)
  );foreach
  (princ)
);defun c:SortDemo2
;-------------------------------------------------------------------------------
« Last Edit: May 19, 2007, 11:02:40 PM by Terry Cadd »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Search of Windows type Sort function
« Reply #8 on: May 20, 2007, 12:16:10 PM »
VVA has done an excellent job.
I wrote a version that changes the strings to list but it was much longer & slower than your code.
I made some mods of your code for my use. I'll post them in case anyone is interested.

Code: [Select]
;;  By VVW --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count
                                     NormalizeNumberInString getcount)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
       )
      Lst
    )
    count
  )
  ;;===============================================

  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
) ;_ end of defun


<edit: corrections made per VVA suggestion below>
« Last Edit: May 21, 2007, 11:33:57 AM by CAB »
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

VVA

  • Newt
  • Posts: 166
Re: Search of Windows type Sort function
« Reply #9 on: May 21, 2007, 04:21:41 AM »
CAB has written, I so think, a final variant of function. One small addition:
NorStrs count set as local variables
Code: [Select]
;;Published http://www.theswamp.org/index.php?topic=16564.0
;;By VVA --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
) ;_ end of defun

terrycadd

  • Guest
Re: Search of Windows type Sort function
« Reply #10 on: May 21, 2007, 10:42:01 AM »
VVA,
Thank you so much for writing this sort program. It’s excellent!
Thanks,
Terry

VVA

  • Newt
  • Posts: 166
Re: Search of Windows type Sort function
« Reply #11 on: June 21, 2007, 03:48:50 AM »
Found one bugs (thanks Elpanov Evgeniy)
(SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
 return
("A1" "A10" "A9" "B05" "B11" "B2")
should be
("A1" "A9" "A10" "B2" "B05" "B11")
The corrected variant
Code: [Select]
;;Published http://www.theswamp.org/index.php?topic=16564.0
;;By VVA --  05.20.07 mods by CAB
;;Usage (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") nil)
;;With ignore case (SortStringWithNumberAsNumber '("A9" "A1" "A10" "B11" "B2" "B05") t)
;;  CAB added Ignore Case Flag as an argument
;;Return ("A1" "A9" "A10" "B2" "B05" "B11")
(defun SortStringWithNumberAsNumber (ListOfString IgnoreCase / NorStrs count)
;;;Function Normalize (add 0 befor number) number in string
;;; Count normalize symbols set in variable count
;;; CAB added count as an argument
  (defun NormalizeNumberInString (str count / ch i pat ret buf)
    (setq i   0
          pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
          ret ""
    ) ;_ end of setq
    (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
      (if (vl-position ch pat)
        (progn
          (setq buf ch) ;_ end of setq
          (while
            (vl-position (setq ch (substr str (setq i (1+ i)) 1)) pat)
             (setq buf (strcat buf ch))
          ) ;_ end of while
          (while (< (strlen buf) count) (setq buf (strcat "0" buf)))
          (setq ret (strcat ret buf))
        ) ;_ end of progn
      ) ;_ end of if
      (setq ret (strcat ret ch))
    ) ;_ end of while
    ret
  ) ;_ end of defun
  ;;-------------------------------------------------
  ;;  function to Count the longest number in string
  ;;  CAB added to get the correct COUNT
  (defun getcount (lst / count pat)
    (setq count 0)
    (setq pat '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9"))
    (mapcar
      '(lambda (str / i maxlen ch)
         (setq i 0 maxlen 0)
         (while (/= (setq ch (substr str (setq i (1+ i)) 1)) "")
           (if (vl-position ch pat) ; number
             (setq maxlen (1+ maxlen))
             (setq count  (max count maxlen) maxlen 0)
           )
         )
(setq count  (max count maxlen)) ;_<<< ADD 21.06.2007 by VVA
       )
      Lst
    )
    count
  )
  ;;===============================================
  (setq count   (GetCount ListOfString)
        NorStrs (mapcar '(lambda (x) (NormalizeNumberInString x count))
                        ListOfString)
  )
  (and IgnoreCase (setq NorStrs (mapcar 'strcase NorStrs)))
  (mapcar '(lambda (x) (nth x ListOfString)) (vl-sort-i NorStrs '<))
) ;_ end of defun


antistar

  • Guest
Re: Search of Windows type Sort function
« Reply #12 on: January 27, 2014, 10:11:10 AM »
Hi,
Could anyone help me to sort this way?
("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" T10B ")

Thanks in advance.

dale_fuger

  • Guest
Re: Search of Windows type Sort function
« Reply #13 on: January 27, 2014, 11:29:44 PM »
You might look into DOSLib's DOS_STRSORT function and it's logical sorting option.

http://www.en.na.mcneel.com/doslib/string_functions/dos_strsort.htm

For example:

Command: (dos_strsort '("A1" "A10" "A9" "B05" "B11" "B2") -1)
("A1" "A9" "A10" "B2" "B05" "B11")

Does this help?

-- Dale

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: Search of Windows type Sort function
« Reply #14 on: January 28, 2014, 06:13:30 AM »
Hi,
Could anyone help me to sort this way?
("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" T10B ")

Thanks in advance.
I have this:
Code: [Select]
; Function: ALE_List_SortAtoms
;
; Version 1.00 -    01/2005    (old name ALE_SortAlphaNum)
; Version 1.13 - 24/01/2007
; Version 1.20 - 26/03/2007
; Version 1.21 - 26/08/2010
;
; Example:
;   (ALE_List_SortAtoms
;    '("C20.10R" "C20.3R" nil (1 . 20) "C12" nil "C20.1R" "0"
;      "20K" T (10 20 30) T "2K" -99 "C2" 0 (55) "C201" "-99"
;      "L4" "L1" "L100" "-200K" 8 1 "2C" "20C.1R" "20C.10R"
;      "20C.3R" "20C.R4" "20C.R44" "20C.R3" 4 "20C" "4R" "4C"
;      3.2 1 10 100 200 2 20
;     )
;   )
; =>(nil nil -99 0 1 1 2 3.2 4 8 10 20 100 200 "-200K" "-99" "0"
;    "2C" "2K" "4C" "4R" "20C" "20C.10R" "20C.1R" "20C.3R" "20C.R3"
;    "20C.R4" "20C.R44" "20K" "C2" "C12" "C20.10R" "C20.1R" "C20.3R"
;    "C201" "L1" "L4" "L100" T T (55) (10 20 30) (1 . 20)
;   )
;
(defun ALE_List_SortAtoms (InpLst)
  (mapcar
   '(lambda (LmbDat) (nth LmbDat InpLst))
    (vl-sort-i InpLst
     '(lambda (LmbDt1 LmbDt2 / Typ001 Typ002 Num001 Num002 Flg001 Flg002)
        (setq Typ001 (type LmbDt1)    Typ002 (type LmbDt2))
        (cond
          ( (not LmbDt1) )
          ( (not LmbDt2) nil)
          ( (eq Typ001 'LIST) nil)
          ( (eq Typ002 'LIST) )
          ( (eq Typ001 'SYM)  nil)
          ( (eq Typ002 'SYM) )
          ( (and
              (setq Flg001 (numberp LmbDt1)  Flg002 (numberp LmbDt2))
              Flg001
            )
            (< LmbDt1 LmbDt2)
          )
          ( (and Flg002 (not Flg001)) nil )
          ( Flg001 )
          ( (=
              (setq Num001 (if Flg001 LmbDt1 (atof LmbDt1)))
              (setq Num002 (if Flg002 LmbDt2 (atof LmbDt2)))
              0
            )
            (setq
              Num001 (atof
                       (vl-string-translate
                         " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                         "000000000000000000000000000"
                         (strcase LmbDt1)
                       )
                     )
              Num002 (atof
                       (vl-string-translate
                         " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
                         "000000000000000000000000000"
                         (strcase LmbDt2)
                       )
                     )
              LmbDt1 (vl-string-translate "123456789" "000000000" LmbDt1)
              LmbDt2 (vl-string-translate "123456789" "000000000" LmbDt2)
            )
            (cond
              ( (and (= LmbDt1 LmbDt2) (< Num001 Num002)) )
              ( (< LmbDt1 LmbDt2) )
            )
          )
          ( (and (zerop Num001) (not (eq LmbDt1 "0"))) nil )
          ( (and (zerop Num002) (not (eq LmbDt2 "0"))) )
          ( (or (< Num001 Num002) (and (= Num001 Num002) (< LmbDt1 LmbDt2))) )
        )
      )
    )
  )
)
Code: [Select]
(ALE_List_SortAtoms '("T1A" "AS2" "AS10" "T10B" "T1" "AS1" "T2" "T10" "T2A" "T10A" "T1B" "T2B"))
=====>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T10A" "T10B" "T1A" "T2A" "T1B" "T2B")
Your=>  ("AS1" "AS2" "AS10" "T1" "T2" "T10" "T1A" "T2A" "T10A" "T1B" "T2B" "T10B")