批量将B文件夹内的每个DWG文件插入到A文件夹内的同名文件中

874185423

求助：有A B两个文件夹，A B文件夹内分别都有1 2 3 4.......DWG文件，要求将B文件夹内的1.DWG解块插入到A文件夹内的1.DWG文件（基点为0,0），依次类推.

byghbcx

1. (defun c:cn_dx(/ dir dir1 file n file$ newdoc dwgname);批量处理地图
   
2.     (defun qf_getFolder  (msg / WinShell shFolder path catchit)
   
3.       (vl-load-com)
   
4.       (setq winshell (vlax-create-object "Shell.Application"))
   
5.       (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
   
6.       (setq catchit
   
7.   (vl-catch-all-apply
   
8.     '(lambda ()
   
9.        (setq shFolder (vlax-get-property shFolder 'self))
   
10.        (setq path (vlax-get-property shFolder 'path))
    
11.        )
    
12.     )
    
13. )
    
14.       (if (vl-catch-all-error-p catchit)
    
15. nil
    
16. path
    
17. )
    
18.       )
    
19.   (vl-load-com)
    
20.   (setvar 'blipmode 0)
    
21.   (setvar 'cmdecho 0)
    
22.   (setq dir (qf_getFolder "请选择要批量处理文件所在文件夹" ))
    
23.   (setq dir1 (qf_getFolder "请选择要插入源图文件的文件夹" ))
    
24.   (setq file (vl-directory-files dir "*.dwg" 1) n 0)
    
25.   (repeat (length file)
    
26.     (setq file$ (nth n file))
    
27.     (setq dwgname (strcat dir "\\" file$))
    
28.     (setq newdoc (vla-open (vla-get-documents (vlax-get-acad-object)) dwgname));打开并获得档
    
29.     (vla-insertblock (vla-get-modelspace newdoc) (vlax-3d-point '(0 0 0)) (strcat dir1 "\\" file$) 1 1 1 0)
    
30.     (princ (strcat "\r正在处理地形图" dir "\\" file$))
    
31.     (vla-close newdoc :vlax-true);关闭另存档
    
32.     (setq n (1+ n))
    
33.     )
    
34.   (setvar 'cmdecho 1)
    
35.   (princ)
    
36. )
    

(defun c:cn_dx(/ dir dir1 file n file$ newdoc dwgname);批量处理地图<br />     (defun qf_getFolder  (msg / WinShell shFolder path catchit)<br />       (vl-load-com)<br />       (setq winshell (vlax-create-object "Shell.Application"))<br />       (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))<br />       (setq catchit<br />   (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 />   (vl-load-com)<br />   (setvar 'blipmode 0)<br />   (setvar 'cmdecho 0)<br />   (setq dir (qf_getFolder "请选择要批量处理文件所在文件夹" ))<br />   (setq dir1 (qf_getFolder "请选择要插入源图文件的文件夹" ))<br />   (setq file (vl-directory-files dir "*.dwg" 1) n 0)<br />   (repeat (length file)<br />     (setq file$ (nth n file))<br />     (setq dwgname (strcat dir "\\" file$))<br />     (setq newdoc (vla-open (vla-get-documents (vlax-get-acad-object)) dwgname));打开并获得档<br />     (vla-insertblock (vla-get-modelspace newdoc) (vlax-3d-point '(0 0 0)) (strcat dir1 "\\" file$) 1 1 1 0)<br />     (princ (strcat "\r正在处理地形图" dir "\\" file$))<br />     (vla-close newdoc :vlax-true);关闭另存档<br />     (setq n (1+ n))<br />     )<br />   (setvar 'cmdecho 1)<br />   (princ)<br /> )<br />

shalei021647

唉，这个用处好像不大啊，如果你有编辑那么多不同的块的时间，顺手就把他插到图形中算了

czb203

希望高手能尽快解决啊 谢谢

874185423

shalei021647 发表于 2011-11-17 15:07
唉，这个用处好像不大啊，如果你有编辑那么多不同的块的时间，顺手就把他插到图形中算了

主要用于测绘中的等高线处理，图形编辑与等高线是分开处理的，多个分幅图合在一起勾绘等高线，勾绘好后批量分幅，等高线分幅图与图形编辑分幅图合并成最终数据。

czb203

测试一下，真的还不错啊 谢谢啊

874185423

命令: appload
已成功加载 批量处理地图.lsp。
命令: ; 错误: 输入的列表有缺陷
命令:

byghbcx

874185423 发表于 2011-11-19 16:14
命令: appload
已成功加载 批量处理地图.lsp。
命令: ; 错误: 输入的列表有缺陷

哪里出错？试了一下，VLA-INSERTBLOCK好象不能插入分解块，把“*”号去掉，如需分解，加一句把刚插入的文件块炸一下。

874185423

多谢，可以正常使用，可能我昨天复制代码时没复制全

softbird

• (defun c:ctml(/ dir dir1 file n file$ newdoc dwgname);批量处理地图
•   (defun qf_getFolder  (msg / WinShell shFolder path catchit)
•     (vl-load-com)
•     (setq winshell (vlax-create-object "Shell.Application"))
•     (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
•     (setq catchit
•       (vl-catch-all-apply
•         '(lambda ()
•            (setq shFolder (vlax-get-property shFolder 'self))
•            (setq path (vlax-get-property shFolder 'path))
•          )
•       )
•     )
•     (if (vl-catch-all-error-p catchit)
•       nil
•       path
•     )
•   )
•   (vl-load-com)
•   (setvar 'blipmode 0)
•   (setvar 'cmdecho 0)
•   (setq dir (qf_getFolder "请选择要批量处理文件所在文件夹" ))
•   ;;(setq dir1 (qf_getFolder "请选择要插入源图文件的文件夹" ))
•   (setq file (vl-directory-files dir "*.dwg" 1) n 0)
•   (repeat (length file)
•     (setq file$ (nth n file))
•     (setq dwgname (strcat dir "\\" file$))
•     (setq newdoc (vla-open (vla-get-documents (vlax-get-acad-object)) dwgname));打开并获得档
•     (vla-insertblock (vla-get-modelspace newdoc) (vlax-3d-point '(0 0 0)) (strcat "d:\\源图\\" (substr file$ 1 13) ".dwg") 1 1 1 0)
•   ;(vla-insertblock (vla-get-modelspace newdoc) (vlax-3d-point (list (car (getvar "extmin"))(cadr (getvar "extmin")) 0.0)) (strcat "d:\\" (substr file$ 1 13) ".dwg") 1 1 1 0)
•     ;(list (car (getvar "extmin"))(cadr (getvar "extmin")) 0.0))这个得到的坐标不准确，偏离很远，不知道为什么？
•     (VLA-EXPLODE (vlax-ename->vla-object (entlast)))
•      (princ (strcat "\r正在处理地形图" dir "\\" file$))
•     (vla-close newdoc :vlax-true);关闭另存档
•     (setq n (1+ n))
•   )
•   (setvar 'cmdecho 1)
•   (princ)
• )
• ;请教一下;(VLA-EXPLODE (vlax-ename->vla-object (entlast)))－－这个炸不开？
  ;(list (car (getvar "extmin"))(cadr (getvar "extmin")) 0.0))这个得到的坐标不准确，偏离很远，不知道为什么？