咳，我对vb不懂，老板还是要我做真是急死人。还请版主们救救我啊。
我想我给你贴的代码你没有看吧，我再贴一次好了，你在我指出的地方sendcommand加载你的lisp，请试一下，看行不行。Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End TypePrivate Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
'Public Declare function GetVersion Lib "Kernel32" () As Integer
Private Declare function GetCommandLine Lib "Kernel32" Alias "GetCommandLineA" () As String
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare function lstrcat Lib "Kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As LongPublic Sub qdtubl()
Dim inDir As String
Dim elem
Dim filenom As String
Dim WholeFile As String
Dim newHeight As Double
Dim tufu As String
Dim neirong33 As String
inDir = ""
inDir = ThisDrawing.BrowseForFolder("请选择目录：")
If inDir = "" Then Exit Sub
If Right(inDir, 1) = "\" Then inDir = Left(inDir, Len(inDir) - 1)
filenom = Dir$(inDir & "\*.dwg")
'On Error GoTo errorcontrol
Do While filenom <> ""
WholeFile = inDir & "\" & filenom
ThisDrawing.Application.Documents.Open WholeFile在这里加入你的sendcommand代码
ThisDrawing.Application.ActiveDocument.Close filenom = Dir$
Loop
Exit Suberrorcontrol:
MsgBox "错误，程序退出！"
End SubPublic function BrowseForFolder(sPrompt As String) As String
'Public function BrowseForFolder(hWndOwner As Long, sPrompt As String) As StringDim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
With udtBI
' .hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With lpIDList = SHBrowseForFolder(udtBI) If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar) If iNull Then
sPath = Left$(sPath, iNull - 1)
End If End If BrowseForFolder = sPath
End Function
好像不行。我上传了lisp，好像程序不能运行。再帮我看看，谢谢。
可以运行阿，我用你的lisp把cad/sample下的dwg全部打印成了dwf文件了，运行的很好，vba和lisp结合的很好，也没有命令顺序混乱的现象，现在我把所有的代码全都贴一次，你再试试，我这里一点问题都没有（我是2004） 下面这个是你那个lisp，我只修改了filedia的设置和dwf打印机的名称下面这个是vba的代码，你把它复制下来，粘贴在thisdrawing的code区
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End TypePrivate Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
'Public Declare function GetVersion Lib "Kernel32" () As Integer
Private Declare Function GetCommandLine Lib "Kernel32" Alias "GetCommandLineA" () As String
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "Kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As LongPublic Sub qdtubl()
Dim inDir As String
Dim elem
Dim filenom As String
Dim WholeFile As String
Dim newHeight As Double
Dim tufu As String
Dim neirong33 As String
inDir = ""
inDir = ThisDrawing.BrowseForFolder("请选择目录：")
If inDir = "" Then Exit Sub
If Right(inDir, 1) = "\" Then inDir = Left(inDir, Len(inDir) - 1)
filenom = Dir$(inDir & "\*.dwg")
On Error GoTo errorcontrolDo While filenom <> ""
WholeFile = inDir & "\" & filenom
ThisDrawing.Application.Documents.Open WholeFile'在这里加入你的sendcommand代码
'输出dwf文件（运行plo.lisp文件）ThisDrawing.SendCommand "(load " & Chr(34) & "plo.lsp" & Chr(34) & ")" & vbCr ThisDrawing.Application.ActiveDocument.Close false filenom = Dir$Loop
Exit Suberrorcontrol:
MsgBox "错误，程序退出！"
End SubPublic Function BrowseForFolder(sPrompt As String) As String
'Public function BrowseForFolder(hWndOwner As Long, sPrompt As String) As StringDim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
With udtBI
' .hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With lpIDList = SHBrowseForFolder(udtBI) If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar) If iNull Then
sPath = Left$(sPath, iNull - 1)
End If End If BrowseForFolder = sPath
End Function
刚才又试了几次，还是可能会出现命令混乱的现象，主要表现在cad一张张打开图的时候，我同时点了几下鼠标，就可能出现命令混乱。明主说这是cad的bug，我想那就是很难解决的了，不过对你这个lisp来说，我想如果都改写为vba的话，应该不是很难的事。不过citykunan是作lisp，我想干脆plo.lsp文件就一句话一条命令好了：
(command "-plot" "no" "model" "" "DWF6 ePlot.pc3" <BR> (strcat "c:\\lhy_leo" "\\" (vl-filename-base (getvar "dwgname"))) "n" "y")
这样我试了试，点击鼠标试图干扰cad，没什么作用，程序顺利运行。
另外：好像filedia对lisp不起什么作用，上一个帖子我把你注释掉的改成语句是画蛇添足了。
你这是vba，我是想用vb，在cad外做一个*.exe文件，双击此文件，能选择目录，选取dwg 文件，在打开cad，分别加载lisp程序，不知可以否？
可以这样试试：
用Lisp做一个反应器，触发条件为Users1值为“VB－Cad”，Users2的值改变
触发处理就是调用对应路径（Users2的值）的Lisp文件，Lisp文件全部用VL改写
VB端改变Users1、Users2的值
to citykunan其实把vba程序改成vb程序不是很难的。按你的要求，我已经把vba改写成了vb，程序代码如下，窗体上加个按钮（command1），点击按钮就可以打开cad，把选定的目录文件打印成dwf了。别忘记在reference中添加cad的引用。Option Explicit
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End TypePrivate Const BIF_RETURNONLYFSDIRS = 1
Private Const MAX_PATH = 260
'Public Declare function GetVersion Lib "Kernel32" () As Integer
Private Declare Function GetCommandLine Lib "Kernel32" Alias "GetCommandLineA" () As String
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "Kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Public Function BrowseForFolder(sPrompt As String) As String
'Public function BrowseForFolder(hWndOwner As Long, sPrompt As String) As StringDim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo
With udtBI
' .hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF_RETURNONLYFSDIRS
End With lpIDList = SHBrowseForFolder(udtBI) If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
iNull = InStr(sPath, vbNullChar) If iNull Then
sPath = Left$(sPath, iNull - 1)
End If End If BrowseForFolder = sPath
End FunctionPrivate Sub Command1_Click()
Dim inDir As String
Dim elem
Dim filenom As String
Dim WholeFile As String
Dim newHeight As Double
Dim tufu As String
Dim neirong33 As String
inDir = ""
inDir = BrowseForFolder("请选择目录：")
If inDir = "" Then Exit Sub
If Right(inDir, 1) = "\" Then inDir = Left(inDir, Len(inDir) - 1)
filenom = Dir$(inDir & "\*.dwg")Dim acadApp As AcadApplication
Set acadApp = CreateObject("AutoCAD.Application")On Error GoTo errorcontrol
Do While filenom <> ""
WholeFile = inDir & "\" & filenom
acadApp.Documents.Open WholeFile'在这里加入你的sendcommand代码
'输出dwf文件（运行plo.lisp文件）
acadApp.ActiveDocument.SendCommand "(load " & Chr(34) & "plo.lsp" & Chr(34) & ")" & vbCr
acadApp.ActiveDocument.Close False
filenom = Dir$Loop
acadApp.Quit
Exit Suberrorcontrol:
MsgBox "错误，程序退出！"
End Sub
谢谢各位热心人，可以了。但是如果dwg文件很大的话，是不是会出现混乱的现象？不知道有没有办法解决。再次感谢。
在前一楼的程序中acadApp.ActiveDocument.SendCommand "(load " & Chr(34) & "plo.lsp" & Chr(34) & ")" 中要将*.lsp的路径写上，有没有办法，让vb自己找到自身的*.exe的所在目录，自动加载同一目录下的*.lsp程序呢？（*.lsp程序总与*.exe程序在同一目录），这样程序复制到不同的目录就不要改程序了。谢谢。