Community
Solved! Go to Solution.
Sub Test()
On Error GoTo ErrorHandler
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim oLine As AcadLine
Dim oLine2 As AcadLine
Dim dAngle As Double
Dim oEnt As AcadEntity
Const HalfPi = 1.5707963267949
ThisDrawing.Utility.GetEntity oEnt, p1
If TypeOf oEnt Is AcadLine Then
Set oLine = oEnt
dAngle = oLine.Angle + HalfPi
v = ThisDrawing.Utility.GetPoint(, "Select the start point")
p1(0) = v(0)
p1(1) = v(1)
v = ThisDrawing.Utility.PolarPoint(p1, dAngle, 10)
p2(0) = v(0)
p2(1) = v(1)
Set oLine2 = ThisDrawing.ModelSpace.AddLine(p1, p2)
v = oLine.IntersectWith(oLine2, acExtendBoth) ' Note the options here
p2(0) = v(0)
p2(1) = v(1)
oLine2.EndPoint = p2
oLine2.Update
Else
End If
Exit Sub
ErrorHandler:
MsgBox "Unable to complete Sub 'Test' due to" & vbCrLf & Err.Description
Err.Clear
End Sub ' Test