[求助]CAD文件合并

杨张张

就是有2个文件夹
A文件夹（图名为1、2、3、4、5。。。）
B文件夹（图名为1、2、3、4、5。。。）；
就是将A文件夹与B文件夹中的同名图层原坐标合并，合并后的文件放在C文件夹（图名为1、2、3、4、5。。。）
以下收集的一个源码但有点不成熟，请高手帮忙修改。

• 

  2. (DEFUN C:pc ()
  3. (setq dsc (xuanzekuai))
  4. (setq ljm (xuanzewenjian))
  5. (setq selscr (strcat (getvar "TEMPPREFIX")"20140408.scr"));;创建CSR脚本语句
  6. ;;; 向脚本添加能识别的CSR语句；；；
  7. (setq txlist (vl-directory-files ljm "*.dwg"));;生成文件列表
  8. (setq i 0)
  10. (setq len (vl-list-length txlist));;读取文件个数
  11. (setq neirong (open selscr "w"))
  12. (repeat len
  13.    (setq tm (nth i txlist))
  14.    (setq str2 (strcat ljm "\\" tm));;打开文件路径
  15.    (setq str3 (strcat dsc "\\" tm));;插入块路径
  16.    (princ (strcat "open \"" str2 "\"\n"
  17.                  "-insert "  str3
  18.                 " 1 1 1 0 qsave \n"
  19.                  "close \n"
  20.                 )
  21.           neirong
  22.     )
  23.    (setq i (1+ i))
  24.   )
  25. ;;;;按文件数写入语句
  26. (close neirong)
  27. ;;;关闭脚本文件
  28. (command "._script" selscr);;;运行脚本
  29. (princ)
  30. )
  31. ;;;以下为选择需要打开的文件的子程序；；；
  32. (defun xuanzewenjian (/ obj folder path)
  33. (vl-load-com)
  34. (setq obj (vlax-create-object "Shell.Application"))
  35. (setq    folder (vlax-invoke-method
  36.                obj                 'browseforfolder
  37.                0                 "请指定要打开的DWG文件夹"
  38.                1
  39.               )
  40.   )
  41.   (if(vl-catch-all-error-p
  42.        (setq path (vl-catch-all-apply
  43.                    '(lambda
  44.                      ()
  45.                       (vlax-get-property
  46.                         (vlax-get-property folder 'self)
  47.                         'path
  48.                       )
  49.                     )
  50.                  )
  51.        )
  52.      )
  53.    nil
  54.    path
  55.   )
  56. )
  57. ;;;以下为选择块的文件的子程序；；；
  58. (defun xuanzekuai (/ obj folder path)
  59. (vl-load-com)
  60. (setq obj (vlax-create-object "Shell.Application"))
  61. (setq    folder (vlax-invoke-method
  62.                obj            'browseforfolder
  63.                0               "请指定要插入的DWG块文件夹"
  64.                1
  65.               )
  66.   )
  67.   (if(vl-catch-all-error-p
  68.        (setq path (vl-catch-all-apply
  69.                    '(lambda
  70.                      ()
  71.                       (vlax-get-property
  72.                         (vlax-get-property folder 'self)
  73.                        'path
  74.                       )
  75.                     )
  76.                  )
  77.        )
  78.      )
  79.    nil
  80.    path
  81.   )
  82. )
      

  <li>(DEFUN C:pc ()<li>(setq dsc (xuanzekuai))<li>(setq ljm (xuanzewenjian))<li>(setq selscr (strcat (getvar "TEMPPREFIX")"20140408.scr"));;创建CSR脚本语句<li>;;; 向脚本添加能识别的CSR语句；；；<li>(setq txlist (vl-directory-files ljm "*.dwg"));;生成文件列表<li>(setq i 0)<li><li>(setq len (vl-list-length txlist));;读取文件个数<li>(setq neirong (open selscr "w"))<li>(repeat len<li>   (setq tm (nth i txlist))<li>   (setq str2 (strcat ljm "\\" tm));;打开文件路径<li>   (setq str3 (strcat dsc "\\" tm));;插入块路径<li>   (princ (strcat "open \"" str2 "\"\n"<li>                 "-insert "  str3<li>                " 1 1 1 0 qsave \n"<li>                 "close \n"<li>                )<li>          neirong<li>    )<li>   (setq i (1+ i))<li>  )<li>;;;;按文件数写入语句<li>(close neirong)<li>;;;关闭脚本文件<li>(command "._script" selscr);;;运行脚本<li>(princ)<li>)<li>;;;以下为选择需要打开的文件的子程序；；；<li>(defun xuanzewenjian (/ obj folder path)<li>(vl-load-com)<li>(setq obj (vlax-create-object "Shell.Application"))<li>(setq    folder (vlax-invoke-method<li>               obj                 'browseforfolder<li>               0                 "请指定要打开的DWG文件夹"<li>               1<li>              )<li>  )<li>  (if(vl-catch-all-error-p<li>       (setq path (vl-catch-all-apply<li>                   '(lambda<li>                     ()<li>                      (vlax-get-property<li>                        (vlax-get-property folder 'self)<li>                        'path<li>                      )<li>                    )<li>                 )<li>       )<li>     )<li>   nil<li>   path<li>  )<li>)<li>;;;以下为选择块的文件的子程序；；；<li>(defun xuanzekuai (/ obj folder path)<li>(vl-load-com)<li>(setq obj (vlax-create-object "Shell.Application"))<li>(setq    folder (vlax-invoke-method<li>               obj            'browseforfolder<li>               0               "请指定要插入的DWG块文件夹"<li>               1<li>              )<li>  )<li>  (if(vl-catch-all-error-p<li>       (setq path (vl-catch-all-apply<li>                   '(lambda<li>                     ()<li>                      (vlax-get-property<li>                        (vlax-get-property folder 'self)<li>                       'path<li>                      )<li>                    )<li>                 )<li>       )<li>     )<li>   nil<li>   path<li>  )<li>)<br />

杨张张

补充：同名的CAD文件，文件里的图形不在同一坐标，需要原坐标合并

杨张张

没有人解答啊。。。。

杨张张

2. ;；；自定义函数，打开文件名
   
3. (defun try-getFolder (msg / WinShell shFolder path catchit)
   
4. (setq winshell (vlax-create-object "Shell.Application"))
   
5. (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
   
6. (setq catchit (vl-catch-all-apply
   
7.            '(lambda ()
   
8.              (setq shFolder (vlax-get-property shFolder 'self))
   
9.              (setq path (vlax-get-property shFolder 'path))
   
10.             )
    
11.           )
    
12. )
    
13. (if (vl-catch-all-error-p catchit)
    
14.   nil
    
15.   path
    
16. )
    
17. )
    
18. ;；；；；合并
    
19. (defun c:pltmhb (/ BANBEN DBX pathXZ pathgh pathgh FILESxz filesgh  I j DWGNAMExz dwgnamegh)
    
20.         (vl-load-com)
    
21.         (setq banben (substr (getvar "acadver") 1 2))
    
22.         ;版本2004-2006返回16,2007-2009返回17,2010-2012返回18,2013返回19
    
23.         (setq dbx (Vlax-Get-Or-Create-Object (strcat "ObjectDBX.AxDbDocument." banben)))
    
24.         (setq pathXZ (strcat (try-getFolder "\n 选择现状图所在文件夹名称：") "\"));文件夹路径       
    
25.         (setq filesxz (vl-directory-files pathXZ "*.dwg" 1)) ;获取所有文件名
    
26.         (setq pathGH (strcat (try-getFolder "\n 选择规划图所在文件夹名称：") "\"));文件夹路径       
    
27.         (setq filesgh (vl-directory-files pathGH "*.dwg" 1)) ;获取所有文件名
    
28.         (setq pathHB (strcat (try-getFolder "\n 选择合并后所在文件夹名称：") "\"));文件夹路径       
    
29.                
    
30.         (setq i -1)
    
31.         (while (setq dwgnamexz (nth (setq i (1+ i)) filesxz))
    
32.                      (vlax-invoke-method dbx 'open (strcat pathxz dwgnamexz))
    
33.                      (command-s "insert"  *(strcat pathgh dwgnamexz)"0,0" "1" "1" "0" )               
    
34.       
    
35.                       (vlax-invoke-method dbx 'SaveAs (strcat pathHB dwgnameXZ))
    
36.                
    
37.         )
    
38.         (vlax-release-object dbx);释放
    
39. )

;；；自定义函数，打开文件名<br /> (defun try-getFolder (msg / WinShell shFolder path catchit)<br /> (setq winshell (vlax-create-object "Shell.Application"))<br /> (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))<br /> (setq catchit (vl-catch-all-apply<br />            '(lambda ()<br />              (setq shFolder (vlax-get-property shFolder 'self))<br />              (setq path (vlax-get-property shFolder 'path))<br />             )<br />           )<br /> )<br /> (if (vl-catch-all-error-p catchit)<br />   nil<br />   path<br /> )<br /> )<br /> ;；；；；合并<br /> (defun c:pltmhb (/ BANBEN DBX pathXZ pathgh pathgh FILESxz filesgh  I j DWGNAMExz dwgnamegh)<br />         (vl-load-com)<br />         (setq banben (substr (getvar "acadver") 1 2))<br />         ;版本2004-2006返回16,2007-2009返回17,2010-2012返回18,2013返回19<br />         (setq dbx (Vlax-Get-Or-Create-Object (strcat "ObjectDBX.AxDbDocument." banben)))<br />         (setq pathXZ (strcat (try-getFolder "\n 选择现状图所在文件夹名称：") "\"));文件夹路径        <br />         (setq filesxz (vl-directory-files pathXZ "*.dwg" 1)) ;获取所有文件名<br />         (setq pathGH (strcat (try-getFolder "\n 选择规划图所在文件夹名称：") "\"));文件夹路径        <br />         (setq filesgh (vl-directory-files pathGH "*.dwg" 1)) ;获取所有文件名<br />         (setq pathHB (strcat (try-getFolder "\n 选择合并后所在文件夹名称：") "\"));文件夹路径        <br />                 <br />         (setq i -1)<br />         (while (setq dwgnamexz (nth (setq i (1+ i)) filesxz)) <br />                      (vlax-invoke-method dbx 'open (strcat pathxz dwgnamexz))<br />                      (command-s "insert"  *(strcat pathgh dwgnamexz)"0,0" "1" "1" "0" )                <br />       <br />                       (vlax-invoke-method dbx 'SaveAs (strcat pathHB dwgnameXZ))<br />                 <br />         )<br />         (vlax-release-object dbx);释放<br /> )

请大神帮助修改

杨张张

一直无人问啊