AutoCAD二次开发教程（1）-通过VB6绘制直线

1：准备工作

开发环境：Visual Basic 6

软件：AutoCAD2008

vb6年代有点久远，如果用的是win10或者win11系统大概率会安装不上，不想换系统的话，可以通过虚拟机（比如VMware）来安装一个win7系统然后再搭建开发环境。

安装AutoCAD2008之后需要引用的文件会自动出现在Visual Basic 6里的引用列表里。

工程类软件用vb来开发是最合适的，简单易学，虽然效率可能没有其他编程语言高，但是好在容易掌握。

2：绘制直线

环境搭建好之后，我们从通过vb控制AutoCAD来绘制一条直线开始。

1）新建工程，选择标准exe。

2）添加引用

工程->引用

选择AutoCAD开头的几个文件。

3）输入直线绘制代码

新建一个控制按钮，双击按钮之后输入下面的代码：

On Error Resume Next
' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If
' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True    
' 创建直线的端点
Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = 1
startPoint(1) = 1
startPoint(2) = 0 '可不给定
endPoint(0) = 5
endPoint(1) = 5
endPoint(2) = 0 '可不给定
' 在模型空间中创建 Line 对象
Set lineObj = acadDoc.ModelSpace.AddLine(startPoint, endPoint)
ZoomAll

点击按钮之后会创建一条从起点(1,1,0)到终点(5,5,0)的图形，坐标形式为(x,y,z)，也就是x轴，y轴，z轴三个坐标值。二维图形的话z为0就可以了。或者不给点z轴坐标也可以。

 

每点一次新建一个新的窗口就会绘制一次直线。

运行之前最好先把AutoCAD2008打开，不然可能会出现下面的错误：

如果还要画另外一条直线的话，可以在后面继续设置起点与终点。

On Error Resume Next

' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If

' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True

' 创建直线的端点
Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim endPoint(0 To 2) As Double
startPoint(0) = 1
startPoint(1) = 1
startPoint(2) = 0
endPoint(0) = 5
endPoint(1) = 5
endPoint(2) = 0
' 在模型空间中创建 Line 对象
Set lineObj = acadDoc.ModelSpace.AddLine(startPoint, endPoint)


startPoint(0) = 10
startPoint(1) = 0
startPoint(2) = 0
endPoint(0) = 50
endPoint(1) = 50
endPoint(2) = 0
' 在模型空间中创建 Line 对象
Set lineObj = acadDoc.ModelSpace.AddLine(startPoint, endPoint)
ZoomAll

这样就可以绘制两条直线。

如果要修改前面绘制的直线，需要设置不同的变量，如果不修改则可以直接修改startPoint与endPoint两个变量的值绘制第二条直线。

3：绘制多线段

代码如下：

On Error Resume Next
' 连接至 AutoCAD 应用程序
Dim acadApp As AcadApplication
Dim docObj As AcadDocument
Set acadApp = GetObject(, "AutoCAD.Application.17.1")
Set docObj = acadApp.Application.Documents.Add
If Err Then
    Err.Clear
    Set acadApp = CreateObject("AutoCAD.Application.17.1")
    Set docObj = acadApp.Application.Documents.Add
    If Err Then
        MsgBox ("无法运行AutoCAD2008，请检查是否安装了AutoCAD2008")
        Exit Sub
    End If
End If

' 连接至 AutoCAD 图形
Dim acadDoc As AcadDocument
Set acadDoc = acadApp.ActiveDocument
acadApp.Visible = True
acadDoc.WindowState = acMax


Dim plineObj As AcadLWPolyline
Dim points(0 To 5) As Double

' 定义二维多段线的点
points(0) = 2: points(1) = 6
points(2) = 6: points(3) = 2
points(4) = 6: points(5) = 6

' 在模型空间中创建一个优化多段线对象
Set plineObj = acadDoc.ModelSpace.AddLightWeightPolyline(points)

ZoomExtents