社区 › VB › 如何寻找图形中所有直线的交点并把它们变成红色或与其它图元加以区别

luckyliya 发表于 2006-3-19 17:24:00

如何寻找图形中所有直线的交点并把它们变成红色或与其它图元加以区别

各位大侠帮帮忙,请问如何寻找图形中所有直线的交点并把它们变成红色或与其它图元加以区别

雪山飞狐_lzh 发表于 2006-3-19 21:20:00

找到交点就画个红色的点：），有什么问题么？

luckyliya 发表于 2006-3-19 21:54:00

可我实在很菜呀,具体代码能帮发一下吗,我的图形是这样的,直线与直线的交点都要找到

xinghesnak 发表于 2006-3-20 16:15:00

我没有2004版本,所以下面的这个大概做了个样子...具体还是得你自己调试
Dim Circle1 As AcadCircle
For i = 0 To ThisDrawing.ModelSpace.Count
    On Error Resume Next
    Set object = ThisDrawing.ModelSpace.Item(i)
    If Not Err Then
      For j = i To ThisDrawing.ModelSpace.Count
            point = object.IntersectWith(ThisDrawing.ModelSpace.Item(j), acExtendNone)
            If point"" Then
'                你要做的处理,变红或者别的
'                Set Circle1 = ThisDrawing.ModelSpace.AddCircle(point, 200)
'                Circle1.Color = acRed
            End If
      Next
    End If
Next
ThisDrawing.Application.Update

chtd 发表于 2006-3-21 21:03:00

最好定义一下选择集，不然后生成的圆也会计算。

xinghesnak 发表于 2006-3-22 08:12:00

chtd说得有道理..应该定义一下选择集

兰州人 发表于 2007-11-6 16:07:00

Sub Example_IntersectWith()
    ' This example creates a line and circle and finds the points at
    ' which they intersect.
    Dim Object As AcadEntity, Object1 As AcadEntity
    Dim ii As Integer
    Dim ppt As Variant
    For ii = 0 To ThisDrawing.ModelSpace.Count - 1
      On Error Resume Next
      Set Object = ThisDrawing.ModelSpace.Item(ii)
      If ii = ThisDrawing.ModelSpace.Count - 1 Then
      Set Object1 = ThisDrawing.ModelSpace.Item(0)
      Else
      Set Object1 = ThisDrawing.ModelSpace.Item(ii + 1)
      End If
      'Debug.Print Object.Handle, Object1.Handle
      ppt = Object1.IntersectWith(Object, acExtendBoth)
      Debug.Print ii, ppt(0), ppt(1), ppt(2)
   
   
    Next ii
End Sub

chtd 发表于 2007-11-11 22:13:00

对于不在一个平面上的两条线，IntersectWith不好使，还需要将两条线投影到一个平面上。

gdzhou 发表于 2007-11-16 10:41:00

我有多段线的
没有直线检查的。。。

junhua1123 发表于 2007-12-15 13:24:00

楼上这个检查线相交做得不到位,用的可能是IntersectWith方法,所以对不同标高的多线段检查不出.

查看完整版本: 如何寻找图形中所有直线的交点并把它们变成红色或与其它图元加以区别