gu_xl版主及懂VB的朋友请进

masterlong 发表于 2015-12-30 17:44

本帖最后由 masterlong 于 2015-12-30 17:48 编辑

下面是根据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 发表于 2015-12-30 23:03

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

Else
   Set ThisDrawing = objcad.activedocument
   Path = Replace(Path, "\", "\\")
   ThisDrawing.SendCommand ("(load ""D:\\某程序\\模拟安装.lsp"")" & vbCr)
End If

mikewolf2k 发表于 2015-12-31 11:03

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

yyzhan12 发表于 2016-1-2 09:59

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 发表于 2016-1-2 10:03

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

yyzhan12 发表于 2016-1-2 10:04

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

yefei812678 发表于 2024-2-23 16:43

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

tender138 发表于 2024-5-8 21:16

你好！麻烦帮忙看看我这个问题，谢谢:handshake
http://bbs.mjtd.com/thread-190110-1-1.html

ThisDrawing.SendCommand ("(load ""E:\\LZXCAD\\LZXLoad.lsp"")" & vbCr)
ThisDrawing.SendCommand ("LZXLoadApp" & vbCr)
这样不行

页: [1]

明经CAD社区's Archiver

gu_xl版主及懂VB的朋友请进