vnanhvu Posted January 2, 2013 Share Posted 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 ! Quote Link to comment Share on other sites More sharing options...
MSasu Posted January 2, 2013 Share Posted January 2, 2013 You should check the ACAD_STRLSORT or VL_SORT functions. Please note that the second one may leave out duplicate entries. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 2, 2013 Share Posted 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) '<)) ) Quote Link to comment Share on other sites More sharing options...
vnanhvu Posted January 2, 2013 Author Share Posted 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. Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 3, 2013 Share Posted 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")) Quote Link to comment Share on other sites More sharing options...
hmsilva Posted January 3, 2013 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
pBe Posted January 3, 2013 Share Posted January 3, 2013 (edited) 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 Quote Link to comment Share on other sites More sharing options...
hmsilva Posted January 3, 2013 Share Posted January 3, 2013 (edited) 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... Quote Link to comment Share on other sites More sharing options...
pBe Posted January 3, 2013 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
Tharwat Posted January 3, 2013 Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
hmsilva Posted January 3, 2013 Share Posted January 3, 2013 Tharwat, nice code, super compact. Cheers Henrique Quote Link to comment Share on other sites More sharing options...
Tharwat Posted January 3, 2013 Share Posted January 3, 2013 Tharwat,nice code, super compact. Cheers Henrique Thank you Henrique , I am very happy that you liked the code . Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 3, 2013 Share Posted 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]) ) Quote Link to comment Share on other sites More sharing options...
hmsilva Posted January 3, 2013 Share Posted January 3, 2013 Lee Mac, as always, excellent... I keep on learning, I hope. Cheers Henrique Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 3, 2013 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
vnanhvu Posted January 4, 2013 Author Share Posted January 4, 2013 Oh, thank you for your enthusiasm. Thank HMSILVA,PBE,THARWAT,LEE MAC .... vrey much ! Quote Link to comment Share on other sites More sharing options...
pBe Posted January 4, 2013 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted January 4, 2013 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
pBe Posted January 4, 2013 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
irneb Posted January 4, 2013 Share Posted January 4, 2013 (edited) 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.