Topic: Please help me fix the Lisp code that merges the drawings

[hcbn1997]

I often use lisp to merge imf drawings I found on here. But there is a problem: if you combine 100 drawings, they will all be arranged in a horizontal row, making tracking more difficult.
I hope you pros can help me fix it so that when I merge the drawings, there are 10 copies in 1 row.
For example, 100 drawings will have 10 vertical rows and 10 horizontal rows.
The other day I fixed the horizontal rows to be 1000 apart. Please, if you fix it, give me the distance between the vertical rows to be 5000 like in the photo.
Thanks everyone

[ribarm]

Here, try this mod., but I am unsure - it's untested, but should work...

Code - Auto/Visual Lisp: [Select]

1. (defun c:imf ( / pathname filelist p xht yht oldos k p1 p2 blname ptl ) ;;;Insert Multi Files by Nguyen Hoanh ( bo tat ca ban ve vao 1 file rieng, roi nhan lenh, chon ban ve dau tien )
2.   (setq pathname (vl-filename-directory
3.                    (getfiled "Hay chon file dwg bat ky thuoc thu muc" "" "dwg" 0)
4.                    )
5.         filelist (vl-sort (vl-directory-files pathname "*.dwg") '<)
6.         p        (getpoint "\nDiem chen: ")
7.         xht      (car p)
8.         yht      (cadr p)
9.         )
10.   (setq oldos (getvar "osmode"))
11.   (setvar "osmode" 0)
12.   (setq k 0)
13.   (foreach filename filelist
14.     (setq k (1+ k))
15.     (if (/= 0 (rem k 11))
16.       (progn
17.         (command "-insert"
18.                  (strcat pathname "/" filename)
19.                  (list xht yht)
20.                  1.0
21.                  1.0
22.                  0.0
23.                  )
24.         (vla-getboundingbox
25.           (vlax-ename->vla-object (entlast))
26.           'p1
27.           'p2
28.           )
29.         (setq p1     (vlax-safearray->list p1)
30.               p2     (vlax-safearray->list p2)
31.               xht    (+ xht (abs (car (mapcar '- p2 p1))) 1000)
32.               blname (cdr (assoc 2 (entget (entlast))))
33.               )
34.         (setq ptl (cons (abs (cadr (mapcar '- p2 p1))) ptl))
35.         (command ".explode" (entlast) "")
36.         (command "-purge" "Block" blname "N")
37.         )
38.       (progn
39.         (setq k (1+ k) xht (car p) yht (+ yht (car (vl-sort ptl '>)) 5000) ptl nil)
40.         (command "-insert"
41.                  (strcat pathname "/" filename)
42.                  (list xht yht)
43.                  1.0
44.                  1.0
45.                  0.0
46.                  )
47.         (vla-getboundingbox
48.           (vlax-ename->vla-object (entlast))
49.           'p1
50.           'p2
51.           )
52.         (setq p1     (vlax-safearray->list p1)
53.               p2     (vlax-safearray->list p2)
54.               xht    (+ xht (abs (car (mapcar '- p2 p1))) 1000)
55.               blname (cdr (assoc 2 (entget (entlast))))
56.               )
57.         (setq ptl (cons (abs (cadr (mapcar '- p2 p1))) ptl))
58.         (command ".explode" (entlast) "")
59.         (command "-purge" "Block" blname "N")
60.         )
61.       )
62.     )
63.   (setvar "osmode" oldos)
64.   (princ)
65.   )
66.  
67. (defun c:exf ( / filenamevalid getboundingbox ss2ent dxf gettag entbl blname taglst index tag ss lst e f fh ) ;;;EXtract Files by Nguyen Hoanh
68.   (defun filenamevalid (str)
69.     (vl-list->string
70.       (vl-remove-if
71.         '(lambda (x) (member x (vl-string->list "\\/:?>|")))
72.         (vl-string->list str)
73.         )
74.       )
75.     )
76.   (defun getboundingbox ( ent / p1 p2 )
77.     (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
78.     (list (setq p1 (vlax-safearray->list p1))
79.           (setq p2 (vlax-safearray->list p2))
80.           )
81.     )
82.   (defun ss2ent ( ss / sodt index ent lstent )
83.     (setq sodt  (if ss
84.                   (sslength ss)
85.                   0
86.                   )
87.           index 0
88.           )
89.     (repeat sodt
90.       (setq ent    (ssname ss index)
91.             index  (1+ index)
92.             lstent (cons ent lstent)
93.             )
94.       )
95.     (reverse lstent)
96.     )
97.   (defun dxf ( ent code ) (cdr (assoc code (entget ent))))
98.   (defun gettag ( ent / entbl lst )
99.     (setq entbl ent)
100.     (while (and (setq entbl (entnext entbl))
101.                 (= (dxf entbl 0) "ATTRIB")
102.                 )
103.       (setq lst (append lst (list (cons (dxf entbl 2) (dxf entbl 1)))))
104.       )
105.     lst
106.     )
107.   (setq entbl  (car (entsel "\nHay pick vao block khung ten"))
108.         blname (dxf entbl 2)
109.         taglst (gettag entbl)
110.         index  0
111.         )
112.   (princ "\nCac tag trong block:")
113.   (foreach pp taglst
114.     (princ (strcat "\n" (itoa index) ": " (car pp)))
115.     (setq index (1+ index))
116.     )
117.   (textscr)
118.   (setq
119.     tag (car
120.           (nth (getint "\nHay nhan 0,1,2... de chon tag: ") taglst)
121.           )
122.     )
123.   (graphscr)
124.   (command ".zoom" "e")
125.   (setq oldos (getvar "osmode"))
126.   (setvar "osmode" 0)
127.   (setq ss  (ssget "x" (list (cons 0 "INSERT") (cons 2 blname)))
128.         lst (ss2ent ss)
129.         lst (mapcar '(lambda (e)
130.                        (append (list e (cdr (assoc tag (gettag e))))
131.                                (getboundingbox e)
132.                                )
133.                        )
134.                     lst
135.                     )
136.         )
137.   (foreach pp lst
138.     (setq e  (nth 0 pp)
139.           f  (strcat (getvar "dwgprefix")
140.                      (filenamevalid (nth 1 pp))
141.                      ".dwg"
142.                      )
143.           p1 (nth 2 pp)
144.           p2 (nth 3 pp)
145.           ss (ssget "_w" p1 p2)
146.           ss (ssadd e ss)
147.           )
148.     (command ".wblock" f)
149.     (if (setq fh (open f "r"))
150.       (progn (close fh) (command "y"))
151.       )
152.     (command "" p1 ss "")
153.     (command ".oops")
154.     )
155.   (setvar "osmode" oldos)
156.   (command ".zoom" "p")
157.   (princ)
158.   )
159.  

HTH.
Regards, M.R.

[hcbn1997]

Here, try this mod., but I am unsure - it's untested, but should work...

Code - Auto/Visual Lisp: [Select]

1. (defun c:imf ( / pathname filelist p xht yht oldos k p1 p2 blname ptl ) ;;;Insert Multi Files by Nguyen Hoanh ( bo tat ca ban ve vao 1 file rieng, roi nhan lenh, chon ban ve dau tien )
2.   (setq pathname (vl-filename-directory
3.                    (getfiled "Hay chon file dwg bat ky thuoc thu muc" "" "dwg" 0)
4.                    )
5.         filelist (vl-sort (vl-directory-files pathname "*.dwg") '<)
6.         p        (getpoint "\nDiem chen: ")
7.         xht      (car p)
8.         yht      (cadr p)
9.         )
10.   (setq oldos (getvar "osmode"))
11.   (setvar "osmode" 0)
12.   (setq k 0)
13.   (foreach filename filelist
14.     (setq k (1+ k))
15.     (if (/= 0 (rem k 11))
16.       (progn
17.         (command "-insert"
18.                  (strcat pathname "/" filename)
19.                  (list xht yht)
20.                  1.0
21.                  1.0
22.                  0.0
23.                  )
24.         (vla-getboundingbox
25.           (vlax-ename->vla-object (entlast))
26.           'p1
27.           'p2
28.           )
29.         (setq p1     (vlax-safearray->list p1)
30.               p2     (vlax-safearray->list p2)
31.               xht    (+ xht (abs (car (mapcar '- p2 p1))) 1000)
32.               blname (cdr (assoc 2 (entget (entlast))))
33.               )
34.         (setq ptl (cons (abs (cadr (mapcar '- p2 p1))) ptl))
35.         (command ".explode" (entlast) "")
36.         (command "-purge" "Block" blname "N")
37.         )
38.       (progn
39.         (setq k (1+ k) xht (car p) yht (+ yht (car (vl-sort ptl '>)) 5000) ptl nil)
40.         (command "-insert"
41.                  (strcat pathname "/" filename)
42.                  (list xht yht)
43.                  1.0
44.                  1.0
45.                  0.0
46.                  )
47.         (vla-getboundingbox
48.           (vlax-ename->vla-object (entlast))
49.           'p1
50.           'p2
51.           )
52.         (setq p1     (vlax-safearray->list p1)
53.               p2     (vlax-safearray->list p2)
54.               xht    (+ xht (abs (car (mapcar '- p2 p1))) 1000)
55.               blname (cdr (assoc 2 (entget (entlast))))
56.               )
57.         (setq ptl (cons (abs (cadr (mapcar '- p2 p1))) ptl))
58.         (command ".explode" (entlast) "")
59.         (command "-purge" "Block" blname "N")
60.         )
61.       )
62.     )
63.   (setvar "osmode" oldos)
64.   (princ)
65.   )
66.  
67. (defun c:exf ( / filenamevalid getboundingbox ss2ent dxf gettag entbl blname taglst index tag ss lst e f fh ) ;;;EXtract Files by Nguyen Hoanh
68.   (defun filenamevalid (str)
69.     (vl-list->string
70.       (vl-remove-if
71.         '(lambda (x) (member x (vl-string->list "\\/:?>|")))
72.         (vl-string->list str)
73.         )
74.       )
75.     )
76.   (defun getboundingbox ( ent / p1 p2 )
77.     (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
78.     (list (setq p1 (vlax-safearray->list p1))
79.           (setq p2 (vlax-safearray->list p2))
80.           )
81.     )
82.   (defun ss2ent ( ss / sodt index ent lstent )
83.     (setq sodt  (if ss
84.                   (sslength ss)
85.                   0
86.                   )
87.           index 0
88.           )
89.     (repeat sodt
90.       (setq ent    (ssname ss index)
91.             index  (1+ index)
92.             lstent (cons ent lstent)
93.             )
94.       )
95.     (reverse lstent)
96.     )
97.   (defun dxf ( ent code ) (cdr (assoc code (entget ent))))
98.   (defun gettag ( ent / entbl lst )
99.     (setq entbl ent)
100.     (while (and (setq entbl (entnext entbl))
101.                 (= (dxf entbl 0) "ATTRIB")
102.                 )
103.       (setq lst (append lst (list (cons (dxf entbl 2) (dxf entbl 1)))))
104.       )
105.     lst
106.     )
107.   (setq entbl  (car (entsel "\nHay pick vao block khung ten"))
108.         blname (dxf entbl 2)
109.         taglst (gettag entbl)
110.         index  0
111.         )
112.   (princ "\nCac tag trong block:")
113.   (foreach pp taglst
114.     (princ (strcat "\n" (itoa index) ": " (car pp)))
115.     (setq index (1+ index))
116.     )
117.   (textscr)
118.   (setq
119.     tag (car
120.           (nth (getint "\nHay nhan 0,1,2... de chon tag: ") taglst)
121.           )
122.     )
123.   (graphscr)
124.   (command ".zoom" "e")
125.   (setq oldos (getvar "osmode"))
126.   (setvar "osmode" 0)
127.   (setq ss  (ssget "x" (list (cons 0 "INSERT") (cons 2 blname)))
128.         lst (ss2ent ss)
129.         lst (mapcar '(lambda (e)
130.                        (append (list e (cdr (assoc tag (gettag e))))
131.                                (getboundingbox e)
132.                                )
133.                        )
134.                     lst
135.                     )
136.         )
137.   (foreach pp lst
138.     (setq e  (nth 0 pp)
139.           f  (strcat (getvar "dwgprefix")
140.                      (filenamevalid (nth 1 pp))
141.                      ".dwg"
142.                      )
143.           p1 (nth 2 pp)
144.           p2 (nth 3 pp)
145.           ss (ssget "_w" p1 p2)
146.           ss (ssadd e ss)
147.           )
148.     (command ".wblock" f)
149.     (if (setq fh (open f "r"))
150.       (progn (close fh) (command "y"))
151.       )
152.     (command "" p1 ss "")
153.     (command ".oops")
154.     )
155.   (setvar "osmode" oldos)
156.   (command ".zoom" "p")
157.   (princ)
158.   )
159.  

HTH.
Regards, M.R.

Oh, it works exactly as I described. That's great, thank you so much for your help.
But one thing I hope the fix helps with is the merge sequence. Your code will merge from bottom to top but I would like it to merge from top to bottom.
For example, if there are 23 drawings, your current lisp's first row will have 3 drawings and the next 2 rows will have 10 drawings. What I want is that the first and second rows have 10 drawings and the third row has 3 drawings. The order from top to bottom I think will be easier to follow.
Looking forward to receiving your further help!

[ribarm]

OK, just change line 39 from this :
        (setq k (1+ k) xht (car p) yht (+ yht (car (vl-sort ptl '>)) 5000) ptl nil)
to this :
        (setq k (1+ k) xht (car p) yht (- yht (car (vl-sort ptl '>)) 5000) ptl nil)

Plus, you'll have to change sysvar "BASE" to be top-left point to all DWG files...
So maybe better is to leave like it was from bottom-left to top-right sorting of DWG files - and line 39 with that "+"

[ribarm]

Or even better... BASE should stay on 0,0,0 for every drawing, just make sure that extends lower left point of drawn title blocks is 0,0,0...
I've modified line 40 and added lines 35 and 59

Code - Auto/Visual Lisp: [Select]

1. (defun c:imf ( / pathname filelist p xht yht oldos k p1 p2 blname ptl ) ;;;Insert Multi Files by Nguyen Hoanh ( bo tat ca ban ve vao 1 file rieng, roi nhan lenh, chon ban ve dau tien )
2.   (setq pathname (vl-filename-directory
3.                    (getfiled "Hay chon file dwg bat ky thuoc thu muc" "" "dwg" 0)
4.                    )
5.         filelist (vl-sort (vl-directory-files pathname "*.dwg") '<)
6.         p        (getpoint "\nDiem chen: ")
7.         xht      (car p)
8.         yht      (cadr p)
9.         )
10.   (setq oldos (getvar "osmode"))
11.   (setvar "osmode" 0)
12.   (setq k 0)
13.   (foreach filename filelist
14.     (setq k (1+ k))
15.     (if (/= 0 (rem k 11))
16.       (progn
17.         (command "-insert"
18.                  (strcat pathname "/" filename)
19.                  (list xht yht)
20.                  1.0
21.                  1.0
22.                  0.0
23.                  )
24.         (vla-getboundingbox
25.           (vlax-ename->vla-object (entlast))
26.           'p1
27.           'p2
28.           )
29.         (setq p1     (vlax-safearray->list p1)
30.               p2     (vlax-safearray->list p2)
31.               xht    (+ xht (abs (car (mapcar '- p2 p1))) 1000)
32.               blname (cdr (assoc 2 (entget (entlast))))
33.               )
34.         (setq ptl (cons (abs (cadr (mapcar '- p2 p1))) ptl))
35.         (command ".move" (entlast) "" (list 0.0 0.0 0.0) (list 0.0 (- (car ptl)) 0.0))
36.         (command ".explode" (entlast) "")
37.         (command "-purge" "Block" blname "N")
38.         )
39.       (progn
40.         (setq k (1+ k) xht (car p) yht (- yht (car (vl-sort ptl '>)) 5000) ptl nil)
41.         (command "-insert"
42.                  (strcat pathname "/" filename)
43.                  (list xht yht)
44.                  1.0
45.                  1.0
46.                  0.0
47.                  )
48.         (vla-getboundingbox
49.           (vlax-ename->vla-object (entlast))
50.           'p1
51.           'p2
52.           )
53.         (setq p1     (vlax-safearray->list p1)
54.               p2     (vlax-safearray->list p2)
55.               xht    (+ xht (abs (car (mapcar '- p2 p1))) 1000)
56.               blname (cdr (assoc 2 (entget (entlast))))
57.               )
58.         (setq ptl (cons (abs (cadr (mapcar '- p2 p1))) ptl))
59.         (command ".move" (entlast) "" (list 0.0 0.0 0.0) (list 0.0 (- (car ptl)) 0.0))
60.         (command ".explode" (entlast) "")
61.         (command "-purge" "Block" blname "N")
62.         )
63.       )
64.     )
65.   (setvar "osmode" oldos)
66.   (princ)
67.   )
68.  
69. (defun c:exf ( / filenamevalid getboundingbox ss2ent dxf gettag entbl blname taglst index tag ss lst e f fh ) ;;;EXtract Files by Nguyen Hoanh
70.   (defun filenamevalid (str)
71.     (vl-list->string
72.       (vl-remove-if
73.         '(lambda (x) (member x (vl-string->list "\\/:?>|")))
74.         (vl-string->list str)
75.         )
76.       )
77.     )
78.   (defun getboundingbox ( ent / p1 p2 )
79.     (vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
80.     (list (setq p1 (vlax-safearray->list p1))
81.           (setq p2 (vlax-safearray->list p2))
82.           )
83.     )
84.   (defun ss2ent ( ss / sodt index ent lstent )
85.     (setq sodt  (if ss
86.                   (sslength ss)
87.                   0
88.                   )
89.           index 0
90.           )
91.     (repeat sodt
92.       (setq ent    (ssname ss index)
93.             index  (1+ index)
94.             lstent (cons ent lstent)
95.             )
96.       )
97.     (reverse lstent)
98.     )
99.   (defun dxf ( ent code ) (cdr (assoc code (entget ent))))
100.   (defun gettag ( ent / entbl lst )
101.     (setq entbl ent)
102.     (while (and (setq entbl (entnext entbl))
103.                 (= (dxf entbl 0) "ATTRIB")
104.                 )
105.       (setq lst (append lst (list (cons (dxf entbl 2) (dxf entbl 1)))))
106.       )
107.     lst
108.     )
109.   (setq entbl  (car (entsel "\nHay pick vao block khung ten"))
110.         blname (dxf entbl 2)
111.         taglst (gettag entbl)
112.         index  0
113.         )
114.   (princ "\nCac tag trong block:")
115.   (foreach pp taglst
116.     (princ (strcat "\n" (itoa index) ": " (car pp)))
117.     (setq index (1+ index))
118.     )
119.   (textscr)
120.   (setq
121.     tag (car
122.           (nth (getint "\nHay nhan 0,1,2... de chon tag: ") taglst)
123.           )
124.     )
125.   (graphscr)
126.   (command ".zoom" "e")
127.   (setq oldos (getvar "osmode"))
128.   (setvar "osmode" 0)
129.   (setq ss  (ssget "x" (list (cons 0 "INSERT") (cons 2 blname)))
130.         lst (ss2ent ss)
131.         lst (mapcar '(lambda (e)
132.                        (append (list e (cdr (assoc tag (gettag e))))
133.                                (getboundingbox e)
134.                                )
135.                        )
136.                     lst
137.                     )
138.         )
139.   (foreach pp lst
140.     (setq e  (nth 0 pp)
141.           f  (strcat (getvar "dwgprefix")
142.                      (filenamevalid (nth 1 pp))
143.                      ".dwg"
144.                      )
145.           p1 (nth 2 pp)
146.           p2 (nth 3 pp)
147.           ss (ssget "_w" p1 p2)
148.           ss (ssadd e ss)
149.           )
150.     (command ".wblock" f)
151.     (if (setq fh (open f "r"))
152.       (progn (close fh) (command "y"))
153.       )
154.     (command "" p1 ss "")
155.     (command ".oops")
156.     )
157.   (setvar "osmode" oldos)
158.   (command ".zoom" "p")
159.   (princ)
160.   )
161.  

[hcbn1997]

It's great, exactly what I need.
 Thank you so much!!!