gzy 发表于 2003-11-12 11:13:00

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

本帖最后由 作者 于 2003-11-12 18:43:26 编辑

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

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

efan2000 发表于 2003-11-12 20:29:00

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

gzy 发表于 2003-11-12 22:27:00

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

efan2000 发表于 2003-11-12 23:02:00

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

gzy 发表于 2003-11-13 09:48:00

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 发表于 2003-11-13 11:44:00

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

mccad 发表于 2003-11-13 11:44:00

还有一个办法，用VL控件，取得点取的点到线上的最近点，然后用SelectAtPoint方法得到对象。
页: [1]
查看完整版本: [VBA]如何知道折线分解后第几段