Topic: Help: Export coordinates from block attribute

[mhy3sx]

Hi, I use this code to export coordinates from my attibute blocks. Is it possible to change the code to work only for one block with name STATION.dwg (ignore all the other blocks)?

Code - Auto/Visual Lisp: [Select]

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

Thanks

[kozmos]

simply change
(setq sel (ssget '((0 . "INSERT") (66 . 1))))
into
(setq sel (ssget '((0 . "INSERT")(2 . "STATION") (66 . 1))))

[Lee Mac]

Original source

You may also wish to include anonymous references in the selection (using the filter "`*U*") and then check the ActiveX effectivename property within the repeat loop if your blocks are dynamic, otherwise they won't be selected if their dynamic parameters have been altered following insertion.