[求助]直线相交触发事件

suwei0072000

您好：
请教一个 vba事件的编写问题。
---------------------------------------
如两条直线相交并有交点 为触发事件
来引发别的程序，应怎么做呢？
---------------------------------------
也就是说，当我画直线时如区域中有直线
相交他们需要以 半圆线隔开（请看图片）
这种用法在电路图中经常用到
---------------------------------------
用vba能不能做
============请您多指点=================
============谢谢！！===================

mccad

你可以通过画线的起点和终点两个点取得选择集，通过选择集中的对象与刚画的线的交点...[br]可以做到你所要做的工作。

ysf505

Dim MyPline As Acad3DPolyline
  
   ' On Error Resume Next

    point1 = ThisDrawing.Utility.GetPoint(, "Enter first point: ")
    point2 = ThisDrawing.Utility.GetPoint(point1, "Enter Other corner: ")
   
    ReDim vpoints(0 To 5) As Double
    vpoints(0) = point1(0)
    vpoints(1) = point1(1)
    vpoints(2) = 0
    vpoints(3) = point2(0)
    vpoints(4) = point2(1)
    vpoints(5) = 0
        
    Set MyPline = ThisDrawing.ModelSpace.Add3DPoly(vpoints)

     Dim sset As AcadSelectionSet     'Define sset as a SelectionSet object
     Dim elem As Acad3DPolyline
     Dim intersectPoint As Variant

   
    'Set sset to a new selection set named SS2 (the name doesn't matter here)
    Set sset = ThisDrawing.SelectionSets.Add("SS2")
    'Call sset.Select(acSelectionSetWindow, point1, point2)
   
       Call sset.Select(acSelectionSetCrossing, point1, point2)

        
    Dim pointObj As AcadPoint
    Dim location(0 To 2) As Double
   
  
  
        
        For I = 1 To sset.count - 1
        If sset.Item(I).ObjectName = "AcDb3dPolyline" Then
        
     
      
        Set elem = sset.Item(I)
        
        vpoints(2) = elem.Coordinates(2)
        vpoints(5) = elem.Coordinates(2)
         MyPline.Coordinates = vpoints
        ' MsgBox vpoints(5), , elem.Coordinates(2)
        
        intersectPoint = MyPline.IntersectWith(elem, acExtendNone)
      
                If VarType(intersectPoint) <> vbEmpty Then

。。。。。。。。此处加入你的程序，OK         
               
              
                End If
        End If
        Next I
   
        Set sset = Nothing

南子

Private Sub AcadDocument_ObjectAdded(ByVal Object As Object)

End Sub

Private Sub AcadDocument_ObjectModified(ByVal Object As Object)

End Sub