以下代码为什么不能求得交点也不能划直线
以下代码为什么不能求得交点也不能划直线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)
请高手指点！
错误太多了！
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
非常感谢你的帮助
页:
[1]