|
|
发表于 2009-3-1 11:58:00
|
显示全部楼层
我恰好写过类似的程序，见下面的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
|
|
置顶卡
