Autocad VBA初级教程 (第十二课:参数化设计基础)

    简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。

    本课的例程是画一个标准足球场。足球场长度90～120米，宽度45～90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。

Sub court()
Dim courtlay As AcadLayer '定义球场图层
Dim ent As AcadEntity '镜像对象
Dim linep1(0 To 2) As Double '线条端点1
Dim linep2(0 To 2) As Double '线条端点2
Dim linep3(0 To 2) As Double '罚球弧端点1
Dim linep4(0 To 2) As Double '罚球弧端点2
Dim centerp As Variant '中心坐标
xjq = 11000 '小禁区尺寸
djq = 33000 '大禁区尺寸
fqd = 11000 '罚球点位置
fqr = 9150 '罚球弧半径
fqh = 14634.98 '罚球弧弦长
jqqr = 1000 '角球区半径
zqr = 9150 '中圈半径

On Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90000～120000)<105000>")
If Err.Number <> 0 Then '用户输入的不是有效数字
  chang = 105000
  Err.Clear '清除错误
End If
kuan = ThisDrawing.Utility.GetReal("宽度(45000～90000)<68000>")
If Err.Number <> 0 Then
  kuan = 68000
End If

centerp = ThisDrawing.Utility.GetPoint(, "定位球场中心:")

Set courtlay = ThisDrawing.Layers.Add("足球场") '设置图层
ThisDrawing.ActiveLayer = courtlay '把当前图层设为足球场图层

'画小禁区
linep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + xjq / 2
linep2(0) = centerp(0) + chang / 2 - xjq / 2
linep2(1) = centerp(1) - xjq / 2
Call drawbox(linep1, linep2) '调用画矩形子程序

'画大禁区
linep1(0) = centerp(0) + chang / 2
linep1(1) = centerp(1) + djq / 2
linep2(0) = centerp(0) + chang / 2 - djq / 2
linep2(1) = centerp(1) - djq / 2
Call drawbox(linep1, linep2)

' 画罚球点
linep1(0) = centerp(0) + chang / 2 - fqd
linep1(1) = centerp(1)
Call ThisDrawing.ModelSpace.AddPoint(linep1)
'ThisDrawing.SetVariable "PDMODE", 32 '点样式
ThisDrawing.SetVariable "PDSIZE", 30 '点的尺寸

'画罚球弧，罚球弧圆心就是罚球点linep1
linep3(0) = centerp(0) + chang / 2 - djq / 2
linep3(1) = centerp(1) + fqh / 2
linep4(0) = linep3(0) '两个端点的x轴相同
linep4(1) = centerp(1) - fqh / 2
ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧

'角球弧
ang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度转换为弧度
ang2 = ThisDrawing.Utility.AngleToReal(180, 0)
linep1(0) = centerp(0) + chang / 2 '角球弧圆心
linep1(1) = centerp(1) - kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) '画弧

ang1 = ThisDrawing.Utility.AngleToReal(270, 0)
linep1(1) = centerp(1) + kuan / 2
Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1)

'镜像轴
linep1(0) = centerp(0)
linep1(1) = centerp(1) - kuan / 2
linep2(0) = centerp(0)
linep2(1) = centerp(1) + kuan / 2

'镜像
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
  If ent.Layer = "足球场" Then '对象在"足球场"图层中
    ent.Mirror linep1, linep2 '镜像
  End If
Next ent

'画中线
Call ThisDrawing.ModelSpace.AddLine(linep1, linep2)

'画中圈
Call ThisDrawing.ModelSpace.AddCircle(centerp, zqr)

'画外框
linep1(0) = centerp(0) - chang / 2
linep1(1) = centerp(1) - kuan / 2
linep2(0) = centerp(0) + chang / 2
linep2(1) = centerp(1) + kuan / 2
Call drawbox(linep1, linep2)

ZoomExtents '显示整个图形

End Sub

Private Sub drawbox(p1, p2) '根据对角线坐标画矩形的子程序
Dim boxp(0 To 14) As Double

boxp(0) = p1(0)
boxp(1) = p1(1)

boxp(3) = p1(0)
boxp(4) = p2(1)

boxp(6) = p2(0)
boxp(7) = p2(1)

boxp(9) = p2(0)
boxp(10) = p1(1)

boxp(12) = p1(0)
boxp(13) = p1(1)

Call ThisDrawing.ModelSpace.AddPolyline(boxp)

End Sub

下面开始分析源码：

On Error Resume Next
chang = ThisDrawing.Utility.GetReal("长度(90～120)<10500>")
If Err.Number <> 0 Then '用户输入的不是有效数字
chang = 10500
Err.Clear '清除错误
End If

    这段代码的作用是要求用户输入一个足球场长度的数字，由于getreal只能输入数字，如果输入其他字符程序就会报错，所以先要用去掉错误提示：On Error Resume Next，虽然错误不再提示，但是出错代码会err.number改变，有兴趣的读者可以用变量跟踪的方法看看这个代码的数值。您只要记住，如果这个数字不是0，那么就是有错了，这时就可以把长度定为默认值，然后用Err.Clear语句把错误代码清零。

    在画小禁区的最后一行这样写：Call drawbox(linep1, linep2)

    Drawbox并不是vba提供的方法，它是一个带参数的子程序。由于画足球场要画好几次矩形，
而vba没有提供一个现成的画矩形方法，如果每次都用一长串代码画矩形是很麻烦的，所以需要把这些麻烦的代码写到一个子程序中，在需要时只有写一条调用语句就行了。这个子程序最后几行，从“Private Sub drawbox(p1, p2) ”开始，到end sub结束，p1,p2是参数，调用时也必须写两个参数：linep1、linep2。

ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧

    画圆用addarc方法，需要4个参数：圆心、半径、起始角度、结束角度。AngleFromXAxis用于计算角度，其参数需要两个点坐标

下面看镜像操作：
For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环
  If ent.Layer = "足球场" Then '对象在"足球场"图层中
    ent.Mirror linep1, linep2 '镜像
  End If
Next ent

    本例只对“足球场”图层中的对象进行镜像，所以要对全部对象进行循环，判断对象的图层属性，只有位于“足球场”图层中的对象才作镜像。

本课思考题：

1、对本课的例程进行修改，当用户输入长、宽不在规定的范围时要求用户重新输入

2、设计一张简单的平面图，用户输入2个参数，其他尺寸写进程序中