ARRANGEMENTS letters in the order ABCD...

January 2, 2013

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 !

January 2, 2013

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

January 2, 2013

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) '<))
)

January 2, 2013

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.

January 3, 2013

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"))

January 3, 2013

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

January 3, 2013

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:

Edited January 3, 2013 by pBe
optimized

January 3, 2013

Looks fun to code. I think i'll play
...

[\QUOTE]

And you did play well!!!

Concise and clean, very good code.

Cheers

Henrique

Edited January 3, 2013 by hmsilva
trying to format quote unsuccessfully...

January 3, 2013

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

January 3, 2013

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)
)

January 3, 2013

Tharwat,

nice code, super compact.

Cheers

Henrique

January 3, 2013

Tharwat,
nice code, super compact.

Cheers

Henrique

Thank you Henrique ,

I am very happy that you liked the code .

January 3, 2013

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])
)

January 3, 2013

Lee Mac,

as always, excellent...

I keep on learning, I hope.

Cheers

Henrique

January 3, 2013

Lee Mac,
as always, excellent...

I keep on learning, I hope.

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

January 4, 2013

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

January 4, 2013

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

January 4, 2013

nice code super compact

for any one that cares

Lee 39 brackets

PBE 53

Tharwat 65

Ps did not count them used a lisp what else

January 4, 2013

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

January 4, 2013

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))

Edited January 4, 2013 by irneb

Sign In

ARRANGEMENTS letters in the order ABCD...

Recommended Posts

vnanhvu

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

MSasu

Lee Mac

vnanhvu

BIGAL

hmsilva

pBe

hmsilva

pBe

Tharwat

hmsilva

Tharwat

Lee Mac

hmsilva

Lee Mac

vnanhvu

pBe

BIGAL

pBe

irneb

Join the conversation

Tutorials

Forums

Activity