创建区域的问题，大虾，请教一下，在此谢谢了！！！
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 注意Dim entobj(2) As Variant这里有误。
程序可以这样写：
Private Sub lick()
Dim ssetobj As AcadSelectionSet
Dim i As Integer
Dim regions As Variant
Dim entobj() As AcadEntity
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
ReDim entobj(ssetcount - 1) As AcadEntity
For i = 0 To ssetcount - 1
Set entobj(i) = ssetobj.Item(i)
'MsgBox "选择集的图元名称为:" & entobj(i).ObjectName
Next
regions = ThisDrawing.ModelSpace.AddRegion(entobj)
End Sub
的确是啊，高人呢！谢谢了！谢谢！
页:
[1]