社区 › VB › 线的交点问题

dchlmz 发表于 2006-2-27 17:26:00

线的交点问题

思路：选一条多段线，程序自动创建5条线，求交点
问题：所求交点重合为一个点？？？请高手指点。谢谢。
   Dim ent As AcadEntity

   On Error Resume Next
    N = -1
    Do
      ThisDrawing.Utility.GetEntity ent, Pnt, "选择区域范围线（多段线）："
      If Err Then Exit Sub
      If TypeName(ent) Like "IAcad*Polyline" Then Exit Do
    Loop
    Dim StartPt(0 To 2) As Double, EndPt(0 To 2) As Double
    For u = 1 To 5
   
      StartPt(0) = 100 + (u - 1) * 5
      StartPt(1) = 100
      StartPt(2) = 0
      
      EndPt(0) =120 + (u - 1) * 5
      EndPt(1) = 120
      EndPt(2) = 0
      
    Dim LineObj As AcadLine
   
    Set LineObj = ThisDrawing.ModelSpace.AddLine(StartPt, EndPt)
    LineObj.Update
   
   
    intPoints = LineObj.IntersectWith(ent, acExtendThisEntity)
   
      Dim str As String
    Dim pointObj As AcadPoint         '声明点的对象变量
    Dim Location(0 To 2) As Double    '声明点的位置数组变量
   
   
    If VarType(intPoints)vbEmpty Then
      For i = LBound(intPoints) To UBound(intPoints)
            str = "Intersection Point[" & k & "] is: " & Format(intPoints(j), "0.000") & "," & Format(intPoints(j + 1), "0.000") & "," & intPoints(j + 2)
            'MsgBox str, , "IntersectWith Example"
            
            Location(0) = Format(intPoints(j), "0.000")
            Location(1) = Format(intPoints(j + 1), "0.000")
            Location(2) = 0
            
            Set pointObj = ThisDrawing.ModelSpace.AddPoint(Location)
            str = ""
            i = i + 2
            j = j + 3
            k = k + 1
      Next i
    End If
   
    Next u

dchlmz 发表于 2006-2-28 15:37:00

没有人回答呀

雪山飞狐_lzh 发表于 2006-2-28 17:33:00

复制代码for each 语句的种子是i，为什么在循环体还要改变它的值？
Sub test2()
Dim ent As AcadEntity
   On Error Resume Next
    n = -1
    Do
      ThisDrawing.Utility.GetEntity ent, pnt, "选择区域范围线（多段线）："
      If Err Then Exit Sub
      If TypeName(ent) Like "IAcad*Polyline" Then Exit Do
    Loop
    Dim StartPt(0 To 2) As Double, EndPt(0 To 2) As Double
    For u = 1 To 5
   
      StartPt(0) = 100 + (u - 1) * 5
      StartPt(1) = 100
      StartPt(2) = 0
      
      EndPt(0) = 120 + (u - 1) * 5
      EndPt(1) = 120
      EndPt(2) = 0
      
    Dim LineObj As AcadLine
   
    Set LineObj = ThisDrawing.ModelSpace.AddLine(StartPt, EndPt)
    LineObj.Update
   
   
    intPoints = LineObj.IntersectWith(ent, acExtendThisEntity)
   
      Dim str As String
    Dim pointObj As AcadPoint         '声明点的对象变量
    Dim Location(0 To 2) As Double    '声明点的位置数组变量
   
   
    If UBound(intPoints) > 0 Then
      For i = 0 To UBound(intPoints) Step 3
            j = i / 2
            str = "Intersection Point[" & j & "] is: " & Format(intPoints(i), "0.000") & "," & Format(intPoints(i + 1), "0.000") & "," & intPoints(i + 2)
            MsgBox str, , "IntersectWith Example"
            
            Location(0) = Format(intPoints(i), "0.000")
            Location(1) = Format(intPoints(i + 1), "0.000")
            Location(2) = Format(intPoints(i + 2), "0.000")
            
            Set pointObj = ThisDrawing.ModelSpace.AddPoint(Location)
            str = ""
      Next i
    End If
   
    Next u
End Sub

dchlmz 发表于 2006-3-1 13:49:00

i重给定值是因为没有加步长，默认为1，为得到正确坐标，需重赋值。
现在解决了，谢谢版主。

查看完整版本: 线的交点问题