打断程序问题：有时候可以运行，有时候不能
<p>源程序如下：</p><p>Sub r4() '打断<br/> Dim returnObj As AcadEntity<br/> Dim x(2), y(2) As Double<br/> Dim ss(100000) As Variant<br/> Dim det As String<br/> Dim det1 As String<br/> Dim lspPnt As String<br/> Dim minp, maxp As Variant<br/> Dim ssetobj, ssetobj2 As AcadSelectionSet<br/> Dim ent As AcadEntity<br/> 'ScreenUpdating = False<br/> <br/> On Error Resume Next<br/> SsetName = "au100"<br/> On Error Resume Next<br/> For i = 0 To ThisDrawing.SelectionSets.Count - 1<br/> Set ssetobj = ThisDrawing.SelectionSets.Item(i)<br/> If ssetobj.Name = "au100" Then ssetobj.Delete<br/> Next i<br/> Set ssetobj = ThisDrawing.SelectionSets.Add(SsetName)<br/> ssetobj.SelectOnScreen<br/> <br/> k = 0<br/> <br/> j = ssetobj.Count<br/> For i = 0 To j - 1<br/> For ii = 0 To j - 1<br/> If Abs(ssetobj.Item(i).Angle - ssetobj.Item(ii).Angle) > 0.5 Then<br/> ss(k) = ssetobj.Item(i).IntersectWith(ssetobj.Item(ii), acExtendBoth)<br/> det = GetDoubleEntTable(ssetobj.Item(i), ss(k))<br/> det1 = GetDoubleEntTable(ssetobj.Item(ii), ss(k))<br/> lspPnt = axPoint2lspPoint(ss(k))<br/> ThisDrawing.SendCommand "_break" & vbCr & det & vbCr & lspPnt & vbCr<br/> ThisDrawing.SendCommand "_break" & vbCr & det1 & vbCr & lspPnt & vbCr<br/> k = k + 1<br/> End If<br/> Next<br/> Next<br/> <br/> SsetName = "au101"<br/> On Error Resume Next<br/> For i = 0 To ThisDrawing.SelectionSets.Count - 1<br/> Set ssetobj2 = ThisDrawing.SelectionSets.Item(i)<br/> If ssetobj2.Name = "au101" Then ssetobj2.Delete<br/> Next i<br/> Set ssetobj2 = ThisDrawing.SelectionSets.Add(SsetName)<br/> <br/> ssetobj2.SelectOnScreen '删除打断中产生的小雨1000的直线<br/> For Each returnObj In ssetobj2<br/> If returnObj.Length < 1000 Then returnObj.Delete<br/> returnObj.color = acRed<br/> Next<br/> <br/> end sub</p><p><br/>'转换双元表的函数<br/>Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String<br/> Dim entHandle As String<br/> entHandle = entObj.Handle<br/> GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _<br/> ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"<br/>End Function</p><p>'转换点的函数</p><p>Public Function axPoint2lspPoint(Pnt As Variant) As String<br/> axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)<br/>End Function</p><p>'转换图元函数</p><p>Public Function axEnt2lspEnt(entObj As AcadEntity) As String<br/> Dim entHandle As String<br/> entHandle = entObj.Handle<br/> axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"<br/>End Function</p> 高手请指教阿 本帖最后由 作者 于 2008-11-22 12:45:37 编辑关闭对象捕捉试试。另外屏幕外的对象是无法操作的。 还是不行啊，如果不建立第二个选择集，打断可以实现，建立第二个选择集之后，连打断都不能实现啊？请问楼上的，是否是选择集相冲突呢？
页:
[1]