[VBA函数]：大家看一下这个程序，为什么不运行？

weihong0371

Sub drawcircularpavers()
    Dim brickcircles() As AcadCircle
    Dim center As Variant, radius As Double
    Dim counter As Integer
    ReDim brickcircles(txtnumberofcircles)
    With ThisDrawing.Utility
        center = .GetPoint(, "click the position for the center")
        radius = .GetDistance(center, "enter the radius")
    End With
    For counter = 0 To txtnumberofcircles - 1
    Set brickcircles(counter) = ThisDrawing.ModelSpace.AddCircle(center, (radius - counter * radius / txtnumberofcircles))
    brickcircles(counter).Color = acRed
    brickcircles(counter).Update
    drawmortar
    Next
End Sub
Sub drawmortar(center As Variant, counter As Integer, radius As Double)
    Dim startpoint(0 To 2) As Double, endpoint(0 To 2) As Double
    Dim theta As Double, stepsize As Double
    Static adjust As Double
    If frmcircleofbricks.optbrickparallel = True Then
        stepsize = 15 * 3.1415 / 180
    Else
        stepsize = 30 * 3.1415 / 180
        If adjust = 0# Then
            adjust = 15 * 3.1415 / 180
        Else
            adjust = 0#
        End If
    End If
    For theta = 0 To 360 * 3.1415 / 180 Step stepsize
    startpoint(0) = (radius - counter * radius / txtnumberofcircles) * Cos(theta + adjust) + center(0)
    startpoint(1) = (radius - counter * radius / txtnumberofcircles) * Sin(theta + adjust) + center(1)
    endpoint(0) = (radius - (counter + 1) * radius / txtnumberofcircles) * Cos(theta + adjust) + center(0)
    endpoint(1) = (radius - (counter + 1) * radius / txtnumberofcircles) * Sin(theta + adjust) + center(1)
    startpoint(2) = 0#: endpoint(2) = 0#
    With ThisDrawing.ModelSpace
        .AddLine startpoint, endpoint
        .Item(ModelSpace.Count - 1).Update
    End With
    Next
End Sub


Private Sub cmdcancel_Click()
    Unload Me
End Sub

Private Sub cmdcreatepavers_Click()
    Unload Me
    drawcircularpavers
End Sub

efan2000

主要的问题是在提示用户获取点时没有先隐藏窗体，其它的在编程中注意一下就可以了。

2. 
   
3.   [FONT=courier new]
   
4. Sub drawcircularpavers()
   
5. Dim brickcircles() As AcadCircle
   
6. Dim center As Variant, radius As Double
   
7. Dim counter As Integer
   
8. '这里首先应判断文本框是否有输入，是否是数字。
   
9. if txtnumberofcircles="" then exit sub
   
10. if not isnumeric(txtnumberofcircles) then exit sub
    
11. ReDim brickcircles(txtnumberofcircles)
    
12. '这里隐藏窗体
    
13. frmcircleofbricks.hide
    
14. With ThisDrawing.Utility
    
15. center = .GetPoint(, "click the position for the center")
    
16. radius = .GetDistance(center, "enter the radius")
    
17. End With
    
18. For counter = 0 To txtnumberofcircles - 1
    
19. Set brickcircles(counter) = ThisDrawing.ModelSpace.AddCircle(center, (radius - counter * radius / txtnumberofcircles))
    
20. brickcircles(counter).Color = acRed
    
21. brickcircles(counter).Update
    
22. '下面的语句在过程中定义了参数，但却没有对其赋值。
    
23. drawmortar center, counter, radius
    
24. Next
    
25. End Sub
    
26. Sub drawmortar(center As Variant, counter As Integer, radius As Double)
    
27. Dim startpoint(0 To 2) As Double, endpoint(0 To 2) As Double
    
28. Dim theta As Double, stepsize As Double
    
29. Static adjust As Double
    
30. If frmcircleofbricks.optbrickparallel = True Then
    
31. stepsize = 15 * 3.1415 / 180
    
32. Else
    
33. stepsize = 30 * 3.1415 / 180
    
34. If adjust = 0# Then
    
35. adjust = 15 * 3.1415 / 180
    
36. Else
    
37. adjust = 0#
    
38. End If
    
39. End If
    
40. For theta = 0 To 360 * 3.1415 / 180 Step stepsize
    
41. startpoint(0) = (radius - counter * radius / txtnumberofcircles) * Cos(theta + adjust) + center(0)
    
42. startpoint(1) = (radius - counter * radius / txtnumberofcircles) * Sin(theta + adjust) + center(1)
    
43. endpoint(0) = (radius - (counter + 1) * radius / txtnumberofcircles) * Cos(theta + adjust) + center(0)
    
44. endpoint(1) = (radius - (counter + 1) * radius / txtnumberofcircles) * Sin(theta + adjust) + center(1)
    
45. startpoint(2) = 0#: endpoint(2) = 0#
    
46. With ThisDrawing.ModelSpace
    
47. .AddLine startpoint, endpoint
    
48. 'Count前不能再有ModelSpace。
    
49. .Item(.Count - 1).Update
    
50. End With
    
51. Next
    
52. End Sub
    
53. 
    
54. 
    
55. Private Sub cmdcancel_Click()
    
56. Unload Me
    
57. End Sub
    
58. 
    
59. Private Sub cmdcreatepavers_Click()
    
60. 'Unload Me 这里就不对了，还没执行程序就把窗体卸载了，后面的程序当然就不执行了。
    
61. drawcircularpavers
    
62. End Sub
    
63.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub drawcircularpavers()<br /> Dim brickcircles() As AcadCircle<br /> Dim center As Variant, radius As Double<br /> Dim counter As Integer<br /> '这里首先应判断文本框是否有输入，是否是数字。<br /> if txtnumberofcircles="" then exit sub<br /> if not isnumeric(txtnumberofcircles) then exit sub<br /> ReDim brickcircles(txtnumberofcircles)<br /> '这里隐藏窗体<br /> frmcircleofbricks.hide<br /> With ThisDrawing.Utility<br /> center = .GetPoint(, "click the position for the center")<br /> radius = .GetDistance(center, "enter the radius")<br /> End With<br /> For counter = 0 To txtnumberofcircles - 1<br /> Set brickcircles(counter) = ThisDrawing.ModelSpace.AddCircle(center, (radius - counter * radius / txtnumberofcircles))<br /> brickcircles(counter).Color = acRed<br /> brickcircles(counter).Update<br /> '下面的语句在过程中定义了参数，但却没有对其赋值。<br /> drawmortar center, counter, radius<br /> Next<br /> End Sub<br /> Sub drawmortar(center As Variant, counter As Integer, radius As Double)<br /> Dim startpoint(0 To 2) As Double, endpoint(0 To 2) As Double<br /> Dim theta As Double, stepsize As Double<br /> Static adjust As Double<br /> If frmcircleofbricks.optbrickparallel = True Then<br /> stepsize = 15 * 3.1415 / 180<br /> Else<br /> stepsize = 30 * 3.1415 / 180<br /> If adjust = 0# Then<br /> adjust = 15 * 3.1415 / 180<br /> Else<br /> adjust = 0#<br /> End If<br /> End If<br /> For theta = 0 To 360 * 3.1415 / 180 Step stepsize<br /> startpoint(0) = (radius - counter * radius / txtnumberofcircles) * Cos(theta + adjust) + center(0)<br /> startpoint(1) = (radius - counter * radius / txtnumberofcircles) * Sin(theta + adjust) + center(1)<br /> endpoint(0) = (radius - (counter + 1) * radius / txtnumberofcircles) * Cos(theta + adjust) + center(0)<br /> endpoint(1) = (radius - (counter + 1) * radius / txtnumberofcircles) * Sin(theta + adjust) + center(1)<br /> startpoint(2) = 0#: endpoint(2) = 0#<br /> With ThisDrawing.ModelSpace<br /> .AddLine startpoint, endpoint<br /> 'Count前不能再有ModelSpace。<br /> .Item(.Count - 1).Update<br /> End With<br /> Next<br /> End Sub<br /> <br /> <br /> Private Sub cmdcancel_Click()<br /> Unload Me<br /> End Sub<br /> <br /> Private Sub cmdcreatepavers_Click()<br /> 'Unload Me 这里就不对了，还没执行程序就把窗体卸载了，后面的程序当然就不执行了。 <br /> drawcircularpavers<br /> End Sub<br />   [/FONT]<br />

weihong0371

我很高兴你能帮忙解决这个问题！我是vba的爱好者，只是现在水平还不行！！很希望向你多学些！

efan2000

欢迎常来，每个人总有第一次，总有从不熟悉到熟悉的过程。只要自己掌握了编程的方法和技巧，那么你也可以成为VBA的高手。