Topic: Help me, extract data Dynamic blocks and Attribute block to excel

[minhphuong_humg]

Hello,
I have a drawing (attach) with Dynamic Blocks and Attribute Blocks.
Please, help me, write a lisp to extract data Dynamic blocks and Attribute block to Excel.
I used to Extraction Data in Autocad 2014 but don't expected.
Please, help me.
Thank you very much!

[ribarm]

Here, try this and check attached *.csv - it's little different than your *.xls, but if you run the routine with step-by-step selections you may get desired result... The process is the same as Lnam.lsp posted here :

http://www.autolisp.com/forum/threads/892-Help-me-edit-complete-my-lisp!/page2&p=#11

Code - Auto/Visual Lisp: [Select]

1. (defun round ( x )
2.   (if (>= (- x (fix x)) 0.5)
3.     (1+ (fix x))
4.     (fix x)
5.   )
6. )
7.  
8. ;; Get Dynamic Block Property Value  -  Lee Mac
9. ;; Returns the value of a Dynamic Block property (if present)
10. ;; blk - [vla] VLA Dynamic Block Reference object
11. ;; prp - [str] Dynamic Block property name (case-insensitive)
12.  
13. (defun LM:getdynpropvalue ( blk prp )
14.   (setq prp (strcase prp))
15.   (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
16.     (vlax-invoke blk 'getdynamicblockproperties)
17.   )
18. )
19.  
20. (defun c:LNam-blk ( / ch dim ent f fname i loop pt ptdimlst pttxtlst s ss ssdim sstxt std std-m std-m-r std1 std1-m std1-m-r std2 std2-m std2-m-r stddlst stdmemb stl stt1 stt1-d stt2 stt2-d sttd sttn sttn1 sttn2 stxts txt )
21.  
22.   (vl-load-com)
23.  
24.   (setq f (open (setq fname (strcat (getvar 'dwgprefix) "LNam-blk.csv")) "w"))
25.   (setq loop t)
26.   (while loop
27.     (initget "Yes No")
28.     (setq ch (getkword "\nStart/continue selecting data [Yes/No] <Yes>: "))
29.     (if (or (eq ch "Yes") (eq ch nil))
30.       (progn
31.         (setq ss nil s nil)
32.         (prompt "\nSelect desired branches with their specifications")
33.         (while (not ss)
34.           (setq ss (ssget))
35.         )
36.         (setq ssdim (ssadd))
37.         (setq sstxt (ssadd))
38.         (setq i -1)
39.         (while (setq ent (ssname ss (setq i (1+ i))))
40.           (cond
41.             ( (and (eq (cdr (assoc 0 (entget ent))) "INSERT") (wcmatch (cdr (assoc 2 (entget ent))) "[*]*") (eq (vlax-get-property (vlax-ename->vla-object ent) 'EffectiveName) "DimPC"))
42.               (ssadd ent ssdim)
43.             )
44.             ( (and (eq (cdr (assoc 0 (entget ent))) "INSERT") (eq (cdr (assoc 2 (entget ent))) "Buble"))
45.               (ssadd ent sstxt)
46.             )
47.           )
48.         )
49.         (prompt "\nPick first dimension-dynamic block that has free end - starting dimension-dynamic block without starting end specification")
50.         (while (not s)
51.           (setq s (ssget "_+.:E:S" '((0 . "INSERT"))))
52.         )
53.         (setq std (ssname s 0))
54.         (while std
55.           (setq std-m (LM:getdynpropvalue (vlax-ename->vla-object std) "Distance1"))
56.           (setq std-m-r (round std-m))
57.           (setq std-a (polar (cdr (assoc 10 (entget std))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std) "Angle1") (vlax-get-property (vlax-ename->vla-object std) 'Rotation)) std-m))
58.          
59.           (setq i -1)
60.           (while (setq txt (ssname sstxt (setq i (1+ i))))
61.             (setq pt (cdr (assoc 10 (entget txt))))
62.             (setq pttxtlst (cons (cons pt txt) pttxtlst))
63.           )
64.          
65.           (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std-a (car a)) (distance std-a (car b)))))))))
66.           (setq stt2 stt1)
67.           (setq stt1-d nil)
68.           (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
69.             (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
70.           )
71.           (setq stt1-d (reverse stt1-d))
72.           (setq sttn (car stt1-d))
73.           (setq sttd (cdr stt1-d))
74.           (setq sttd (apply 'strcat (mapcar '(lambda ( x ) (strcat "," x)) sttd)))
75.          
76.           (ssdel stt1 sstxt)
77.           (setq pttxtlst nil)
78.          
79.           (setq stl (strcat sttn "," (itoa std-m-r) sttd))
80.           (write-line stl f)
81.           (setq sttn nil sttd nil stl nil)
82.          
83.           (ssdel std ssdim)
84.  
85.           (setq i -1)
86.           (while (setq dim (ssname ssdim (setq i (1+ i))))
87.             (setq pt (cdr (assoc 10 (entget dim))))
88.             (setq ptdimlst (cons (cons pt dim) ptdimlst))
89.           )
90.          
91.           (setq std1 (cdr (car (setq stdmemb (vl-member-if '(lambda ( x ) (equal (list (caar x) (cadar x)) (list (car std-a) (cadr std-a)) 0.5)) ptdimlst)))))
92.           (setq std2 (cdr (car (vl-member-if '(lambda ( x ) (equal (list (caar x) (cadar x)) (list (car std-a) (cadr std-a)) 0.5)) (cdr stdmemb)))))
93.  
94.           (setq ptdimlst nil stdmemb nil)
95.          
96.           (if (and std1 std2)
97.             (progn
98.               (setq std1-m (LM:getdynpropvalue (vlax-ename->vla-object std1) "Distance1"))
99.               (setq std1-m-r (round std1-m))
100.               (setq std1-a (polar (cdr (assoc 10 (entget std1))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std1) "Angle1") (vlax-get-property (vlax-ename->vla-object std1) 'Rotation)) std1-m))
101.          
102.               (setq i -1)
103.               (while (setq txt (ssname sstxt (setq i (1+ i))))
104.                 (setq pt (cdr (assoc 10 (entget txt))))
105.                 (setq pttxtlst (cons (cons pt txt) pttxtlst))
106.               )
107.              
108.               (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std1-a (car a)) (distance std1-a (car b)))))))))
109.               (setq stt2 stt1)
110.               (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
111.                 (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
112.               )
113.               (setq stt1-d (reverse stt1-d))
114.               (setq sttn (car stt1-d))
115.  
116.               (setq sttn1 sttn)
117.               (setq pttxtlst nil)
118.              
119.               (setq std2-m (LM:getdynpropvalue (vlax-ename->vla-object std2) "Distance1"))
120.               (setq std2-m-r (round std2-m))
121.               (setq std2-a (polar (cdr (assoc 10 (entget std2))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std2) "Angle1") (vlax-get-property (vlax-ename->vla-object std2) 'Rotation)) std2-m))
122.  
123.               (setq i -1)
124.               (while (setq txt (ssname sstxt (setq i (1+ i))))
125.                 (setq pt (cdr (assoc 10 (entget txt))))
126.                 (setq pttxtlst (cons (cons pt txt) pttxtlst))
127.               )
128.              
129.               (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std2-a (car a)) (distance std2-a (car b)))))))))
130.               (setq stt2 stt1)
131.               (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
132.                 (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
133.               )
134.               (setq stt1-d (reverse stt1-d))
135.               (setq sttn (car stt1-d))
136.  
137.               (setq sttn2 sttn)
138.               (setq pttxtlst nil)
139.              
140.               (if (> (strlen sttn1) (strlen sttn2)) (setq std std1 stddlst (cons std2 stddlst)) (setq std std2 stddlst (cons std1 stddlst)))
141.             )
142.             (if std1 (setq std std1) (if stddlst (setq std (car stddlst) stddlst (cdr stddlst)) (setq std nil)))
143.           )
144.         )
145.       )
146.       (setq loop nil)
147.     )
148.   )
149.   (close f)
150.   (startapp "explorer" fname)
151.   (princ)
152. )
153.  

M.R.

[minhphuong_humg]

Here, try this and check attached *.csv - it's little different than your *.xls, but if you run the routine with step-by-step selections you may get desired result... The process is the same as Lnam.lsp posted here :

http://www.autolisp.com/forum/threads/892-Help-me-edit-complete-my-lisp!/page2&p=#11

Code - Auto/Visual Lisp: [Select]

1. (defun round ( x )
2.   (if (>= (- x (fix x)) 0.5)
3.     (1+ (fix x))
4.     (fix x)
5.   )
6. )
7.  
8. ;; Get Dynamic Block Property Value  -  Lee Mac
9. ;; Returns the value of a Dynamic Block property (if present)
10. ;; blk - [vla] VLA Dynamic Block Reference object
11. ;; prp - [str] Dynamic Block property name (case-insensitive)
12.  
13. (defun LM:getdynpropvalue ( blk prp )
14.   (setq prp (strcase prp))
15.   (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
16.     (vlax-invoke blk 'getdynamicblockproperties)
17.   )
18. )
19.  
20. (defun c:LNam-blk ( / ch dim ent f fname i loop pt ptdimlst pttxtlst s ss ssdim sstxt std std-m std-m-r std1 std1-m std1-m-r std2 std2-m std2-m-r stddlst stdmemb stl stt1 stt1-d stt2 stt2-d sttd sttn sttn1 sttn2 stxts txt )
21.  
22.   (vl-load-com)
23.  
24.   (setq f (open (setq fname (strcat (getvar 'dwgprefix) "LNam-blk.csv")) "w"))
25.   (setq loop t)
26.   (while loop
27.     (initget "Yes No")
28.     (setq ch (getkword "\nStart/continue selecting data [Yes/No] <Yes>: "))
29.     (if (or (eq ch "Yes") (eq ch nil))
30.       (progn
31.         (setq ss nil s nil)
32.         (prompt "\nSelect desired branches with their specifications")
33.         (while (not ss)
34.           (setq ss (ssget))
35.         )
36.         (setq ssdim (ssadd))
37.         (setq sstxt (ssadd))
38.         (setq i -1)
39.         (while (setq ent (ssname ss (setq i (1+ i))))
40.           (cond
41.             ( (and (eq (cdr (assoc 0 (entget ent))) "INSERT") (wcmatch (cdr (assoc 2 (entget ent))) "[*]*") (eq (vlax-get-property (vlax-ename->vla-object ent) 'EffectiveName) "DimPC"))
42.               (ssadd ent ssdim)
43.             )
44.             ( (and (eq (cdr (assoc 0 (entget ent))) "INSERT") (eq (cdr (assoc 2 (entget ent))) "Buble"))
45.               (ssadd ent sstxt)
46.             )
47.           )
48.         )
49.         (prompt "\nPick first dimension-dynamic block that has free end - starting dimension-dynamic block without starting end specification")
50.         (while (not s)
51.           (setq s (ssget "_+.:E:S" '((0 . "INSERT"))))
52.         )
53.         (setq std (ssname s 0))
54.         (while std
55.           (setq std-m (LM:getdynpropvalue (vlax-ename->vla-object std) "Distance1"))
56.           (setq std-m-r (round std-m))
57.           (setq std-a (polar (cdr (assoc 10 (entget std))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std) "Angle1") (vlax-get-property (vlax-ename->vla-object std) 'Rotation)) std-m))
58.          
59.           (setq i -1)
60.           (while (setq txt (ssname sstxt (setq i (1+ i))))
61.             (setq pt (cdr (assoc 10 (entget txt))))
62.             (setq pttxtlst (cons (cons pt txt) pttxtlst))
63.           )
64.          
65.           (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std-a (car a)) (distance std-a (car b)))))))))
66.           (setq stt2 stt1)
67.           (setq stt1-d nil)
68.           (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
69.             (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
70.           )
71.           (setq stt1-d (reverse stt1-d))
72.           (setq sttn (car stt1-d))
73.           (setq sttd (cdr stt1-d))
74.           (setq sttd (apply 'strcat (mapcar '(lambda ( x ) (strcat "," x)) sttd)))
75.          
76.           (ssdel stt1 sstxt)
77.           (setq pttxtlst nil)
78.          
79.           (setq stl (strcat sttn "," (itoa std-m-r) sttd))
80.           (write-line stl f)
81.           (setq sttn nil sttd nil stl nil)
82.          
83.           (ssdel std ssdim)
84.  
85.           (setq i -1)
86.           (while (setq dim (ssname ssdim (setq i (1+ i))))
87.             (setq pt (cdr (assoc 10 (entget dim))))
88.             (setq ptdimlst (cons (cons pt dim) ptdimlst))
89.           )
90.          
91.           (setq std1 (cdr (car (setq stdmemb (vl-member-if '(lambda ( x ) (equal (list (caar x) (cadar x)) (list (car std-a) (cadr std-a)) 0.5)) ptdimlst)))))
92.           (setq std2 (cdr (car (vl-member-if '(lambda ( x ) (equal (list (caar x) (cadar x)) (list (car std-a) (cadr std-a)) 0.5)) (cdr stdmemb)))))
93.  
94.           (setq ptdimlst nil stdmemb nil)
95.          
96.           (if (and std1 std2)
97.             (progn
98.               (setq std1-m (LM:getdynpropvalue (vlax-ename->vla-object std1) "Distance1"))
99.               (setq std1-m-r (round std1-m))
100.               (setq std1-a (polar (cdr (assoc 10 (entget std1))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std1) "Angle1") (vlax-get-property (vlax-ename->vla-object std1) 'Rotation)) std1-m))
101.          
102.               (setq i -1)
103.               (while (setq txt (ssname sstxt (setq i (1+ i))))
104.                 (setq pt (cdr (assoc 10 (entget txt))))
105.                 (setq pttxtlst (cons (cons pt txt) pttxtlst))
106.               )
107.              
108.               (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std1-a (car a)) (distance std1-a (car b)))))))))
109.               (setq stt2 stt1)
110.               (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
111.                 (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
112.               )
113.               (setq stt1-d (reverse stt1-d))
114.               (setq sttn (car stt1-d))
115.  
116.               (setq sttn1 sttn)
117.               (setq pttxtlst nil)
118.              
119.               (setq std2-m (LM:getdynpropvalue (vlax-ename->vla-object std2) "Distance1"))
120.               (setq std2-m-r (round std2-m))
121.               (setq std2-a (polar (cdr (assoc 10 (entget std2))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std2) "Angle1") (vlax-get-property (vlax-ename->vla-object std2) 'Rotation)) std2-m))
122.  
123.               (setq i -1)
124.               (while (setq txt (ssname sstxt (setq i (1+ i))))
125.                 (setq pt (cdr (assoc 10 (entget txt))))
126.                 (setq pttxtlst (cons (cons pt txt) pttxtlst))
127.               )
128.              
129.               (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std2-a (car a)) (distance std2-a (car b)))))))))
130.               (setq stt2 stt1)
131.               (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
132.                 (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
133.               )
134.               (setq stt1-d (reverse stt1-d))
135.               (setq sttn (car stt1-d))
136.  
137.               (setq sttn2 sttn)
138.               (setq pttxtlst nil)
139.              
140.               (if (> (strlen sttn1) (strlen sttn2)) (setq std std1 stddlst (cons std2 stddlst)) (setq std std2 stddlst (cons std1 stddlst)))
141.             )
142.             (if std1 (setq std std1) (if stddlst (setq std (car stddlst) stddlst (cdr stddlst)) (setq std nil)))
143.           )
144.         )
145.       )
146.       (setq loop nil)
147.     )
148.   )
149.   (close f)
150.   (startapp "explorer" fname)
151.   (princ)
152. )
153.  

M.R.

Thank for help.
When I used coincides with the LMAN (Layer State Mannager) command (Autocad 2014). Please, help me change to other command.
Thank you very much.
P / S: You can fix the sort by number
1
2
3
....
then to
1.1
1.2
1.3
  .....
been is not?
instead
1
1.1
1.2
1.3
2
3
Means:
Sort an integer first then up to the number of Odd after.
Please, help me. Thank you very much.

[ribarm]

Thank for help.
When I used coincides with the LMAN (Layer State Mannager) command (Autocad 2014). Please, help me change to other command.

Routine starts with : LNam-blk - it's totally different than LMAN, I've checked it in A2014 and both things work fine...

Thank you very much.
P / S: You can fix the sort by number
1
2
3
....
then to
1.1
1.2
1.3
  .....
been is not?
instead
1
1.1
1.2
1.3
2
3
Means:
Sort an integer first then up to the number of Odd after.
Please, help me.

Populating EXCEL *.csv file is done in relation with branching in reference DWG... If you perform routine command step-by-step, selecting desired branch/es and starting dimension-dynamic block and then continue with the same procedure answering "Yes" for question to continue populating, you'll get at the end what you wanted without sorting, just answer in the end "No"... Otherwise, I am afraid, if you are not patient and you want to process all blocks in singe shot, you may get *.csv like I posted and you'll have to do sorting inside EXCEL, which is what I strongly suggest, and that is the best way of managing data to be in desired form...

Thank you very much.

You're very welcome, minhphuong_humg...

M.R.

[minhphuong_humg]

Thank for help.
When I used coincides with the LMAN (Layer State Mannager) command (Autocad 2014). Please, help me change to other command.

Thank for help.
When I used coincides with the LMAN (Layer State Mannager) command (Autocad 2014). Please, help me change to other command.

Routine starts with : LNam-blk - it's totally different than LMAN, I've checked it in A2014 and both things work fine...

Thank you very much.
P / S: You can fix the sort by number
1
2
3
....
then to
1.1
1.2
1.3
  .....
been is not?
instead
1
1.1
1.2
1.3
2
3
Means:
Sort an integer first then up to the number of Odd after.
Please, help me.

Populating EXCEL *.csv file is done in relation with branching in reference DWG... If you perform routine command step-by-step, selecting desired branch/es and starting dimension-dynamic block and then continue with the same procedure answering "Yes" for question to continue populating, you'll get at the end what you wanted without sorting, just answer in the end "No"... Otherwise, I am afraid, if you are not patient and you want to process all blocks in singe shot, you may get *.csv like I posted and you'll have to do sorting inside EXCEL, which is what I strongly suggest, and that is the best way of managing data to be in desired form...

Thank you very much.

You're very welcome, minhphuong_humg...

M.R.

Thank you very much.
P / S: You can fix the sort by number
1
2
3
....
then to
1.1
1.2
1.3
  .....
been is not?
instead
1
1.1
1.2
1.3
2
3
Means:
Sort an integer first then up to the number of Odd after.
Please, help me.

Populating EXCEL *.csv file is done in relation with branching in reference DWG... If you perform routine command step-by-step, selecting desired branch/es and starting dimension-dynamic block and then continue with the same procedure answering "Yes" for question to continue populating, you'll get at the end what you wanted without sorting, just answer in the end "No"... Otherwise, I am afraid, if you are not patient and you want to process all blocks in singe shot, you may get *.csv like I posted and you'll have to do sorting inside EXCEL, which is what I strongly suggest, and that is the best way of managing data to be in desired form...

Thank you very much.

You're very welcome, minhphuong_humg...

M.R.

Oh, thank you very much.
Your lisp work fine.
Final, goodluck for you.

[minhphuong_humg]

Here, try this and check attached *.csv - it's little different than your *.xls, but if you run the routine with step-by-step selections you may get desired result... The process is the same as Lnam.lsp posted here :

http://www.autolisp.com/forum/threads/892-Help-me-edit-complete-my-lisp!/page2&p=#11

Code - Auto/Visual Lisp: [Select]

1. (defun round ( x )
2.   (if (>= (- x (fix x)) 0.5)
3.     (1+ (fix x))
4.     (fix x)
5.   )
6. )
7.  
8. ;; Get Dynamic Block Property Value  -  Lee Mac
9. ;; Returns the value of a Dynamic Block property (if present)
10. ;; blk - [vla] VLA Dynamic Block Reference object
11. ;; prp - [str] Dynamic Block property name (case-insensitive)
12.  
13. (defun LM:getdynpropvalue ( blk prp )
14.   (setq prp (strcase prp))
15.   (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value)))
16.     (vlax-invoke blk 'getdynamicblockproperties)
17.   )
18. )
19.  
20. (defun c:LNam-blk ( / ch dim ent f fname i loop pt ptdimlst pttxtlst s ss ssdim sstxt std std-m std-m-r std1 std1-m std1-m-r std2 std2-m std2-m-r stddlst stdmemb stl stt1 stt1-d stt2 stt2-d sttd sttn sttn1 sttn2 stxts txt )
21.  
22.   (vl-load-com)
23.  
24.   (setq f (open (setq fname (strcat (getvar 'dwgprefix) "LNam-blk.csv")) "w"))
25.   (setq loop t)
26.   (while loop
27.     (initget "Yes No")
28.     (setq ch (getkword "\nStart/continue selecting data [Yes/No] <Yes>: "))
29.     (if (or (eq ch "Yes") (eq ch nil))
30.       (progn
31.         (setq ss nil s nil)
32.         (prompt "\nSelect desired branches with their specifications")
33.         (while (not ss)
34.           (setq ss (ssget))
35.         )
36.         (setq ssdim (ssadd))
37.         (setq sstxt (ssadd))
38.         (setq i -1)
39.         (while (setq ent (ssname ss (setq i (1+ i))))
40.           (cond
41.             ( (and (eq (cdr (assoc 0 (entget ent))) "INSERT") (wcmatch (cdr (assoc 2 (entget ent))) "[*]*") (eq (vlax-get-property (vlax-ename->vla-object ent) 'EffectiveName) "DimPC"))
42.               (ssadd ent ssdim)
43.             )
44.             ( (and (eq (cdr (assoc 0 (entget ent))) "INSERT") (eq (cdr (assoc 2 (entget ent))) "Buble"))
45.               (ssadd ent sstxt)
46.             )
47.           )
48.         )
49.         (prompt "\nPick first dimension-dynamic block that has free end - starting dimension-dynamic block without starting end specification")
50.         (while (not s)
51.           (setq s (ssget "_+.:E:S" '((0 . "INSERT"))))
52.         )
53.         (setq std (ssname s 0))
54.         (while std
55.           (setq std-m (LM:getdynpropvalue (vlax-ename->vla-object std) "Distance1"))
56.           (setq std-m-r (round std-m))
57.           (setq std-a (polar (cdr (assoc 10 (entget std))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std) "Angle1") (vlax-get-property (vlax-ename->vla-object std) 'Rotation)) std-m))
58.          
59.           (setq i -1)
60.           (while (setq txt (ssname sstxt (setq i (1+ i))))
61.             (setq pt (cdr (assoc 10 (entget txt))))
62.             (setq pttxtlst (cons (cons pt txt) pttxtlst))
63.           )
64.          
65.           (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std-a (car a)) (distance std-a (car b)))))))))
66.           (setq stt2 stt1)
67.           (setq stt1-d nil)
68.           (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
69.             (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
70.           )
71.           (setq stt1-d (reverse stt1-d))
72.           (setq sttn (car stt1-d))
73.           (setq sttd (cdr stt1-d))
74.           (setq sttd (apply 'strcat (mapcar '(lambda ( x ) (strcat "," x)) sttd)))
75.          
76.           (ssdel stt1 sstxt)
77.           (setq pttxtlst nil)
78.          
79.           (setq stl (strcat sttn "," (itoa std-m-r) sttd))
80.           (write-line stl f)
81.           (setq sttn nil sttd nil stl nil)
82.          
83.           (ssdel std ssdim)
84.  
85.           (setq i -1)
86.           (while (setq dim (ssname ssdim (setq i (1+ i))))
87.             (setq pt (cdr (assoc 10 (entget dim))))
88.             (setq ptdimlst (cons (cons pt dim) ptdimlst))
89.           )
90.          
91.           (setq std1 (cdr (car (setq stdmemb (vl-member-if '(lambda ( x ) (equal (list (caar x) (cadar x)) (list (car std-a) (cadr std-a)) 0.5)) ptdimlst)))))
92.           (setq std2 (cdr (car (vl-member-if '(lambda ( x ) (equal (list (caar x) (cadar x)) (list (car std-a) (cadr std-a)) 0.5)) (cdr stdmemb)))))
93.  
94.           (setq ptdimlst nil stdmemb nil)
95.          
96.           (if (and std1 std2)
97.             (progn
98.               (setq std1-m (LM:getdynpropvalue (vlax-ename->vla-object std1) "Distance1"))
99.               (setq std1-m-r (round std1-m))
100.               (setq std1-a (polar (cdr (assoc 10 (entget std1))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std1) "Angle1") (vlax-get-property (vlax-ename->vla-object std1) 'Rotation)) std1-m))
101.          
102.               (setq i -1)
103.               (while (setq txt (ssname sstxt (setq i (1+ i))))
104.                 (setq pt (cdr (assoc 10 (entget txt))))
105.                 (setq pttxtlst (cons (cons pt txt) pttxtlst))
106.               )
107.              
108.               (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std1-a (car a)) (distance std1-a (car b)))))))))
109.               (setq stt2 stt1)
110.               (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
111.                 (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
112.               )
113.               (setq stt1-d (reverse stt1-d))
114.               (setq sttn (car stt1-d))
115.  
116.               (setq sttn1 sttn)
117.               (setq pttxtlst nil)
118.              
119.               (setq std2-m (LM:getdynpropvalue (vlax-ename->vla-object std2) "Distance1"))
120.               (setq std2-m-r (round std2-m))
121.               (setq std2-a (polar (cdr (assoc 10 (entget std2))) (+ (LM:getdynpropvalue (vlax-ename->vla-object std2) "Angle1") (vlax-get-property (vlax-ename->vla-object std2) 'Rotation)) std2-m))
122.  
123.               (setq i -1)
124.               (while (setq txt (ssname sstxt (setq i (1+ i))))
125.                 (setq pt (cdr (assoc 10 (entget txt))))
126.                 (setq pttxtlst (cons (cons pt txt) pttxtlst))
127.               )
128.              
129.               (setq stt1 (cdr (car (setq stxts (vl-sort pttxtlst '(lambda ( a b ) (< (distance std2-a (car a)) (distance std2-a (car b)))))))))
130.               (setq stt2 stt1)
131.               (while (/= (cdr (assoc 0 (entget (setq stt2 (entnext stt2))))) "SEQEND")
132.                 (setq stt1-d (cons (cdr (assoc 1 (entget stt2))) stt1-d))
133.               )
134.               (setq stt1-d (reverse stt1-d))
135.               (setq sttn (car stt1-d))
136.  
137.               (setq sttn2 sttn)
138.               (setq pttxtlst nil)
139.              
140.               (if (> (strlen sttn1) (strlen sttn2)) (setq std std1 stddlst (cons std2 stddlst)) (setq std std2 stddlst (cons std1 stddlst)))
141.             )
142.             (if std1 (setq std std1) (if stddlst (setq std (car stddlst) stddlst (cdr stddlst)) (setq std nil)))
143.           )
144.         )
145.       )
146.       (setq loop nil)
147.     )
148.   )
149.   (close f)
150.   (startapp "explorer" fname)
151.   (princ)
152. )
153.  

M.R.

Dir, Ribarm!
Thanks for the help Ribarm times before.
Howerver, I am also a large number of drawings has not been transferred to the Dynamic Block. It is still in the form of Aligned Dimension. Please edit your AutoLISP little I can do to help you draw out the rest before I switched to Dynamic Block? I changed the order number in the Attribute Block.
Please help me.
Thank Ribarm very much!