[VBA程序]：非直角UCS创建的问题

ybywu

非直角三角形的三个点不在一个面上，（Z值不同），有什么方法设置直角UCS?

mountains3

Public Sub u3p(op As Variant, xp As Variant, yp As Variant, ByRef transmatrix As Variant)
'this program create a new ucs by three points
Dim ox, oy, xy, od As Double
Dim disrate As Double
Dim d(0 To 2) As Double
Dim perline As AcadLine
Dim newy As Variant
Dim newucs As AcadUCS
Dim lineox As AcadLine
Dim lineoy As AcadLine
Dim anglex As Double
Dim angley As Double
ox = caldistance(op, xp)
oy = caldistance(op, yp)
xy = caldistance(xp, yp)
od = (ox ^ 2 + oy ^ 2 - xy ^ 2) / 2 / ox
disrate = od / ox
d(0) = op(0) + disrate * (xp(0) - op(0))
d(1) = op(1) + disrate * (xp(1) - op(1))
d(2) = op(2) + disrate * (xp(2) - op(2))
Set perline = ThisDrawing.ModelSpace.AddLine(d, yp)
     perline.Move d, op
     newy = perline.endPoint
perline.Delete
Set newucs = ThisDrawing.UserCoordinateSystems.Add(op, xp, newy, "New_UCS")
ThisDrawing.ActiveUCS = newucs
transmatrix = newucs.GetUCSMatrix
End Sub