Dragon you dont need a ucs, just the math to tell it what plane to be on .
Cmdrduh I would be tempted to make the height a percentage of the distance betwwen the picked points.
Getpointex is in downloads.
Sub PolyArc3d()
Dim P1, P2, P3
Dim MidP(2) As Double
Dim dHt As Double, dBulge As Double '
Dim dist As Double
Dim oPline As AcadLWPolyline
Dim N As Variant
Dim dElev As Double
Dim Pts(3) As Double
Dim util As AcadUtility
Set util = ThisDrawing.Utility
P1 = GetPointEX
P2 = GetPointEX(P1)
dHt = ThisDrawing.Utility.GetDistance(, vbCrLf + "Type the height:")
MidP(0) = P1(0) + 0.5 * (P2(0) - P1(0))
MidP(1) = P1(1) + 0.5 * (P2(1) - P1(1))
MidP(2) = P1(2) + 0.5 * (P2(2) - P1(2))
dist = Length(P1, MidP)
MidP(2) = MidP(2) + dHt
P3 = MidP
N = NormalFromPoints(P1, P2, P3)
P1 = util.TranslateCoordinates(P1, acWorld, acOCS, False, N)
P2 = util.TranslateCoordinates(P2, acWorld, acOCS, False, N)
P3 = util.TranslateCoordinates(P3, acWorld, acOCS, False, N)
dElev = P1(2)
dBulge = Tan(dHt / dist)
Pts(0) = P1(0): Pts(1) = P1(1)
Pts(2) = P2(0): Pts(3) = P2(1)
Set oPline = ThisDrawing.ModelSpace.AddLightWeightPolyline(Pts)
oPline.SetBulge 0, -dBulge
oPline.Elevation = dElev
oPline.Normal = N
oPline.ConstantWidth = 0.1
End Sub
Public Function Length(Startpoint As Variant, Endpoint As Variant) As Double
Dim Stx As Double, Sty As Double, Stz As Double
Dim Enx As Double, Eny As Double, Enz As Double
Dim dX As Double, dY As Double, dZ As Double
Dim i As Integer
If IsEmpty(Startpoint) Then Err.Raise 13
i = UBound(Startpoint)
If UBound(Endpoint) = i Then
If i > 0 Then
Stx = Startpoint(0): Sty = Startpoint(1)
Enx = Endpoint(0): Eny = Endpoint(1)
dX = Stx - Enx
dY = Sty - Eny
If i = 1 Then
Length = Sqr(dX * dX + dY * dY)
Else
Stz = Startpoint(2): Enz = Endpoint(2)
dZ = Stz - Enz
Length = Sqr((dX * dX) + (dY * dY) + (dZ * dZ))
End If
Else
Exit Function
End If
Else
Exit Function
End If
End Function
Function NormalFromPoints(P0, P1, P2) As Variant
'n = u×v = (V1-V0)×(V2-V0)
Dim X1 As Double, X2 As Double
Dim Y1 As Double, Y2 As Double
Dim Z1 As Double, Z2 As Double
Dim Unit As Double
Dim x(2) As Double
Dim y(2) As Double
Dim N(2) As Double
'Get distance from zero
x(0) = P1(0) - P0(0): y(0) = P2(0) - P0(0)
x(1) = P1(1) - P0(1): y(1) = P2(1) - P0(1)
x(2) = P1(2) - P0(2): y(2) = P2(2) - P0(2)
'get CrossProduct
N(0) = x(1) * y(2) - x(2) * y(1)
N(1) = x(2) * y(0) - x(0) * y(2)
N(2) = x(0) * y(1) - x(1) * y(0)
'Convert to unit normal
Unit = Sqr(N(0) * N(0) + N(1) * N(1) + N(2) * N(2))
N(0) = N(0) / Unit: N(1) = N(1) / Unit: N(2) = N(2) / Unit
NormalFromPoints = N
End Function
