[求助]谁有利用IntersectWith方法的实例程序！

yeats

谁有利用IntersectWith方法的实例程序！


因为多段线数量大，我想用vb编程得到直线和多段线的交点！


请帮忙！！！

haohaohapp

<RE class=Code>Sub Example_IntersectWith()
    ' This example creates a line and circle and finds the points at
    ' which they intersect.
   
    ' Create the line
    Dim lineObj As AcadLine
    Dim startPt(0 To 2) As Double
    Dim endPt(0 To 2) As Double
    startPt(0) = 1: startPt(1) = 1: startPt(2) = 0
    endPt(0) = 5: endPt(1) = 5: endPt(2) = 0
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)
        
    ' Create the circle
    Dim circleObj As AcadCircle
    Dim centerPt(0 To 2) As Double
    Dim radius As Double
    centerPt(0) = 3: centerPt(1) = 3: centerPt(2) = 0
    radius = 1
    Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPt, radius)
    ZoomAll
      
    ' Find the intersection points between the line and the circle
    Dim intPoints As Variant
    intPoints = lineObj.IntersectWith(circleObj, acExtendNone)
   
    ' Print all the intersection points
    Dim I As Integer, j As Integer, k As Integer
    Dim str As String
    If VarType(intPoints) &lt;&gt; vbEmpty Then
        For I = LBound(intPoints) To UBound(intPoints)
            str = "Intersection Point[" &amp; k &amp; "] is: " &amp; intPoints(j) &amp; "," &amp; intPoints(j + 1) &amp; "," &amp; intPoints(j + 2)
            MsgBox str, , "IntersectWith Example"
            str = ""
            I = I + 2
            j = j + 3
            k = k + 1
        Next
    End If
End Sub</PRE>

yeats

谢谢了，haohaohapp！ 这方法能用做获得线与面的交点？？

haohaohapp

可以 Sub Example_IntersectWith()
' This example creates a line and circle and finds the points at
' which they intersect.

' Create the line
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double
startPt(0) = 1: startPt(1) = 1: startPt(2) = 0
endPt(0) = 5: endPt(1) = 5: endPt(2) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)

'Create the face
Dim Plate As Acad3DFace
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim Pt3(0 To 2) As Double
Dim Pt4(0 To 2) As Double
Pt1(0) = 0: Pt1(1) = 0: Pt1(2) = 0
Pt2(0) = 1: Pt2(1) = 0: Pt2(2) = 0
Pt3(0) = 1: Pt3(1) = 1: Pt3(2) = 0
Pt4(0) = 0: Pt4(1) = 1: Pt4(2) = 0
Set Plate = ThisDrawing.ModelSpace.Add3DFace(Pt1, Pt2, Pt3, Pt4)
ZoomAll

' Find the intersection points between the line and the face
Dim intPoints As Variant
intPoints = lineObj.IntersectWith(Plate, acExtendNone) ' Print all the intersection points
Dim I As Integer, j As Integer, k As Integer
Dim str As String
If VarType(intPoints) <> vbEmpty Then
For I = LBound(intPoints) To UBound(intPoints)
str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)
MsgBox str, , "IntersectWith Example"
str = ""
I = I + 2
j = j + 3
k = k + 1
Next
End If
End Sub 我只举了一个最简单的例子。要提醒你的是线与面可能有无数个交点！

yeats

再次谢谢了，haohaohapp！ 还想问下你，能不能得到已有的线和面的交点？ 这点是怎样得到的？通过捕捉吗？

haohaohapp

兄弟，你不会做个辅助线么？

yeats

线是多段线已有的，面可以自己创建！

haohaohapp

用PICK方法分别选择面和多段线中的任意一根线，通过运算可得出交点坐标。不知你是否满意

yeats

如图示得到面域与线的交点！怎么做？


我只是举例，因为线多，面是辅助的，得编程得到点坐标！

yeats

看看这个程序那里有问题！！！？/ Private Sub CommandButton1_Click()
' This example creates a line and circle and finds the points at
' which they intersect.

' Create the line
Dim lineObj As AcadLine
Dim startPt(0 To 2) As Double
Dim endPt(0 To 2) As Double
startPt(0) = 1: startPt(1) = 1: startPt(2) = 1
endPt(0) = 1: endPt(1) = -1: endPt(2) = 1
Set lineObj = ThisDrawing.ModelSpace.AddLine(startPt, endPt)

'Create the face
Dim curves(0 To 0) As AcadCircle ' 创建形成面域边界的圆。
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 2
center(1) = 2
center(2) = 0
radius = 5#
Set curves(0) = ThisDrawing.ModelSpace.AddCircle _
(center, radius) ' 创建面域
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
ZoomAll

' Find the intersection points between the line and the face
Dim intPoints As Variant
intPoints = lineObj.IntersectWith(regionObj, acExtendNone) ' Print all the intersection points
Dim I As Integer, j As Integer, k As Integer
Dim str As String
If VarType(intPoints) <> vbEmpty Then
For I = LBound(intPoints) To UBound(intPoints)
str = "Intersection Point[" & k & "] is: " & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)
MsgBox str, , "IntersectWith Example"
str = ""
I = I + 2
j = j + 3
k = k + 1
Next
End If
End Sub