[讨论]在Excel中申明为通用对象IntersectWith方法无法求出延伸交点

黄玉宏

为什么在Excel中申明为通用对象IntersectWith方法无法求出延伸交点

Sub 求多段线交点()

Dim acadapp As AcadApplication

'上句申明acadapp为明确的Acad对象，须引用"AutoCAD 2006 Type Library"类型库。如修改为Dim acadapp As Object（优点：不需引用CAD类型库而将程序做成通用程序）其余一点不变，则本程序无法用IntersectWith求出延伸交点，不知为什么？各位高手和斑主能否帮助解释一下。

Dim plineObj1 As Object     '轻便多段线1

Dim points1(0 To 13) As Double

Dim plineObj2 As Object     '轻便多段线2

Dim points2(0 To 13) As Double

On Error Resume Next

Set acadapp = GetObject(, "AUTOCAD.APPLICATION")

If Err Then

Set acadapp = CreateObject("AUTOCAD.APPLICATION")

End If

acadapp.Visible = True

points1(0) = -17.25: points1(1) = 2.43

points1(2) = -12.75: points1(3) = 5.43

points1(4) = -12: points1(5) = 5.46

points1(6) = 0: points1(7) = 5.7

points1(8) = 12: points1(9) = 5.46

points1(10) = 12.75: points1(11) = 5.43

points1(12) = 17.25: points1(13) = 2.43

Set plineObj1 = acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points1)

points2(0) = -18.3: points2(1) = 2.2

points2(2) = -15.5: points2(3) = 2.3

points2(4) = -8: points2(5) = 3.5

points2(6) = 0: points2(7) = 4.6

points2(8) = 8.2: points2(9) = 2.2

points2(10) = 12.5: points2(11) = 1.8

points2(12) = 16.3: points2(13) = 3

Set plineObj2 = acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points2)

Dim intPoints As Variant  

intPoints = plineObj2.IntersectWith(plineObj1, acExtendBoth)

MsgBox UBound(intPoints)  

'上句Dim acadapp As AcadApplication显示为5,如Dim acadapp As Object显示为-1即无交点，为什么？

Dim I As Integer, j As Integer, k As Integer

Dim str As String

If VarType(intPoints) <> vbEmpty Then

For I = LBound(intPoints) To UBound(intPoints)

str = "交点(" & k & ")：" & intPoints(j) & "," & intPoints(j + 1) & "," & intPoints(j + 2)

MsgBox str, , "IntersectWith Example"

str = ""

I = I + 2

j = j + 3      '+3是因为一个点有3个坐标x.y.z

k = k + 1      '循环次数累加

Next

End If

End Sub

结果为：交点(0):-17.5550943396226,2.22660377358491,0

        交点(1):16.3644642857143,3.02035714285714,0

 

恳请各位高手和斑主帮助回答我的问题，万分感谢！

 

黄玉宏　　2006.5.29   于姜堰梁徐