VBA - Shrinking points

[jakebullet70]

Hi all

 

I am using this code to grab 2 points

 

v1 = ThisDrawing.Utility.GetPoint(, vbCr & "Select Point 1: ")
v2 = ThisDrawing.Utility.GetPoint(, vbCr & "Select Point 2: ")

 

The points selected can be at any angle. Now...

In certain situations I need to take 18 inches off of each side.

I used v1(0) + 18 and V1(1) - 18 and this works if the line is horizontal but that wont work once the line angle changes.

 

Any ideas? BTW, I am not an Acad programmer, Work is slow and this stuff was just tossed on my desk.

 

Thanks to all!!!

[SEANT]

I'm not sure I'm following. Your example of reducing each side of a horizontal by 18 would seem more appropriate with v1(0) + 18 and v2(0) – 18.

 

Am I not following the objective of the routine?

[jakebullet70]

I'm not sure I'm following. Your example of reducing each side of a horizontal by 18 would seem more appropriate with v1(0) + 18 and v2(0) – 18.

 

Am I not following the objective of the routine?

 

Your right, I typed it to the forum wrong. So I am using:

 

p_vPoint1(0) = (v1(0) + 18)
p_vPoint2(0) = (v2(0) - 18)

 

And that works as long as the line is horizontal but once it goes vertical its all wonky...

[SEANT]

Something like the example shown should allow for points at arbitrary angles.

 

Option Explicit

Const pi As Double = 3.14159265

Sub reduceBy18()
Dim v1 As Variant
Dim v2 As Variant
Dim dblAng As Double
Dim entLine As AcadLine
  With ThisDrawing.Utility
     v1 = .GetPoint(, "Select point 1: ")
     v2 = .GetPoint(v1, "Select point 2: ")
     dblAng = .AngleFromXAxis(v1, v2)
     v1 = .PolarPoint(v1, dblAng, 18#)
     v2 = .PolarPoint(v2, dblAng + pi, 18#)
     Set entLine = ThisDrawing.ModelSpace.AddLine(v1, v2)
  End With
End Sub

[jakebullet70]

SEANT!!!!

 

Thanks a bunch!!! That works great!!!!

[SEANT]

You're welcome. I should point out that the routine is only compatible with points at a common elevation in the WCS. Additional processing would be required to account for full 3D point selection.