Rotate solid object

[smjgsmith]

With the following code I am drawing a cylinder which I then want to get in a different orientation. At the moment it draws it vertically in WCS. How do I now get the object aligned along the 2 points I originally selected.

{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

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

End Sub

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}

[smjgsmith]

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}