AutoCAD二次开发基础（一）：基础使用

AutoCAD二次开发系列

---

前言

• 在船舶与海洋工程专业中，经常会涉及到依据型值表绘制型线图、从型线图中读数据点用作三维建模基础数据、绘制静水力曲线图等等，这些过程往往伴随着大量简单重复性的工作，全手工绘制费时费力又无意义。AutoCAD为上述过程常用的一款绘图软件，通过其内置的VBA，运用代码代替手工进行部分工作。

---

一、VBA简介

• VBA（Visual Basic for Applications）是Visual Basic的一种宏语言，是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。主要能用来扩展Windows的应用程序功能，特别是Microsoft Office软件。它也可说是一种应用程式视觉化的 Basic 脚本。

二、AutoCAD中使用VBA

1.简单使用

打开AutoCAD，输入VBAMAN调出VBA管理器，进入Visual Basic编辑器，从“视图”菜单里进入代码窗口，输入如下代码：

Sub test()
MsgBox("VBA test")
End Sub

返回AutoCAD，按下Alt+F8，选择运行刚定义的过程，执行结果如下：

2.常用图元

AutoCAD中常用图元（统称实体Entity，区别于AcadEntity）在VBA中类型名称为：

​类型名称	含义	​类型名称	含义
AcadEntity	实体	AcadLine	直线
AcadRegion	面域	AcadArc	圆弧
Acad3dSolid	实体	AcadXLine	射线
AcadText	文本	AcadSpline	样条曲线

​绘制一条过 (0, 0) 与 (200, 100) 的直线：

Sub createLine()  ' 定义名为createLine的过程
Dim Line_1 As AcadLine  ' 定义名为Line_1的AcadLine类型
Dim point_1(2) As Double  ' 定义名为point_1的double类型的三维数组
Dim point_2(2) As Double
point_1(0) = 0  ' 将 (0, 0) 点的x坐标值赋给point_1的第一个元素
point_1(1) = 0
point_2(0) = 200
point_2(1) = 100
ThisDrawing.ModelSpace.AddLine point_1, point_2  ' 在当前活动的CAD页面绘制直线
End Sub  ' 过程定义结束

运行上述函数，即在CAD活动页面中创建了一条过固定点的直线。如看不到绘制结果，可点击“范围缩放”让绘制的图形以最大缩放范围显示在视图中心。

​绘制一条过 (0, 0) 、 (100, 200) 与(200, -100)的样条曲线：

• 首先应明确点数组的定义及使用：

Dim Pta(0 to 3*n-1) as Double  ' 包含n个点的名为Pta的数组
'第i个点的x坐标：Pta(i*3)
'第i个点的y坐标：Pta(i*3+1)
'第i个点的z坐标：Pta(i*3+2)

• 绘制上述样条曲线：

Sub CreateSpline
Dim sT(2) as double  ' 定义三维数组存放样条曲线起点端切量
Dim eT(2) as double  ' 定义三维数组存放样条曲线终点端切量
Dim pta(3*3-1) as double  '定义包含3个点的数组
pta(3) = 100 : pta(4) = 200  ' 第二个点的x和y坐标赋值（第一个点不赋值默认为0）
pta(6) = 200 : pta(7) = -100  ' 第三个点的x和y坐标赋值
ThisDrawing.ModelSpace.AddSpline pta, sT, eT  '绘制样条曲线
End Sub

绘制结果：

3.选择实体

拾取图纸上的直线并在命令行输出其端点x坐标：

Sub outPutLineEnd()
Dim ln AS AcadLine
ThisDrawing.Utility.GetEntity ln, p1, "选择一条直线"  ' ln(返回值): 选中的直线， p1(返回值): 做选择时点的位置
ThisDrawing.Utility.Prompt ln.StartPoint(0) ' 命令行输出所选直线的起点x坐标
End Sub

拾取点：

Sub getPoint()
Dim p1(2) as double
rp = ThisDrawing.Utility.getPoint(p1, "选择一个点")  ' p1为参考点
ThisDrawing.ModelSpace.AddPoint rp  ' 绘制所选择的点
End Sub

多选实体（一般按以下步骤）：

• 定义选择集
• 将选择集添加至图形数据库
• 执行选择命令
• 删除选择集

Sub mutiSelect()
On Error GoTo toExit  ' 发生异常则跳转至toExit
Dim ss1 as AcadSelectionSet  ' 定义选择集
Set ss1 = ThisDrawing.SelectionSets.Add("set")  ' 将选择集添加至图形数据库
ss1.SelectOnScreen  ' 执行选择命令，选择完成后按回车结束选择状态
For Each element in ss1
	element.Color = acYellow  ' 将选中的实体的颜色改为黄色
Next
ss1.Delete
toExit:
End Sub

---