|
|
Public Function CreateUCS3Point(ByVal originWcs As Variant, ByVal xAxisPointWcs As Variant, ByVal yAxisPointWcs As Variant, _
ucsName As String, ByRef objUCS As AcadUCS) As Boolean
' 如果pt1和pt2重合
Dim math As New clsMath
If math.PointIsEqual(originWcs, xAxisPointWcs) Then
CreateUCS3Point = False
End If
Dim a1 As Double, b1 As Double, c1 As Double
Dim a2 As Double, b2 As Double, c2 As Double
Dim x As Double, y As Double, z As Double
y = (yAxisPointWcs(1) + xAxisPointWcs(1)) / 2
a1 = xAxisPointWcs(0) - originWcs(0) '
b1 = xAxisPointWcs(2) - originWcs(2)
c1 = (originWcs(1) - xAxisPointWcs(1)) * y
a2 = ((xAxisPointWcs(1) - originWcs(1)) * (yAxisPointWcs(2) - originWcs(2))) - ((yAxisPointWcs(1) - originWcs(1)) * (xAxisPointWcs(2) - originWcs(2)))
b2 = (a1 * (yAxisPointWcs(1) - originWcs(1))) - ((xAxisPointWcs(1) - originWcs(1)) * (yAxisPointWcs(0) - originWcs(0)))
c2 = (a1 * (yAxisPointWcs(2) - originWcs(2)) - b1 * (yAxisPointWcs(0) - originWcs(0))) * y
' 如果三点共线或重合
If (a1 * b2 - a2 * b1) = 0 Then
CreateUCS3Point = False
Else
x = (c1 * b2 - c2 * b1) / (a1 * b2 - a2 * b1)
z = (c2 * a1 - c1 * a2) / (a1 * b2 - a2 * b1)
' 将假定的偏移量加在坐标上
Dim ptY(0 To 2) As Double
SetPoint3d ptY, x + originWcs(0), y + originWcs(1), z + originWcs(2)
Set objUCS = ThisDrawing.UserCoordinateSystems.Add(originWcs, xAxisPointWcs, ptY, ucsName)
CreateUCS3Point = True
End If
End Function |
|
置顶卡
