intersectWith函数存在Bug？

zfbj · 发表于 2006-3-23 14:51:00

具体内容请参加下面的贴子：

下面是我写的一段测试代码：
Public Sub test()
On Error GoTo LAST

Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("Exapmle")
sset.SelectOnScreen

If sset.Count = 2 Then
      Dim ent1 As AcadEntity, ent2 As AcadEntity
      Set ent1 = sset.Item(0)
      Set ent2 = sset.Item(1)
      Dim pt As Variant
      pt = ent1.IntersectWith(ent2, acExtendNone)

      If UBound(pt)

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

gzmkshjsh · 发表于 2006-3-23 17:00:00

请版主多多发上VBA知识！

ljpnb · 发表于 2006-3-23 18:41:00

试了一下确实有问题，我试了有3组有交点，一组无交点，怪了。

无痕 · 发表于 2006-3-27 23:52:00

确实只能求2个交点。。。
可能是cad实数运算的误差导致，但是用region的时候，在很小的阈值内cad自动处理了（当作闭合）

zfbj · 发表于 2006-3-28 22:10:00

同意楼上的意见，已经准备用别的方案来实现。

bjjob1 · 发表于 2014-12-3 10:46:00

请教版主，如何求面域和直线的交点？
运行代码时，老是提示：object requred！
Sub Ch4_CreateRegion()
' 定义数组以保存面域的边界。
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)
Dim pnt(0 To 2) As Double, pnt2(0 To 2) As Double
pnt(0) = 0: pnt(1) = 0: pnt(2) = 0
pnt2(0) = 0: pnt2(1) = 50: pnt2(2) = 0
Dim line As AcadLine
Set line = ThisDrawing.ModelSpace.AddLine(pnt, pnt2)
Dim inter_pnt As Variant
inter_pnt = line.IntersectWith(regionObj, acExtendNone)
MsgBox inter_pnt(0)
ZoomAll
End Sub