http://www.cadtutor.net/forum/showthread.php?76914-与VBA工作不正常相关 嗨，好的，
现在我看到了问题，它可能与修剪问题有关。我认为问题在于，在黄色多段线上有一个节点，距离两条线的交点0.039 mm。第二组坐标是节点的坐标。如果我移动这个节点，使其距离交点0.060 mm，那么代码只返回一个交点。这就好像搜索半径约为0.05 mm，该半径内的任何线段都将返回与其他多段线的交点。我不明白的是，在与1区相同的其他“区域”中，不返回2个十字路口。我复制了“原始区域”，并返回了2个相交点。我在谷歌上搜索了一下，发现了很多关于IntersectWith方法的问题，所以这很可能是VBA中的一个bug。
不幸的是，我认为这个问题没有解决方法。很抱歉让我们看看有没有其他人可以帮忙。 好奇地当复制直线时，似乎“向上”返回两个交点坐标，而“向下”仅返回一个。
为了验证我的理论，尝试在Y轴的区域1和区域2之间复制区域1，在区域和右侧的白线之间工作，并返回两个坐标。
但是，如果要将区域1的结果副本在Y轴上向下移动，使其现在位于原始区域1和右侧白线底部之间，则返回一个坐标。 我合并了你的线程，并将你的代码封装在代码标签中。
请阅读代码发布指南。将来，如果你在错误的论坛上发帖，请版主帮你移动。
我可以证实你的话，RenderMan。但是为什么呢？这就是我不明白的。但是，如果OP仅适用于原始多段线，则问题不应出现，因为它似乎仅适用于某些复制的对象。
在区域1中，如果使用两条新的多段线绘制两条多段线，然后删除原始多段线，仍然会返回两个交点。这推翻了上述理论。我没有解释！ 嗨，小家伙。
我不会解决这个问题。但对我来说是正确的部分。更好地检查。问题坐标系。我想。我想知道数字是否会带来财富？当问题不接近坐标0,0,0时。当远离问题和错误时。问候语。
Sub DEDECTIPONPL()
Dim Poly1 As AcadLWPolyline
Dim Poly2 As AcadLWPolyline
Dim pts As Variant
Dim varPick As Variant
Dim objEntAs AcadEntity
ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 1: "
If objEnt.ObjectName = "AcDbPolyline" Then
Set Poly1 = objEnt
End If
ThisDrawing.Utility.GetEntity objEnt, varPick, "Select Poly 2: "
If objEnt.ObjectName = "AcDbPolyline" Then
Set Poly2 = objEnt
End If
'New . New . New . New . New
Dim pont(0 To 2) As Double
Dim kont(0 To 2) As Double
pont(0) = Poly1.Coordinates(0)
pont(1) = Poly1.Coordinates(1)
pont(2) = 0
kont(0) = 0
kont(1) = 0
kont(2) = 0
Poly1.Move pont, kont
Poly2.Move pont, kont
'New . New . New . New . New
'This Project can be dedected, 1,2 or 3 intersection point of Plines.
'This program will detect the number of point of intersection.
pts = Poly1.IntersectWith(Poly2, acExtendNone)
If UBound(pts) = 2 Then
MsgBox "1 intersection point dedected." & vbCr & _
"X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr, _
vbInformation, "Intersection Point Dedector"
ElseIf UBound(pts) = 5 Then
MsgBox "2 intersection point dedected." & vbCr & _
"X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr & _
"X= " & pts(3) & ", " & "Y= " & pts(4), _
vbInformation, "Intersection Point Dedector"
ElseIf UBound(pts) = 8 Then
MsgBox "3 intersection point dedected." & vbCr & _
"X= " & pts(0) & ", " & "Y= " & pts(1) & vbCr & _
"X= " & pts(3) & ", " & "Y= " & pts(4) & vbCr & _
"X= " & pts(6) & ", " & "Y= " & pts(7), _
vbInformation, "Intersection Point Dedector"
Else
MsgBox "intersection point number > 3" & vbCr & "Program Limits Exceed"
End If
'New . New . New . New . New
Poly1.Move kont, pont
Poly2.Move kont, pont
'New . New . New . New . New
End Sub
页:
1
[2]