打断程序问题：有时候可以运行，有时候不能

liuyang4740

源程序如下：

Sub r4()                          '打断
    Dim returnObj As AcadEntity
    Dim x(2), y(2) As Double
    Dim ss(100000) As Variant
    Dim det As String
    Dim det1 As String
    Dim lspPnt As String
    Dim minp, maxp As Variant
    Dim ssetobj, ssetobj2 As AcadSelectionSet
    Dim ent As AcadEntity
    'ScreenUpdating = False
   
    On Error Resume Next
    SsetName = "au100"
    On Error Resume Next
    For i = 0 To ThisDrawing.SelectionSets.Count - 1
        Set ssetobj = ThisDrawing.SelectionSets.Item(i)
       If ssetobj.Name = "au100" Then ssetobj.Delete
    Next i
       Set ssetobj = ThisDrawing.SelectionSets.Add(SsetName)
       ssetobj.SelectOnScreen
     
       k = 0
 
       j = ssetobj.Count
     For i = 0 To j - 1
        For ii = 0 To j - 1
          If Abs(ssetobj.Item(i).Angle - ssetobj.Item(ii).Angle) > 0.5 Then
            ss(k) = ssetobj.Item(i).IntersectWith(ssetobj.Item(ii), acExtendBoth)
            det = GetDoubleEntTable(ssetobj.Item(i), ss(k))
            det1 = GetDoubleEntTable(ssetobj.Item(ii), ss(k))
            lspPnt = axPoint2lspPoint(ss(k))
            ThisDrawing.SendCommand "_break" & vbCr & det & vbCr & lspPnt & vbCr
            ThisDrawing.SendCommand "_break" & vbCr & det1 & vbCr & lspPnt & vbCr
            k = k + 1
          End If
        Next
     Next
    
    SsetName = "au101"
    On Error Resume Next
    For i = 0 To ThisDrawing.SelectionSets.Count - 1
        Set ssetobj2 = ThisDrawing.SelectionSets.Item(i)
       If ssetobj2.Name = "au101" Then ssetobj2.Delete
    Next i
       Set ssetobj2 = ThisDrawing.SelectionSets.Add(SsetName)
                        
          ssetobj2.SelectOnScreen          '删除打断中产生的小雨1000的直线
      For Each returnObj In ssetobj2
      If returnObj.Length < 1000 Then returnObj.Delete
      returnObj.color = acRed
   Next
   
   end  sub

'转换双元表的函数
Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String
    Dim entHandle As String
    entHandle = entObj.Handle
    GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _
                     ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"
End Function

'转换点的函数

Public Function axPoint2lspPoint(Pnt As Variant) As String
    axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
End Function

'转换图元函数

Public Function axEnt2lspEnt(entObj As AcadEntity) As String
    Dim entHandle As String
    entHandle = entObj.Handle
    axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function

liuyang4740

高手请指教阿

mccad

关闭对象捕捉试试。另外屏幕外的对象是无法操作的。

liuyang4740

还是不行啊，如果不建立第二个选择集，打断可以实现，建立第二个选择集之后，连打断都不能实现啊？请问楼上的，是否是选择集相冲突呢？