Autocad VBA初級(jí)教程 (第十二課:參數(shù)化設(shè)計(jì)基礎(chǔ))

    簡(jiǎn)單地講，參數(shù)化設(shè)計(jì)就是根據(jù)參數(shù)進(jìn)行精確繪圖，繪圖所需要的參數(shù)也可以由用戶手工輸入。真正的參數(shù)化設(shè)計(jì)往往需要數(shù)據(jù)庫(kù)操作，為了簡(jiǎn)化程序，把數(shù)據(jù)庫(kù)部分放在以后的課程中詳細(xì)講解。

    本課的例程是畫(huà)一個(gè)標(biāo)準(zhǔn)足球場(chǎng)。足球場(chǎng)長(zhǎng)度90～120米，寬度45～90米，而紅色標(biāo)注的尺寸是程序默認(rèn)的，綠色標(biāo)注固定不變。

Sub court()
Dim courtlay As AcadLayer '定義球場(chǎng)圖層
Dim ent As AcadEntity '鏡像對(duì)象
Dim linep1(0 To 2) As Double '線條端點(diǎn)1
Dim linep2(0 To 2) As Double '線條端點(diǎn)2
Dim linep3(0 To 2) As Double '罰球弧端點(diǎn)1
Dim linep4(0 To 2) As Double '罰球弧端點(diǎn)2
Dim centerp As Variant '中心坐標(biāo)
xjq = 11000 '小禁區(qū)尺寸
djq = 33000 '大禁區(qū)尺寸
fqd = 11000 '罰球點(diǎn)位置
fqr = 9150 '罰球弧半徑
fqh = 14634.98 '罰球弧弦長(zhǎng)
jqqr = 1000 '角球區(qū)半徑
zqr = 9150 '中圈半徑

On Error Resume Next
chang = ThisDrawing.Utility.GetReal("長(zhǎng)度(90000～120000)<105000>")
If Err.Number <> 0 Then '用戶輸入的不是有效數(shù)字
  chang = 105000
  Err.Clear '清除錯(cuò)誤
End If
kuan = ThisDrawing.Utility.GetReal("寬度(45000～90000)<68000>")
If Err.Number <> 0 Then
  kuan = 68000
End If

centerp = ThisDrawing.Utility.GetPoint(, "定位球場(chǎng)中心:")

Set courtlay = ThisDrawing.Layers.Add("足球場(chǎng)") '設(shè)置圖層
ThisDrawing.ActiveLayer = courtlay '把當(dāng)前圖層設(shè)為足球場(chǎng)圖層

'畫(huà)小禁區(qū)
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) '調(diào)用畫(huà)矩形子程序

'畫(huà)大禁區(qū)
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)

' 畫(huà)罰球點(diǎn)
linep1(0) = centerp(0) + chang / 2 - fqd
linep1(1) = centerp(1)
Call ThisDrawing.ModelSpace.AddPoint(linep1)
'ThisDrawing.SetVariable "PDMODE", 32 '點(diǎn)樣式
ThisDrawing.SetVariable "PDSIZE", 30 '點(diǎn)的尺寸

'畫(huà)罰球弧，罰球弧圓心就是罰球點(diǎn)linep1
linep3(0) = centerp(0) + chang / 2 - djq / 2
linep3(1) = centerp(1) + fqh / 2
linep4(0) = linep3(0) '兩個(gè)端點(diǎn)的x軸相同
linep4(1) = centerp(1) - fqh / 2
ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '計(jì)算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '畫(huà)弧

'角球弧
ang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度轉(zhuǎn)換為弧度
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) '畫(huà)弧

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 '所有模型空間的對(duì)象進(jìn)行一次循環(huán)
  If ent.Layer = "足球場(chǎng)" Then '對(duì)象在"足球場(chǎng)"圖層中
    ent.Mirror linep1, linep2 '鏡像
  End If
Next ent

'畫(huà)中線
Call ThisDrawing.ModelSpace.AddLine(linep1, linep2)

'畫(huà)中圈
Call ThisDrawing.ModelSpace.AddCircle(centerp, zqr)

'畫(huà)外框
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 '顯示整個(gè)圖形

End Sub

Private Sub drawbox(p1, p2) '根據(jù)對(duì)角線坐標(biāo)畫(huà)矩形的子程序
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

下面開(kāi)始分析源碼：

On Error Resume Next
chang = ThisDrawing.Utility.GetReal("長(zhǎng)度(90～120)<10500>")
If Err.Number <> 0 Then '用戶輸入的不是有效數(shù)字
chang = 10500
Err.Clear '清除錯(cuò)誤
End If

    這段代碼的作用是要求用戶輸入一個(gè)足球場(chǎng)長(zhǎng)度的數(shù)字，由于getreal只能輸入數(shù)字，如果輸入其他字符程序就會(huì)報(bào)錯(cuò)，所以先要用去掉錯(cuò)誤提示：On Error Resume Next，雖然錯(cuò)誤不再提示，但是出錯(cuò)代碼會(huì)err.number改變，有興趣的讀者可以用變量跟蹤的方法看看這個(gè)代碼的數(shù)值。您只要記住，如果這個(gè)數(shù)字不是0，那么就是有錯(cuò)了，這時(shí)就可以把長(zhǎng)度定為默認(rèn)值，然后用Err.Clear語(yǔ)句把錯(cuò)誤代碼清零。

    在畫(huà)小禁區(qū)的最后一行這樣寫(xiě)：Call drawbox(linep1, linep2)

    Drawbox并不是vba提供的方法，它是一個(gè)帶參數(shù)的子程序。由于畫(huà)足球場(chǎng)要畫(huà)好幾次矩形，
而vba沒(méi)有提供一個(gè)現(xiàn)成的畫(huà)矩形方法，如果每次都用一長(zhǎng)串代碼畫(huà)矩形是很麻煩的，所以需要把這些麻煩的代碼寫(xiě)到一個(gè)子程序中，在需要時(shí)只有寫(xiě)一條調(diào)用語(yǔ)句就行了。這個(gè)子程序最后幾行，從“Private Sub drawbox(p1, p2) ”開(kāi)始，到end sub結(jié)束，p1,p2是參數(shù)，調(diào)用時(shí)也必須寫(xiě)兩個(gè)參數(shù)：linep1、linep2。

ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '計(jì)算角度
ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4)
Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '畫(huà)弧

    畫(huà)圓用addarc方法，需要4個(gè)參數(shù)：圓心、半徑、起始角度、結(jié)束角度。AngleFromXAxis用于計(jì)算角度，其參數(shù)需要兩個(gè)點(diǎn)坐標(biāo)

下面看鏡像操作：
For Each ent In ThisDrawing.ModelSpace '所有模型空間的對(duì)象進(jìn)行一次循環(huán)
  If ent.Layer = "足球場(chǎng)" Then '對(duì)象在"足球場(chǎng)"圖層中
    ent.Mirror linep1, linep2 '鏡像
  End If
Next ent

    本例只對(duì)“足球場(chǎng)”圖層中的對(duì)象進(jìn)行鏡像，所以要對(duì)全部對(duì)象進(jìn)行循環(huán)，判斷對(duì)象的圖層屬性，只有位于“足球場(chǎng)”圖層中的對(duì)象才作鏡像。

本課思考題：

1、對(duì)本課的例程進(jìn)行修改，當(dāng)用戶輸入長(zhǎng)、寬不在規(guī)定的范圍時(shí)要求用戶重新輸入

2、設(shè)計(jì)一張簡(jiǎn)單的平面圖，用戶輸入2個(gè)參數(shù)，其他尺寸寫(xiě)進(jìn)程序中