- UID
- 433376
- 积分
- 61
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2006-5-6
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
为什么在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 于姜堰梁徐 |
|