创建区域的问题，大虾，请教一下，在此谢谢了！！！

freshair

Private Sub CommandButton1_Click()
Dim curves(0 To 1) As AcadEntity

Dim centerpoint(0 To 2) As Double

Dim radius As Double

Dim startangle As Double

Dim endangle As Double

centerpoint(0) = 125#: centerpoint(1) = 75#: centerpoint(2) = 0#
radius = 50#
startangle = 0
endangle = 3.141592
Set curves(0) = ThisDrawing.ModelSpace.AddArc(centerpoint, radius, startangle, endangle)

Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).StartPoint, curves(0).EndPoint)

Dim regionobj As Variant

regionobj = ThisDrawing.ModelSpace.AddRegion(curves)

regionobj(0).Color = acRed
ZoomAll

Dim i As Integer
For i = LBound(regionobj) To UBound(regionobj)

MsgBox "区域的名称为：" & regionobj(i).ObjectName

Next


End Sub

这是书上的例子，创建了一个由圆弧和直线组成的区域。我的问题是，我的直线和圆弧已知，在图上已生成了。于是我想用选择集的办法，从屏幕上直接选取要组成区域的这俩图元。然后生成面域。可是生成域的命令却执行不了。说是方法addregion作用于iacadmodelspace时失败。
我的程序是

Private Sub CommandButton1_Click()
Dim ssetobj As AcadSelectionSet
Dim i As Integer
Dim regions As Variant
Dim entobj(2) As Variant
Dim ssetcount As Integer

If ThisDrawing.SelectionSets.Count <> 0 Then
For i = 0 To ThisDrawing.SelectionSets.Count - 1
Set ssetobj = ThisDrawing.SelectionSets.Item(i)
   ssetobj.Delete
    Next
   End If
Set ssetobj = ThisDrawing.SelectionSets.Add("test")
ssetobj.SelectOnScreen
ssetcount = ssetobj.Count

For i = 0 To ssetcount - 1
   Set entobj(i) = ssetobj.Item(i)
   MsgBox "选择集的图元名称为:" & entobj(i).ObjectName

   Next

regions = ThisDrawing.ModelSpace.AddRegion(entobj)           ‘就是这句话执行不了方法addregion作用于iacadmodelspace时失败
End Sub

mccad

注意Dim entobj(2) As Variant这里有误。
程序可以这样写：

2. Private Sub lick()
   
3. Dim ssetobj As AcadSelectionSet
   
4. Dim i As Integer
   
5. Dim regions As Variant
   
6. Dim entobj() As AcadEntity
   
7. Dim ssetcount As Integer
   
8. 
   
9. If ThisDrawing.SelectionSets.Count <> 0 Then
   
10. For i = 0 To ThisDrawing.SelectionSets.Count - 1
    
11. Set ssetobj = ThisDrawing.SelectionSets.Item(i)
    
12.    ssetobj.Delete
    
13.     Next
    
14.    End If
    
15. Set ssetobj = ThisDrawing.SelectionSets.Add("test")
    
16. ssetobj.SelectOnScreen
    
17. ssetcount = ssetobj.Count
    
18. ReDim entobj(ssetcount - 1) As AcadEntity
    
19. For i = 0 To ssetcount - 1
    
20.    Set entobj(i) = ssetobj.Item(i)
    
21.    'MsgBox "选择集的图元名称为:" & entobj(i).ObjectName
    
22. 
    
23.    Next
    
24. 
    
25. regions = ThisDrawing.ModelSpace.AddRegion(entobj)
    
26. End Sub
    
27. 
    

Private Sub lick()<br /> Dim ssetobj As AcadSelectionSet<br /> Dim i As Integer<br /> Dim regions As Variant<br /> Dim entobj() As AcadEntity<br /> Dim ssetcount As Integer<br /> <br /> If ThisDrawing.SelectionSets.Count <> 0 Then<br /> For i = 0 To ThisDrawing.SelectionSets.Count - 1<br /> Set ssetobj = ThisDrawing.SelectionSets.Item(i)<br />    ssetobj.Delete<br />     Next<br />    End If<br /> Set ssetobj = ThisDrawing.SelectionSets.Add("test")<br /> ssetobj.SelectOnScreen<br /> ssetcount = ssetobj.Count<br /> ReDim entobj(ssetcount - 1) As AcadEntity<br /> For i = 0 To ssetcount - 1<br />    Set entobj(i) = ssetobj.Item(i)<br />    'MsgBox "选择集的图元名称为:" & entobj(i).ObjectName<br /> <br />    Next<br /> <br /> regions = ThisDrawing.ModelSpace.AddRegion(entobj)<br /> End Sub<br /> <br />

freshair

的确是啊，高人呢！谢谢了！谢谢！