求教,关于选择集.请帮忙

foxlinshan

我想获得一个已存在圆的圆心坐标和半径数据 写了下面的一段: Private Sub Cmd_getcircle_Click()
Dim set_circle As AcadSelectionSet If Not IsNull(ThisDrawing.SelectionSets.Item("newcircle")) Then
Set set_circle = ThisDrawing.SelectionSets.Item("newcircle")
set_circle.Delete
End If
Set set_circle = ThisDrawing.SelectionSets.Add("newcircle") set_circle.SelectOnScreen Dim objcircle As AcadCircle
Set objcircle = set_circle.Item(0) Dim circle_cen As Variant
Dim circle_radius As Variant circle_cen = objcircle.Center
circle_radius = objcircle.Radius
cen_x = circle_cen(0)
cen_y = circle_cen(1)
cen_z = circle_cen(2)
circle_r = circle_radius set_circle.Delete
End Sub 但是运行的时候出现"没有主键",不知道怎么回事 但是我去掉下面一段后: If Not IsNull(ThisDrawing.SelectionSets.Item("newcircle")) Then
Set set_circle = ThisDrawing.SelectionSets.Item("newcircle")
set_circle.Delete
End If
再运行的时候就没有问题,请高手帮忙解答一下 我本来想安全创建选择集的,现在反而有问题了

雪山飞狐_lzh

[WEB]http://www.vba.cn/function/list.asp?id=295&ordertype=byletter[/WEB]

foxlinshan

谢谢版主.


可是我还是不太明白为什么会出现这样的情况,


我觉得用if判断和用函数实现这个功能原理一样


能不能再请版主说明一下.

王咣生

给你一个创建选择集的函数: '---------------------------------------------------------------------
'
'[函数] 创建选择集, 返回选择集对象
'
'--------------------------------------------------------------------- Private Function CreateSSet(ByVal name As String) As AcadSelectionSet
On Error GoTo ERR_HANDLER

Dim ssetObj As AcadSelectionSet
Dim SSetColl As AcadSelectionSets
Set SSetColl = ThisDrawing.SelectionSets

Dim index As Integer
Dim found As Boolean

found = False For index = 0 To SSetColl.count - 1
Set ssetObj = SSetColl.Item(index)
If StrComp(ssetObj.name, name, 1) = 0 Then
found = True
Exit For
End If
Next


If Not (found) Then
Set ssetObj = SSetColl.Add(name)
Else
ssetObj.Clear
End If

Set CreateSSet = ssetObj

Exit Function
ERR_HANDLER:
'-----------------------------------------------
' just print the error the the debug window.
Debug.Print "Error in sub CreateSSet: " & Err.Number & " -- "; Err.Description
Resume ERR_END

ERR_END:
End Function 调用方法: Dim ssetObj1 As AcadSelectionSet
Set ssetObj1 = CreateSSet("MySet")

雪山飞狐_lzh

选择集多次使用会有Bug，一般是将同名选择集删除而不是清空

王咣生

如果选择集已经存在,它必然能够存在,那么Clear之后,作为一个空的选择集,你认为和Delete后新建有什么区别吗? '选择集多次使用会有Bug'有什么依据吗? 告诉我们是哪个版本,也许新版本中会得到改进.

雪山飞狐_lzh

试试 Sub tttt()
Dim ss As AcadSelectionSet
Set ss = ThisDrawing.ActiveSelectionSet
ss.Clear
ss.SelectOnScreen
End Sub
先运行一遍，选择几个实体 在图形中点击文件菜单->打开，显示打开对话框，然后点击取消回到原来的图形中。 再运行一遍

foxlinshan

通过指点，好像明白了一点。


现在还有点疑问，就是我把选择集以sub开始的子过程中的时候，运行就会说我“未找到主键”，然后我把选择集放在以function开始的函数中，在通过别处调用，好像就没问题。


这两种方式有什么区别么？请高手在帮忙解释一下，谢谢

雪山飞狐_lzh

If Not IsNull(ThisDrawing.SelectionSets.Item("newcircle")) Then
先运行ThisDrawing.SelectionSets.Item("newcircle") 由于此时并没有名为"newcircle"的选择集，所以会引发错误

foxlinshan

问题解决了


谢谢！！！