Change of UCS

Is there any way to change the UCS by using VBA by selecting ONLY two points - the same way you would define a UCS with the ZAxis command under the regular UCS prompt.

I have coded a routine that does it, but it is about 60 lines of code & logic - for one basic command!! I think this is just too long.

Thanks

DRW

 

Dim p0 As Variant
Dim p1 As Variant
Dim ang1 As Double
Dim v1 As Variant
Dim v2 As Variant
Dim newUCS As AcadUCS

p0 = ThisDrawing.Utility.GetPoint
p1 = ThisDrawing.Utility.GetPoint

ang1 = ThisDrawing.Utility.AngleFromXAxis(p0, p1)
v1 = ThisDrawing.Utility.PolarPoint(p0, ang1, 1)
ang1 = ang1 + pi½
v2 = ThisDrawing.Utility.PolarPoint(p0, ang1, 1)
ThisDrawing.ModelSpace.AddLine p0, v1
ThisDrawing.ModelSpace.AddLine p0, v2

Set newUCS = ThisDrawing.UserCoordinateSystems.Add(p0, v1, v2, "myUCS")
ThisDrawing.ActiveUCS = newUCS

 

oops:
I forgot Public Const pi½ As Double = 3.14159265358979 / 2
and missing AddLine, of course

 

antmjr,

That works for 2nd stuff, but the ZAxis command works for 3d conditions (my problem is mainly 3d). If you follow the way ZAxis creates a UCS, the z-axis itself is defines by the specified 2 points, and the x & y axes are mutually perpendicular vectors following the right-hand rule, with the x-axis vector being at the same constant elevation as the first user selected point.

How to determine the vertical angle?

DRW

 

' sorry, I misunderstood.
' I calculate the UnitVector from 2 points p0 and p1 with the following

Private Sub UnitVector(v() As Double, ByVal p0 As Variant, ByVal p1 As Variant)
Dim i As Integer
Dim VLen As Double

For i = 0 To 2
v(i) = p1(i) - p0(i)
Next

VLen = Sqr(v(0) ^ 2 + v(1) ^ 2 + v(2) ^ 2)
If VLen = 0 Then VLen = 10 ^ -10 'ok, here you have to manage the usual problem of the division by zero
For i = 0 To 2
v(i) = v(i) / VLen
Next
End Sub

' cross and dot products:

Private Function DotProduct(u() As Double, v() As Double) As Double
DotProduct = u(0) * v(0) + u(1) * v(1) + u(2) * v(2)
End Function

Private Sub CrossProduct(u() As Double, v() As Double, normal() As Double)
Dim VLen As Double
Dim i As Integer

normal(0) = u(1) * v(2) - v(1) * u(2)
normal(1) = v(0) * u(2) - u(0) * v(2)
normal(2) = u(0) * v(1) - v(0) * u(1)
VLen = Sqr(normal(0) ^ 2 + normal(1) ^ 2 + normal(2) ^ 2)
If VLen = 0 Then VLen = 10 ^ -10
For i = 0 To 2
normal(i) = normal(i) / VLen
Next
End Sub

' To define an arbitrary UCS system having 3 WCSpoints
' (origin p0, XaxisPoint p1 and an arbitrary XYplanPoint p2),
' you have to calculate the two unitvectors x (ie p0-p1) and u (i.e. p0-p2)

Dim x(0 To 2) As Double
Dim y(0 To 2) As Double
Dim z(0 To 2) As Double
Dim u(0 To 2) As Double

Call UnitVector(x, p0, p1)
Call UnitVector(u, p0, p2)

' then:
Call CrossProduct(x, u, z) 'asse z
Call CrossProduct(z, x, y) 'asse y

' the cosine of the angle between two vectors, say x and u, is:
CosXU = DotProduct(x, u)

'(I excerpted from a dll of mine, hoping not to have forgot something...)

 

antmjr,

ahh, i will try it out. I knew it had something to do with dot products, and i did try that, but my linear algebra skill are too rusty, and i'm sure that I was calculating something incorrectly.

thanks

DRW