如何将多个DWG文件图纸自动导入一个DWG文件中？

meflying

这些文件过程的实现不是问题，问题是怎么才能确定哪个是一个图框，自动把图框选择出来，因为要搜索整个图形，而你的图框仅仅是简单的直线，我搜索到直线时无法判断这是图框的直线，还是你图形中的直线。。。为什么你的图框就这么简单？


现在只能给你做个半自动的，就是你的图必须按你导入的规则排列好的，然后输入一些距离和大小的参数来计算所有图框的位置，如果你的图框及排列跟图中的一样，而且是固定不变的话（数量可以变化），就好办些

123abc

meflying老师： 我的图形都是和28楼附件中的图形图框一样的，而且位置都是一成不变的，大小也是一样的，只要用各个图框的对角点确定选择图形范围即可。 其实我的图形中的图框都是在图框层中的，但我只要求能用固定的位置确定图形范围即可。 在编程时，一切图框位置、大小按28楼附件即可。 谢谢

meflying

2. (defun c:em( / str_pre ss_lst Newdoc Doc i m path pt pt1 pt2 ss Sels pt_temp)
3.    (setq m t)
4.    (setq i 0)
5.    (setvar "cmdecho" 0)
6.    (setq path (GetFolder "e:\" "选择输出文件夹..."))
7.    (if (not path) (exit))
8.    (setq str_pre (getstring "文件规则(前缀):"))
9.    (setq pt (getpoint "选择起点:"))
10.    (setq NewDoc (vla-open (vla-get-documents (vlax-get-acad-object)) (getenv "LastTemplate")))
11.    (setq Doc (vla-get-activedocument (vlax-get-acad-object)))   
12.    (command "_.undo" "be")
13.    (while m
14.        (setq pt1 (polar pt 0 (* (rem i 5) 500.0)))
15.        (setq pt1 (polar pt1 (* 1.5 pi) (* (/ i 5) 400.0)))
16.        (setq pt_temp pt1)
17.        (setq pt2 (list (+ (car pt1) 346) (- (cadr pt1) 245)))
18.        (setq pt1 (polar pt1 (angle pt2 pt1) 2) pt2 (polar pt2 (angle pt1 pt2) 2))
19.        (command "_.zoom" "w" pt1 pt2 )
20.        (setq ss (ssget "_C" pt1 pt2))
21.        (princ "\n")
22.        (if ss
23.            (Emas ss Doc NewDoc (GetFilename path str_pre i))
24.            (setq m nil)
25.        )
26.        (setq i (1+ i))
27.    );while
28.    (vla-close NewDoc)
29.    (command "_.undo" "e")
30.    (command "_.u")
31.    (princ)
32. )(defun Emas(ss Doc NewDoc filename / i n ss_lst ssv ent New obj)
33.    (vlax-for obj (vla-get-modelspace NewDoc)
34.        (vla-delete obj)
35.    )
36.    (vla-saveas NewDoc filename acR15_DWG)
37.    (setq i 0 n (sslength ss))
38.    (setq ssv (vlax-make-safearray vlax-vbobject (cons 0 (1- n))))
39.    (repeat n
40.        (setq ent (ssname ss i))
41.        (vlax-safearray-put-element ssv i (vlax-ename->vla-object ent))
42.        (setq i (1+ i))
43.    )
44.    (vla-copyobjects Doc ssv (vla-get-modelspace NewDoc))
45.    (vlax-for obj (vla-get-modelspace NewDoc)
46.        (vla-move obj (vlax-3d-point (polar pt_temp (* 1.5 pi) 246.0)) (vlax-3d-point '(0 0 0)))
47.    )   
48.    (vla-save NewDoc)
49. )
50. (defun GetFilename(path pre i /)
51.    (if (< i 10)
52.        (setq i (strcat "0" (itoa (1+ i))))
53.        (setq i (itoa (1+ i)))
54.    )
55.    (strcat path pre i)
56. )(defun GetFolder(path msg / dcl_id Act Files ns Devices Directories path R
57.      Load_dlg GetDevs Get_Files Getfiles GetParantPath fill_pop Fill_All Act_Dev Act_Dir)
58.    (defun Load_dlg( msg / dcl_id f filename)
59.        (setq filename (strcat (getenv "TMP") "GetFilesDialog.dcl"))
60.        (setq f (open filename "w"))
61.        (write-line "GetFileDialog:dialog{" f)
62.        (write-line (strcat "label ="" msg "";") f)
63.        (write-line ":text {label = ""; key = "name";}" f)
64.        (write-line ":list_box {label = "路径:"; key = "dir"; fixed_height = true; height = 16; fixed_width = true; width = 30;}" f)
65.        (write-line ":popup_list {label = "驱动器:"; key = "dev";}" f)
66.        (write-line "ok_cancel;}" f)
67.        (close f)
68.        (if (< (setq dcl_id (load_dialog filename)) 0) (exit))
69.        (vl-file-delete filename)
70.        dcl_id
71.    )
72.    (defun GetDevs (/ i Device Devs)
73.        (setq i 67)
74.        (while (vl-directory-files (setq Device (strcat (chr i) ":")))
75.            (setq Devs (append Devs (list Device)))
76.            (setq i (1+ i))
77.        )
78.        Devs
79.    )
80.    
81.    (defun Getfiles(path ftype flag / Files)
82.        (setq Files (vl-directory-files path ftype flag))
83.        (if Files
84.            (setq Files (acad_strlsort Files))
85.        )
86.        (vl-remove "." Files)
87.    )
88.    (defun GetParantPath (path)
89.        (setq i 0)
90.        (setq n (strlen path))
91.        (while (/= (substr path (- n i) 1) "\")
92.            (setq i (1+ i))
93.        )
94.        (setq i (1+ i))
95.        (substr path 1 (- n i))
96.    )
97.    (defun fill_pop(key lst)
98.        (start_list key)
99.        (mapcar 'add_list lst)
100.        (end_list)
101.    )
102.    (defun Fill_All(path / dirs Files)
103.        (fill_pop "dir" (GetFiles path nil -1))
104.    )
105.    (defun Act_Dev(n Devices / Dev)
106.        (setq Dev (nth n Devices))
107.        (Fill_All Dev)
108.        (set_tile "name" Dev)
109.        Dev
110.    )
111.    (defun Act_Dir(n path / folder)
112.        (setq folder (nth n (GetFiles path nil -1)))
113.        (if (= folder "..")
114.            (setq path (getParantPath path))
115.            (setq path (strcat path "\" folder))
116.        )
117.        (set_tile "name" path)
118.        (fill_all path)
119.        path
120.    )
121.    (if (= (substr path (strlen path) 1) "\")
122.        (setq path (substr path 1 (- (strlen path) 1)))
123.    )
124.    (setq dcl_id (Load_dlg msg))
125.    (if (not (new_dialog "GetFileDialog" dcl_id)) (exit))
126.    (setq Devices (GetDevs))
127.    (fill_pop "dev" Devices)
128.    (set_tile "dev" (itoa (vl-position (strcase (substr path 1 2)) Devices)))
129.    (Fill_All path)
130.    (set_tile "name" path)
131.    (action_tile "dev" "(setq path (Act_Dev (atoi $value) Devices))")
132.    (action_tile "dir" "(setq path (Act_Dir (atoi $value) path))")
133.    (action_tile "accept" "(setq ns (get_tile "name")) (done_dialog 1)")
134.    (setq Act (start_dialog))
135.    (unload_dialog dcl_id)
136.    (if ns (strcat ns "\"))
137. )

(defun c:em( / str_pre ss_lst Newdoc Doc i m path pt pt1 pt2 ss Sels pt_temp)    (setq m t)    (setq i 0)    (setvar "cmdecho" 0)    (setq path (GetFolder "e:\" "选择输出文件夹..."))    (if (not path) (exit))    (setq str_pre (getstring "文件规则(前缀):"))    (setq pt (getpoint "选择起点:"))    (setq NewDoc (vla-open (vla-get-documents (vlax-get-acad-object)) (getenv "LastTemplate")))    (setq Doc (vla-get-activedocument (vlax-get-acad-object)))       (command "_.undo" "be")    (while m        (setq pt1 (polar pt 0 (* (rem i 5) 500.0)))        (setq pt1 (polar pt1 (* 1.5 pi) (* (/ i 5) 400.0)))        (setq pt_temp pt1)        (setq pt2 (list (+ (car pt1) 346) (- (cadr pt1) 245)))        (setq pt1 (polar pt1 (angle pt2 pt1) 2) pt2 (polar pt2 (angle pt1 pt2) 2))        (command "_.zoom" "w" pt1 pt2 )        (setq ss (ssget "_C" pt1 pt2))        (princ "\n")        (if ss            (Emas ss Doc NewDoc (GetFilename path str_pre i))            (setq m nil)        )        (setq i (1+ i))    );while    (vla-close NewDoc)    (command "_.undo" "e")    (command "_.u")    (princ) )(defun Emas(ss Doc NewDoc filename / i n ss_lst ssv ent New obj)    (vlax-for obj (vla-get-modelspace NewDoc)        (vla-delete obj)    )    (vla-saveas NewDoc filename acR15_DWG)    (setq i 0 n (sslength ss))    (setq ssv (vlax-make-safearray vlax-vbobject (cons 0 (1- n))))    (repeat n        (setq ent (ssname ss i))        (vlax-safearray-put-element ssv i (vlax-ename->vla-object ent))        (setq i (1+ i))    )    (vla-copyobjects Doc ssv (vla-get-modelspace NewDoc))    (vlax-for obj (vla-get-modelspace NewDoc)        (vla-move obj (vlax-3d-point (polar pt_temp (* 1.5 pi) 246.0)) (vlax-3d-point '(0 0 0)))    )       (vla-save NewDoc) ) (defun GetFilename(path pre i /)    (if (< i 10)        (setq i (strcat "0" (itoa (1+ i))))        (setq i (itoa (1+ i)))    )    (strcat path pre i) )(defun GetFolder(path msg / dcl_id Act Files ns Devices Directories path R      Load_dlg GetDevs Get_Files Getfiles GetParantPath fill_pop Fill_All Act_Dev Act_Dir)    (defun Load_dlg( msg / dcl_id f filename)        (setq filename (strcat (getenv "TMP") "GetFilesDialog.dcl"))        (setq f (open filename "w"))        (write-line "GetFileDialog:dialog{" f)        (write-line (strcat "label ="" msg "";") f)        (write-line ":text {label = ""; key = "name";}" f)        (write-line ":list_box {label = "路径:"; key = "dir"; fixed_height = true; height = 16; fixed_width = true; width = 30;}" f)        (write-line ":popup_list {label = "驱动器:"; key = "dev";}" f)        (write-line "ok_cancel;}" f)        (close f)        (if (< (setq dcl_id (load_dialog filename)) 0) (exit))        (vl-file-delete filename)        dcl_id    )    (defun GetDevs (/ i Device Devs)        (setq i 67)        (while (vl-directory-files (setq Device (strcat (chr i) ":")))            (setq Devs (append Devs (list Device)))            (setq i (1+ i))        )        Devs    )        (defun Getfiles(path ftype flag / Files)        (setq Files (vl-directory-files path ftype flag))        (if Files            (setq Files (acad_strlsort Files))        )        (vl-remove "." Files)    )    (defun GetParantPath (path)        (setq i 0)        (setq n (strlen path))        (while (/= (substr path (- n i) 1) "\")            (setq i (1+ i))        )        (setq i (1+ i))        (substr path 1 (- n i))    )    (defun fill_pop(key lst)        (start_list key)        (mapcar 'add_list lst)        (end_list)    )    (defun Fill_All(path / dirs Files)        (fill_pop "dir" (GetFiles path nil -1))    )    (defun Act_Dev(n Devices / Dev)        (setq Dev (nth n Devices))        (Fill_All Dev)        (set_tile "name" Dev)        Dev    )    (defun Act_Dir(n path / folder)        (setq folder (nth n (GetFiles path nil -1)))        (if (= folder "..")            (setq path (getParantPath path))            (setq path (strcat path "\" folder))        )        (set_tile "name" path)        (fill_all path)        path    )    (if (= (substr path (strlen path) 1) "\")        (setq path (substr path 1 (- (strlen path) 1)))    )    (setq dcl_id (Load_dlg msg))    (if (not (new_dialog "GetFileDialog" dcl_id)) (exit))    (setq Devices (GetDevs))    (fill_pop "dev" Devices)    (set_tile "dev" (itoa (vl-position (strcase (substr path 1 2)) Devices)))    (Fill_All path)    (set_tile "name" path)    (action_tile "dev" "(setq path (Act_Dev (atoi $value) Devices))")    (action_tile "dir" "(setq path (Act_Dir (atoi $value) path))")    (action_tile "accept" "(setq ns (get_tile "name")) (done_dialog 1)")    (setq Act (start_dialog))    (unload_dialog dcl_id)    (if ns (strcat ns "\")) )

123abc

谢谢meflying老师！ 我家里机子是win98+CAD2000，现在运行出现以下错误： Command: em
文件规则(前缀):ttt
选择起点:; error: ActiveX Server returned an error: 参数不可选。 我单位机子是winXP+CAD2004，我明天在单位再试试。 第二行程序：(setq m t)
不知什么意思，“t”代表什么？是什么值？

123abc

六楼程序，程序前面加上(vl-load-com)后，
在WIN98+Acad2000机子上，现在运行出现以下错误： Command: im
Usage: (acad_strlsort <list of strings>)
; error: bad argument type: stringp nil 在winXP+CAD2004机子上运行正常。

meflying

33楼的程序已经稍加改动，你再看看，如果不行，再试试将acR15_DWG改为ac2000_dwg


35楼的问题已经讨论过了啊，怎么又来讨论？这次的错误跟上次是不一样的，应该跟系统版本无关，可能CAD的版本有些问题

123abc

真的非常感激meflying老师！你的程序真是太棒了，我在ACAD2004下用非常好， 如有可能一定找机会请你客。 还有一个小要求： 能否将新图的图框左下角都放在原点（0,0）点，再次谢谢您！

meflying

已改好

123abc

我的原图都用如下程序加了标识，meflying老师，你能在新导出的图形中也用以下程序加上标识吗？否则，我的一些需要验证标识的程序在新图中无法运行。 (defun reg(ty)
(vl-load-com)
(vlax-ldata-put "mydict" "mykey" ty T)
(princ (strcat "已将图纸标识为" ty "\n"))
(princ)
)
(defun com()
(vl-load-com)
(vlax-ldata-get "mydict" "mykey" nil T)
) (defun c:tytyty (/ LYTAA001)
(vl-load-com)
(setq LYTAA001 (ssget "x")) (while (= LYTAA001 NIL) (princ)
(setq LYTAA001 8)
(reg "TYTYTY")
)
)

meflying

这样，只要在原文件有的东西，导出后都有了