求助：选择集内直线问题

liuyang4740

选择集内有2条相交直线，现在通过"break"命令实现了在交点处打断，打断之后，选择集就只有2条线 但是怎样让选择集重新包含打断了的4条直线呢？

xinglee

利用selectpoint方法。

robbin840311

ReSelSet:

  '建立选择集

  LineSelset.Select acSelectionSetAll, , , LineType, LineData

  '打断直线

  LineSelSet.Clear  '清空选择集

  goto ReSelSet   '重新建立选择集 

LZ：请问两条直线在交点处打断，通过VBA是怎么实现的？

liuyang4740

可以调用cad命令，你可以具体看看论坛上的，cad转换双元表

liuyang4740

程序如下，但是还是不能实现直线长度小于2000的自动删除，有时候可以，有时候不行，在vba界面里面按执行按钮可以，在cad里面里面点击“宏”运行就不行，为什么呢？

Sub r4()                          '相交的直线彼此打断

    Dim returnObj As AcadEntity
    Dim y(1 To 3) As Double
    Dim ss(100000) As Variant
    Dim det As String
    Dim det1 As String
    Dim lspPnt As String
    
     
    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
    
       j = SsetObj.Count
      MsgBox j
       k = 0
      
     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
          
            SsetObj.SelectAtPoint ss(k)
            k = k + 1
          End If
        Next
     Next     
   For i = 0 To SsetObj.Count
      If SsetObj.Item(i).Length < 2000 Then SsetObj.Item(i).Delete
       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)) & "))"

兰州人

liuyang4740发表于2008-6-16 20:15:00选择集内有2条相交直线，现在通过\"break\"命令实现了在交点处打断，打断之后，选择集就只有2条线 但是怎样让选择集重新包含打断了的4条直线呢？

在没打断前获得选择集的 minPoint,maxPoint坐标，如.GetBoundingBox可以获得实体的minPoint,maxPoint,打断后在重新定义sset选择集用minPoint,maxPoint

liuyang4740

.GetBoundingBox没法获得选择集的minPoint,maxPoint坐标，只有实体才能用.GetBoundingBox方法阿！