如何获得AutoCAD的安装路径求助?

koutx

如题。在VBA代码中能获得AutoCAD的安装路径吗？求助

tmtony

Const   MAX_FILENAME_LEN   =   260   
Private   Declare   Function   FindExecutable   Lib   "shell32.dll"   Alias   "FindExecutableA"   (ByVal   lpFile   As   String,   ByVal   lpDirectory   As   String,   ByVal   lpResult   As   String)   As   Long   
  

Private   Sub   Form_Click()   
        Dim   I   As   Integer,   s2   As   String   
        dim   AutoCADPath   as   String   
        Const   MyCADFile   =   "F:\temp2\try.CAD"   
   
        s2   =   String(MAX_FILENAME_LEN,   32)   
        I   =   FindExecutable(MyCADFile,   vbNullString,   s2)   
        If   I   >   32   Then   
              AutoCADPath=Left$(s2,   InStr(s2,   Chr$(0))   -   1)   
              msgbox   AutoCADPath   '报告AutoCAD.exe程序的路径   
              shell   AutoCADPath   '运行AutoCAD.exe   
        Else   
              MsgBox   "没找到AutoCAD程序！"   
        End   If   
  End   Sub   


事先在自己程序目录下建立一个CAD文件，然后用上面的代码找运行这个CAD文件的程序（即AutoCAD.exe）所在的路径。

tmtony

还可参考这一篇文章的方法

http://k.pconline.com.cn/question/1075253.html

koutx

谢谢版主提供的代码，又看了网页链接内容，但觉得还是版主提供的简明扼要。有一个问题就是：如果"F:\temp2\try.CAD" 不在自己程序目录下怎么办？请讲一下如何获得"F:\temp2\try.CAD"文件的相对路径。

koutx

4#问题可如下拆衷解决:
Dim dwgname As String
Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant

    With fd
        .Filters.Add "AutoCAD", "*.dwg", 1
        .FilterIndex = 1
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
            dwgname = vrtSelectedItem
             Next vrtSelectedItem
        Else
        End If
    End With
   
    MsgBox dwgname
    Set fd = Nothing
谢谢tmtony版主