I'm not sure this is the best way to do this but it apperars to work ok.
I've found some functions on the disussion group from James Belshan that helped
{Option Explicit
Public Sub Bolts()
Dim IntDiameter As Integer
Dim varPnt1 As Variant
Dim varPnt1UCS As Variant
Dim varPnt2 As Variant
Dim dblRadius As Double
Dim dblHeight As Double
Dim dblCenter(2) As Double
Dim objEnt As Acad3DSolid
Dim xAxisPnt(2) As Double
Dim yAxisPnt(2) As Double
Dim origin(2) As Double
Dim testUCS As AcadUCS
IntDiameter = ThisDrawing.Utility.GetInteger("Input bolt diameter: ")
varPnt1 = ThisDrawing.Utility.GetPoint(, "Pick bolt head side")
varPnt1UCS = ThisDrawing.Utility.TranslateCoordinates(varPnt1, acWorld, acUCS, False)
varPnt2 = ThisDrawing.Utility.GetPoint(varPnt1UCS, "Pick nut side")
dblHeight = Distance(varPnt1, varPnt2)
dblRadius = IntDiameter / 2
'' calculate center point from input
dblCenter(0) = varPnt1(0)
dblCenter(1) = varPnt1(1)
dblCenter(2) = varPnt1(2) + (dblHeight / 2)
'' draw the entity
Set objEnt = ThisDrawing.ModelSpace.AddCylinder(dblCenter, dblRadius, dblHeight)
objEnt.Update
origin(0) = varPnt1(0)
origin(1) = varPnt1(1)
origin(2) = varPnt1(2)
xAxisPnt(0) = varPnt2(0)
xAxisPnt(1) = varPnt2(1)
xAxisPnt(2) = varPnt2(2)
yAxisPnt(0) = varPnt1(0)
yAxisPnt(1) = varPnt1(1)
yAxisPnt(2) = varPnt1(2) + dblHeight
Set testUCS = Add_UCS_improved(origin, xAxisPnt, yAxisPnt, "test")
ThisDrawing.ActiveUCS = testUCS
Dim dblAngle As Double
Dim dbla As Double
Dim dblb As Double
Dim dblc As Double
dbla = dblHeight
dblb = dbla
dblc = Distance(yAxisPnt, varPnt2)
dblAngle = (((dbla * dbla) + (dblb * dblb) - (dblc * dblc)) / (2 * dbla * dblb))
dblAngle = Atn(-dblAngle / Sqr(-dblAngle * dblAngle + 1)) + 2 * Atn(1)
dblAngle = -dblAngle
objEnt.Rotate varPnt1, dblAngle
End Sub
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
Function Cross3D(A As Variant, B As Variant) As Variant
' A and B must be dimensioned Double(0 to 2)
Dim C(0 To 2) As Double
C(0) = A(1) * B(2) - A(2) * B(1)
C(1) = -(A(0) * B(2) - A(2) * B(0))
C(2) = A(0) * B(1) - A(1) * B(0)
Cross3D = C
End Function
Function Distance(p1, p2) As Variant
Dim xDist As Variant
Dim yDist As Variant
Dim zDist As Variant
xDist = p1(0) - p2(0)
yDist = p1(1) - p2(1)
zDist = p1(2) - p2(2)
Distance = Sqr(xDist ^ 2 + yDist ^ 2 + zDist ^ 2)
End Function}
