图纸合并源码--待改善

lengxiaxi

2. (defun c:hbtz (/ tzml filelst i x y pmax pmin zx ys dx dy cdy dwg fn fd)
   
3.   (vl-load-com)
   
4.   (defun browseforfolder (msg / shfolder path catchit)
   
5.     (setq shfolder (vlax-invoke-method (vlax-create-object "Shell.Application")
   
6.                                        'browseforfolder
   
7.                                        (vlax-get-property
   
8.                                                           (vlax-get-acad-object)
   
9.                                                           'hwnd
   
10.                                        ) msg 1
    
11.                    )
    
12.           catchit (vl-catch-all-apply '(lambda ()
    
13.                                          (setq shfolder
    
14.                                                (vlax-get-property shfolder
    
15.                                                                   'self
    
16.                                                )
    
17.                                                path
    
18.                                                (vlax-get-property shfolder
    
19.                                                                   'path
    
20.                                                )
    
21.                                          )
    
22.                                        )
    
23.                   )
    
24.     )
    
25.     (if (vl-catch-all-error-p catchit)
    
26.       nil
    
27.       path
    
28.     )
    
29.   )
    
30.   (setq tzml (browseforfolder "选择文件路径"))
    
31.   (if (/= (substr tzml (strlen tzml)) "\")
    
32.     (setq tzml (strcat tzml "\"))
    
33.   )
    
34.   (setq filelst (vl-directory-files tzml "*.dwg" 1))
    
35.   (setq filelst (acad_strlsort filelst)
    
36.         i -1
    
37.         x 0
    
38.         y 0
    
39.         cdy 0
    
40.   )
    
41.   (setq fn (getint "\n[每行文件数量]<1>:"))
    
42.   (if (not fn)
    
43.     (setq fn 1)
    
44.   )
    
45.   (setq fd (getreal "\n[文件间距]<100>:"))
    
46.   (if (not fd)
    
47.     (setq fd 100)
    
48.   )
    
49.   (setvar "osmode" 0)
    
50.   (setvar "attreq" 0)
    
51.   (setvar "cmdecho" 0)
    
52.   (command "ucs" "")
    
53.   (while (setq dwg (nth (setq i (1+ i))
    
54.                         filelst
    
55.                    )
    
56.          )
    
57.     (prompt (strcat "\n" dwg))
    
58.     (command "insert" (strcat tzml dwg) (list 0 0) "" "" "")
    
59.     (vla-getboundingbox (vlax-ename->vla-object (entlast)) 'mi 'ma)
    
60.     (setq pmax (vlax-safearray->list ma)
    
61.           pmin (vlax-safearray->list mi)
    
62.     )
    
63.     (setq zx (list (car pmin) (cadr pmin))
    
64.           ys (list (car pmax) (cadr pmax))
    
65.     )
    
66.     (setq dwg (entlast))
    
67.     (command "rectangle" pmin pmax)
    
68.     (command "change" (entlast) "" "P" "C" "1" "")
    
69.     (command "move" dwg (entlast) "" (list (car zx) (cadr ys))
    
70.              (list x y)
    
71.     )
    
72.     (setq dy (- (cadr ys) (cadr zx))
    
73.           dx (- (car ys) (car zx))
    
74.     )
    
75.     (if (> dy cdy)
    
76.       (setq cdy dy)
    
77.     )
    
78.     (if (= (rem (1+ i) fn) 0)
    
79.       (setq x 0
    
80.             y (- y cdy fd)
    
81.             cdy 0
    
82.       )
    
83.       (setq x (+ x dx fd))
    
84.     )
    
85.   )
    
86.   (princ)
    
87. )

(defun c:hbtz (/ tzml filelst i x y pmax pmin zx ys dx dy cdy dwg fn fd)<br />   (vl-load-com)<br />   (defun browseforfolder (msg / shfolder path catchit)<br />     (setq shfolder (vlax-invoke-method (vlax-create-object "Shell.Application")<br />                                        'browseforfolder<br />                                        (vlax-get-property<br />                                                           (vlax-get-acad-object)<br />                                                           'hwnd<br />                                        ) msg 1<br />                    )<br />           catchit (vl-catch-all-apply '(lambda ()<br />                                          (setq shfolder<br />                                                (vlax-get-property shfolder<br />                                                                   'self<br />                                                )<br />                                                path<br />                                                (vlax-get-property shfolder<br />                                                                   'path<br />                                                )<br />                                          )<br />                                        )<br />                   )<br />     )<br />     (if (vl-catch-all-error-p catchit)<br />       nil<br />       path<br />     )<br />   )<br />   (setq tzml (browseforfolder "选择文件路径"))<br />   (if (/= (substr tzml (strlen tzml)) "\")<br />     (setq tzml (strcat tzml "\"))<br />   )<br />   (setq filelst (vl-directory-files tzml "*.dwg" 1))<br />   (setq filelst (acad_strlsort filelst)<br />         i -1<br />         x 0<br />         y 0<br />         cdy 0<br />   )<br />   (setq fn (getint "\n[每行文件数量]<1>:"))<br />   (if (not fn)<br />     (setq fn 1)<br />   )<br />   (setq fd (getreal "\n[文件间距]<100>:"))<br />   (if (not fd)<br />     (setq fd 100)<br />   )<br />   (setvar "osmode" 0)<br />   (setvar "attreq" 0)<br />   (setvar "cmdecho" 0)<br />   (command "ucs" "")<br />   (while (setq dwg (nth (setq i (1+ i))<br />                         filelst<br />                    )<br />          )<br />     (prompt (strcat "\n" dwg))<br />     (command "insert" (strcat tzml dwg) (list 0 0) "" "" "")<br />     (vla-getboundingbox (vlax-ename->vla-object (entlast)) 'mi 'ma)<br />     (setq pmax (vlax-safearray->list ma)<br />           pmin (vlax-safearray->list mi)<br />     )<br />     (setq zx (list (car pmin) (cadr pmin))<br />           ys (list (car pmax) (cadr pmax))<br />     )<br />     (setq dwg (entlast))<br />     (command "rectangle" pmin pmax)<br />     (command "change" (entlast) "" "P" "C" "1" "")<br />     (command "move" dwg (entlast) "" (list (car zx) (cadr ys))<br />              (list x y)<br />     )<br />     (setq dy (- (cadr ys) (cadr zx))<br />           dx (- (car ys) (car zx))<br />     )<br />     (if (> dy cdy)<br />       (setq cdy dy)<br />     )<br />     (if (= (rem (1+ i) fn) 0)<br />       (setq x 0<br />             y (- y cdy fd)<br />             cdy 0<br />       )<br />       (setq x (+ x dx fd))<br />     )<br />   )<br />   (princ)<br /> )

这段代码，如何加入(command "_explode" "all" "")，使得插入前，分解每一个图块和标注样式；最好是重命名块和标注样式（随机名字也可以）

zhangrunze

感谢分享，也遇见这个问题了~
存档备用学习~

panliang9

合并后的效果应该是这样的。

XPG

感谢分享。