Topic: Help with a lisp

[PM]

Hi .I am using this code to export to csv coordinates from autocad and then i use this csv file to upload data to my total station. The points i use is block attribiutes . Some of the have "ELEV" tag and same not. Some times the "ELEV" have elevetion and some tines is empty. I want  if "ELEV" is empty or does not exist to put 0.00 in the csv file. Can any one help ? Thanks

Code - Auto/Visual Lisp: [Select]

1. (defun c:IDXPXYZ ( / *error* del des ent idx lst obj ord out rtn sel )
2.  
3.  
4.     (defun *error* ( msg )
5.         (if (= 'file (type des))
6.             (close des)
7.         )
8.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
9.             (princ (strcat "\nError: " msg))
10.         )
11.         (princ)
12.     )
13.  
14.     (setq ord '("POINT" POINT-X POINT-Y "ELEV" )
15.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".csv")
16.           del  ","
17.     )
18.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
19.         (if (setq des (open out "w"))
20.             (progn
21.                 (repeat (setq idx (sslength sel))
22.                     (setq ent (ssname sel (setq idx (1- idx)))
23.                           obj (vlax-ename->vla-object ent)
24.                     )
25.                     (setq lst
26.                         (append
27.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
28.                                '(point-x point-y point-z)
29.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
30.                             )
31.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
32.                                 (append
33.                                     (vlax-invoke obj 'getattributes)
34.                                     (vlax-invoke obj 'getconstantattributes)
35.                                 )
36.                             )
37.                         )
38.                     )
39.                   (setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))
40.                 )
41.       (foreach idx (LM:alphanumsort-i (mapcar 'car rtn))
42.       ;(write-line (LM:lst->str (nth idx rtn) del) des)
43.       (write-line (vl-string-translate "Σ;Τ;Κ" "S;T;K" (lm:lst->str (nth idx rtn) del)) des) ; HERE CONVERT SOME GREEK LETERS TO ENGLISH CHARACTERS PLEASE DONT CHANGE IT !!!!
44.    )
45.                 (setq des (close des))
46.             )
47.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
48.         )
49.     )
50.     (princ)
51. )                
52.  
53. ;; List to String  -  Lee Mac
54. ;; Concatenates each string in a list, separated by a given delimiter
55.  
56. (defun LM:lst->str ( lst del )
57.     (if (cdr lst)
58.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
59.         (car lst)
60.     )
61. )
62.  
63. ;; Unique Filename  -  Lee Mac
64. ;; Returns a unique filename for a given path & file extension
65.  
66. (defun LM:uniquefilename ( pth ext / fnm tmp )
67.     (if (findfile (setq fnm (strcat pth ext)))
68.         (progn
69.             (setq tmp 1)
70.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
71.         )
72.     )
73.     fnm
74. )
75.  
76. ;; Alphanumerical Sort-i  -  Lee Mac
77. ;; Sorts a list of strings containing a combination of alphabetical & numerical characters and returns the indices.
78.  
79. (defun LM:alphanumsort-i ( lst )
80.     (vl-sort-i (mapcar 'LM:splitstring lst)
81.         (function
82.             (lambda ( a b / x y )
83.                 (while
84.                     (and
85.                         (setq x (car a))
86.                         (setq y (car b))
87.                         (= x y)
88.                     )
89.                     (setq a (cdr a)
90.                           b (cdr b)
91.                     )
92.                 )
93.                 (cond
94.                     (   (null x) b)
95.                     (   (null y) nil)
96.                     (   (and (numberp x) (numberp y)) (< x y))
97.                     (   (numberp x))
98.                     (   (numberp y) nil)
99.                     (   (< x y))
100.                 )
101.             )
102.         )
103.     )
104. )
105.  
106. ;; Split String  -  Lee Mac
107. ;; Splits a string into a list of text and numbers
108.  
109. (defun LM:splitstring ( str )
110.     (
111.         (lambda ( l )
112.             (read
113.                 (strcat "("
114.                     (vl-list->string
115.                         (apply 'append
116.                             (mapcar
117.                                 (function
118.                                     (lambda ( a b c )
119.                                         (cond
120.                                             (   (or (= 34 b) (= 92 b))
121.                                                 (list 32 34 92 b 34 32)
122.                                             )
123.                                             (   (or (< 47 b 58)
124.                                                    ;(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
125.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
126.                                                 )
127.                                                 (list b)
128.                                             )
129.                                             (   (list 32 34 b 34 32))
130.                                         )
131.                                     )
132.                                 )
133.                                 (cons nil l) l (append (cdr l) '(( )))
134.                             )
135.                         )
136.                     )
137.                     ")"
138.                 )
139.             )
140.         )
141.         (vl-string->list str)
142.     )
143. )
144.  
145.  
146. (vl-load-com) (princ)
147.  
148.  
149.  
150.  

[Lee Mac]

Change:

Code - Auto/Visual Lisp: [Select]

1. (setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))

To:

Code - Auto/Visual Lisp: [Select]

1. (setq rtn (cons (mapcar '(lambda ( x ) (cond ((cdr (assoc x lst))) ("0.00"))) ord) rtn))

(Original source here & here)

[PM]

Hi Lee Mac. I did the change but when "ELEV" does not exist add 0.00 but when the "ELEV" exist and is empty didn't add 0.00. Can you help ? Thanks

Code - Auto/Visual Lisp: [Select]

1. (defun c:IDXPXYZ ( / *error* del des ent idx lst obj ord out rtn sel )
2.  
3.  
4.     (defun *error* ( msg )
5.         (if (= 'file (type des))
6.             (close des)
7.         )
8.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
9.             (princ (strcat "\nError: " msg))
10.         )
11.         (princ)
12.     )
13.  
14.     (setq ord '("POINT" POINT-X POINT-Y "ELEV" )
15.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".csv")
16.           del  ","
17.     )
18.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
19.         (if (setq des (open out "w"))
20.             (progn
21.                 (repeat (setq idx (sslength sel))
22.                     (setq ent (ssname sel (setq idx (1- idx)))
23.                           obj (vlax-ename->vla-object ent)
24.                     )
25.                     (setq lst
26.                         (append
27.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
28.                                '(point-x point-y point-z)
29.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
30.                             )
31.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
32.                                 (append
33.                                     (vlax-invoke obj 'getattributes)
34.                                     (vlax-invoke obj 'getconstantattributes)
35.                                 )
36.                             )
37.                         )
38.                     )
39.                   ;(setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))
40.                    (setq rtn (cons (mapcar '(lambda ( x ) (cond ((cdr (assoc x lst))) ("0.00"))) ord) rtn))
41.                 )
42.       (foreach idx (LM:alphanumsort-i (mapcar 'car rtn))
43.       ;(write-line (LM:lst->str (nth idx rtn) del) des)
44.       (write-line (vl-string-translate "&#931;;&#932;;&#922;" "S;T;K" (lm:lst->str (nth idx rtn) del)) des)
45.    )
46.                 (setq des (close des))
47.             )
48.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
49.         )
50.     )
51.     (princ)
52. )                
53.  
54. ;; List to String  -  Lee Mac
55. ;; Concatenates each string in a list, separated by a given delimiter
56.  
57. (defun LM:lst->str ( lst del )
58.     (if (cdr lst)
59.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
60.         (car lst)
61.     )
62. )
63.  
64. ;; Unique Filename  -  Lee Mac
65. ;; Returns a unique filename for a given path & file extension
66.  
67. (defun LM:uniquefilename ( pth ext / fnm tmp )
68.     (if (findfile (setq fnm (strcat pth ext)))
69.         (progn
70.             (setq tmp 1)
71.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
72.         )
73.     )
74.     fnm
75. )
76.  
77. ;; Alphanumerical Sort-i  -  Lee Mac
78. ;; Sorts a list of strings containing a combination of alphabetical & numerical characters and returns the indices.
79.  
80. (defun LM:alphanumsort-i ( lst )
81.     (vl-sort-i (mapcar 'LM:splitstring lst)
82.         (function
83.             (lambda ( a b / x y )
84.                 (while
85.                     (and
86.                         (setq x (car a))
87.                         (setq y (car b))
88.                         (= x y)
89.                     )
90.                     (setq a (cdr a)
91.                           b (cdr b)
92.                     )
93.                 )
94.                 (cond
95.                     (   (null x) b)
96.                     (   (null y) nil)
97.                     (   (and (numberp x) (numberp y)) (< x y))
98.                     (   (numberp x))
99.                     (   (numberp y) nil)
100.                     (   (< x y))
101.                 )
102.             )
103.         )
104.     )
105. )
106.  
107. ;; Split String  -  Lee Mac
108. ;; Splits a string into a list of text and numbers
109.  
110. (defun LM:splitstring ( str )
111.     (
112.         (lambda ( l )
113.             (read
114.                 (strcat "("
115.                     (vl-list->string
116.                         (apply 'append
117.                             (mapcar
118.                                 (function
119.                                     (lambda ( a b c )
120.                                         (cond
121.                                             (   (or (= 34 b) (= 92 b))
122.                                                 (list 32 34 92 b 34 32)
123.                                             )
124.                                             (   (or (< 47 b 58)
125.                                                    ;(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
126.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
127.                                                 )
128.                                                 (list b)
129.                                             )
130.                                             (   (list 32 34 b 34 32))
131.                                         )
132.                                     )
133.                                 )
134.                                 (cons nil l) l (append (cdr l) '(( )))
135.                             )
136.                         )
137.                     )
138.                     ")"
139.                 )
140.             )
141.         )
142.         (vl-string->list str)
143.     )
144. )
145.  
146.  
147. (vl-load-com) (princ)
148.  
149.  

[Lee Mac]

Change:

Code - Auto/Visual Lisp: [Select]

1. (setq rtn (cons (mapcar '(lambda ( x ) (cond ((cdr (assoc x lst))) ("0.00"))) ord) rtn))

To:

Code - Auto/Visual Lisp: [Select]

1. (setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))

[PM]

Thank you Lee Mac

[PM]

Hi Lee Mac. Is it possible not export data for the points with the tag ¨POINT¨ empty ?

Thanks

[Lee Mac]

Is it possible not export data for the points with the tag ¨POINT¨ empty ?

The program starts to lose it's generic applicability when we start hard-coding criteria for specifc tags/values, but here you go:

Change:

Code - Auto/Visual Lisp: [Select]

1. (setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))

To:

Code - Auto/Visual Lisp: [Select]

1. (if (assoc "POINT" lst)
2.     (setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))
3. )

[PM]

Hi Lee Mack. Did the update but i didn't see any difference. I ask if "point" is empty don't export the coordinates. With this update export the coordinates but ass 0.00 in the empty tag. Can you fix it. Thanks

Code - Auto/Visual Lisp: [Select]

1. (defun c:IDXPXYZ ( / *error* del des ent idx lst obj ord out rtn sel )
2.  
3.  
4.     (defun *error* ( msg )
5.         (if (= 'file (type des))
6.             (close des)
7.         )
8.         (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
9.             (princ (strcat "\nError: " msg))
10.         )
11.         (princ)
12.     )
13.  
14.     (setq ord '("POINT" POINT-X POINT-Y "ELEV" )
15.           out  (LM:uniquefilename (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname))) ".csv")
16.           del  ","
17.     )
18.     (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
19.         (if (setq des (open out "w"))
20.             (progn
21.                 (repeat (setq idx (sslength sel))
22.                     (setq ent (ssname sel (setq idx (1- idx)))
23.                           obj (vlax-ename->vla-object ent)
24.                     )
25.                     (setq lst
26.                         (append
27.                             (mapcar '(lambda ( a b ) (cons a (rtos b)))
28.                                '(point-x point-y point-z)
29.                                 (trans (cdr (assoc 10 (entget ent))) ent 0)
30.                             )
31.                             (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
32.                                 (append
33.                                     (vlax-invoke obj 'getattributes)
34.                                     (vlax-invoke obj 'getconstantattributes)
35.                                 )
36.                             )
37.                         )
38.                     )
39.                   ;(setq rtn (cons (vl-remove 'nil (mapcar '(lambda ( x ) (cdr (assoc x lst))) ord)) rtn))
40.                  ;(setq rtn (cons (mapcar '(lambda ( x ) (cond ((cdr (assoc x lst))) ("0.00"))) ord) rtn))
41.                   ;(setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))
42.     (if (assoc "POINT" lst)
43.         (setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))
44.     )
45.                 )
46.       (foreach idx (LM:alphanumsort-i (mapcar 'car rtn))
47.       ;(write-line (LM:lst->str (nth idx rtn) del) des)
48.       (write-line (vl-string-translate "&#931;;&#932;;&#922;" "S;T;K" (lm:lst->str (nth idx rtn) del)) des)
49.    )
50.                 (setq des (close des))
51.             )
52.             (princ (strcat "\nUnable to open file: \"" out "\" for writing."))
53.         )
54.     )
55.     (princ)
56. )                
57.  
58. ;; List to String  -  Lee Mac
59. ;; Concatenates each string in a list, separated by a given delimiter
60.  
61. (defun LM:lst->str ( lst del )
62.     (if (cdr lst)
63.         (strcat (car lst) del (LM:lst->str (cdr lst) del))
64.         (car lst)
65.     )
66. )
67.  
68. ;; Unique Filename  -  Lee Mac
69. ;; Returns a unique filename for a given path & file extension
70.  
71. (defun LM:uniquefilename ( pth ext / fnm tmp )
72.     (if (findfile (setq fnm (strcat pth ext)))
73.         (progn
74.             (setq tmp 1)
75.             (while (findfile (setq fnm (strcat pth "(" (itoa (setq tmp (1+ tmp))) ")" ext))))
76.         )
77.     )
78.     fnm
79. )
80.  
81. ;; Alphanumerical Sort-i  -  Lee Mac
82. ;; Sorts a list of strings containing a combination of alphabetical & numerical characters and returns the indices.
83.  
84. (defun LM:alphanumsort-i ( lst )
85.     (vl-sort-i (mapcar 'LM:splitstring lst)
86.         (function
87.             (lambda ( a b / x y )
88.                 (while
89.                     (and
90.                         (setq x (car a))
91.                         (setq y (car b))
92.                         (= x y)
93.                     )
94.                     (setq a (cdr a)
95.                           b (cdr b)
96.                     )
97.                 )
98.                 (cond
99.                     (   (null x) b)
100.                     (   (null y) nil)
101.                     (   (and (numberp x) (numberp y)) (< x y))
102.                     (   (numberp x))
103.                     (   (numberp y) nil)
104.                     (   (< x y))
105.                 )
106.             )
107.         )
108.     )
109. )
110.  
111. ;; Split String  -  Lee Mac
112. ;; Splits a string into a list of text and numbers
113.  
114. (defun LM:splitstring ( str )
115.     (
116.         (lambda ( l )
117.             (read
118.                 (strcat "("
119.                     (vl-list->string
120.                         (apply 'append
121.                             (mapcar
122.                                 (function
123.                                     (lambda ( a b c )
124.                                         (cond
125.                                             (   (or (= 34 b) (= 92 b))
126.                                                 (list 32 34 92 b 34 32)
127.                                             )
128.                                             (   (or (< 47 b 58)
129.                                                    ;(and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
130.                                                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
131.                                                 )
132.                                                 (list b)
133.                                             )
134.                                             (   (list 32 34 b 34 32))
135.                                         )
136.                                     )
137.                                 )
138.                                 (cons nil l) l (append (cdr l) '(( )))
139.                             )
140.                         )
141.                     )
142.                     ")"
143.                 )
144.             )
145.         )
146.         (vl-string->list str)
147.     )
148. )
149.  
150.  
151. (vl-load-com) (princ)
152.  
153.  

[BIGAL]

I am sure Lee will answer but maybe here

Code: [Select]

)
(if (/= (strcase (vla-get-tagstring x)) "POINT")
                            (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) (vla-get-textstring x)))
…..
)


[PM]

HI BIGAL .I try to add your code  but something is going wrong .Dont export anything !!!

[Lee Mac]

Change:

Code - Auto/Visual Lisp: [Select]

1. (if (assoc "POINT" lst)
2.     (setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))
3. )

To:

Code - Auto/Visual Lisp: [Select]

1. (if (and (setq pnt (assoc "POINT" lst)) (/= "" (cdr pnt)))
2.     (setq rtn (cons (mapcar '(lambda ( x / v ) (if (and (setq v (cdr (assoc x lst))) (/= "" v)) v "0.00")) ord) rtn))
3. )

[PM]

Thank you Lee Mac and BIGAL