请教VBA的错误处理
我希望第二次使用程序时不会提示“ 所命名的选择集已经存在”, 用下列代码:On Error Resume Next
<BR>Set sset = ThisDrawing.SelectionSets.Add(62)<BR> <BR> <BR>
If Err Then<BR> Err.Clear<BR> <BR> <BR> sset.Delete<BR> End If<BR>Set sset = ThisDrawing.SelectionSets.Add(62)<BR> sset.SelectOnScreen<BR> For Each ent In sset<BR> If ent.EntityName = "AcDbLine" Then<BR> <BR> pstart = ent.StartPoint<BR> pend = ent.EndPoint<BR> End If<BR> Next
运行时不会提示错误, 但却不让选择图元, 直接运行这段代码以后的语句。
请各位帮忙解决。 谢谢! 我已经找到错误的地方, 以下这样就可以了:
<TABLE class=tablebody2 style="TABLE-LAYOUT: fixed; WORD-BREAK: break-all" width="90%" border=0>
<TBODY>
<TR>
<TD style="FONT-SIZE: 9pt; LINE-HEIGHT: 12pt" width="100%">
On Error Resume Next
<BR>Set sset = ThisDrawing.SelectionSets("62")<BR> <BR> <BR>
If Err Then<BR> Err.Clear<BR> <BR> <BR> sset.Delete<BR> End If<BR>Set sset = ThisDrawing.SelectionSets.Add("62")<BR> sset.SelectOnScreen
</TD></TR></TBODY></TABLE> On Error Resume Next
ThisDrawing.SelectionSets("62").delete
Set sset = ThisDrawing.SelectionSets.Add("62")
回复
建立一个函数: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 'Important.<BR> End If<BR> Next<BR> <BR> If Not (found) Then<BR> Set ssetObj = SSetColl.Add(name)<BR> Else<BR> ssetObj.Delete '<BR> Set ssetObj = SSetColl.Add(name)<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
页:
[1]