请教VBA的错误处理

liaowq

我希望第二次使用程序时不会提示“ 所命名的选择集已经存在”， 用下列代码： On Error Resume Next
Set sset = ThisDrawing.SelectionSets.Add(62)


If Err Then
Err.Clear


sset.Delete
End If
Set sset = ThisDrawing.SelectionSets.Add(62)
sset.SelectOnScreen
For Each ent In sset
If ent.EntityName = "AcDbLine" Then

pstart = ent.StartPoint
pend = ent.EndPoint
End If
Next 运行时不会提示错误， 但却不让选择图元， 直接运行这段代码以后的语句。 请各位帮忙解决。 谢谢！

liaowq

我已经找到错误的地方， 以下这样就可以了：

On Error Resume Next Set sset = ThisDrawing.SelectionSets("62") If Err Then Err.Clear sset.Delete End If Set sset = ThisDrawing.SelectionSets.Add("62") sset.SelectOnScreen

雪山飞狐_lzh

1. On Error Resume Next
2. ThisDrawing.SelectionSets("62").delete
3. Set sset = ThisDrawing.SelectionSets.Add("62")

复制代码

王咣生

建立一个函数: 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 'Important.
End If
Next

If Not (found) Then
Set ssetObj = SSetColl.Add(name)
Else
ssetObj.Delete '
Set ssetObj = SSetColl.Add(name)
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