求教,关于选择集.请帮忙
我想获得一个已存在圆的圆心坐标和半径数据写了下面的一段:
Private Sub Cmd_getcircle_Click()
<BR>Dim set_circle As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("newcircle")) Then<BR>Set set_circle = ThisDrawing.SelectionSets.Item("newcircle")<BR>set_circle.Delete<BR>End If<BR>Set set_circle = ThisDrawing.SelectionSets.Add("newcircle")
set_circle.SelectOnScreen
Dim objcircle As AcadCircle<BR>Set objcircle = set_circle.Item(0)
Dim circle_cen As Variant<BR>Dim circle_radius As Variant
circle_cen = objcircle.Center<BR>circle_radius = objcircle.Radius<BR>cen_x = circle_cen(0)<BR>cen_y = circle_cen(1)<BR>cen_z = circle_cen(2)<BR>circle_r = circle_radius
set_circle.Delete<BR>End Sub
但是运行的时候出现"没有主键",不知道怎么回事
但是我去掉下面一段后:
If Not IsNull(ThisDrawing.SelectionSets.Item("newcircle")) Then<BR>Set set_circle = ThisDrawing.SelectionSets.Item("newcircle")<BR>set_circle.Delete<BR>End If<BR>再运行的时候就没有问题,请高手帮忙解答一下
我本来想安全创建选择集的,现在反而有问题了<BR> http://www.vba.cn/function/list.asp?id=295&ordertype=byletter 谢谢版主.
可是我还是不太明白为什么会出现这样的情况,
我觉得用if判断和用函数实现这个功能原理一样
能不能再请版主说明一下. 给你一个创建选择集的函数:
'---------------------------------------------------------------------<BR>'<BR>'[函数] 创建选择集, 返回选择集对象<BR>'<BR>'---------------------------------------------------------------------
Private Function CreateSSet(ByVal name As String) As AcadSelectionSet<BR> On Error GoTo ERR_HANDLER<BR> <BR> Dim ssetObj As AcadSelectionSet<BR> Dim SSetColl As AcadSelectionSets<BR> Set SSetColl = ThisDrawing.SelectionSets<BR> <BR> Dim index As Integer<BR> Dim found As Boolean<BR> <BR> found = False
For index = 0 To SSetColl.count - 1<BR> Set ssetObj = SSetColl.Item(index)<BR> If StrComp(ssetObj.name, name, 1) = 0 Then<BR> found = True<BR> Exit For<BR> End If<BR> Next<BR> <BR> <BR> If Not (found) Then<BR> Set ssetObj = SSetColl.Add(name)<BR> Else<BR> ssetObj.Clear<BR> End If<BR> <BR> Set CreateSSet = ssetObj<BR> <BR> Exit Function<BR>ERR_HANDLER:<BR> '-----------------------------------------------<BR> ' just print the error the the debug window.<BR> Debug.Print "Error in sub CreateSSet: " & Err.Number & " -- "; Err.Description<BR> Resume ERR_END<BR> <BR>ERR_END:<BR>End Function
调用方法:
Dim ssetObj1 As AcadSelectionSet<BR>Set ssetObj1 = CreateSSet("MySet") 选择集多次使用会有Bug,一般是将同名选择集删除而不是清空
回复
如果选择集已经存在,它必然能够存在,那么Clear之后,作为一个空的选择集,你认为和Delete后新建有什么区别吗?'<FONT color=#dddd22>选择集多次使用会有Bug'</FONT>有什么依据吗? 告诉我们是哪个版本,也许新版本中会得到改进. 试试
Sub tttt()<BR>Dim ss As AcadSelectionSet<BR>Set ss = ThisDrawing.ActiveSelectionSet<BR>ss.Clear<BR>ss.SelectOnScreen<BR>End Sub<BR>
先运行一遍,选择几个实体
在图形中点击文件菜单->打开,显示打开对话框,然后点击取消回到原来的图形中。
再运行一遍 通过指点,好像明白了一点。
现在还有点疑问,就是我把选择集以sub开始的子过程中的时候,运行就会说我“未找到主键”,然后我把选择集放在以function开始的函数中,在通过别处调用,好像就没问题。
这两种方式有什么区别么?请高手在帮忙解释一下,谢谢 If Not IsNull(ThisDrawing.SelectionSets.Item("newcircle")) Then<BR>先运行ThisDrawing.SelectionSets.Item("newcircle")
由于此时并没有名为"newcircle"的选择集,所以会引发错误 问题解决了
谢谢!!!
页:
[1]