Topic: HELP WITH A LISP

[Lee Mac]

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]

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

[pedroantonio]

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. (vl-load-com) (princ)
86.  

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]

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

[kdub_nz]

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.  

[pedroantonio]

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. (vl-load-com) (princ)
88.  

[JohnK]

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.

[mailmaverick]

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]

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. (vl-load-com) (princ)
88.  
89.  

[Lee Mac]

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]

Thank you all for the help!!

[mailmaverick]

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]

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]

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.

[mailmaverick]

Excellent Lee Mac !!!!