[教学]：VBA新手入门学堂：从头开始学习VBA

ahlzl

如果您对VBA完全是外行，来这吧，你不会失望的！


我觉得学VBA（或其他程序），“任务驱动法”是最有效的！写出一个程序就能进一步。

第一课：用VBA画圆。

[swf w=800 h=660]http://www.xdcad.net/bbstech/develop/vba/ahlzl/vba1.swf[/swf]

ahlzl

2. Sub vba1()
   
3. '我的第一个VBA程序——画一个圆。
   
4. 
   
5. '先定圆心坐标
   
6. Dim cen(2) As Double
   
7. cen(0) = 100: cen(1) = 200: cen(2) = 0            '这就是圆心的坐标
   
8. 
   
9. '再定半径
   
10. Dim R As Double
    
11. R = 300                                           '这就是半径
    
12. 
    
13. '有了圆心和半径就可以画圆了！
    
14. Dim C As AcadCircle
    
15. Set C = ThisDrawing.ModelSpace.AddCircle(cen, R) '在“当前文档”的“模型空间”里“画圆”
    
16. 
    
17. ZoomExtents
    
18. End Sub

Sub vba1()<br /> '我的第一个VBA程序——画一个圆。<br /> <br /> '先定圆心坐标<br /> Dim cen(2) As Double<br /> cen(0) = 100: cen(1) = 200: cen(2) = 0            '这就是圆心的坐标<br /> <br /> '再定半径<br /> Dim R As Double<br /> R = 300                                           '这就是半径<br /> <br /> '有了圆心和半径就可以画圆了！<br /> Dim C As AcadCircle<br /> Set C = ThisDrawing.ModelSpace.AddCircle(cen, R) '在“当前文档”的“模型空间”里“画圆”<br /> <br /> ZoomExtents<br /> End Sub

从代码中可以看出，VBA中是通过“圆心cen(2)”和“半径R”来画圆的。因此，要先给圆心、半径“赋值”，而“赋值”前，要先对相应的变量进行“声明”。

ahlzl

如果能看懂上述代码，那下面的代码都不难理解了。

2. 
   
3. Sub vba2()
   
4. 
   
5. '画一个蓝色的圆。
   
6. Dim cen(2) As Double
   
7. cen(0) = 100: cen(1) = 200: cen(2) = 0
   
8. Dim R As Double
   
9. R = 300
   
10. Dim C As AcadCircle
    
11. Set C = ThisDrawing.ModelSpace.AddCircle(cen, R) '在“当前文档”的“模型空间”里“画圆”
    
12. C.color = acBlue                                 '将圆的颜色设为蓝色
    
13. 
    
14. '画一条红色的直线
    
15. Dim sp(2) As Double, ep(2) As Double
    
16. sp(0) = 0: sp(1) = 0: sp(2) = 0
    
17. ep(0) = 300: ep(1) = 400: ep(2) = 0
    
18. Dim L As AcadLine
    
19. Set L = ThisDrawing.ModelSpace.AddLine(sp, ep)    '根据“起点”和“终点”画直线
    
20. L.color = acRed                                   '将直线的颜色设为红色
    
21. 
    
22. 
    
23. '画一圆弧，用现成的变量
    
24. pi = 3.1415926535
    
25. Dim A As AcadArc
    
26. Set A = ThisDrawing.ModelSpace.AddArc _
    
27. (sp, R, 30 * pi / 180, 150 * pi / 180)           '根据圆心、半径、起始角、终止角画圆弧
    
28. A.Lineweight = acLnWt030                         '将圆弧的线宽设为0.3mm
    
29. A.Update                                         '刷新，显示线宽
    
30. 
    
31. '过点（800，150），（120，240），（320，600），（350，720）画一二维多段线，并闭合。
    
32. Dim po(9) As Double
    
33. po(0) = 800: po(1) = 150: po(2) = 120: po(3) = 240
    
34. po(4) = 320: po(5) = 600: po(6) = 350: po(7) = 720
    
35. Dim PL As AcadLWPolyline
    
36. Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(po)
    
37. PL.Closed = True                                 '使多段线闭合
    
38. 
    
39. ZoomExtents                                      '范围缩放
    
40. End Sub

<br /> Sub vba2()<br /> <br /> '画一个蓝色的圆。<br /> Dim cen(2) As Double<br /> cen(0) = 100: cen(1) = 200: cen(2) = 0<br /> Dim R As Double<br /> R = 300<br /> Dim C As AcadCircle<br /> Set C = ThisDrawing.ModelSpace.AddCircle(cen, R) '在“当前文档”的“模型空间”里“画圆”<br /> C.color = acBlue                                 '将圆的颜色设为蓝色<br /> <br /> '画一条红色的直线<br /> Dim sp(2) As Double, ep(2) As Double<br /> sp(0) = 0: sp(1) = 0: sp(2) = 0<br /> ep(0) = 300: ep(1) = 400: ep(2) = 0<br /> Dim L As AcadLine<br /> Set L = ThisDrawing.ModelSpace.AddLine(sp, ep)    '根据“起点”和“终点”画直线<br /> L.color = acRed                                   '将直线的颜色设为红色<br /> <br /> <br /> '画一圆弧，用现成的变量<br /> pi = 3.1415926535<br /> Dim A As AcadArc<br /> Set A = ThisDrawing.ModelSpace.AddArc _<br /> (sp, R, 30 * pi / 180, 150 * pi / 180)           '根据圆心、半径、起始角、终止角画圆弧<br /> A.Lineweight = acLnWt030                         '将圆弧的线宽设为0.3mm<br /> A.Update                                         '刷新，显示线宽<br /> <br /> '过点（800，150），（120，240），（320，600），（350，720）画一二维多段线，并闭合。<br /> Dim po(9) As Double<br /> po(0) = 800: po(1) = 150: po(2) = 120: po(3) = 240<br /> po(4) = 320: po(5) = 600: po(6) = 350: po(7) = 720<br /> Dim PL As AcadLWPolyline<br /> Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(po)<br /> PL.Closed = True                                 '使多段线闭合<br /> <br /> ZoomExtents                                      '范围缩放<br /> End Sub

说明：画圆弧时，起始角和终止角分别为30度和150度，但VBA中的角度变量应为弧度，故应进行转化，把度化为弧度。

ahlzl

在更多的情况下，点的坐标和距离值要由用户输入。
下面我们来画一直线，两端点坐标由用户输入，再画一个圆，圆心在所画直线的起点，半径也由用户来输入。

2. 
   
3. Sub vba3()
   
4. 
   
5. '画直线
   
6. Dim sp As Variant, ep As Variant
   
7. sp = ThisDrawing.Utility.GetPoint(, "请输入直线的起点:")
   
8. ep = ThisDrawing.Utility.GetPoint(sp, "请输入直线的终点:")
   
9. Dim L As AcadLine
   
10. Set L = ThisDrawing.ModelSpace.AddLine(sp, ep)    '根据“起点”和“终点”画直线
    
11. 
    
12. '画一圆
    
13. Dim r  As Double
    
14. r = ThisDrawing.Utility.GetDistance(sp, "请输入半径")
    
15. Dim C As AcadCircle
    
16. Set C = ThisDrawing.ModelSpace.AddCircle(sp, r)
    
17. 
    
18. ZoomExtents                                      '范围缩放
    
19. End Sub

<br /> Sub vba3()<br /> <br /> '画直线<br /> Dim sp As Variant, ep As Variant<br /> sp = ThisDrawing.Utility.GetPoint(, "请输入直线的起点:")<br /> ep = ThisDrawing.Utility.GetPoint(sp, "请输入直线的终点:")<br /> Dim L As AcadLine<br /> Set L = ThisDrawing.ModelSpace.AddLine(sp, ep)    '根据“起点”和“终点”画直线<br /> <br /> '画一圆<br /> Dim r  As Double<br /> r = ThisDrawing.Utility.GetDistance(sp, "请输入半径")<br /> Dim C As AcadCircle<br /> Set C = ThisDrawing.ModelSpace.AddCircle(sp, r)<br /> <br /> ZoomExtents                                      '范围缩放<br /> End Sub

ahlzl

VBA是通过ActiveX方法和CAD交互。此外，还可使用SendCommand方法，和AutoLisp中的command函数很相似。

2. 
   
3. Sub vba4()
   
4. 'VBA代码
   
5. '以（100，200）为圆心，500为半径画圆。
   
6. ThisDrawing.SendCommand ("circle" + vbCr + "100,200" + vbCr + "500" + vbCr)
   
7. End Sub

<br /> Sub vba4()<br /> 'VBA代码<br /> '以（100，200）为圆心，500为半径画圆。<br /> ThisDrawing.SendCommand ("circle" + vbCr + "100,200" + vbCr + "500" + vbCr)<br /> End Sub

2. (defun c:cc()
   
3. ;AutoLisp代码
   
4. (command "circle" "100,200" "" "500" "")
   
5. )

(defun c:cc()<br /> ;AutoLisp代码<br /> (command "circle" "100,200" "" "500" "")<br /> )

ahlzl

一想到赋值，长不大的斑竹就觉得VBA代码的可读性要优于LISP。
如x=(a+b)/2,

2. ;LISP代码
   
3. (setq x (/ (+ a b) 2))

;LISP代码<br /> (setq x (/ (+ a b) 2))

1. 'VBA代码
   
2. x = (a + b) / 2

复制代码

越是复杂的赋值语句，VBA代码可读性好的优点就越突出。

ahlzl

第3贴中的二维多段线，在VBA中有两种：AcadLWPolyline和AcadPolyline，分别用AddLightweightPolyline方法和AddPolyline方法创建。

2. Sub Example_AddPolyline()
   
3.    
   
4.     Dim plineObj As AcadPolyline
   
5.     Dim points(0 To 14) As Double
   
6.    
   
7.     points(0) = 1: points(1) = 1: points(2) = 0
   
8.     points(3) = 1: points(4) = 2: points(5) = 0
   
9.     points(6) = 2: points(7) = 2: points(8) = 0
   
10.     points(9) = 3: points(10) = 2: points(11) = 0
    
11.     points(12) = 4: points(13) = 4: points(14) = 0
    
12.         
    
13.     Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
    
14.       
    
15. End Sub

Sub Example_AddPolyline()<br />     <br />     Dim plineObj As AcadPolyline<br />     Dim points(0 To 14) As Double<br />     <br />     points(0) = 1: points(1) = 1: points(2) = 0<br />     points(3) = 1: points(4) = 2: points(5) = 0<br />     points(6) = 2: points(7) = 2: points(8) = 0<br />     points(9) = 3: points(10) = 2: points(11) = 0<br />     points(12) = 4: points(13) = 4: points(14) = 0<br />         <br />     Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)<br />        <br /> End Sub

2. Sub Example_AddLightWeightPolyline()
   
3. 
   
4.     Dim plineObj As AcadLWPolyline
   
5.     Dim points(0 To 9) As Double
   
6.    
   
7.     points(0) = 1: points(1) = 1
   
8.     points(2) = 1: points(3) = 2
   
9.     points(4) = 2: points(5) = 2
   
10.     points(6) = 3: points(7) = 2
    
11.     points(8) = 4: points(9) = 4
    
12.         
    
13.     Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)
    
14. 
    
15. End Sub

Sub Example_AddLightWeightPolyline()<br /> <br />     Dim plineObj As AcadLWPolyline<br />     Dim points(0 To 9) As Double<br />     <br />     points(0) = 1: points(1) = 1<br />     points(2) = 1: points(3) = 2<br />     points(4) = 2: points(5) = 2<br />     points(6) = 3: points(7) = 2<br />     points(8) = 4: points(9) = 4<br />         <br />     Set plineObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(points)<br /> <br /> End Sub

ahlzl

学了一段时间，要测验一下……

出个题目：画一个三角形和它的三条中线，要求三角形的三个角点由用户输入，三角形和其中线由程序自动生成。

哦，还有一难点的附加题：画一个三角形和它的三条角平分线，要求三角形的三个角点由用户输入，三角形和其角平分线由程序自动生成。