Constructing UCS via VBA problem ...

[Anonymous]

Dear all,

Here's a simple mathematical but (turned out) complex ACAD problem:

1) First, user needs to pick point A in World UCS
2) Then user needs to pick point B in Wolrd UCS

Now we have PntA and PntB points defining a straight line (clever indeed).
Then program calculates an angle of that line in World UCS:

Angle = AngleFromXAxis(PntA, PntB)

3) Program calculates a point C that's perpendicular to the last picked
point (B). The distance of 1 is arbitrary:

StraightAngle = ThisDrawing.Utility.AngleToReal("90", acDegrees)

PntC = ThisDrawing.Utility.PolarPoint(PntB, Angle + StraightAngle, 1)

What do I have now? Obviously, 3 points:

Point B - as a center of to-be UCS
Point A - as an X axis of to-be UCS
Point C - as an Y axis of to-be UCS

Oh, but what happens next? ACAD refuses to create a "TEST" UCS based on
defined points:

origin(0) = PntB(0): origin(1) = PntB(1): origin(2) = 0
xAxis(0) = PntA(0): xAxis(1) = PntA(1): xAxis(2) = 0
yAxis(0) = PntC(0): yAxis(1) = PntC(1): yAxis(2) = 0
Set newUCS = ThisDrawing.UserCoordinateSystems.Add(origin, xAxis, yAxis,
"TEST")

Error message goes like "UCS X axis and Y axis are not perpendicular"....
Yeah, right, how's that now?

I tried approaches like defining my own AngleToReal, using mathematically
calculated PI, constructing an arc to get a straight angle... using
whatever... and it's always the same. On the other hand, when I construct
lines in World UCS based on described points, and then manually add the UCS
in 3 points (command "UCS" "n" "3" ...) it works when I pick the constructed
lines' endpoints (?!?)...

Alough, it bothers me if I have to use SendCommand to accomplish the task as
when the procedure's done, and user tries to repeat that macro command using
right-click, he gets the "UCS" in his last-command-buffer... that was issued
while "manually" constructing @#@!% UCS...

Please help, it drives me nuts...

[Anonymous]

Another neat "feature" of Acad ActiveX.......create the UCS using 0,0,0 as
the UCS center then move the UCS to the actual center, PntB.

I saw this in a post when I was searching for just this question last
week...

HTH,
Jeff

"Maksim Sestic" wrote in message
news:4CE80F319F833A134B31AA0F2523C2C9@in.WebX.maYIadrTaRb...
> Dear all,
>
> Here's a simple mathematical but (turned out) complex ACAD problem:
>
> 1) First, user needs to pick point A in World UCS
> 2) Then user needs to pick point B in Wolrd UCS
>
> Now we have PntA and PntB points defining a straight line (clever indeed).
> Then program calculates an angle of that line in World UCS:
>
> Angle = AngleFromXAxis(PntA, PntB)
>
> 3) Program calculates a point C that's perpendicular to the last picked
> point (B). The distance of 1 is arbitrary:
>
> StraightAngle = ThisDrawing.Utility.AngleToReal("90", acDegrees)
>
> PntC = ThisDrawing.Utility.PolarPoint(PntB, Angle + StraightAngle, 1)
>
> What do I have now? Obviously, 3 points:
>
> Point B - as a center of to-be UCS
> Point A - as an X axis of to-be UCS
> Point C - as an Y axis of to-be UCS
>
> Oh, but what happens next? ACAD refuses to create a "TEST" UCS based on
> defined points:
>
> origin(0) = PntB(0): origin(1) = PntB(1): origin(2) = 0
> xAxis(0) = PntA(0): xAxis(1) = PntA(1): xAxis(2) = 0
> yAxis(0) = PntC(0): yAxis(1) = PntC(1): yAxis(2) = 0
> Set newUCS = ThisDrawing.UserCoordinateSystems.Add(origin, xAxis, yAxis,
> "TEST")
>
> Error message goes like "UCS X axis and Y axis are not perpendicular"....
> Yeah, right, how's that now?
>
> I tried approaches like defining my own AngleToReal, using mathematically
> calculated PI, constructing an arc to get a straight angle... using
> whatever... and it's always the same. On the other hand, when I construct
> lines in World UCS based on described points, and then manually add the
UCS
> in 3 points (command "UCS" "n" "3" ...) it works when I pick the
constructed
> lines' endpoints (?!?)...
>
> Alough, it bothers me if I have to use SendCommand to accomplish the task
as
> when the procedure's done, and user tries to repeat that macro command
using
> right-click, he gets the "UCS" in his last-command-buffer... that was
issued
> while "manually" constructing @#@!% UCS...
>
> Please help, it drives me nuts...
>
>

[Anonymous]

Maksim,
Does the Add_UCS_Improved function at this link help you at all? It was
made to help get past the fact that ACAD is so picky about the
perpendicularity when adding a UCS with VBA. Try sending your points A,B,C
to it instead of the built-in AddUCS.

http://groups.google.com/groups?q=belshan+ucs+perpendicular+group:autodesk.autocad.customization.vba

Good luck,
James

[Anonymous]

James,

Your function is not _always_ working 🙂 I tried it in many ways, in 2D and
3D, and sometimes it works and sometimes not... Can't get the exact
situation when it is not functioning, but when it rises one - the error is
still: "UCS X axis and Y axis are not perpendicular".

Regards,
Maksim Sestic

"James Belshan" wrote in message
news:66239994C085DDC6E473904264803C16@in.WebX.maYIadrTaRb...
> Maksim,
> Does the Add_UCS_Improved function at this link help you at all? It was
> made to help get past the fact that ACAD is so picky about the
> perpendicularity when adding a UCS with VBA. Try sending your points
A,B,C
> to it instead of the built-in AddUCS.
>
>
http://groups.google.com/groups?q=belshan+ucs+perpendicular+group:autodesk.a
utocad.customization.vba
>
> Good luck,
> James
>
>

[Anonymous]

I'm sorry to hear that the function didn't solve the problem. It's about
the best solution I am able of coming up with, and should produce exactly
perpendicular X & Y vectors to within the accuracy of double-precision math.

I added some debug statements to print out all of the variables at full
precision. If you have one that fails, I'd be interested in seeing the
values. * note: the required Cross3D function is not in this post. *

James


Function Add_UCS_improved(origin() As Double, xAxisPnt() _
As Double, yAxisPnt() As Double, ucsName As String) As AcadUCS
' origin, xAxisPnt, and yAxisPnt must all be dimmed (0 to 2)

Dim ucsObj As AcadUCS
Dim xAxisVec(0 To 2) As Double
Dim yAxisVec(0 To 2) As Double
Dim perpYaxisPnt(0 To 2) As Double
Dim xCy As Variant, perpYaxisVec As Variant

debug.print "xAxisPnt: " & xAxisPnt(0) & ", " & xAxisPnt(1) & ", " &
xAxisPnt(2)
debug.print "yAxisPnt: " & yAxisPnt(0) & ", " & yAxisPnt(1) & ", " &
yAxisPnt(2)
debug.print "origin: " & origin(0) & ", " & origin(1) & ", " &
origin(2)

xAxisVec(0) = xAxisPnt(0) - origin(0)
xAxisVec(1) = xAxisPnt(1) - origin(1)
xAxisVec(2) = xAxisPnt(2) - origin(2)
yAxisVec(0) = yAxisPnt(0) - origin(0)
yAxisVec(1) = yAxisPnt(1) - origin(1)
yAxisVec(2) = yAxisPnt(2) - origin(2)

debug.print "xAxis: " & xAxisVec(0) & ", " & xAxisVec(1) & ", " &
xAxisVec(2)
debug.print "yAxis: " & yAxisVec(0) & ", " & yAxisVec(1) & ", " &
yAxisVec(2)

xCy = Cross3D(xAxisVec, yAxisVec)

debug.print "xCy: " & xCy(0) & ", " & xCy(1) & ", " & xCy(2)

perpYaxisVec = Cross3D(xCy, xAxisVec)

debug.print "perpYaxisVec: " & perpYaxisVec(0) & ", " & perpYaxisVec(1)
& ", " & perpYaxisVec(2)

perpYaxisPnt(0) = perpYaxisVec(0) + origin(0)
perpYaxisPnt(1) = perpYaxisVec(1) + origin(1)
perpYaxisPnt(2) = perpYaxisVec(2) + origin(2)

debug.print "perpYaxisPnt: " & perpYaxisPnt(0) & ", " & perpYaxisPnt(1)
& ", " & perpYaxisPnt(2)

Set ucsObj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxisPnt,
perpYaxisPnt, ucsName)
Set Add_UCS_improved = ucsObj

End Function