社区 › VB › intersectWith函数存在Bug？

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

intersectWith函数存在Bug？

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

下面是我写的一段测试代码：
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)
**** Hidden Message *****

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

crazylsp 发表于 2014-12-3 17:06:00

交点最好用集合来做selectiom.item改成collection.item。

crazylsp 发表于 2014-12-3 17:09:00

面域是变量？可能是acadobject或acadRegion。

Real_King 发表于 2015-4-22 15:39:00

跟高程有关吧？elevation

Real_King 发表于 2015-4-22 15:39:00

两条相交线的高程应相等？

查看完整版本: intersectWith函数存在Bug？