Author Topic: HELP WITH A LISP  (Read 8774 times)

0 Members and 1 Guest are viewing this topic.

pedroantonio

  • Guest
HELP WITH A LISP
« on: January 17, 2017, 11:39:06 AM »
Hi , i use this code to export attribiute points from my drawings. I select with window all the points and export them to a file  P,X,Y,Z   or P,X,Y    or    P,X,Y,D

The only problem is that all points are radom in the file not in the correct possition. For example we hane 10,5,2,3,9,T1,S3,1 etc .The correct possition is 1,2,3,5,9,S3,T1. I know  i can do this with MS Excell or with a notepad , but i need something faster. I don't know if it possoble to be done with lisp.

The code is

Code - Auto/Visual Lisp: [Select]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                             ;;
  3. ;;                                      PXYZD                                  ;;
  4. ;;                                                                             ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defun c:PXYZD ( / *error* del des ent idx lst obj ord out sel )
  8.  
  9.     (defun *error* ( msg )
  10.         (if (= 'file (type des))
  11.             (close des)
  12.         )
  13.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  14.             (princ (strcat "\nError: " msg))
  15.         )
  16.         (princ)
  17.     )
  18.  
  19.     (setq ord '("POINT" POINT-X POINT-Y "ELEV" "DESC")
  20.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
  21.           del  ","
  22.     )
  23.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
  24.         (if (setq des (open out "w"))
  25.             (progn
  26.                 (repeat (setq idx (sslength sel))
  27.                     (setq ent (ssname sel (setq idx (1- idx)))
  28.                           obj (vlax-ename->vla-object ent)
  29.                     )
  30.                     (setq lst
  31.                         (append
  32.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
  33.                                '(point-x point-y point-z)
  34.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
  35.                             )
  36.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
  37.                                 (append
  38.                                     (vlax-invoke obj 'getattributes)
  39.                                     (vlax-invoke obj 'getconstantattributes)
  40.                                 )
  41.                             )
  42.                         )
  43.                     )
  44.                     (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
  45.                         (write-line (LM:lst->str lst del) des)
  46.                     )
  47.                 )
  48.                 (setq des (close des))
  49.             )
  50.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
  51.         )
  52.     )
  53.     (princ)
  54. )                
  55.  
  56. ;; List to String  -  Lee Mac
  57. ;; Concatenates each string in a list, separated by a given delimiter
  58.  
  59. (defun LM:lst->str ( lst del )
  60.     (if (cdr lst)
  61.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
  62.         (car lst)
  63.     )
  64. )
  65.  
  66. ;; Unique Filename  -  Lee Mac
  67. ;; Returns a unique filename for a given path & file extension
  68.  
  69. (defun LM:uniquefilename ( pth ext / fnm tmp )
  70.     (if (findfile (setq fnm (strcat pth ext)))
  71.         (progn
  72.             (setq tmp 1)
  73.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
  74.         )
  75.     )
  76.     fnm
  77. )
  78.  
  79.  
  80. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  81. ;;                                                                             ;;
  82. ;;                                      PXYZ                                   ;;
  83. ;;                                                                             ;;
  84. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  85.  
  86. (defun c:PXYZ ( / *error* del des ent idx lst obj ord out sel )
  87.  
  88.     (defun *error* ( msg )
  89.         (if (= 'file (type des))
  90.             (close des)
  91.         )
  92.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  93.             (princ (strcat "\nError: " msg))
  94.         )
  95.         (princ)
  96.     )
  97.  
  98.     (setq ord '("POINT" POINT-X POINT-Y "ELEV" )
  99.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
  100.           del  ","
  101.     )
  102.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
  103.         (if (setq des (open out "w"))
  104.             (progn
  105.                 (repeat (setq idx (sslength sel))
  106.                     (setq ent (ssname sel (setq idx (1- idx)))
  107.                           obj (vlax-ename->vla-object ent)
  108.                     )
  109.                     (setq lst
  110.                         (append
  111.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
  112.                                '(point-x point-y point-z)
  113.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
  114.                             )
  115.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
  116.                                 (append
  117.                                     (vlax-invoke obj 'getattributes)
  118.                                     (vlax-invoke obj 'getconstantattributes)
  119.                                 )
  120.                             )
  121.                         )
  122.                     )
  123.                     (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
  124.                         (write-line (LM:lst->str lst del) des)
  125.                     )
  126.                 )
  127.                 (setq des (close des))
  128.             )
  129.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
  130.         )
  131.     )
  132.     (princ)
  133. )                
  134.  
  135. ;; List to String  -  Lee Mac
  136. ;; Concatenates each string in a list, separated by a given delimiter
  137.  
  138. (defun LM:lst->str ( lst del )
  139.     (if (cdr lst)
  140.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
  141.         (car lst)
  142.     )
  143. )
  144.  
  145. ;; Unique Filename  -  Lee Mac
  146. ;; Returns a unique filename for a given path & file extension
  147.  
  148. (defun LM:uniquefilename ( pth ext / fnm tmp )
  149.     (if (findfile (setq fnm (strcat pth ext)))
  150.         (progn
  151.             (setq tmp 1)
  152.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
  153.         )
  154.     )
  155.     fnm
  156. )
  157.  
  158.  
  159.  
  160. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  161. ;;                                                                             ;;
  162. ;;                                      PXY                                    ;;
  163. ;;                                                                             ;;
  164. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  165.  
  166. (defun c:PXY ( / *error* del des ent idx lst obj ord out sel )
  167.  
  168.     (defun *error* ( msg )
  169.         (if (= 'file (type des))
  170.             (close des)
  171.         )
  172.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  173.             (princ (strcat "\nError: " msg))
  174.         )
  175.         (princ)
  176.     )
  177.  
  178.     (setq ord '("POINT" POINT-X POINT-Y )
  179.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
  180.           del  ","
  181.     )
  182.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
  183.         (if (setq des (open out "w"))
  184.             (progn
  185.                 (repeat (setq idx (sslength sel))
  186.                     (setq ent (ssname sel (setq idx (1- idx)))
  187.                           obj (vlax-ename->vla-object ent)
  188.                     )
  189.                     (setq lst
  190.                         (append
  191.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
  192.                                '(point-x point-y point-z)
  193.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
  194.                             )
  195.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
  196.                                 (append
  197.                                     (vlax-invoke obj 'getattributes)
  198.                                     (vlax-invoke obj 'getconstantattributes)
  199.                                 )
  200.                             )
  201.                         )
  202.                     )
  203.                     (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
  204.                         (write-line (LM:lst->str lst del) des)
  205.                     )
  206.                 )
  207.                 (setq des (close des))
  208.             )
  209.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
  210.         )
  211.     )
  212.     (princ)
  213. )                
  214.  
  215. ;; List to String  -  Lee Mac
  216. ;; Concatenates each string in a list, separated by a given delimiter
  217.  
  218. (defun LM:lst->str ( lst del )
  219.     (if (cdr lst)
  220.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
  221.         (car lst)
  222.     )
  223. )
  224.  
  225. ;; Unique Filename  -  Lee Mac
  226. ;; Returns a unique filename for a given path & file extension
  227.  
  228. (defun LM:uniquefilename ( pth ext / fnm tmp )
  229.     (if (findfile (setq fnm (strcat pth ext)))
  230.         (progn
  231.             (setq tmp 1)
  232.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
  233.         )
  234.     )
  235.     fnm
  236. )
  237.  
  238. [code]
  239.  

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: HELP WITH A LISP
« Reply #1 on: January 17, 2017, 12:18:46 PM »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: HELP WITH A LISP
« Reply #2 on: January 17, 2017, 12:29:26 PM »
Thanks Lee for the heads up.
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.

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #3 on: January 17, 2017, 02:48:00 PM »
Any ideas ?

JohnK

  • Administrator
  • Seagull
  • Posts: 10603
Re: HELP WITH A LISP
« Reply #4 on: January 17, 2017, 03:47:13 PM »
HELP WITH THE SUBJECT LINE!
Please tell me how the subject of this thread and the question relate. Please tell me how this subject line will help another user find this thread if they have a similar problem.

Re: HELP WITH A LISP
I don't think I understand fully what the output is you are trying to sort looks like but you can use simple Unix tools to do this and a thousand other different combinations of what you may want/need (There are a lot of tools created for just operating on delimited text files). -e.g. AWK and SORT for example.

https://www.theswamp.org/index.php?topic=8476.msg492563#msg492563
http://www.linuxquestions.org/questions/linux-general-1/how-to-use-awk-to-sort-243177/
http://www.linuxfocus.org/English/September1999/article103.html
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

ChrisCarlson

  • Guest
Re: HELP WITH A LISP
« Reply #5 on: January 17, 2017, 03:50:39 PM »
You simply need to sort the data, before passing it to "LM:lst->str". Although you probably won't get much help in this topic. Changing the command is one thing but completely deleting the attribution, not cool.

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #6 on: January 17, 2017, 05:42:10 PM »
for example the export coordinates are

Code: [Select]
3,293649.870,4225552.726,
5,293657.899,4225547.326,
7,293650.257,4225543.748,
6,293653.935,4225545.454,
8,293647.561,4225542.282,
2,293639.053,4225547.491,
9,293644.538,4225540.620,
1,293642.102,4225539.320,
s2,293635.766,4225553.648,
s1,293637.563,4225539.929,
s3,293655.810,4225554.488,
s4,293662.935,4225556.538,
4,293654.540,4225554.975,

The numbers are random. Is any command or function to put them in the correct possition ??

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2120
  • class keyThumper<T>:ILazy<T>
Re: HELP WITH A LISP
« Reply #7 on: January 17, 2017, 06:43:17 PM »

Perhaps try something like
Code - Auto/Visual Lisp: [Select]
  1. (vl-sort lst '<)


or Google
AutoLisp sort list of strings
https://www.google.com.au/webhp?source=search_app&gfe_rd=cr&ei=WFtzVuOUI-zN8AefzYCIAg&gws_rd=ssl#q=AutoLisp+sort+list+of+strings

Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

mailmaverick

  • Bull Frog
  • Posts: 494
Re: HELP WITH A LISP
« Reply #8 on: January 17, 2017, 11:25:44 PM »
Sorting is not a difficult task, kindly attach your AutoCAD file.

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #9 on: January 18, 2017, 05:02:36 AM »
I dont know how to use this command

Code - Auto/Visual Lisp: [Select]
  1. (vl-sort lst '<)
  2.  


CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: HELP WITH A LISP
« Reply #10 on: January 18, 2017, 08:22:15 AM »
Then look it up in the help files.
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.

JohnK

  • Administrator
  • Seagull
  • Posts: 10603
Re: HELP WITH A LISP
« Reply #11 on: January 18, 2017, 08:29:16 AM »
Then look it up in the help files.

Or make use my hard work and click the function name in the code block?
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

Marc'Antonio Alessi

  • Swamp Rat
  • Posts: 1451
  • Marco
Re: HELP WITH A LISP
« Reply #12 on: January 18, 2017, 09:01:09 AM »
Then look it up in the help files.
... and make your apology for Source & attribution: http://bit.ly/11XjtTZ

ronjonp

  • Needs a day job
  • Posts: 7526
Re: HELP WITH A LISP
« Reply #13 on: January 18, 2017, 09:42:59 AM »
I dont know how to use this command

Code - Auto/Visual Lisp: [Select]
  1. (vl-sort lst '<)
  2.  
There are hyperlinks in the post that give an explanation  ... does not get much easier than that to TRY and figure it out.  ::)

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

JohnK

  • Administrator
  • Seagull
  • Posts: 10603
Re: HELP WITH A LISP
« Reply #14 on: January 18, 2017, 10:05:16 AM »
Thank you, ronjonp!
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

ronjonp

  • Needs a day job
  • Posts: 7526
Re: HELP WITH A LISP
« Reply #15 on: January 18, 2017, 10:25:31 AM »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #16 on: January 18, 2017, 04:57:13 PM »
Hi ronjonp. Hi read all the examples of vl-sort bul all the examples have numbers or letters in parenthesis .In the lisp i use have a file with numbers. How to use it ?

ronjonp

  • Needs a day job
  • Posts: 7526
Re: HELP WITH A LISP
« Reply #17 on: January 18, 2017, 05:03:50 PM »
Hi ronjonp. Hi read all the examples of vl-sort bul all the examples have numbers or letters in parenthesis .In the lisp i use have a file with numbers. How to use it ?
You have to sort before it goes to the file ( when it's still a list ).

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #18 on: January 18, 2017, 05:07:27 PM »
I am not good in lisp .can you give an exaple from the PXYZ  and i try to fix the others?

ChrisCarlson

  • Guest
Re: HELP WITH A LISP
« Reply #19 on: January 19, 2017, 07:44:39 AM »
If you are not willing to learn, I suggest you hire a 3rd party firm to generate the routines for you.

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Re: HELP WITH A LISP
« Reply #20 on: January 19, 2017, 08:23:26 AM »

Wow, I read through all then replies and I agree that the provided links and information should steer him to the answer but I was surprised at the tone of how it was delivered. I've been a member here since 2003 and I have been blessed by the fantastic help over the years by many many experienced people here (too many to list here). I have learned more from this site than I ever would elsewhere. I thought this WAS a place to come and learn and share, collaborate, debate etc... It is very clear that this person does not know lisp and I know that everyone here have separate lives and sometimes not enough time to dig into his issue(s) with his code or provide a snippet of code to get him/her started in the right direction but to me it just seemed excessive. I am only saying this cause I was in his/her shoes many years ago myself and back then I did not get this kind of response. I got assistance and very helpful HELP. Please don't take this the wrong way guys. I'm just giving my honest Opinion.
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #21 on: January 19, 2017, 09:03:55 AM »
Stop shooting me OK !! I ask for an example . i didin;t say anything about not trying to learn lisp. I have learn a lot of things all this years. If V-Man or any one don't want to help .. .don't post. I know this link http://www.theswamp.org/~john/avlisp/ and i have allready read it before begin this topic. If don't want to help don't help.

Thanks for nothing

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Re: HELP WITH A LISP
« Reply #22 on: January 19, 2017, 09:16:42 AM »

Don't shoot the messenger (Me). I was actually sticking up for you.
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #23 on: January 19, 2017, 09:21:51 AM »
I have seen a lot of people like you in this site.If you  know something about this post don't write something only to write it. You don't help in this way. You comfiused evereone and then all the other gays will came and wtite about your post and at the end .... no one can help..... Are you satisfied know ... What you earn about it ...

ChrisCarlson

  • Guest
Re: HELP WITH A LISP
« Reply #24 on: January 19, 2017, 09:23:43 AM »
I'm just saying you'll get more responsive help if you attempt something, even if it doesn't work.

V-Man

  • Bull Frog
  • Posts: 343
  • I exist therefore I am! Finally Retired!
Re: HELP WITH A LISP
« Reply #25 on: January 19, 2017, 09:26:37 AM »

Bump!!!

Quote
I have seen a lot of people like you in this site.If you  know something about this post don't write something only to write it. You don't help in this way. You comfiused evereone and then all the other gays will came and wtite about your post and at the end .... no one can help..... Are you satisfied know ... What you earn about it ...

If you are going to post please use spell check. Too many misspelled words in your last post and proper grammar.
AutoCAD 9 - 2023, AutoCADMap 2008 - 2010, Revit 2012 - 2022, Autocad Civil 3D 2023

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #26 on: January 19, 2017, 09:33:48 AM »
Sorry for my spell but i thing you understand......


When i come from first time to this forum i didn't know anything about lisp.Then i meet here people like LeeMac, ronjonp , marko_ribar, pbe ,Tharwat etc and help me with thre codes and learn a lot of thing about lisp. I am trying to learn but some thing is still difficult to me.

ChrisCarlson

  • Guest
Re: HELP WITH A LISP
« Reply #27 on: January 19, 2017, 09:47:59 AM »
Hi ronjonp. Hi read all the examples of vl-sort bul all the examples have numbers or letters in parenthesis .In the lisp i use have a file with numbers. How to use it ?

I'll give you the benefit of the doubt in that you are trying to learn.

Code - Auto/Visual Lisp: [Select]
  1.                     (setq lst
  2.                         (append
  3.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
  4.                                '(point-x point-y point-z)
  5.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
  6.                             )
  7.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
  8.                                 (append
  9.                                     (vlax-invoke obj 'getattributes)
  10.                                     (vlax-invoke obj 'getconstantattributes)
  11.                                 )
  12.                             )
  13.                         )
  14.                     )
  15.                     (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
  16.                         (write-line (LM:lst->str lst del) des)
  17.                     )
  18.  

In this section, the routine is creating a list (variable lst), passing the list to the subfunction LM:lst->str to convert the list to a string and simultaneously writing the string to a file. This is then repeated for each entity in the selection set. From a non-LISP standpoint where would you perform the sort function? At a certain point, it is too early to sort and at a certain point, it's too late.

ronjonp

  • Needs a day job
  • Posts: 7526
Re: HELP WITH A LISP
« Reply #28 on: January 19, 2017, 10:17:46 AM »
Wow, I read through all then replies and I agree that the provided links and information should steer him to the answer but I was surprised at the tone of how it was delivered. I've been a member here since 2003 and I have been blessed by the fantastic help over the years by many many experienced people here (too many to list here). I have learned more from this site than I ever would elsewhere. I thought this WAS a place to come and learn and share, collaborate, debate etc... It is very clear that this person does not know lisp and I know that everyone here have separate lives and sometimes not enough time to dig into his issue(s) with his code or provide a snippet of code to get him/her started in the right direction but to me it just seemed excessive. I am only saying this cause I was in his/her shoes many years ago myself and back then I did not get this kind of response. I got assistance and very helpful HELP. Please don't take this the wrong way guys. I'm just giving my honest Opinion.
Sorry you feel that way V-Man .. the OP has continually asked for handouts and IMO put forth very little effort to learn on his/her own. I personally have extended an olive branch to the OP many times in the past but until I actually see effort, I'm out.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: HELP WITH A LISP
« Reply #29 on: January 19, 2017, 11:04:18 AM »
Man I hate that kind of general thread titles:
"HELP WITH A LISP" "LISP HELP" "FIX THIS LISP" "Need Fresh Eyes".

And with this sentence from the OP shows that he doesn't understand anything and expects something on the plate:
Quote
I don't know if it possoble to be done with lisp.
(Pointing out the obvious)
Again, read about vl-sort and ask how it works  :straight:
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: HELP WITH A LISP
« Reply #30 on: January 19, 2017, 12:43:05 PM »
There is a subtlety here in that the vl-sort operation will need to be performed outside of the repeat loop, with a separate list constructed within the repeat loop, as each iteration of the repeat loop is writing a single line to file.

Given that this isn't obvious at first glance, I would suggest changing:
Code - Auto/Visual Lisp: [Select]
  1. (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
  2.     (write-line (LM:lst->str lst del) des)
  3. )
to:
Code - Auto/Visual Lisp: [Select]
  1. (setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))

And then, after the repeat loop (i.e. on line 48), a separate foreach loop is required to write each line of the sorted list to file:
Code - Auto/Visual Lisp: [Select]
  1. (foreach itm (vl-sort rtn '(lambda ( a b ) (< (car a) (car b))))
  2.     (write-line (LM:lst->str itm del) des)
  3. )

Be sure to also include the 'rtn' variable in the list of local variables:
Code - Auto/Visual Lisp: [Select]
  1. ( / *error* del des ent idx lst obj ord out rtn sel )

Note that all of the above is wholly untested.



As an aside, given the comments in this thread, I do sometimes wonder whether I am unfortunately contributing to this growing problem in that, by publishing free programs written for my own enjoyment, it will inevitably lead to users who request that the programs be modified to better suit their needs.

In answer to this, I could only offer up the familiar phrase 'beggars can't be choosers': when using a program you have obtained for free and of your own accord, the author of that program and the community as a whole does not owe you anything - the free product is not faulty simply because it does not quite meet your needs, it performs exactly as it should.

When posting requests for modifications to such programs, yes there will be those members who have toiled with studying programming over the course of years and will have the knowledge to modify the program, but this is on an entirely voluntary basis and as a gesture of goodwill. In the real world, you'd be lucky enough to even acquire something so useful at no charge, let alone request that such a thing be modified for your own personal needs also at no charge...

Just my humble opinion, no offence intended.

Lee

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: HELP WITH A LISP
« Reply #31 on: January 19, 2017, 02:46:03 PM »
After reading Lee's comment, just to elaborate what I think about the aside problem:

As an aside, given the comments in this thread, I do sometimes wonder whether I am unfortunately contributing to this growing problem in that, by publishing free programs written for my own enjoyment, it will inevitably lead to users who request that the programs be modified to better suit their needs.
Its not that simple, it has it pluses and minuses:
-Some people gain more knowledge by dissecting your solution(s) and sometimes we start long aside discussions (in the same thread) where people can benefit more in understanding (while the others are fed from the "plate")
-The OP gets the free program, with the chance to learn or not (but thats his intention)
-There will always be a modification requests - but then I think it would be better to give a hint the OP, so it will be forced to learn something - and to avoid spamming with modified codes

Overall I think its better to have something than nothing (I mean providing a code on a plate is not a bad thing, but may lead to further abuse).

In answer to this, I could only offer up the familiar phrase 'beggars can't be choosers': when using a program you have obtained for free and of your own accord, the author of that program and the community as a whole does not owe you anything - the free product is not faulty simply because it does not quite meet your needs, it performs exactly as it should.
Exactly, I mean when the OP starts being arrogant and argues with the people that share their oppinion (not fully provided code), what would push anyone to help.

When posting requests for modifications to such programs, yes there will be those members who have toiled with studying programming over the course of years and will have the knowledge to modify the program, but this is on an entirely voluntary basis and as a gesture of goodwill. In the real world, you'd be lucky enough to even acquire something so useful at no charge, let alone request that such a thing be modified for your own personal needs also at no charge...
1+

Just my humble opinion, no offence intended.
I don't think you ever tried to offend anyone on the forums (afterall in my definition: forum is a place where people share oppinions/ideas/knowledge/questions/solutions).
 :rolleyes2:
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #32 on: January 19, 2017, 06:48:52 PM »
Hi Lee Mac . Thanks for the help i do the changes in the code

Code - Auto/Visual Lisp: [Select]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                                                                     ;;
  3. ;;                                      PXYZ                                                                      ;;
  4. ;;                                                                                                                    ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defun c:PXYZ ( / *error* del des ent idx lst obj ord out rtn sel )
  8.  
  9.  
  10.     (defun *error* ( msg )
  11.         (if (= 'file (type des))
  12.             (close des)
  13.         )
  14.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  15.             (princ (strcat "\nError: " msg))
  16.         )
  17.         (princ)
  18.     )
  19.  
  20.     (setq ord '("POINT" POINT-X POINT-Y "ELEV" )
  21.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
  22.           del  ","
  23.     )
  24.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
  25.         (if (setq des (open out "w"))
  26.             (progn
  27.                 (repeat (setq idx (sslength sel))
  28.                     (setq ent (ssname sel (setq idx (1- idx)))
  29.                           obj (vlax-ename->vla-object ent)
  30.                     )
  31.                     (setq lst
  32.                         (append
  33.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
  34.                                '(point-x point-y point-z)
  35.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
  36.                             )
  37.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
  38.                                 (append
  39.                                     (vlax-invoke obj 'getattributes)
  40.                                     (vlax-invoke obj 'getconstantattributes)
  41.                                 )
  42.                             )
  43.                         )
  44.                     )
  45.            ; (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
  46.                   ;      (write-line (LM:lst->str lst del) des)
  47.                   ;  )
  48.                   (setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))
  49.                 )
  50.                                                         (foreach itm (vl-sort rtn '(lambda ( a b ) (< (car a) (car b))))
  51.     (write-line (LM:lst->str itm del) des)
  52. )
  53.        
  54.                 (setq des (close des))
  55.             )
  56.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
  57.         )
  58.     )
  59.     (princ)
  60. )                
  61.  
  62. ;; List to String  -  Lee Mac
  63. ;; Concatenates each string in a list, separated by a given delimiter
  64.  
  65. (defun LM:lst->str ( lst del )
  66.     (if (cdr lst)
  67.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
  68.         (car lst)
  69.     )
  70. )
  71.  
  72. ;; Unique Filename  -  Lee Mac
  73. ;; Returns a unique filename for a given path & file extension
  74.  
  75. (defun LM:uniquefilename ( pth ext / fnm tmp )
  76.     (if (findfile (setq fnm (strcat pth ext)))
  77.         (progn
  78.             (setq tmp 1)
  79.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
  80.         )
  81.     )
  82.     fnm
  83. )
  84.  
  85.  

and gives me this results

Code: [Select]
1,293194.436,4223954.179,109.130
10,293119.590,4223876.956,102.977
11,293111.330,4223873.266,102.524
12,293094.236,4223865.717,
13,293090.831,4223873.322,101.531
14,293088.610,4223878.282,101.471
15,293082.991,4223890.831,
16,293093.239,4223896.909,101.882
17,293118.988,4223912.366,103.460
18,293145.312,4223927.679,105.006
19,293170.059,4223941.093,106.943
2,293192.890,4223941.304,108.846
20,293182.533,4223947.752,108.027
3,293192.005,4223933.294,108.766
4,293190.314,4223909.952,
5,293185.490,4223908.126,
6,293164.970,4223898.855,
7,293150.456,4223892.212,
8,293135.932,4223885.002,
9,293130.982,4223881.708,103.711

why this happend 1,10,...19,2,20 ?

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: HELP WITH A LISP
« Reply #33 on: January 19, 2017, 07:39:18 PM »
Topographer, I think you need to:
Code - Auto/Visual Lisp: [Select]
  1. (foreach itm (vl-sort rtn '(lambda ( a b ) (< (atoi (car a)) (atoi (car b)))))
  2.   (write-line (LM:lst->str itm del) des)
  3. )

Heres an example what may went wrong:
Code - Auto/Visual Lisp: [Select]
  1. _$ (vl-sort '(40 3 30 9 7 10 50 4 6 20 2 8 5 1) '<) ; list of integers
  2. (1 2 3 4 5 6 7 8 9 10 20 30 40 50) ; <- no problem
  3.  
  4. _$ (vl-sort '("40" "3" "30" "9" "7" "10" "50" "4" "6" "20" "2" "8" "5" "1") '<) ; list of string integers
  5. ("1" "10" "2" "20" "3" "30" "4" "40" "5" "50" "6" "7" "8" "9") ; <- this is your problem
  6. _$
  7.  
  8. _$ (mapcar 'ascii '("1" "10" "2" "20" "3" "30" "4" "40" "5" "50" "6" "7" "8" "9")) ; lets convert the result to ascii
  9. (49 49 50 50 51 51 52 52 53 53 54 55 56 57) ; <- reason
  10. _$
  11.  
  12. _$ (mapcar 'itoa (vl-sort (mapcar 'atoi '("40" "3" "30" "9" "7" "10" "50" "4" "6" "20" "2" "8" "5" "1")) '<)) ; <- example solution
  13. ("1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "20" "30" "40" "50") ; no problem
  14. _$

Whete atoi converts string-number to integer, and itoa converts integer to string
Code - Auto/Visual Lisp: [Select]
  1. _$ (mapcar 'atoi '("40" "3" "30" "9" "7" "10" "50" "4" "6" "20" "2" "8" "5" "1"))
  2. (40 3 30 9 7 10 50 4 6 20 2 8 5 1)
  3. _$

In short vl-sort sorts the string-characters by their ascii value, and does not threat them like "real" numbers.
Heres some nice thread by mr.Togores that explains how vl-sort/vl-sort-i works (and LM's remarks).


(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2120
  • class keyThumper<T>:ILazy<T>
Re: HELP WITH A LISP
« Reply #34 on: January 19, 2017, 08:20:42 PM »
Because the data lists may either be numeric or strings ( according to an earlier post)
One Option
requires the doslib library https://wiki.mcneel.com/doslib/home

Instead of writing the strings directly to a file you could write them to an in memory list.
Then use dos_strsort to process the list
then write the sorted list to file.

Code - Auto/Visual Lisp: [Select]
  1. (setq rawstringlist
  2.             '(  "1,293194.436,4223954.179,109.130"
  3.                 "10,293119.590,4223876.956,102.977"
  4.                 "11,293111.330,4223873.266,102.524"
  5.                 "12,293094.236,4223865.717"
  6.                 "13,293090.831,4223873.322,101.531"
  7.                 "14,293088.610,4223878.282,101.471"
  8.                 "15,293082.991,4223890.831"
  9.                 "S22, 1. 2. 3"
  10.                 "16,293093.239,4223896.909,101.882"
  11.                 "17,293118.988,4223912.366,103.460"
  12.                 "18,293145.312,4223927.679,105.006"
  13.                 "19,293170.059,4223941.093,106.943"
  14.                 "S12, 1. 2. 3"
  15.                 "2,293192.890,4223941.304,108.846"
  16.                 "20,293182.533,4223947.752,108.027"
  17.                 "3,293192.005,4223933.294,108.766"
  18.                 "4,293190.314,4223909.952"
  19.                 "5,293185.490,4223908.126"
  20.                 "6,293164.970,4223898.855"
  21.                 "7,293150.456,4223892.212"
  22.                 "b12, 1. 2. 3"
  23.                 "8,293135.932,4223885.002"
  24.                 "9,293130.982,4223881.708,103.711"
  25.                )
  26. )
  27.  
  28.  
  29.  
  30. (dos_strsort rawstringlist -1)
  31.  
  32. ;;->
  33. ;|
  34. ( "1,293194.436,4223954.179,109.130"
  35.   "2,293192.890,4223941.304,108.846"
  36.   "3,293192.005,4223933.294,108.766"
  37.   "4,293190.314,4223909.952"
  38.   "5,293185.490,4223908.126"
  39.   "6,293164.970,4223898.855"
  40.   "7,293150.456,4223892.212"
  41.   "8,293135.932,4223885.002"
  42.   "9,293130.982,4223881.708,103.711"
  43.   "10,293119.590,4223876.956,102.977"
  44.   "11,293111.330,4223873.266,102.524"
  45.   "12,293094.236,4223865.717"
  46.   "13,293090.831,4223873.322,101.531"
  47.   "14,293088.610,4223878.282,101.471"
  48.   "15,293082.991,4223890.831"
  49.   "16,293093.239,4223896.909,101.882"
  50.   "17,293118.988,4223912.366,103.460"
  51.   "18,293145.312,4223927.679,105.006"
  52.   "19,293170.059,4223941.093,106.943"
  53.   "20,293182.533,4223947.752,108.027"
  54.   "b12, 1. 2. 3"
  55.   "S12, 1. 2. 3"
  56.   "S22, 1. 2. 3"
  57.  )
  58. |;
  59.  
Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #35 on: January 20, 2017, 10:33:58 AM »
Hi Grrr1337. I want ask something. When i use Lee Mac code

Code - Auto/Visual Lisp: [Select]
  1. (foreach itm (vl-sort rtn '(lambda ( a b ) (< (car a) (car b))))
  2.     (write-line (LM:lst->str itm del) des)
  3. )
  4.  

I take this results (the points s1,s2,s3,s4,s5 are correct, but the numbers are radom )
Code: [Select]
1,334449.843,4210569.247,776.899
10,334431.801,4210568.277,771.985
100,334480.284,4210512.679,780.678
101,334479.586,4210507.935,780.279
102,334479.063,4210503.202,780.284
103,334466.755,4210480.763,780.166
104,334465.646,4210480.928,780.244
107,334470.715,4210507.658,779.845
108,334469.838,4210508.630,778.318
109,334468.276,4210510.486,777.665
11,334425.258,4210566.172,770.751
110,334460.301,4210508.278,775.945
111,334455.924,4210507.072,776.703
112,334441.583,4210503.171,775.092
113,334431.288,4210506.375,774.659
114,334419.363,4210502.974,773.052
115,334439.733,4210508.560,776.396
116,334448.821,4210511.259,776.651
117,334450.056,4210511.832,776.746
118,334451.584,4210511.317,776.079
119,334453.942,4210512.037,776.365
12,334421.952,4210563.846,769.924
125,334467.156,4210521.611,778.113
126,334467.053,4210517.129,
127,334455.904,4210542.388,782.548
128,334469.089,4210517.638,
129,334469.200,4210521.818,
13,334415.821,4210561.206,768.305
130,334463.274,4210518.693,777.695
131,334459.815,4210516.466,777.634
132,334460.191,4210519.967,777.598
134,334457.277,4210516.413,776.458
135,334459.515,4210520.052,776.996
136,334462.508,4210524.110,777.539
137,334459.532,4210518.382,777.554
138,334466.533,4210523.682,777.616
139,334466.901,4210532.586,777.691
14,334414.516,4210561.166,768.263
140,334466.502,4210542.915,778.416
141,334458.258,4210539.803,777.248
142,334458.078,4210539.871,778.542
143,334457.677,4210541.433,778.543
144,334456.318,4210539.605,779.232
145,334456.341,4210539.621,779.234
146,334456.085,4210540.812,779.243
147,334462.221,4210535.818,777.529
148,334455.637,4210537.987,777.135
149,334454.710,4210531.499,776.920
15,334414.798,4210560.449,768.142
150,334457.240,4210526.580,776.850
151,334452.912,4210519.886,776.027
152,334448.433,4210536.698,775.802
16,334416.412,4210563.106,
17,334421.042,4210564.348,
18,334418.193,4210563.896,
19,334423.642,4210569.924,
2,334445.803,4210574.461,776.005
20,334402.758,4210556.375,765.995
21,334395.788,4210553.260,770.824
22,334401.101,4210559.722,770.329
23,334404.728,4210549.802,765.935
24,334395.516,4210545.773,764.228
25,334419.955,4210557.103,
26,334420.511,4210556.586,769.865
27,334429.242,4210560.393,770.667
28,334431.431,4210561.170,770.956
3,334445.056,4210575.256,776.060
30,334432.332,4210561.413,771.957
31,334433.610,4210552.542,773.231
32,334436.593,4210540.192,775.061
33,334431.207,4210555.835,
34,334431.201,4210553.156,
36,334437.552,4210541.350,775.029
37,334440.889,4210543.942,775.463
38,334438.612,4210550.203,774.796
39,334437.742,4210555.164,774.185
4,334443.028,4210576.492,776.288
40,334437.512,4210564.206,773.230
41,334441.980,4210565.969,774.564
42,334444.136,4210563.993,776.517
43,334440.614,4210559.494,776.218
44,334439.716,4210555.062,776.115
45,334439.399,4210551.949,775.779
48,334442.560,4210581.776,776.145
49,334440.729,4210585.562,775.802
5,334431.322,4210570.664,772.082
50,334438.615,4210589.696,775.332
51,334460.578,4210558.264,778.600
52,334462.802,4210554.808,778.941
53,334462.017,4210554.165,778.863
54,334461.661,4210552.548,778.433
55,334457.899,4210550.540,780.431
56,334457.021,4210552.285,778.267
57,334452.319,4210549.819,777.578
58,334452.993,4210547.966,781.180
59,334464.615,4210546.927,779.458
6,334425.831,4210566.351,771.041
60,334466.086,4210546.531,779.242
61,334466.493,4210545.610,779.268
62,334468.577,4210544.339,779.500
63,334477.240,4210535.308,781.753
64,334476.841,4210532.285,781.374
65,334476.065,4210532.152,781.001
66,334475.243,4210532.918,780.437
67,334474.641,4210538.470,780.042
68,334474.084,4210542.728,779.879
69,334472.754,4210548.443,779.685
7,334426.097,4210565.602,770.814
70,334469.422,4210557.325,779.003
71,334463.120,4210565.397,778.349
72,334459.279,4210575.893,
73,334460.703,4210574.036,
74,334463.487,4210570.499,781.249
75,334466.547,4210566.658,781.634
76,334470.652,4210561.434,782.336
77,334441.880,4210540.714,
78,334443.789,4210534.210,
79,334445.483,4210528.087,777.981
80,334469.310,4210540.022,779.699
81,334470.800,4210530.567,780.162
82,334470.591,4210529.100,781.714
85,334483.908,4210569.920,784.671
86,334482.462,4210570.510,785.081
87,334491.720,4210573.165,785.100
88,334492.904,4210571.676,785.211
89,334482.239,4210562.820,784.330
9,334431.872,4210569.212,772.162
90,334480.816,4210563.131,784.658
91,334485.657,4210545.141,782.937
92,334482.978,4210532.735,782.022
93,334483.769,4210529.848,
94,334482.339,4210523.549,
95,334479.474,4210550.560,783.204
REPER,334455.765,4210512.986,777.561
s1,334435.199,4210565.300,772.547
s2,334456.696,4210571.200,777.567
s3,334476.229,4210530.509,780.876
s4,334460.077,4210527.536,777.479
s5,334477.468,4210514.214,780.279


When i use your code  (the numbers are correct s5,s4,s3,s2,s1) .. Why ?

Code - Auto/Visual Lisp: [Select]
  1. (foreach itm (vl-sort rtn '(lambda ( a b ) (< (atoi (car a)) (atoi (car b)))))
  2.   (write-line (LM:lst->str itm del) des)
  3. )
  4.  

Code: [Select]
s5,334477.468,4210514.214,780.279
s4,334460.077,4210527.536,777.479
s3,334476.229,4210530.509,780.876
s2,334456.696,4210571.200,777.567
s1,334435.199,4210565.300,772.547
REPER,334455.765,4210512.986,777.561
1,334449.843,4210569.247,776.899
2,334445.803,4210574.461,776.005
3,334445.056,4210575.256,776.060
4,334443.028,4210576.492,776.288
5,334431.322,4210570.664,772.082
6,334425.831,4210566.351,771.041
7,334426.097,4210565.602,770.814
9,334431.872,4210569.212,772.162
10,334431.801,4210568.277,771.985
11,334425.258,4210566.172,770.751
12,334421.952,4210563.846,769.924
13,334415.821,4210561.206,768.305
14,334414.516,4210561.166,768.263
15,334414.798,4210560.449,768.142
16,334416.412,4210563.106,
17,334421.042,4210564.348,
18,334418.193,4210563.896,
19,334423.642,4210569.924,
20,334402.758,4210556.375,765.995
21,334395.788,4210553.260,770.824
22,334401.101,4210559.722,770.329
23,334404.728,4210549.802,765.935
24,334395.516,4210545.773,764.228
25,334419.955,4210557.103,
26,334420.511,4210556.586,769.865
27,334429.242,4210560.393,770.667
28,334431.431,4210561.170,770.956
30,334432.332,4210561.413,771.957
31,334433.610,4210552.542,773.231
32,334436.593,4210540.192,775.061
33,334431.207,4210555.835,
34,334431.201,4210553.156,
36,334437.552,4210541.350,775.029
37,334440.889,4210543.942,775.463
38,334438.612,4210550.203,774.796
39,334437.742,4210555.164,774.185
40,334437.512,4210564.206,773.230
41,334441.980,4210565.969,774.564
42,334444.136,4210563.993,776.517
43,334440.614,4210559.494,776.218
44,334439.716,4210555.062,776.115
45,334439.399,4210551.949,775.779
48,334442.560,4210581.776,776.145
49,334440.729,4210585.562,775.802
50,334438.615,4210589.696,775.332
51,334460.578,4210558.264,778.600
52,334462.802,4210554.808,778.941
53,334462.017,4210554.165,778.863
54,334461.661,4210552.548,778.433
55,334457.899,4210550.540,780.431
56,334457.021,4210552.285,778.267
57,334452.319,4210549.819,777.578
58,334452.993,4210547.966,781.180
59,334464.615,4210546.927,779.458
60,334466.086,4210546.531,779.242
61,334466.493,4210545.610,779.268
62,334468.577,4210544.339,779.500
63,334477.240,4210535.308,781.753
64,334476.841,4210532.285,781.374
65,334476.065,4210532.152,781.001
66,334475.243,4210532.918,780.437
67,334474.641,4210538.470,780.042
68,334474.084,4210542.728,779.879
69,334472.754,4210548.443,779.685
70,334469.422,4210557.325,779.003
71,334463.120,4210565.397,778.349
72,334459.279,4210575.893,
73,334460.703,4210574.036,
74,334463.487,4210570.499,781.249
75,334466.547,4210566.658,781.634
76,334470.652,4210561.434,782.336
77,334441.880,4210540.714,
78,334443.789,4210534.210,
79,334445.483,4210528.087,777.981
80,334469.310,4210540.022,779.699
81,334470.800,4210530.567,780.162
82,334470.591,4210529.100,781.714
85,334483.908,4210569.920,784.671
86,334482.462,4210570.510,785.081
87,334491.720,4210573.165,785.100
88,334492.904,4210571.676,785.211
89,334482.239,4210562.820,784.330
90,334480.816,4210563.131,784.658
91,334485.657,4210545.141,782.937
92,334482.978,4210532.735,782.022
93,334483.769,4210529.848,
94,334482.339,4210523.549,
95,334479.474,4210550.560,783.204
100,334480.284,4210512.679,780.678
101,334479.586,4210507.935,780.279
102,334479.063,4210503.202,780.284
103,334466.755,4210480.763,780.166
104,334465.646,4210480.928,780.244
107,334470.715,4210507.658,779.845
108,334469.838,4210508.630,778.318
109,334468.276,4210510.486,777.665
110,334460.301,4210508.278,775.945
111,334455.924,4210507.072,776.703
112,334441.583,4210503.171,775.092
113,334431.288,4210506.375,774.659
114,334419.363,4210502.974,773.052
115,334439.733,4210508.560,776.396
116,334448.821,4210511.259,776.651
117,334450.056,4210511.832,776.746
118,334451.584,4210511.317,776.079
119,334453.942,4210512.037,776.365
125,334467.156,4210521.611,778.113
126,334467.053,4210517.129,
127,334455.904,4210542.388,782.548
128,334469.089,4210517.638,
129,334469.200,4210521.818,
130,334463.274,4210518.693,777.695
131,334459.815,4210516.466,777.634
132,334460.191,4210519.967,777.598
134,334457.277,4210516.413,776.458
135,334459.515,4210520.052,776.996
136,334462.508,4210524.110,777.539
137,334459.532,4210518.382,777.554
138,334466.533,4210523.682,777.616
139,334466.901,4210532.586,777.691
140,334466.502,4210542.915,778.416
141,334458.258,4210539.803,777.248
142,334458.078,4210539.871,778.542
143,334457.677,4210541.433,778.543
144,334456.318,4210539.605,779.232
145,334456.341,4210539.621,779.234
146,334456.085,4210540.812,779.243
147,334462.221,4210535.818,777.529
148,334455.637,4210537.987,777.135
149,334454.710,4210531.499,776.920
150,334457.240,4210526.580,776.850
151,334452.912,4210519.886,776.027
152,334448.433,4210536.698,775.802

Code - Auto/Visual Lisp: [Select]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                             ;;
  3. ;;                                      PXYZ                                   ;;
  4. ;;                                                                             ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defun c:PXYZ ( / *error* del des ent idx lst obj ord out rtn sel )
  8.  
  9.  
  10.     (defun *error* ( msg )
  11.         (if (= 'file (type des))
  12.             (close des)
  13.         )
  14.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  15.             (princ (strcat "\nError: " msg))
  16.         )
  17.         (princ)
  18.     )
  19.  
  20.     (setq ord '("POINT" POINT-X POINT-Y "ELEV" )
  21.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
  22.           del  ","
  23.     )
  24.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
  25.         (if (setq des (open out "w"))
  26.             (progn
  27.                 (repeat (setq idx (sslength sel))
  28.                     (setq ent (ssname sel (setq idx (1- idx)))
  29.                           obj (vlax-ename->vla-object ent)
  30.                     )
  31.                     (setq lst
  32.                         (append
  33.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
  34.                                '(point-x point-y point-z)
  35.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
  36.                             )
  37.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
  38.                                 (append
  39.                                     (vlax-invoke obj 'getattributes)
  40.                                     (vlax-invoke obj 'getconstantattributes)
  41.                                 )
  42.                             )
  43.                         )
  44.                     )
  45.            ; (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
  46.                   ;      (write-line (LM:lst->str lst del) des)
  47.                   ;  )
  48.                   (setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))
  49.                 )
  50.            ;(foreach itm (vl-sort rtn '(lambda ( a b ) (< (car a) (car b))))
  51.     ;(write-line (LM:lst->str itm del) des)
  52. ;)
  53.         (foreach itm (vl-sort rtn '(lambda ( a b ) (< (atoi (car a)) (atoi (car b)))))
  54.   (write-line (LM:lst->str itm del) des)
  55. )
  56.                 (setq des (close des))
  57.             )
  58.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
  59.         )
  60.     )
  61.     (princ)
  62. )                
  63.  
  64. ;; List to String  -  Lee Mac
  65. ;; Concatenates each string in a list, separated by a given delimiter
  66.  
  67. (defun LM:lst->str ( lst del )
  68.     (if (cdr lst)
  69.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
  70.         (car lst)
  71.     )
  72. )
  73.  
  74. ;; Unique Filename  -  Lee Mac
  75. ;; Returns a unique filename for a given path & file extension
  76.  
  77. (defun LM:uniquefilename ( pth ext / fnm tmp )
  78.     (if (findfile (setq fnm (strcat pth ext)))
  79.         (progn
  80.             (setq tmp 1)
  81.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
  82.         )
  83.     )
  84.     fnm
  85. )
  86.  
  87.  
« Last Edit: January 20, 2017, 10:46:02 AM by Topographer »

JohnK

  • Administrator
  • Seagull
  • Posts: 10603
Re: HELP WITH A LISP
« Reply #36 on: January 20, 2017, 11:18:50 AM »
It is almost always better to build the list into memory and preform other options you may want preformed on that list before writing that list out to file--like kdub suggests--however, why do you want the list sorted? -i.e. there's extra cost associated with sorting that may be necessary and you should really weigh the costs of having a sorted list.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

mailmaverick

  • Bull Frog
  • Posts: 494
Re: HELP WITH A LISP
« Reply #37 on: January 20, 2017, 12:54:35 PM »
Dear Topographer, I think following code solves your problem completely :-

Code: [Select]
(defun c:test ()
(setq rawstringlist
            '(  "1,293194.436,4223954.179,109.130"
                "10,293119.590,4223876.956,102.977"
                "11,293111.330,4223873.266,102.524"
                "12,293094.236,4223865.717"
                "13,293090.831,4223873.322,101.531"
                "14,293088.610,4223878.282,101.471"
                "15,293082.991,4223890.831"
                "S22, 1. 2. 3"
                "16,293093.239,4223896.909,101.882"
                "17,293118.988,4223912.366,103.460"
                "18,293145.312,4223927.679,105.006"
                "19,293170.059,4223941.093,106.943"
                "S12, 1. 2. 3"
                "2,293192.890,4223941.304,108.846"
                "20,293182.533,4223947.752,108.027"
                "3,293192.005,4223933.294,108.766"
                "4,293190.314,4223909.952"
                "5,293185.490,4223908.126"
                "6,293164.970,4223898.855"
                "7,293150.456,4223892.212"
                "b12, 1. 2. 3"
                "8,293135.932,4223885.002"
                "9,293130.982,4223881.708,103.711"
               )
)
(setq SortedList (SortStringWithNumberAsNumber rawstringlist T))
(foreach xx SortedList (princ "\n") (princ xx))
(princ)
)
;;
;;
;;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

Output :-

1,293194.436,4223954.179,109.130
2,293192.890,4223941.304,108.846
3,293192.005,4223933.294,108.766
4,293190.314,4223909.952
5,293185.490,4223908.126
6,293164.970,4223898.855
7,293150.456,4223892.212
8,293135.932,4223885.002
9,293130.982,4223881.708,103.711
10,293119.590,4223876.956,102.977
11,293111.330,4223873.266,102.524
12,293094.236,4223865.717
13,293090.831,4223873.322,101.531
14,293088.610,4223878.282,101.471
15,293082.991,4223890.831
16,293093.239,4223896.909,101.882
17,293118.988,4223912.366,103.460
18,293145.312,4223927.679,105.006
19,293170.059,4223941.093,106.943
20,293182.533,4223947.752,108.027
b12, 1. 2. 3
S12, 1. 2. 3
S22, 1. 2. 3

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #38 on: January 20, 2017, 02:41:54 PM »
Hi mailmaverick.In this code you  already have the coordinates ? I alresdy have a lisp code. Is any other way to convert it ?


Code - Auto/Visual Lisp: [Select]
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;                                                                                                                   ;;
  3. ;;                                      PXYZ                                                                    ;;
  4. ;;                                                                                                                  ;;
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6.  
  7. (defun c:PXYZ ( / *error* del des ent idx lst obj ord out rtn sel )
  8.  
  9.  
  10.     (defun *error* ( msg )
  11.         (if (= 'file (type des))
  12.             (close des)
  13.         )
  14.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  15.             (princ (strcat "\nError: " msg))
  16.         )
  17.         (princ)
  18.     )
  19.  
  20.     (setq ord '("POINT" POINT-X POINT-Y "ELEV" )
  21.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".crd")
  22.           del  ","
  23.     )
  24.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
  25.         (if (setq des (open out "w"))
  26.             (progn
  27.                 (repeat (setq idx (sslength sel))
  28.                     (setq ent (ssname sel (setq idx (1- idx)))
  29.                           obj (vlax-ename->vla-object ent)
  30.                     )
  31.                     (setq lst
  32.                         (append
  33.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
  34.                                '(point-x point-y point-z)
  35.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
  36.                             )
  37.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
  38.                                 (append
  39.                                     (vlax-invoke obj 'getattributes)
  40.                                     (vlax-invoke obj 'getconstantattributes)
  41.                                 )
  42.                             )
  43.                         )
  44.                     )
  45.            ; (if (setq lst (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)))
  46.                   ;      (write-line (LM:lst->str lst del) des)
  47.                   ;  )
  48.                   (setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))
  49.                 )
  50.            ;(foreach itm (vl-sort rtn '(lambda ( a b ) (< (car a) (car b))))
  51.     ;(write-line (LM:lst->str itm del) des)
  52. ;)
  53.         (foreach itm (vl-sort rtn '(lambda ( a b ) (< (atoi (car a)) (atoi (car b)))))
  54.   (write-line (LM:lst->str itm del) des)
  55. )
  56.                 (setq des (close des))
  57.             )
  58.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
  59.         )
  60.     )
  61.     (princ)
  62. )                
  63.  
  64. ;; List to String  -  Lee Mac
  65. ;; Concatenates each string in a list, separated by a given delimiter
  66.  
  67. (defun LM:lst->str ( lst del )
  68.     (if (cdr lst)
  69.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
  70.         (car lst)
  71.     )
  72. )
  73.  
  74. ;; Unique Filename  -  Lee Mac
  75. ;; Returns a unique filename for a given path & file extension
  76.  
  77. (defun LM:uniquefilename ( pth ext / fnm tmp )
  78.     (if (findfile (setq fnm (strcat pth ext)))
  79.         (progn
  80.             (setq tmp 1)
  81.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
  82.         )
  83.     )
  84.     fnm
  85. )
  86.  
  87.  
  88.  

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: HELP WITH A LISP
« Reply #39 on: January 20, 2017, 03:05:38 PM »
Since your point IDs are alphanumerical, I would suggest the following function to perform the sort:
Code - Auto/Visual Lisp: [Select]
  1. ;; Alphanumerical Sort-i  -  Lee Mac
  2. ;; Sorts a list of strings containing a combination of alphabetical & numerical characters and returns the indices.
  3.  
  4. (defun LM:alphanumsort-i ( lst )
  5.     (vl-sort-i (mapcar 'LM:splitstring lst)
  6.         (function
  7.             (lambda ( a b / x y )
  8.                 (while
  9.                     (and
  10.                         (setq x (car a))
  11.                         (setq y (car b))
  12.                         (= x y)
  13.                     )
  14.                     (setq a (cdr a)
  15.                           b (cdr b)
  16.                     )
  17.                 )
  18.                 (cond
  19.                     (   (null x) b)
  20.                     (   (null y) nil)
  21.                     (   (and (numberp x) (numberp y)) (< x y))
  22.                     (   (numberp x))
  23.                     (   (numberp y) nil)
  24.                     (   (< x y))
  25.                 )
  26.             )
  27.         )
  28.     )
  29. )
  30.  
  31. ;; Split String  -  Lee Mac
  32. ;; Splits a string into a list of text and numbers
  33.  
  34. (defun LM:splitstring ( str )
  35.     (
  36.         (lambda ( l )
  37.             (read
  38.                 (strcat "("
  39.                     (vl-list->string
  40.                         (apply 'append
  41.                             (mapcar
  42.                                 (function
  43.                                     (lambda ( a b c )
  44.                                         (cond
  45.                                             (   (or (= 34 b) (= 92 b))
  46.                                                 (list 32 34 92 b 34 32)
  47.                                             )
  48.                                             (   (or (< 47 b 58)
  49.                                                    ;(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
  50.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
  51.                                                 )
  52.                                                 (list b)
  53.                                             )
  54.                                             (   (list 32 34 b 34 32))
  55.                                         )
  56.                                     )
  57.                                 )
  58.                                 (cons nil l) l (append (cdr l) '(( )))
  59.                             )
  60.                         )
  61.                     )
  62.                     ")"
  63.                 )
  64.             )
  65.         )
  66.         (vl-string->list str)
  67.     )
  68. )

Paste the above at the end of the code, and then change:
Code - Auto/Visual Lisp: [Select]
  1. (foreach itm (vl-sort rtn '(lambda ( a b ) (< (car a) (car b))))
  2.     (write-line (LM:lst->str itm del) des)
  3. )

To:
Code - Auto/Visual Lisp: [Select]
  1. (foreach idx (LM:alphanumsort-i (mapcar 'car rtn))
  2.     (write-line (LM:lst->str (nth idx rtn) del) des)
  3. )

pedroantonio

  • Guest
Re: HELP WITH A LISP
« Reply #40 on: January 20, 2017, 04:25:16 PM »
Thank you all for the help!!

mailmaverick

  • Bull Frog
  • Posts: 494
Re: HELP WITH A LISP
« Reply #41 on: January 21, 2017, 04:07:11 AM »
Hi mailmaverick.In this code you  already have the coordinates ? I alresdy have a lisp code. Is any other way to convert it ?

Hi Topographer, kindly share your autocad drawing.

mailmaverick

  • Bull Frog
  • Posts: 494
Re: HELP WITH A LISP
« Reply #42 on: January 21, 2017, 04:18:01 AM »
Since your point IDs are alphanumerical, I would suggest the following function to perform the sort:

Dear Lee Mac, I have used following code :-
Code: [Select]
(defun c:test ()
  (setq rawstringlist
         '("1,293194.436,4223954.179,109.130"          "10,293119.590,4223876.956,102.977"         "11,293111.330,4223873.266,102.524"         "12,293094.236,4223865.717"
           "13,293090.831,4223873.322,101.531"         "14,293088.610,4223878.282,101.471"         "15,293082.991,4223890.831"                 "S22, 1. 2. 3"
           "16,293093.239,4223896.909,101.882"         "17,293118.988,4223912.366,103.460"         "18,293145.312,4223927.679,105.006"         "19,293170.059,4223941.093,106.943"
           "S12, 1. 2. 3"                              "2,293192.890,4223941.304,108.846"          "20,293182.533,4223947.752,108.027"         "3,293192.005,4223933.294,108.766"
           "4,293190.314,4223909.952"                  "5,293185.490,4223908.126"                  "6,293164.970,4223898.855"                  "7,293150.456,4223892.212"
           "b12, 1. 2. 3"                              "8,293135.932,4223885.002"                  "9,293130.982,4223881.708,103.711"
          )
  )
  (setq SortedList1 (SortStringWithNumberAsNumber rawstringlist T))
  (setq SortedList2 (LM:alphanumsort rawstringlist))
  (foreach xx SortedList1 (princ "\n") (princ xx))
  (princ "\n\n")
  (foreach xx SortedList2 (princ "\n") (princ xx))
  (princ)
)
;;
;;
;;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


;; Alphanumerical Sort  -  Lee Mac
;; Sorts a list of strings containing a combination of alphabetical & numerical characters.

(defun LM:alphanumsort (lst)
  (mapcar (function (lambda (n) (nth n lst)))
          (vl-sort-i (mapcar 'LM:splitstring lst)
                     (function (lambda (a b / x y)
                                 (while (and (setq x (car a)) (setq y (car b)) (= x y))
                                   (setq a (cdr a)
                                         b (cdr b)
                                   )
                                 )
                                 (cond ((null x) b)
                                       ((null y) nil)
                                       ((and (numberp x) (numberp y)) (< x y))
                                       ((numberp x))
                                       ((numberp y) nil)
                                       ((< x y))
                                 )
                               )
                     )
          )
  )
)

;; Split String  -  Lee Mac
;; Splits a string into a list of text and numbers

(defun LM:splitstring (str)
  ((lambda (l)
     (read
       (strcat "("
               (vl-list->string
                 (apply 'append
                        (mapcar (function
                                  (lambda (a b c)
                                    (cond ((= 92 b) (list 32 34 92 b 34 32))
                                          ((or (< 47 b 58) (and (= 45 b) (< 47 c 58) (not (< 47 a 58))) (and (= 46 b) (< 47 a 58) (< 47 c 58)))
                                           (list b)
                                          )
                                          ((list 32 34 b 34 32))
                                    )
                                  )
                                )
                                (cons nil l)
                                l
                                (append (cdr l) '(()))
                        )
                 )
               )
               ")"
       )
     )
   )
    (vl-string->list str)
  )
)

I get following output :-
Output as per SortStringWithNumberAsNumber :-
1,293194.436,4223954.179,109.130
2,293192.890,4223941.304,108.846
3,293192.005,4223933.294,108.766
4,293190.314,4223909.952
5,293185.490,4223908.126
6,293164.970,4223898.855
7,293150.456,4223892.212
8,293135.932,4223885.002
9,293130.982,4223881.708,103.711
10,293119.590,4223876.956,102.977
11,293111.330,4223873.266,102.524
12,293094.236,4223865.717
13,293090.831,4223873.322,101.531
14,293088.610,4223878.282,101.471
15,293082.991,4223890.831
16,293093.239,4223896.909,101.882
17,293118.988,4223912.366,103.460
18,293145.312,4223927.679,105.006
19,293170.059,4223941.093,106.943
20,293182.533,4223947.752,108.027
b12, 1. 2. 3
S12, 1. 2. 3
S22, 1. 2. 3

Output as per LM:alphanumsort :-
1,293194.436,4223954.179,109.130
2,293192.890,4223941.304,108.846
3,293192.005,4223933.294,108.766
4,293190.314,4223909.952
5,293185.490,4223908.126
6,293164.970,4223898.855
7,293150.456,4223892.212
8,293135.932,4223885.002
9,293130.982,4223881.708,103.711
10,293119.590,4223876.956,102.977
11,293111.330,4223873.266,102.524
12,293094.236,4223865.717
13,293090.831,4223873.322,101.531
14,293088.610,4223878.282,101.471
15,293082.991,4223890.831
16,293093.239,4223896.909,101.882
17,293118.988,4223912.366,103.460
18,293145.312,4223927.679,105.006
19,293170.059,4223941.093,106.943
20,293182.533,4223947.752,108.027
S12, 1. 2. 3
S22, 1. 2. 3
b12, 1. 2. 3


If you see the above two outputs, b12, S12, S22 is correct whereas S12,S22,b12 is incorrect.
Please check.


Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: HELP WITH A LISP
« Reply #43 on: January 21, 2017, 07:04:44 AM »
If you see the above two outputs, b12, S12, S22 is correct whereas S12,S22,b12 is incorrect.

My function will sort uppercase characters before lowercase characters, as designed.

If this is not desirable, simply use:
Code - Auto/Visual Lisp: [Select]
  1. (mapcar '(lambda ( n ) (nth n rawstringlist)) (LM:alphanumsort-i (mapcar 'strcase rawstringlist)))

Or better yet, write your own function.
« Last Edit: January 21, 2017, 07:11:50 AM by Lee Mac »

mailmaverick

  • Bull Frog
  • Posts: 494
Re: HELP WITH A LISP
« Reply #44 on: January 21, 2017, 07:19:11 AM »
Excellent Lee Mac !!!!