以下代码为什么不能求得交点也不能划直线

kobe

以下代码为什么不能求得交点也不能划直线

Dim InsPoint(0 To 2) As Double

Dim pt1(0 To 2), pt2(0 To 2), pt3(0 To 2) As Double

Dim SPoint, pt As Variant

Dim Hint As String
Hint = vbCrLf & "Please put in Point:"
SPoint = acadApp.ActiveDocument.Utility.GetPoint(, Hint)
InsPoint(0) = SPoint(0) + 10#

InsPoint(1) = SPoint(1)

InsPoint(2) = 0

pt1(0) = SPoint(0)
pt1(1) = SPoint(1) + 10#
pt(2) = 0

pt2(0) = SPoint(0) + 10#
pt2(1) = SPoint(1) + 10#
pt2(2) = 0

Dim La, Lb As AcadLine

Dim st1, St2, ed1, ed2 As Variant
ed1(0) = pt2(0)
ed1(1) = pt2(1)
ed1(2) = 0

St2(0) = InsPoint(0)
St2(1) = InsPoint(1)
St2(2) = 0

ed2(0) = pt1(0)
ed2(1) = pt1(1)
ed2(2) = 0

Dim cir As AcadCircle

cir = acadApp.ActiveDocument.ModelSpace.AddCircle(pt1, 20)

Set La = acadApp.ActiveDocument.ModelSpace.AddLine(SPoint, ed1)
Set Lb = acadApp.ActiveDocument.ModelSpace.AddLine(St2, ed1)

pt = Lb.IntersectWith(La, acExtendBoth)

请高手指点！

雪山飞狐_lzh

错误太多了！

Sub tttt()
Dim acadapp As AcadApplication
Set acadapp = Application
Dim InsPoint(0 To 2) As Double

Dim pt1(0 To 2) As Double, pt2(0 To 2) As Double, pt3(0 To 2) As Double

Dim SPoint, pt As Variant

Dim Hint As String
Hint = vbCrLf & "Please put in Point:"
SPoint = acadapp.ActiveDocument.Utility.GetPoint(, Hint)
InsPoint(0) = SPoint(0) + 10#

InsPoint(1) = SPoint(1)

InsPoint(2) = 0

pt1(0) = SPoint(0)
pt1(1) = SPoint(1) + 10#
pt1(2) = 0

pt2(0) = SPoint(0) + 10#
pt2(1) = SPoint(1) + 10#
pt2(2) = 0

Dim La, Lb As AcadLine

Dim st1, St2, ed1, ed2
ed1 = pt2
St2 = InsPoint
ed2 = pt1

Dim cir As AcadCircle

Set cir = acadapp.ActiveDocument.ModelSpace.AddCircle(pt1, 20)

Set La = acadapp.ActiveDocument.ModelSpace.AddLine(SPoint, ed1)
Set Lb = acadapp.ActiveDocument.ModelSpace.AddLine(St2, ed1)

pt = Lb.IntersectWith(La, acExtendBoth)

End Sub

kobe

非常感谢你的帮助