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

intersectWith函数存在Bug？

<P>具体内容请参加下面的贴子：<BR><A href="dispbbs.asp?boardID=14&amp;ID=48355&amp;page=1" target="_blank" >dispbbs.asp?boardID=14&amp;ID=48355&amp;page=1</A></P>
<P>下面是我写的一段测试代码：<BR>Public Sub test()<BR>&nbsp;&nbsp;&nbsp; On Error GoTo LAST<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; Dim sset As AcadSelectionSet<BR>&nbsp;&nbsp;&nbsp; Set sset = ThisDrawing.SelectionSets.Add("Exapmle")<BR>&nbsp;&nbsp;&nbsp; sset.SelectOnScreen<BR>&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp; If sset.Count = 2 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim ent1 As AcadEntity, ent2 As AcadEntity<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ent1 = sset.Item(0)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set ent2 = sset.Item(1)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim pt As Variant<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; pt = ent1.IntersectWith(ent2, acExtendNone)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If UBound(pt) &lt; 0 Then<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "无交点"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "有交点"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; End If<BR>&nbsp;&nbsp;&nbsp; <BR>LAST:<BR>&nbsp;&nbsp;&nbsp; sset.Delete<BR>End Sub<BR></P>

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

<P>请版主多多发上VBA知识！</P>

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

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

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

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

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

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

bjjob1 发表于 2014-12-3 10:46:48

请教版主，如何求面域和直线的交点？
运行代码时，老是提示：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:05

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

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

本帖最后由 crazylsp 于 2014-12-3 17:13 编辑

Dim regionObj As Variant' 创建面域
面域是变量？可能是acadobject或acadRegion。

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

跟高程有关吧？elevation

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

两条相交线的高程应相等？
页: [1]
查看完整版本: intersectWith函数存在Bug？