[VBA]如何知道折线分解后第几段

gzy

有一条POLYLINE分成三折，鼠标选择到之后就将它分解成三段直线了。那么有没有办法知道刚才鼠标选择的是第几段呢？

If (selobj.EntityName = "AcDbPolyline") Then
   Dim explodedObjects As Variant
    explodedObjects = selobj.Explode
End If
下面应该怎么提取鼠标选择的那一段（现在变成了直线）的信息？

efan2000

object.GetEntity Object, PickedPoint[, Prompt]，GetEntity时有返回一个PickedPoint，即选择点。通过它与各段直线的关系来判断，离哪一段最近的应该就是吧。

gzy

凡兄能不能详细一点，喝醉了，看不大懂啊。
  最好帮我完善上面的程序。
多谢！

efan2000

2. Sub test()
   
3.     Dim selobj As AcadEntity
   
4.     Dim pPt As Variant
   
5.    
   
6.     On Error GoTo ErrTrap
   
7.     '选择多段线
   
8.     ThisDrawing.Utility.GetEntity selobj, pPt, "指定多段线: "
   
9.     If selobj.EntityName = "AcDbPolyline" Then
   
10.         Dim explodedObjects As Variant
    
11.         '炸开
    
12.         explodedObjects = selobj.Explode
    
13.         Dim i As Integer
    
14.         Dim sPt As Variant
    
15.         Dim ePt As Variant
    
16.         Dim EntObj As AcadEntity
    
17.         For i = 0 To UBound(explodedObjects)
    
18.             sPt = explodedObjects(i).StartPoint
    
19.             ePt = explodedObjects(i).EndPoint
    
20.             '判断选择点是否位于直线两端点的X坐标和Y坐标之内
    
21.             '一般情况下这种方法是可行的，对于特殊情况未做判断
    
22.             If (pPt(0) > sPt(0) And pPt(0) < ePt(0)) Or (pPt(0) > ePt(0) And pPt(0) < sPt(0)) Then
    
23.                 If (pPt(0) > sPt(0) And pPt(0) < ePt(0)) Or (pPt(0) > ePt(0) And pPt(0) < sPt(0)) Then
    
24.                     Set EntObj = explodedObjects(i)
    
25.                     Exit For
    
26.                 End If
    
27.             End If
    
28.         Next
    
29.         If Not (EntObj Is Nothing) Then
    
30.             Debug.Print "距选择点最近的直线: " & EntObj.Handle
    
31.         End If
    
32.     End If
    
33.     Exit Sub
    
34.    
    
35. ErrTrap:
    
36.     If ThisDrawing.GetVariable("errno") = 7 Then
    
37.         Resume
    
38.     End If
    
39.     On Error GoTo 0
    
40. End Sub

Sub test()<br />     Dim selobj As AcadEntity<br />     Dim pPt As Variant<br />     <br />     On Error GoTo ErrTrap<br />     '选择多段线<br />     ThisDrawing.Utility.GetEntity selobj, pPt, "指定多段线: "<br />     If selobj.EntityName = "AcDbPolyline" Then<br />         Dim explodedObjects As Variant<br />         '炸开<br />         explodedObjects = selobj.Explode<br />         Dim i As Integer<br />         Dim sPt As Variant<br />         Dim ePt As Variant<br />         Dim EntObj As AcadEntity<br />         For i = 0 To UBound(explodedObjects)<br />             sPt = explodedObjects(i).StartPoint<br />             ePt = explodedObjects(i).EndPoint<br />             '判断选择点是否位于直线两端点的X坐标和Y坐标之内<br />             '一般情况下这种方法是可行的，对于特殊情况未做判断<br />             If (pPt(0) > sPt(0) And pPt(0) < ePt(0)) Or (pPt(0) > ePt(0) And pPt(0) < sPt(0)) Then<br />                 If (pPt(0) > sPt(0) And pPt(0) < ePt(0)) Or (pPt(0) > ePt(0) And pPt(0) < sPt(0)) Then<br />                     Set EntObj = explodedObjects(i)<br />                     Exit For<br />                 End If<br />             End If<br />         Next<br />         If Not (EntObj Is Nothing) Then<br />             Debug.Print "距选择点最近的直线: " & EntObj.Handle<br />         End If<br />     End If<br />     Exit Sub<br />     <br /> ErrTrap:<br />     If ThisDrawing.GetVariable("errno") = 7 Then<br />         Resume<br />     End If<br />     On Error GoTo 0<br /> End Sub

gzy

Sub fj()
Dim explodedObjects As Variant
        '炸开
        explodedObjects = selobj.Explode
        Dim k As Integer
        Dim EntObj As AcadEntity
        For k = 0 To UBound(explodedObjects)
            sPt = explodedObjects(k).StartPoint
            ePt = explodedObjects(k).EndPoint
            If (pPt(0) > sPt(0) And pPt(0) < ePt(0)) Or (pPt(0) > ePt(0) And pPt(0) < sPt(0)) Then
                If (pPt(1) > sPt(1) And pPt(1) < ePt(1)) Or (pPt(1) > ePt(1) And pPt(1) < sPt(1)) Then
                    Set lineobj = explodedObjects(k)
                    mp1(0) = sPt(0)
                    mp1(1) = sPt(1)
                    mp2(0) = ePt(0)
                    mp2(1) = ePt(1)        '判断选择点是否位于直线两端点的X坐标和Y坐标之内
            '一般情况下这种方法是可行的，对于特殊情况未做判断
                  ' Exit For
                End If
            End If
        Next
        If Not (EntObj Is Nothing) Then
            Debug.Print "距选择点最近的直线: " & EntObj.Handle
        End If
End Sub
  程序怎么只执行到 If (pPt(0) > sPt(0) And pPt(0) < ePt(0)) Or (pPt(0) > ePt(0) And pPt(0) < sPt(0)) Then然后就跳出来了啊？也不经过End if或者End sub,是什么原因呢？

efan2000

pPt是选择点，使用GetEntity时返回的。这儿你没有定义，就跑到原点（0，0，0）了。

mccad

还有一个办法，用VL控件，取得点取的点到线上的最近点，然后用SelectAtPoint方法得到对象。