[求助]如何加while语句

ljpnb · 发表于 2005-4-12 17:10:00

下面程序如何加while语句，我想循环选择圆弧，直到回车结束程序。谢谢！ Sub arc_to_circle()
   Dim cen As Variant
   Dim radius As Single
   Dim obj As AcadArc
   Dim circleObj As AcadCircle
   ThisDrawing.Utility.GetEntity obj, point, "选择圆弧:"
   cen = obj.Center
   radius = obj.radius
   obj.Delete
   Set circleObj = ThisDrawing.ModelSpace.AddCircle(cen, radius)
End Sub

雪山飞狐_lzh · 发表于 2005-4-12 21:16:00

Sub arc_to_circle()
On Error GoTo ErrHandle
   Dim cen As Variant
   Dim radius As Single
   Dim obj As AcadArc
   Dim circleObj As AcadCircle
   Do While True
   ThisDrawing.Utility.GetEntity obj, Point, "选择圆弧:"
   cen = obj.Center
   radius = obj.radius
   obj.Delete
   Set circleObj = ThisDrawing.ModelSpace.AddCircle(cen, radius)
   Loop
ErrHandle:
End Sub

ljpnb · 发表于 2005-4-12 21:28:00

多谢版主指点，现在明白了！我刚开始接触VBA，所以有很多东西要学，还望你们多多指教！！

alin · 发表于 2005-4-12 21:55:00

Sub arc_to_circle()
   Dim Centre As Variant
   Dim BasePnt As Variant
   Dim Rad As Double
   Dim ReturnObj As AcadArc
   Dim circleObj As AcadCircle
   Dim Descript As String
Do
   On Error Resume Next
   ThisDrawing.Utility.InitializeUserInput 1, " "
   ThisDrawing.Utility.GetEntity ReturnObj, BasePnt, "选择圆弧:"
   If Err  0 Then
   Descript = Err.Description
   Err.Clear
   If Descript = "类型不匹配" Then
   MsgBox "不是圆弧!"
   Else
   If Descript =    "用户输入的是关键字" Then
   Exit Do
   Else
   MsgBox "没有选择!"
   End If
   End If
   Else
   Centre = ReturnObj.center
   Rad = ReturnObj.radius
   ReturnObj.Delete
   Set circleObj = ThisDrawing.ModelSpace.AddCircle(Centre, Rad)
   End If
Loop
End Sub