AutoCAD VBA二次开发(4)

在VB和VBA中，使用On Error语句来捕获运行时错误。此语句为系统设置精确的捕获。当错误发生时，此语句会自动转到专门编写的错误处理程序，系统的默认错误处理则被略过。

On Error 语句有三种形式：

(1) On Error Resume Next

(2) On Error GoTo Label

(3) On Error GoTo 0

当希望忽略错误时，可以使用On Error Resume Next语句。此语句捕获错误但是不会显示错误信息或者终止程序，而是移到下一行代码继续执行。例如，如果希望创建子例程来遍历模型空间并修改每个图元的颜色，则在试图对锁定图层上的图元着色时AutoCAD将会抛出错误。这时不需要终止过程，而只需要跳过锁定图层上的图元并继续处理其余的图元。On Error Resume Next语句就可以完成这个过程。

当希望编写明确的处理程序时，可以使用On Error GoTo Flag语句（Flag为标记）。此语句捕获错误但不会显示错误信息或者终止程序，而是跳到代码中的特定位置。然后代码可以使用适当的方式来响应错误。例如，可以扩充上一个样例，以显示包含锁定图层上每个图元句柄的消息。

 训练2  应用VBA编写输入圆心、半径、起l角和终止角绘制圆弧的参数化程序。

应用VBA程序绘制样条曲线的方法为：AddArc(Center, Radius, StartAngle, EndAngle)，其中，Center为圆心坐标3元素列表，Radius为圆弧半径，StartAngle, EndAngle为圆弧起始、终止角（弧度）。

按训练1的方法和步骤设计参数化绘制圆弧的VBA程序，其步骤依次为：打开VBA IDE、插入用户窗体并设置属性、插入控件并设置属性、编写代码、调试运行程序、保存工程。参数化绘制圆弧的窗体如图16所示，并按表2所示设置窗体及控件的相应属性。

图16  绘制圆弧的窗体

 表2  绘制圆弧的窗体及控件属性设置

窗体及控件名称	属性	设置值	作用
窗体	Name	frmArc
	Caption	参数化绘圆弧练习
标签	Name	lblXCen，lblYCen，lblZCen， lblArcR，lblStaAng，lblEndAng， lblSAUnit，lblEAUnit
	Caption	x_CenPoint，y_CenPoint，z_CenPoint， ArcR，StaAng，EndAng， °（角度单位），°	提示输入圆心坐标、半径、角度值及角度单位
文本框	Name	txtXCen，txtYCen，txtZCen， txtRadius，txtStaAng，txtEndAng
	Text	50，70，0，30，20，160	输入圆心坐标、圆弧半径及圆弧起始、终止角度值
命令按钮	Name	cmdOK_Click，cmdEnd_Click
	Caption	确定，结束	点击按钮

 参数化绘制圆弧的主要代码如下：

Private Sub cmdOK_Click( )

  Dim pi As Double

  pi = 4 * Atn(1)  ’ 定义常数π

  ThisDrawing.Application.Documents.Add   ’ 打开新图形

  Dim ArcCenter(0 To 2) As Double   ’ 定义圆弧中心

  Dim ArcRadius As Double         ’ 定义圆弧半径

  Dim StartAngle As Double         ’ 定义圆弧起始角

  Dim EndAngle As Double          ’ 定义圆弧终止角

  ArcCenter(0) = txtXCen.Text       ’ 提取圆弧中心X坐标

  ArcCenter(1) = txtYCen.Text       ’ 提取圆弧中心Y坐标

  ArcCenter(2) = txtZCen.Text       ’ 提取圆弧中心Z坐标

  ArcRadius = txtRadius.Text        ’ 提取"弧半径

  StartAngle = txtStaAng.Text * pi / 180   ’ 提取圆弧起始角并转换为弧度

  EndAngle = txtEndAng.Text * pi / 180   ’ 提取圆弧终止角并转换为弧度

   Dim ArcObj As AcadArc    ’ 定义Arc对象

  ’ 设置Arc对象

  Set ArcObj = ThisDrawing.ModelSpace.AddArc(ArcCenter, ArcRadius, StartAngle, EndAngle)

  ThisDrawing.SaveAs (“D:\Arc_Ex.dwg”)  ’ 保存图形

End Sub

 训练3  应用VBA编写输入基圆半径和展角上限绘制渐开线的参数化程序。

渐开线为常用工程曲线，在机m设计基础或机械原理教材中有详细介绍。在VBA中，可采用样条曲线拟合的方法绘制渐开线。

在如图17所示的直角坐标系Oxy中，渐开线上点K的坐标为^[7]187

                                                    (1)

式中，—形成渐开线的基圆半径；

—用弧度表示的渐开线上K点对应的展角，且。

渐开线的切线方向可用其斜率（导数）表示，即

 ()                                          (2)

图17  直角坐标系下的渐开线

 应用VBA程序绘制样U曲线的方法为：AddSpline(PointsArray, StartTangent, EndTangent)，其中，PointsArray为样条曲线（渐开线）拟合点的3维坐标组成的列表（即数组，必须为3的倍数），StartTangent，EndTangent为样条曲线的起点和终点切向向量（必需为3元素列表，切向必需与曲线的走向一致）^[8]。起点的切向竖直向上^[7]181-183，可取(0, 1, 0)；根据式(2)可知终点的切向为。

可根据精度要求将所绘渐开线的展角上限等分为J个区间（程序中取J=10），应用For…Next循环计算拟合点的坐标。首先按下式计算展角：

， (j=0, 1, 2, …, J)                                    (3)

再用式(1)计算点K的坐标(x_Kj, y_Kj)。

图18  绘制渐开线的窗体

绘制渐开线及基圆的窗体如图18所示，程序如下：

Private Sub cmdOK_Click()

  ThisDrawing.Application.Documents.Add

  pi = 4 * Atn(1)                   ’ 定义常数π

  Dim rb As Double                ’ 定义基圆半径

  Dim theta0 As Double             ’ 定义渐开线展角

  Dim InvPoint(0 To 32) As Double    ’ 定义拟合点坐标

  Dim SPtan(0 To 2) As Double       ’ 定义起点切线方向

  Dim EPtan(0 To 2) As Double       ’ 定义终点切线方向

  Dim InvObj As AcadSpline         ’ 定义Spline对象

  rb = txtRb.Text

  theta0 = txtTheta0.Text * pi / 180     ’ 将角度转换为弧度

  delta_theta = theta0 / 10

  For j = 0 To 10

     theta = j * delta_theta

     InvPoint(j * 3) = rb * (Sin(theta) - theta * Cos(theta))

     InvPoint(j * 3 + 1) = rb * (Cos(theta) + theta * Sin(theta))

     InvPoint(j * 3 + 2) = 0

  Next j

  SPtan(0) = 0: SPtan(1) = 1: SPtan(2) = 0

  EPtan(0) = 1: EPtan(1) = 1 / Tan(theta0): EPtan(2) = 0

  ’ 设置Spline对象

  Set InvObj = ThisDrawing.ModelSpace.AddSpline(InvPoint, SPtan, EPtan)

 

  ’ 绘制基圆

  Dim CirObj As AcadCircle       ’ 定义Circle对象

  Dim CenPoint(0 To 2) As Double  ’ 定义圆心坐标

  CenPoint(0) = 0: CenPoint(1) = 0: CenPoint(2) = 0

  ’ 设置Circle对象

  Set CirObj = ThisDrawing.ModelSpace.AddCircle(CenPoint, rb)

  ThisDrawing.SaveAs (“D:\Draw_Inv.dwg”)

End Sub

 参考文献