[求助]：有一个想法，不知能否实现。

Wildcat

关于利用AUTOCAD批量执行大量图纸。
举例说：
有Ｎ张图纸，图名为abc1、abc2、abc3……
希望对这些图纸进行相同的操作。

我的想法：
1、打开abc1
2、进行批量操作（如改颜色，换图层之类，每张图都一样）
3、存盘
4、打开下一个图

问题就出在4，如果图的数目多了，选起来是最多时间的。
能否利用DWGNAME和DWGPREFIX这两个变量，组合出下一个该打开的图纸名并打开，这样的话能节约很多很多的时间。

DWGNAME和DWGPREFIX反馈的是字符串（当前图名），能再+1吗？（下一个图名）
能实现吗？如果能实现该如何做？

XDSoft

可以用script实现

土土土

选中多个DWG文件
对选中的文件做循环
循环内是读入每一个DWG，并对每个DWG做你要做的事情。

Wildcat

我先自己查查script怎么用。

长清

最初由 Wildcat 发布
[B]关于利用AUTOCAD批量执行大量图纸。
举例说：
有Ｎ张图纸，图名为abc1、abc2、abc3……
希望对这些图纸进行相同的操作。

我的想法：
1、打开abc1
2、进行批量操作（如改颜色，换图层之类，每张图都一样）
3... [/B]

1  打开一张空图
2 手动选取或用程序选取某一目录所有文件。
3 依次把一个图作为图块插入，打碎，要进行PUERGE操作，然后进行你需要的操作，最后把文件存为引入块的文件名。
4 删除图上所有实体，插入另一个图形，重复3的步骤，直到完成所有的图形。

这样，可以避开在用script时的变量跟踪，实现自动处理一批图形。


注意：调试程序时必须线备份所有图纸，否则，可能丢失你的图纸。

Wildcat

用script执行命令正常，只有执行这个LSP不行。（打不开我想要的图纸）
SCR内容如下：
11
e:\abc2
11.lsp内容如下：
;;;
(defun c:11()
(defun *error*( msg / )
(setq *error* nil)
)
(c:c01)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c02)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c03)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c04)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c05)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c06)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c07)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c08)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c09)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c10)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c11)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c12)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c13)
(defun *error*( msg / )
(setq *error* nil)
)
(c:c14)
(c:c15)
(c:c16)
(c:c18)
(c:ze)
(c:c16)
(c:c17)
(setq *error* nil)
)
;;;----------------------------------------------------层6变黄色
(defun c:c02(/ s20)
  (Setq s20 (ssget "x" '((8 . "0"))))
  (command "change" s20 "" "p" "c" "1" "")  
)
;;;----------------------------------------------------层6变黄色
(defun c:c03(/ s11)
  (Setq s11 (ssget "x" '((8 . "6"))))
  (command "change" s11 "" "p" "la" "0" "")
  (command "change" s11 "" "p" "c" "2" "")  
)
;;;----------------------------------------------------层dim的text变黄色
(defun c:c05(/ ss1)
  (Setq ss1 (ssget "x" '((8 . "dim")(0 . "text"))))
  (command "change" ss1 "" "p" "la" "0" "")
  (command "change" ss1 "" "p" "c" "2" "")  
)
;;;----------------------------------------------------层text的text变黄色
(defun c:c04(/ ss2)
  (setq ss2 (ssget "x" '((8 . "text")(0 . "text"))))
  (command "change" ss2 "" "p" "c" "2" "")
  (command "change" ss2 "" "p" "la" "0" "")
)
;;;----------------------------------------------------层text紫色图元变深篮色
(defun c:c06(/ ss3)
  (setq ss3 (ssget "x" '((8 . "text")(62 . 6))))
  (command "change" ss3 "" "p" "c" "5" "")
  (command "change" ss3 "" "p" "la" "0" "")
)
;;;----------------------------------------------------层dim红色图元变白色
(defun c:c07(/ ss4)
  (setq ss4 (ssget "x" '((8 . "dim")(62 . 1))))
  (command "change" ss4 "" "p" "c" "7" "")
  (command "change" ss4 "" "p" "la" "0" "")
)
;;;----------------------------------------------------层text图元变黄色
(defun c:c14(/ s16)
  (Setq s16 (ssget "x" '((8 . "text"))))
  (command "change" s16 "" "p" "c" "2" "")
)
;;;----------------------------------------------------层dim图元变红色
(defun c:c13(/ s17)
  (Setq s17 (ssget "x" '((8 . "dim"))))
  (command "change" s17 "" "p" "c" "1" "")
)
;;;----------------------------------------------------层2图元变蓝色
(defun c:c12(/ s18)
  (Setq s18 (ssget "x" '((8 . "2"))))
  (command "change" s18 "" "p" "c" "4" "")
)
;;;----------------------------------------------------层bh图元变红色
(defun c:c11(/ s18)
  (Setq s18 (ssget "x" '((8 . "bh"))))
  (command "change" s18 "" "p" "c" "1" "")
)
;;;----------------------------------------------------层7图元变黄色
(defun c:c10(/ ent)
  (Setq s15 (ssget "x" '((8 . "7"))))
  (command "change" s15 "" "p" "c" "2" "")
)
;;;----------------------------------------------------层4图元变浅篮色
(defun c:c09(/ s12)
  (Setq s12 (ssget "x" '((8 . "4"))))
  (command "change" s12 "" "p" "c" "4" "")
)
;;;----------------------------------------------------层3图元变红色
(defun c:c08(/ s19)
  (Setq s19 (ssget "x" '((8 . "3"))))
  (command "change" s19 "" "p" "c" "1" "")
)
;;;-----------------------------------------------------全部变0层
(defun c:c16(/ ent)
   (ssget "x" '())
   (command "change" "p" "" "p" "la" "0" "")
)
;;;------------------------------------------------------设置当前层为0层
(DEFUN C:c15  () (COMMAND "clayer" "0"))
;;;------------------------------------------------------快速保存
(DEFUN C:c16  () (COMMAND "qsave"))
;;;------------------------------------------------------炸开所有图块
(defun c:c01(/ ent)
  (ssget "x" '((0 . "INSERT")))
  (COMMAND "qaflags" "1" "")
  (COMMAND "EXPLODE" "p" "")
)
;;;------------------------------------------------------打开
(DEFUN C:c17  () (COMMAND "open"))
;;;----------------------------------------------------清理图层
(defun C:c18 ()(command "_.Purge" "All" "*" "No" "_.Purge" "All" "*" "No"
               "_.Purge" "All" "*" "No")(princ))

附件为其中的一张图纸。
SCR配合LSP的写法我换了几种都不行。
各位有时间的话，能帮我看看吗？

秋枫

LSP程序一般不能跨文档执行。可以考虑用vba或如长清同志的方法。

长清

最初由 Wildcat 发布
[B]用script执行命令正常，只有执行这个LSP不行。（打不开我想要的图纸）
SCR内容如下：
11
e:\abc2
11.lsp内容如下：
;;;
(defun c:11()
(defun *error*( msg / )
(setq *error* nil)
)
(c:c01)
(def... [/B]

SCRIPT在变量跟踪时需要先把“LISPINIT”设置成0，有关说明如下：
Type: Integer

Saved in: Registry

Initial value: 1

Specifies whether AutoLISP-defined functions and variables are preserved when you open a new drawing or whether they are valid in the current drawing session only.

0        AutoLISP functions and variables are preserved from drawing to drawing
1        AutoLISP functions and variables are valid in current drawing only (Release 13 behavior)

但是，SCRIPT文件需要用LISP来写，不要手工编辑，只有这样才可靠。我认为，SCRIPT不是很好用，即难看，又不安全。我只在一个地方使用过：正在编辑图形时，需要查看图形的某一局部的详图，而该详图在另外一个文件上，文件名称用扩展数据记录，这样，可以通过执行一个命令打开关联图，通过另一个命令切换回来，代码不是很长，就是编程难受。实际上，有了VL，就不用这个了，原代码都很难找了。

秋枫

Open and process all drawings in sub-directories [/COLOR]

Chapter 19 of the VBA for AutoCAD 2000 book covers batch processing AutoCAD files.  The example on page 19-2 shows how to open each .dwg file in a specified directory.  An individual who has purchased the book wanted to take this to the next level - how to open all drawings in not only the specified directory, but also all of the sub-directories.  This is possible through the use of the Dir function.   However, it does take a fair amount of code.  Another way to accomplish this task is through the use of the File System Oject.  The File System Object contains objects, methods, and properties to simplify working with drives, directories, and files.   Before using any of FSO's calls, you must first add a reference to it.  The File System Object is contained in the Microsoft Scripting Runtime dll.
In the VBA environment, click on the menu: Tools - References.  In the dialog box you are shown, you will see a list of objects you can add as references.  Once added, the objects, methods, and properties of the selected object becomes available.  For this example, we want to scroll down to the "Microsoft Scripting Runtime" item.  If you click on it (not on the check box, but the words), you will see that the actual file name you are referencing is "SCRRUN.DLL".  If you do not see "Microsoft Scripting Runtime" in the Available References list box, you can click the Browse button and look for it.  If it is on your machine, it will be in your System directory.  You can also perform a search for it using Windows Explorer.  Go ahead and select the check box next to "Microsoft Scripting Runtime" and then click the "OK" button in the References dialog box.

Now that you have added the Microsoft Scripting Runtime dll, you have access to the File System Object.

The individual who requested this tip provided a reference to a web site where he first read about FSO's capabilities.  So, believeing in giving credit where credit is due, here is the link:  http://www.vbtechniques.com/ar/fso.asp    The code below has been borrowed and modified from the above link to fit our needs.  Place it in a blank Module.  Make sure that the General Declarations code gets into the General Declarations area of the newly added module.

2. 
   
3. [FONT=courier new][COLOR=blue]
   
4. 'General Declarations
   
5. Option Explicit
   
6. Dim m_objFSO As Scripting.FileSystemObject
   
7. 'End of General Declarations
   
8. 
   
9. Sub RunThisMacro()
   
10.    Set m_objFSO = New Scripting.FileSystemObject
    
11.    GetAllDwgs "C:\Program Files\Acad2000"
    
12. End Sub
    
13. 
    
14. Sub GetAllDwgs(strPath As String)
    
15.    Dim objFolder As Scripting.Folder
    
16.    Dim objFile As Scripting.File
    
17.    Dim objSubdirs As Scripting.Folders
    
18.    Dim objLoopFolder As Scripting.Folder
    
19.    Dim strFileName As String
    
20. 
    
21.    Set objFolder = m_objFSO.GetFolder(strPath)
    
22.    '
    
23.    ' Check files in the root search directory
    
24.    '
    
25.    For Each objFile In objFolder.Files
    
26.       If UCase$(Right$(objFile.ShortPath, 4)) = ".DWG" Then
    
27.          strFileName = objFile.Path
    
28.          MsgBox "Place code here to run on the file" & vbCr & strFileName
    
29.       End If
    
30.    Next objFile
    
31.    '
    
32.    ' Loop through all subdirectories
    
33.    '
    
34.    Set objSubdirs = objFolder.SubFolders
    
35.    For Each objLoopFolder In objSubdirs
    
36.       GetAllDwgs objLoopFolder.Path
    
37.    Next objLoopFolder
    
38. 
    
39.    Set objSubdirs = Nothing
    
40.    Set objFolder = Nothing
    
41. 
    
42. End Sub
    
43. 
    
44. [/COLOR][/FONT]

<br /> [FONT=courier new][COLOR=blue]<br /> 'General Declarations<br /> Option Explicit<br /> Dim m_objFSO As Scripting.FileSystemObject<br /> 'End of General Declarations<br /> <br /> Sub RunThisMacro()<br />    Set m_objFSO = New Scripting.FileSystemObject<br />    GetAllDwgs "C:\Program Files\Acad2000"<br /> End Sub<br /> <br /> Sub GetAllDwgs(strPath As String)<br />    Dim objFolder As Scripting.Folder<br />    Dim objFile As Scripting.File<br />    Dim objSubdirs As Scripting.Folders<br />    Dim objLoopFolder As Scripting.Folder<br />    Dim strFileName As String<br /> <br />    Set objFolder = m_objFSO.GetFolder(strPath)<br />    '<br />    ' Check files in the root search directory<br />    '<br />    For Each objFile In objFolder.Files<br />       If UCase$(Right$(objFile.ShortPath, 4)) = ".DWG" Then<br />          strFileName = objFile.Path<br />          MsgBox "Place code here to run on the file" & vbCr & strFileName<br />       End If<br />    Next objFile<br />    '<br />    ' Loop through all subdirectories<br />    '<br />    Set objSubdirs = objFolder.SubFolders<br />    For Each objLoopFolder In objSubdirs<br />       GetAllDwgs objLoopFolder.Path<br />    Next objLoopFolder<br /> <br />    Set objSubdirs = Nothing<br />    Set objFolder = Nothing<br /> <br /> End Sub<br /> <br /> [/COLOR][/FONT]

How does it work?  The GetAllDwgs fuction does two things.  First, it looks at all of the files in the directory it is looking at.  If the file extension is .DWG, it sets the file name to a variable and displays the filename in a message box.   This is where you want to place your code to work with the file.  You can open it, print it, draw in it, extract info from it, etc.  Make sure you close it.

After it looks through all of the files it is looking at, it goes down to look at all sub-directories.  You may notice that the procedure GetAllDwgs calls itself with this code:

      GetAllDwgs objLoopFolder.Path

When your code behaves in this way - executing itself from within itself, it is called 'recursive'.  This is what allows us to get all sub-directories.

Happy Programming!

来源: www.vbcad.com

Wildcat

你们的方法虽好，但对我来说太难了，我是最近几天才学LSP，以前也没有学过编程，所以我的想法都较简单（是想法简单，程序一定比你们的长得多：）。
没办法，底子不好，只有用些笨方法。
我改了改原来的LSP，把(DEFUN C:c17 () (COMMAND "open")) 改成了
(DEFUN C:c17  () (COMMAND "open" "" "e:\abc2"))　，
但发现一个很奇怪的问题，这个LSP一定要手动加载才能成功打开下一幅图。？？？？
把它拖到CAD的绘图区域内加载，这样可以。
在命令行写入（load "xxxx")，这样可以。
加到acadr14.lsp里，这样不行。
在acadr14.lsp末行加入（load "xxxx")，这样也不行。
真怪。
有办法解决吗？

秋枫

目前bug很多

秋枫

程序写好了。

有点问题是添加文件时，一次不能添加太多的文件。尚未找出bug.

秋枫

这是程序文件。

解开，复制到support下面，加载:
command: (load "batchproc")
command: batchproc
运行即可。

秋枫

补充： 添加目录时小心，自动查找目录下面的dwg文件，包括子目录。
所以，不要选根目录之类的大文件夹，上万个文件处理起来很慢的。

LUCAS

2. 
   
3. (defun c:c02(/ s20)
   
4.   (Setq s20 (ssget "x" '((8 . "0"))))
   
5.   (if (/= s20 nil);;要先看看是否为空
   
6.   (command "change" s20 "" "p" "c" "1" "")  
   
7.   )
   
8. )
   

<br /> (defun c:c02(/ s20)<br />   (Setq s20 (ssget "x" '((8 . "0"))))<br />   (if (/= s20 nil);;要先看看是否为空<br />   (command "change" s20 "" "p" "c" "1" "")  <br />   )<br /> )<br />