Message 1 of 2
relative point for line

Not applicable
04-05-2007
08:28 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello. This is very basic, but I have not found the answer that I am looing for. What is the simplest way to pick a point and have VBA create another point in relation to the one picked so you can create a line? To add a line requires another point so there should be a very simplified verson of this:
Function SetNewPoint(aPoint, distance, angle)
'This is an internal function used to create a new point relative to another
'aPoint = the point from which the new point will be located from
'distance = the distance from aPoint to the new Point
'angle = the angle from aPoint to the new point (radians) measured from the global
' x-axis with positive angles being CCW
Dim newEndPoint(3) As Double
newEndPoint(1) = aPoint(1) + distance * Cos(angle)
newEndPoint(2) = aPoint(2) + distance * Sin(angle)
newEndPoint(3) = 0
SetNewPoint = newEndPoint
End Function
Sub DrawVertLine()
Dim P1 as Variant
Dim Pnt1 as Double
Dim Pnt2 As Double
Dim Line1 As AcadLine
P1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Enter the start point of the line: ")
Pnt1(1) = P1(0): Pnt1(2) = P1(1): Pnt1(3) = 0
Pnt2 = SetNewPoint(Pnt1, 10, Pi / 2)
Set Line1 = ThisDrawing.ModelSpace.Addline(Pnt1, Pnt2)
End Sub
Function SetNewPoint(aPoint, distance, angle)
'This is an internal function used to create a new point relative to another
'aPoint = the point from which the new point will be located from
'distance = the distance from aPoint to the new Point
'angle = the angle from aPoint to the new point (radians) measured from the global
' x-axis with positive angles being CCW
Dim newEndPoint(3) As Double
newEndPoint(1) = aPoint(1) + distance * Cos(angle)
newEndPoint(2) = aPoint(2) + distance * Sin(angle)
newEndPoint(3) = 0
SetNewPoint = newEndPoint
End Function
Sub DrawVertLine()
Dim P1 as Variant
Dim Pnt1 as Double
Dim Pnt2 As Double
Dim Line1 As AcadLine
P1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Enter the start point of the line: ")
Pnt1(1) = P1(0): Pnt1(2) = P1(1): Pnt1(3) = 0
Pnt2 = SetNewPoint(Pnt1, 10, Pi / 2)
Set Line1 = ThisDrawing.ModelSpace.Addline(Pnt1, Pnt2)
End Sub