form1.frm

能使VB跟AUTOCAD连接并控制AUTOCAD的绘图。

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   2280
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3600
   LinkTopic       =   "Form1"
   ScaleHeight     =   2280
   ScaleWidth      =   3600
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   495
      Left            =   120
      TabIndex        =   4
      Top             =   1680
      Width           =   1575
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "保存图形"
      Height          =   495
      Left            =   1920
      TabIndex        =   3
      Top             =   960
      Width           =   1575
   End
   Begin VB.CommandButton cmdDraw 
      Caption         =   "绘图"
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   960
      Width           =   1575
   End
   Begin VB.CommandButton cmdCloseAcad 
      Caption         =   "关闭AutoCAD"
      Height          =   495
      Left            =   1920
      TabIndex        =   1
      Top             =   240
      Width           =   1575
   End
   Begin VB.CommandButton cmdOpenAcad 
      Caption         =   "连接AutoCAD"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   1575
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' 在运行程序之前，选择“Project/References”菜单，引用“AutoCAD 2004 Type Library”

Dim acadApp As AcadApplication  ' 将程序对象作为窗体的全局对象
Dim acadDoc As AcadDocument     ' 文档对象作为窗体的全局对象

Private Sub cmdCloseAcad_Click()
    If Not (acadApp Is Nothing) Then
        acadApp.Quit    ' 关闭AutoCAD程序
    Else
        MsgBox "请先连接AutoCAD！", vbCritical
    End If
End Sub

Private Sub cmdDraw_Click()
    ' 获得文档对象
    If acadApp Is Nothing Then
        MsgBox "请先连接AutoCAD", vbCritical
        Exit Sub
    End If
    
    Set acadDoc = acadApp.ActiveDocument
    
    ' 绘制一条直线
    Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double
    pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
    pt2(0) = 200: pt2(1) = 200: pt2(2) = 0
    acadDoc.ModelSpace.AddLine pt1, pt2
    
    acadDoc.Regen acActiveViewport
End Sub

Private Sub cmdExit_Click()
    End
End Sub

Private Sub cmdOpenAcad_Click()
    ' 使用OLE方式连接AutoCAD
    On Error Resume Next
    
    Set acadApp = GetObject(, "AutoCAD.Application.16")
    If Err Then
        Err.Clear
        Set acadApp = CreateObject("AutoCAD.Application.16")
        If Err Then
            MsgBox Err.Description
            Exit Sub
        End If
    End If
    
    ' 显示AutoCAD窗口
    acadApp.Visible = True
End Sub

Private Sub cmdSave_Click()
    If Not (acadDoc Is Nothing) Then
        acadApp.ActiveDocument.SaveAs "C:\001.dwg"  ' 保存图形
    Else
        MsgBox "首先连接AutoCAD，并且绘图！", vbCritical
    End If
End Sub