ARRANGEMENTS letters in the order ABCD...

I have a drawing with 1000 rows letters .

For example: row 1 with letter: photoshop, Row 2: autocad, Row 3: Ok ..... You can help me with lisp, that I could to sort the words in order ABCD...: 1.autocad, 2.Ok, 3.Photoshop...etc..

Thank you very much & happy new year !

You should check the ACAD_STRLSORT or VL_SORT functions. Please note that the second one may leave out duplicate entries.

Consider the following simple function for a case-insensitive alphabetical sort:

(defun _alphasort ( lst )
   (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i (mapcar 'strcase lst) '<))
)

Consider the following simple function for a case-insensitive alphabetical sort:

(defun _alphasort ( lst )
   (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i (mapcar 'strcase lst) '<))
)

Could Lee help me with complete lisp. Thanks ! I'm not good at written lisp.

Heres an example of a list of text objects that will test Lee's code you need to work out what text your picking please provide more detail

(setq lst (list "autocad" "photoshop" "ZYX" "aaa" "1st"))

I have a drawing with 1000 rows letters .

For example: row 1 with letter: photoshop, Row 2: autocad, Row 3: Ok ..... You can help me with lisp, that I could to sort the words in order ABCD...: 1.autocad, 2.Ok, 3.Photoshop...etc..

Thank you very much & happy new year !

if I understand correctly, and if they are text entities...

(defun c:test (/ ss ptlst lst itm ent txt ptlst1)
 (prompt "\nSelect the Text Objects to Sort :")
 (if (setq ss (ssget '((0 . "TEXT"))))
   (progn
     (setq ptlst nil
    lst nil
    itm 0
     )
     ;; setq
     (repeat (sslength ss)
(setq ent   (entget (ssname ss itm))
      pt    (list (cdr (assoc 10 ent)))
      txt   (list (cdr (assoc 1 ent)))
      ptlst (append ptlst pt)
      lst   (append lst txt)
      itm   (1+ itm)
)
;; setq
     )
     ;; progn
     (setq lst    (acad_strlsort lst)
    ptlst1 (vl-sort ptlst
      (function (lambda (e1 e2)
    (> (cadr e1) (cadr e2))
         )
      )
    )
    itm    0
     )
     ;; setq
     (repeat (sslength ss)
(setq ent (entget (ssname ss itm))
      ent (subst (cons 10 (nth 0 ptlst1)) (assoc 10 ent) ent)
      ent (subst (cons 1 (nth 0 lst)) (assoc 1 ent) ent)
)
;; setq
(entmod ent)
(setq ptlst1 (vl-remove (nth 0 ptlst1) ptlst1)
      lst    (vl-remove (nth 0 lst) lst)
      itm    (1+ itm)
)
;; setq
     )
     ;; repeat
   )
   ;; progn
 )
 ;; if
 (princ)
)
;; defun

Hope that helps,

Henrique

Looks fun to code. I think i'll play

Alpha sort

(defun c:Order (/ order ss data i e sym d1 d2) 
(vl-load-com)
;;;	pBe	;;;
 (initget "A D")
 (setq data  nil
       order (getkword "\nChoose Option [Ascending/Descending]<A>: ")
       order (if (not order) "A" order
               ) 
       ) 
 (if (setq ss (ssget "_:L" '((0 . "TEXT"))))
   (progn
     (setq sym (if (eq order "A")
                 <
                 >
                 ) 
           ) 
     (repeat (setq i (sslength ss))
       (setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
       (setq data (cons
                    (list (vlax-get e 'insertionpoint)
                          (vla-get-textstring e)
                          e
                          ) 
                    data
                    ) 
             ) 
       ) 
     (setq d1 (vl-sort data
                      (function (lambda (x y)
                         (> (cadar x) (cadar y))))) 
           d2 (vl-sort (mapcar 'cadr data)
                      (function (lambda (x y)
                         (sym (strcase x) (strcase y)))) 
                      )
           )
     (mapcar (function (lambda (j k)
                         (vla-put-textstring (last j) k)
                         ) 
                       ) d1 d2 
             ) 
     ) 
   ) 
 (princ)
 )
 

USAGE:

Command: ORDER

Choose Option [Ascending/Descending]:

Select objects:

Looks fun to code. I think i'll play

...

[\QUOTE]

 

And you did play well!!!

Concise and clean, very good code.

 

Cheers

 

Henrique

 

And you did play well!!!

Concise and clean, very good code.

 

Henrique

Thank you for your kind words Henrique, I would probably modify the code to work not just for alpha sort but cases like this

("ABC" "1" "egg" "23 houses" "100 banana" ) , where "23 houses" will be after "1" rather than "100 banana" and what not. maybe later then, it's getting pretty late on this part of the world

Cheers

My Version .

(defun c:Test (/ ss i sn st+e p pt pts j e)
;;; Tharwat 03. 01. 2013 ;;;
 (if (setq ss (ssget "_:L" '((0 . "TEXT"))))
   (progn
     (repeat (setq i (sslength ss))
       (setq sn   (ssname ss (setq i (1- i)))
             st+e (cons (list (cdr (assoc 1 (entget sn))) sn) st+e)
             p    (cons (cdr (assoc 10 (entget sn))) p)
       )
     )
     (setq pt   (vl-sort p (function (lambda (q s) (< (car q) (car s)))))
           pts  (vl-sort pt (function (lambda (a b) (> (cadr a) (cadr b)))))
           st+e (vl-sort st+e
                         (function (lambda (x k)
                                     (< (car (vl-string->list (car x)))
                                        (car (vl-string->list (car k)))
                                     )
                                   )
                         )
                )
     )
     (setq j -1)
     (repeat (length pt)
       (entmod
         (subst (cons 10 (nth (setq j (1+ j)) pts))
                (assoc 10 (setq e (entget (cadr (nth j st+e)))))
                e
         )
       )
     )
   )
 )
 (princ)
)

Tharwat,

nice code, super compact.

Cheers

Henrique

Tharwat,

nice code, super compact.

 

Cheers

 

Henrique

Thank you Henrique ,

I am very happy that you liked the code .

Another:

([color=BLUE]defun[/color] c:sortxt ( [color=BLUE]/[/color] e i l p s )
   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] s ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"TEXT"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s))
               ([color=BLUE]setq[/color] e ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] s ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
                     l ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 1 e)) l)
                     p ([color=BLUE]cons[/color] ([color=BLUE]list[/color] ([color=BLUE]caddr[/color] ([color=BLUE]assoc[/color] 10 e)) ([color=BLUE]assoc[/color] -1 e)) p)
               )
           )
           ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]entmod[/color] ([color=BLUE]list[/color] ([color=BLUE]cadr[/color] b) ([color=BLUE]cons[/color] 1 a))))
               ([color=BLUE]vl-sort[/color] l '[color=BLUE]<[/color])
               ([color=BLUE]vl-sort[/color] p '([color=BLUE]lambda[/color] ( a b ) ([color=BLUE]>[/color] ([color=BLUE]car[/color] a) ([color=BLUE]car[/color] b))))
           )
       )
   )
   ([color=BLUE]princ[/color])
)

Lee Mac,

as always, excellent...

I keep on learning, I hope.

Cheers

Henrique

Lee Mac,

as always, excellent...

I keep on learning, I hope.

Thank you Henrique - ask if you have any questions about the code

Oh, thank you for your enthusiasm. Thank HMSILVA,PBE,THARWAT,LEE MAC .... vrey much !

My Version .

 

(defun c:Test (/ ss i sn st+e p pt pts j e)
;;; Tharwat 03. 01. 2013 ;;;

Interesting approach Tharwat, Watch out for duplicates(ish) , and sometimes gives strange results

Another:

 

([color=BLUE]defun[/color] c:sortxt ( [color=BLUE]/[/color] e i l p s )
  

Wow, splitting the list into two sets makes more sense. I stopped using entmod for string modification ever since ADESK introduced Annotative Text Styles

nice code super compact

Lee 39 brackets

PBE 53

Tharwat 65

Ps did not count them used a lisp what else

.... PBE 53

....

In fairness, order code includes an option for Ascending/Descending though.

I'll be working on the "numbers" issue later today, i'm swamped with endless network cables to input

If i could play also . Somewhat similar to pBe's but only 42 sets of parentheses:

(defun c:SortTxt2  (/ ss eLst sLst)
 (vl-load-com)
 (if (ssget "_:L" '((0 . "TEXT")))
   (progn (vlax-for eo  (setq ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
            (setq eLst (cons eo eLst)
                  sLst (cons (vla-get-TextString eo) sLst)))
          (vla-Delete ss)
          (setq eLst (vl-sort eLst '(lambda (eo1 eo2) (<= (cadr (vlax-get eo1 'InsertionPoint)) (cadr (vlax-get eo2 'InsertionPoint)))))
                sLst (vl-sort sLst '(lambda (s1 s2) (<= (strcase s1) (strcase s2)))))
          (repeat (setq ss (length eLst))
            (vla-put-TextString (nth (setq ss (1- ss)) eLst) (nth ss sLst)))))
 (princ))

Edit: or including pBe's Asc/Desc, though now 50 "("'s:

(defun c:SortTxt3  (/ sym ss eLst sLst)
 (vl-load-com)
 (setq sym (cond ((progn (initget "Ascending Descending") (eq (getkword "\nChoose [Ascending/Descending] <Ascending>: ") "Descending"))
                  >=)
                 (t <=)))
 (if (ssget "_:L" '((0 . "TEXT")))
   (progn (vlax-for eo  (setq ss (vla-get-ActiveSelectionSet (vla-get-ActiveDocument (vlax-get-acad-object))))
            (setq eLst (cons eo eLst)
                  sLst (cons (vla-get-TextString eo) sLst)))
          (vla-Delete ss)
          (setq eLst (vl-sort eLst '(lambda (eo1 eo2) (sym (cadr (vlax-get eo1 'InsertionPoint)) (cadr (vlax-get eo2 'InsertionPoint)))))
                sLst (vl-sort sLst '(lambda (s1 s2) (sym (strcase s1) (strcase s2)))))
          (repeat (setq ss (length eLst))
            (vla-put-TextString (nth (setq ss (1- ss)) eLst) (nth ss sLst)))))
 (princ))