[求助]vb如何启动cad并用autolisp自动出图

05625lcc

如题,用vb开发图形用户界面,将得到的数据写入文件.txt,另有一lisp程序,读取这个文件

问题是在vb中运行完后vb如何启动cad并驱动lisp程序完成出图,或者详细点vb如何得到cad的安装路径,成功启动cad后又如何让lisp程序在cad中运行呢?

msdzt

我恰好写过类似的程序，见下面的VB代码。其中，cboDrawing为Combox控件,还有一个确定按钮OKButton。用VB生成的文件保存在sFileName中,并使用SetVariable方法保存于系统变量users1中，然后使用SendCommand方法加载lisp文件DwgList.vlx并运行其中的dwg_list函数。这是用VB写的一个自动提取Dwg文件中图签中的标题和图号并生成图纸目录的程序。下面的代码仅是制表部分，供参考。注意在lisp程序中使用(findfile (getvar "users1"))来获得保存的文件名称。

Option Explicit
Dim CadApp As AcadApplication
Dim oDoc As AcadDocument
Dim colFN As New Collection '图形文件的FullName集合
Dim State As AcadState

Private Sub cboDrawing_Click()
cboDrawing.ToolTipText = colFN.Item(cboDrawing.ListIndex + 1)
End Sub

Private Sub Form_Load()
Dim sMsg As String '错误信息
On Error Resume Next
Set CadApp = GetObject(, "AutoCAD.Application")
If Err Then
    sMsg = sMsg & "AutoCAD软件没有运行！请启动AutoCAD软件后继续！" & vbCrLf
Else
    Set State = GetAcadState
    If State.IsQuiescent = True Then
        cboDrawing.Clear
        For Each oDoc In CadApp.Documents
        cboDrawing.AddItem oDoc.Name
        colFN.Add oDoc.FullName
        Next
        If cboDrawing.ListCount = 0 Then
            sMsg = sMsg & "AutoCAD中没有打开任何图形文件！" & vbCrLf
        Else
            cboDrawing.Text = CadApp.ActiveDocument.Name
        End If
    Else
        sMsg = sMsg & "AutoCAD 正忙！请结束AutoCAD窗口中的任何命令后继续！" & vbCrLf
    End If
End If
If sMsg <> "" Then
    MsgBox "由于存在以下错误而无法进行制表！请检查相关问题后继续！" & vbCrLf & sMsg, vbExclamation
    OKButton.Enabled = False
    cboDrawing.Enabled = False
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set colFN = Nothing
Set oDoc = Nothing
Set CadApp = Nothing
End Sub

Private Sub OKButton_Click()
Dim sFN As String
sFN = colFN.Item(cboDrawing.ListIndex + 1)
On Error Resume Next
If cboDrawing.Text <> CadApp.ActiveDocument.Name Or sFN <> CadApp.ActiveDocument.FullName Then
    CadApp.Documents.Item(cboDrawing.ListIndex).Activate
End If
Set State = GetAcadState
If State.IsQuiescent = False Then
    MsgBox "AutoCAD 正忙！请结束AutoCAD窗口中的任何命令后继续！", vbInformation
    OKButton.Caption = "重试(&R)"
    CadApp.WindowState = acMax
    AppActivate CadApp.Caption
    Exit Sub
End If
'开始制表
CadApp.WindowState = acMax
AppActivate CadApp.Caption
Set oDoc = CadApp.ActiveDocument
If Err Then
    OKButton.Caption = "重试(&R)"
    Exit Sub
End If
oDoc.SetVariable "USERS1", sFileName
oDoc.SendCommand "(Load " & Chr(34) & "Dwglist.vlx" & Chr(34) & ")" & vbCr & "(Dwg_list)" & vbCr
Unload Me
End Sub

05625lcc

高手,仔细研究一下,十分感谢分享.