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

线的交点问题

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

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

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

没有人回答呀

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

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 Iffor 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

<P>i重给定值是因为没有加步长，默认为1，为得到正确坐标，需重赋值。</P>
<P>现在解决了，谢谢版主。</P>
<P>&nbsp;</P>
页: [1]
查看完整版本: 线的交点问题