gu_xl版主及懂VB的朋友请进

masterlong

下面是根据G版的一段代码改造的
Set fs = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Path = fs.GetParentFolderName(WScript.ScriptFullName)
Set fs = Nothing : Set ws = Nothing
On Error Resume Next
Set objCAD = GetObject(, "AutoCAD.Application")
If Err Then
    Err.Clear
    MsgBox "未发现已打开的AutoCAD，请开启AutoCAD后，打开文件夹【D:\某程序\】执行手动安装"
Else
  Set ThisDrawing = objCAD.activedocument
  Path = replace (Path , "\" ,"\\")
  ThisDrawing.SendCommand ("(load ""D:\\某程序\\模拟安装.lsp"")" & vbCr)
End If

这段代码保存为“双击我自动加载.vbs”
主要用于我的一个程序的安装
安装包自动解压至指定目录后自动在CAD中进行加载
由于某些原因
不想使用秋枫大侠的安装程序

现在的问题是
我使用的是xp+CAD2004
上述代码没有问题
但我在xp+CAD2012中测试时
提示没有找到CAD
请问上述代码如何修改
才能适用于xp、win7 & CAD2004~2012呢
望各位大侠出手
不尽感激

下面是模拟的程序安装包

zzyong00

1.     On Error Resume Next
   
2.     Set objcad = GetObject(, "AutoCAD.Application")
   
3.     If Err Then
   
4.         Err.Clear
   
5.         'MsgBox "未发现已打开的AutoCAD，请开启AutoCAD后，打开文件夹【D:\某程序\】执行手动安装"
   
6.         Set objcad = CreateObject("AutoCAD.Application")
   
7.         objcad.Visible = True
   
8.         Set ThisDrawing = objcad.activedocument
   
9.         Path = Replace(Path, "\", "\\")
   
10.         ThisDrawing.SendCommand ("(load ""D:\\某程序\\模拟安装.lsp"")" & vbCr)
    
11.         
    
12.     Else
    
13.         Set ThisDrawing = objcad.activedocument
    
14.         Path = Replace(Path, "\", "\\")
    
15.         ThisDrawing.SendCommand ("(load ""D:\\某程序\\模拟安装.lsp"")" & vbCr)
    
16.     End If

    On Error Resume Next<br />     Set objcad = GetObject(, "AutoCAD.Application")<br />     If Err Then<br />         Err.Clear<br />         'MsgBox "未发现已打开的AutoCAD，请开启AutoCAD后，打开文件夹【D:\某程序\】执行手动安装"<br />         Set objcad = CreateObject("AutoCAD.Application")<br />         objcad.Visible = True<br />         Set ThisDrawing = objcad.activedocument<br />         Path = Replace(Path, "\", "\\")<br />         ThisDrawing.SendCommand ("(load ""D:\\某程序\\模拟安装.lsp"")" & vbCr)<br />         <br />     Else<br />         Set ThisDrawing = objcad.activedocument<br />         Path = Replace(Path, "\", "\\")<br />         ThisDrawing.SendCommand ("(load ""D:\\某程序\\模拟安装.lsp"")" & vbCr)<br />     End If

mikewolf2k

提示没找到ACAD的话，应该是getobject这句出问题了。我这里win7X64+Excel2007+ACAD2012，Excel VBA中引用AutoCAD 2012 type library，以下代码能够获得ACAD
Sub aa()
   Set objCAD = GetObject(, "AutoCAD.Application")
End Sub
所以从代码上来看，后期绑定，应该没问题，楼主失败的运行环境是什么？仅打开一个ACAD程序再试下？

yyzhan12

Set fs = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("WScript.Shell")
Path = fs.GetParentFolderName(WScript.ScriptFullName)
Set fs = Nothing : Set ws = Nothing
On Error Resume Next
Set objCAD = GetObject(, "AutoCAD.Application")
If Err Then
    Err.Clear
    MsgBox "未发现已打开的AutoCAD，请开启AutoCAD后，执行手动安装"
Else
  Set ThisDrawing = objCAD.activedocument
  Path = Replace (Path , "\" ,"\\")   'VBS程序所在目录
  if Right(Path ,2) <> "\\" Then Path =Path & "\\"   '完善路径
  Path = Path & "模拟安装.lsp"   'lsp程序详细路径
  ThisDrawing.SendCommand ("(vl-catch-all-apply 'load (list """ & Path & """))(princ)" & vbCr)   '向CAD发送语句
End If


主要lsp程序和VBS程序放在同一文件夹中,
修改语句:
Path = Path & "模拟安装.lsp"   'lsp程序详细路径
均可自动加载

测试cad04、07、10、16+win7 32位

yyzhan12

会不会是你的cad12没有安装好?

yyzhan12

会不会是你的cad12没有安装好?

yefei812678

不懂不懂不懂不懂不懂不懂不懂