Function rotateXYangle(ByVal sPoint As Variant, ePoint As Variant, txtEnt As String) As Double Dim ll As AcadEntity, Alfa As Double, lll As AcadLine, Rot3D As AcadEntity Dim pp(0 To 2) As Double, ppp(0 To 2) As Double '' pp(0) = 0: pp(1) = 0: pp(2) = 0 Set Rot3D = ThisDrawing.ObjectIdToObject(txtEnt) '' Dim x As Double, x1 As Double, y As Double, y1 As Double, z As Double, z1 As Double Dim deltaX As Double, deltaY As Double, deltaZ As Double '' x1 = sPoint(0): x = ePoint(0) y1 = sPoint(1): y = ePoint(1) z1 = sPoint(2): z = ePoint(2) '' deltaX = x - x1: deltaY = y - y1: deltaZ = z - z1 Debug.Print deltaX, deltaY If deltaX > 0 And deltaY > 0 Then rotateXYangle = Atn(deltaY / deltaX) ElseIf deltaX < 0 And deltaY > 0 Then Debug.Print Atn(deltaY / deltaX) rotateXYangle = Pi + Atn(deltaY / deltaX) ElseIf deltaY < 0 And deltaX < 0 Then rotateXYangle = Pi + Atn(deltaY / deltaX) ElseIf deltaX > 0 And deltaY < 0 Then rotateXYangle = 2 * Pi + Atn(deltaY / deltaX) ElseIf deltaY = 0 And deltaX > 0 Then rotateXYangle = 0 ElseIf deltaY = 0 And deltaX < 0 Then rotateXYangle = Pi ElseIf deltaY < 0 And deltaX = 0 Then rotateXYangle = 3 / 2 * Pi ElseIf deltaY > 0 And deltaX = 0 Then rotateXYangle = Pi / 2 End If '''' Alfa = rotateXYangle + Alfa + Pi / 2 '' ppp(0) = sPoint(0) + 4 * Cos(Alfa): ppp(1) = sPoint(1) + 4 * Sin(Alfa): ppp(2) = sPoint(2) Set lll = ThisDrawing.ModelSpace.AddLine(sPoint, ppp) '' Rot3D.Move pp, sPoint Rot3D.Rotate3D ppp, sPoint, -Pi / 2 Rot3D.Rotate3D sPoint, ePoint, -Pi / 2 '' End Function |