Jump to content

Problem with function vl-sort

Tue_NV

By Tue_NV
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

Tue_NV Rookie

Tue_NV

Posted
Posted

Hi, all.

I have problem with function vl-sort

This is code

(setq L (list "D1A" "D3" "D7" "D4" "D9" "D10B" "D10A" "D11" "D2" "D20A"))
(vl-sort L '<)

-> Result :

("D10A" "D10B" "D11" "D1A" "D2" "D20A" "D3" "D4" "D7" "D9")

 

I've to want this result :

("D1A" "D2" "D3" "D4" "D7" "D9" "D10A" "D10B" "D11" "D20A")

 

this problem is difficult with me :(

Please show me

Thanks you very much

Lee Mac Grand Master

Lee Mac

Posted
Posted

This looks like an Architectural Sort - I used something like this in my code here.

 

I collaborated with Gile to get this code:

 

(defun ArchSort (lst / SplitStr comparable)
 ;; Gile & Lee Mac

 (defun SplitStr (str / lst test rslt num tmp)
   
   (setq lst  (vl-string->list str)
         test (chr (car lst)))
   
   (if (< 47 (car lst) 58)
     (setq num T))
   
   (while (setq lst (cdr lst))
     (if num
       (cond (  (= 46 (car lst))
                (if (and (cadr lst)
                         (setq tmp (strcat "0." (chr (cadr lst))))
                         (numberp (read tmp)))

                  (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))
                  (setq rslt (cons (read test) rslt) test "." num nil)))

             (  (< 47 (car lst) 58)
                (setq test (strcat test (chr (car lst)))))

             (T (setq rslt (cons (read test) rslt) test (chr (car lst)) num  nil)))

       (if (< 47 (car lst) 58)
         (setq rslt (cons test rslt) test (chr (car lst)) num  T)
         (setq test (strcat test (chr (car lst)))))))
   
   (if num
     (setq rslt (cons (read test) rslt))
     (setq rslt (cons test rslt)))
   
   (reverse rslt))
 
 (defun comparable (e1 e2)
   (or (and (numberp e1) (numberp e2))
       (= 'STR (type e1) (type e2))
       (not e1)
       (not e2)))
 
 (mapcar
   (function
     (lambda (x)
       (nth x lst)))
   
   (vl-sort-i (mapcar (function SplitStr) lst)
     (function
       (lambda (x1 x2 / n1 n2 comp)
         (while
           (and (setq comp (comparable (setq n1 (car x1))
                                       (setq n2 (car x2))))
                (= n1 n2))
            (setq x1 (cdr x1) x2 (cdr x2)))
         
         (if comp (< n1 n2) (numberp n1)))))))

 

Example:

 

(ArchSort (list "D1A" "D3" "D7" "D4" "D9" "D10B" "D10A" "D11" "D2" "D20A"))
>> ("D1A" "D2" "D3" "D4" "D7" "D9" "D10A" "D10B" "D11" "D20A")

 

(ArchSort (list "A1.2.5B" "A1.2.3B" "A1.2.5C" "A1.1.4D" "A1.5.2C"))
>> ("A1.1.4D" "A1.2.3B" "A1.2.5B" "A1.2.5C" "A1.5.2C")

Tue_NV Rookie

Tue_NV

Posted
  • Author
Posted

That's great!

Thanks Gile

Thanks Lee

 

Thank you very much :)

Tue_NV Rookie

Tue_NV

Posted
  • Author
Posted
You're welcome :)

Thanks Lee

Please show me to use function ArchSort When I have list L

 

(setq L (append (list (cons "D1A" 2)) (list (cons "D3" 2)) (list (cons "D7" 3)) (list (cons"D4" 2)) (list (cons "D9" 1)) (list (cons "D10B" 1)) (list (cons "D10A" 3)) (list (cons "D11" 2)) (list (cons "D2" 4)) (list (cons "D20A" 2))))

 

(("D1A" . 2) ("D3" . 2) ("D7" . 3) ("D4" . 2) ("D9" . 1) ("D10B" . 1) ("D10A" .

3) ("D11" . 2) ("D2" . 4) ("D20A" . 2))

 

Please show me to solve

Thanks

Lee Mac Grand Master

Lee Mac

Posted
Posted

Change highlighted.

 

(defun ArchSort (lst / SplitStr comparable)
 ;; Gile & Lee Mac

 (defun SplitStr (str / lst test rslt num tmp)
   
   (setq lst  (vl-string->list str)
         test (chr (car lst)))
   
   (if (< 47 (car lst) 58)
     (setq num T))
   
   (while (setq lst (cdr lst))
     (if num
       (cond (  (= 46 (car lst))
                (if (and (cadr lst)
                         (setq tmp (strcat "0." (chr (cadr lst))))
                         (numberp (read tmp)))

                  (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))
                  (setq rslt (cons (read test) rslt) test "." num nil)))

             (  (< 47 (car lst) 58)
                (setq test (strcat test (chr (car lst)))))

             (T (setq rslt (cons (read test) rslt) test (chr (car lst)) num  nil)))

       (if (< 47 (car lst) 58)
         (setq rslt (cons test rslt) test (chr (car lst)) num  T)
         (setq test (strcat test (chr (car lst)))))))
   
   (if num
     (setq rslt (cons (read test) rslt))
     (setq rslt (cons test rslt)))
   
   (reverse rslt))
 
 (defun comparable (e1 e2)
   (or (and (numberp e1) (numberp e2))
       (= 'STR (type e1) (type e2))
       (not e1)
       (not e2)))
 
 (mapcar
   (function
     (lambda (x)
       (nth x lst)))
   
   (vl-sort-i (mapcar (function SplitStr) [color=Blue][b](mapcar (function car)[/b][/color] lst[b][color=Blue])[/color][/b])
     (function
       (lambda (x1 x2 / n1 n2 comp)
         (while
           (and (setq comp (comparable (setq n1 (car x1))
                                       (setq n2 (car x2))))
                (= n1 n2))
            (setq x1 (cdr x1) x2 (cdr x2)))
         
         (if comp (< n1 n2) (numberp n1)))))))

By the way, no need for all the appending...

 

(setq lst (list (cons "D1A" 2) (cons "D3"  2) (cons "D7" 3) (cons "D4" 2) (cons "D9" 1) (cons "D10B" 1) (cons "D10A" 3) (cons "D11" 2) (cons "D2" 4) (cons "D20A" 2)))

(ArchSort lst)
==> (("D1A" . 2) ("D2" . 4) ("D3" . 2) ("D4" . 2) ("D7" . 3) ("D9" . 1) ("D10A" . 3) ("D10B" . 1) ("D11" . 2) ("D20A" . 2))

  • 2 months later...
Tue_NV Rookie

Tue_NV

Posted
  • Author
Posted
This looks like an Architectural Sort - I used something like this in my code here.

 

I collaborated with Gile to get this code:

 

(defun ArchSort (lst / SplitStr comparable)
 ;; Gile & Lee Mac

 (defun SplitStr (str / lst test rslt num tmp)

   (setq lst  (vl-string->list str)
         test (chr (car lst)))

   (if (< 47 (car lst) 58)
     (setq num T))

   (while (setq lst (cdr lst))
     (if num
       (cond (  (= 46 (car lst))
                (if (and (cadr lst)
                         (setq tmp (strcat "0." (chr (cadr lst))))
                         (numberp (read tmp)))

                  (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))
                  (setq rslt (cons (read test) rslt) test "." num nil)))

             (  (< 47 (car lst) 58)
                (setq test (strcat test (chr (car lst)))))

             (T (setq rslt (cons (read test) rslt) test (chr (car lst)) num  nil)))

       (if (< 47 (car lst) 58)
         (setq rslt (cons test rslt) test (chr (car lst)) num  T)
         (setq test (strcat test (chr (car lst)))))))

   (if num
     (setq rslt (cons (read test) rslt))
     (setq rslt (cons test rslt)))

   (reverse rslt))

 (defun comparable (e1 e2)
   (or (and (numberp e1) (numberp e2))
       (= 'STR (type e1) (type e2))
       (not e1)
       (not e2)))

 (mapcar
   (function
     (lambda (x)
       (nth x lst)))

   (vl-sort-i (mapcar (function SplitStr) lst)
     (function
       (lambda (x1 x2 / n1 n2 comp)
         (while
           (and (setq comp (comparable (setq n1 (car x1))
                                       (setq n2 (car x2))))
                (= n1 n2))
            (setq x1 (cdr x1) x2 (cdr x2)))

         (if comp (< n1 n2) (numberp n1)))))))

 

Example:

 

(ArchSort (list "D1A" "D3" "D7" "D4" "D9" "D10B" "D10A" "D11" "D2" "D20A"))
>> ("D1A" "D2" "D3" "D4" "D7" "D9" "D10A" "D10B" "D11" "D20A")

 

(ArchSort (list "A1.2.5B" "A1.2.3B" "A1.2.5C" "A1.1.4D" "A1.5.2C"))
>> ("A1.1.4D" "A1.2.3B" "A1.2.5B" "A1.2.5C" "A1.5.2C")

Thank Lee very much

But I've a trouble with List L. This code didn't work

(ArchSort (list "D1-1" "D1-10" "D1-12" "D1-13" "D1-14" "D1-15A" "D1-15B" "D1-15C" "D1-1B" "D1-1C" "D1-1D" "D1-2" "D1-20" "D1-21" "D1-22" "D1-23" "D1-3A" "D1-3B" "D1-4A" "D1-4B" "D1-4C" "D1-5" "D1-6A" "D1-6B" "D1-7A" "D1-7B" "D1-8" "D1-9A" "D1-9B" "D1-9C" "D1-B" "D1-C" "DL-D" "DL-D" "DL-E"))

>>>> didn't work.....:(

 

I don't understand why? :unsure:

Please show me to solve

Thanks

Tue_NV Rookie

Tue_NV

Posted
  • Author
Posted
Thank Lee very much

But I've a trouble with List L. This code didn't work

(ArchSort (list "D1-1" "D1-10" "D1-12" "D1-13" "D1-14" "D1-15A" "D1-15B" "D1-15C" "D1-1B" "D1-1C" "D1-1D" "D1-2" "D1-20" "D1-21" "D1-22" "D1-23" "D1-3A" "D1-3B" "D1-4A" "D1-4B" "D1-4C" "D1-5" "D1-6A" "D1-6B" "D1-7A" "D1-7B" "D1-8" "D1-9A" "D1-9B" "D1-9C" "D1-B" "D1-C" "DL-D" "DL-D" "DL-E"))

>>>> didn't work.....:(

 

I don't understand why? :unsure:

Please show me to solve

Thanks

Could you please help me to get code?

Thank you very much :(

Lee Mac Grand Master

Lee Mac

Posted
Posted

Try this:

 

(defun ArchSort (lst / SplitStr comparable)
 ;; Gile & Lee Mac

 (defun SplitStr (str / lst test rslt num tmp)
   
   (setq lst  (vl-string->list str)
         test (chr (car lst)))
   
   (if (< 47 (car lst) 58)
     (setq num T))
   
   (while (setq lst (cdr lst))
     (if num
       (cond (  (= 46 (car lst))
                (if (and (cadr lst)
                         (setq tmp (strcat "0." (chr (cadr lst))))
                         (numberp (read tmp)))

                  (setq rslt (cons (read test) rslt) test tmp lst (cdr lst))
                  (setq rslt (cons (read test) rslt) test "." num nil)))

             (  (< 47 (car lst) 58)
                (setq test (strcat test (chr (car lst)))))

             (T (setq rslt (cons (read test) rslt) test (chr (car lst)) num  nil)))

       (if (< 47 (car lst) 58)
         (setq rslt (cons test rslt) test (chr (car lst)) num  T)
         (setq test (strcat test (chr (car lst)))))))
   
   (if num
     (setq rslt (cons (read test) rslt))
     (setq rslt (cons test rslt)))
   
   (reverse rslt))
 
 (defun comparable (e1 e2)
   (or (and (numberp e1) (numberp e2))
       (= 'STR (type e1) (type e2))
       (not e1)
       (not e2)))
 
 (mapcar
   (function
     (lambda (x)
       (nth x lst)))
   
   (vl-sort-i (mapcar (function SplitStr) lst)
     (function
       (lambda (x1 x2 / n1 n2 comp)
         (while
           (and (setq comp (comparable (setq n1 (car x1))
                                       (setq n2 (car x2))))
                (= n1 n2)
                (setq x1 (cdr x1) x2 (cdr x2))))
         
         (if comp (< n1 n2) (numberp n1)))))))

Tue_NV Rookie

Tue_NV

Posted
  • Author
Posted
Did the code work for you?

That's great

Thank you for your help

The Code worked very good

Thanks :)

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...