rotate 3d

Hi
I am trying to place an entity on the end of a line then rotate it with
rotate3D. It works fine if the lines 'Z' is zero.
If it is anything but zero it will rotate the entity then offset it using
the valve that is in the 'Z'.

thanks
bob Vetrano


Sub DrawEntity()
Dim StartPt As Variant
Dim DrawEntity As AcadEntity
Dim EntityLine As AcadLine
Dim SelectedPoint As Variant
Dim I As Integer

Dim Ln1pt(0 To 11) As Double
Dim width As Double, leng As Double

leng = 4# ' length in X direction
width = -8# 'distance in y direction

'select line to place entity at start of
With ThisDrawing.Utility
.GetEntity EntityLine, SelectedPoint, "select line"

StartPt = EntityLine.StartPoint
Ln1pt(0) = StartPt(0): Ln1pt(1) = StartPt(1)
Ln1pt(2) = StartPt(0) + leng / 2: Ln1pt(3) = StartPt(1)
Ln1pt(4) = Ln1pt(2): Ln1pt(5) = StartPt(1) + width
Ln1pt(6) = Ln1pt(2) - leng: Ln1pt(7) = Ln1pt(5)
Ln1pt(8) = Ln1pt(6): Ln1pt(9) = Ln1pt(1)
Ln1pt(10) = Ln1pt(0): Ln1pt(11) = Ln1pt(1)

End With

Set DrawEntity = ThisDrawing.ModelSpace.AddLightWeightPolyline(Ln1pt)

Dim Rot1x(0 To 2) As Double
Dim Rot2x(0 To 2) As Double
Dim rotAngX As Double
Dim Rot1Y(0 To 2) As Double
Dim Rot2Y(0 To 2) As Double
Dim rotAngY As Double
Dim Rot1z(0 To 2) As Double
Dim Rot2z(0 To 2) As Double
Dim rotAngz As Double

rotAngX = -90 * 3.141592 / 180#
rotAngY = 0 * 3.141592 / 180#
rotAngz = 0 * 3.141592 / 180#

Rot1x(0) = StartPt(0): Rot1x(1) = StartPt(1): Rot1x(2) = StartPt(2)
Rot2x(0) = StartPt(0) - 4: Rot2x(1) = StartPt(1): Rot2x(2) = StartPt(2)

Rot1Y(0) = StartPt(0): Rot1Y(1) = StartPt(1): Rot1Y(2) = StartPt(2)
Rot2Y(0) = StartPt(0): Rot2Y(1) = StartPt(1) - 4: Rot2Y(2) = StartPt(2)
Rot1z(0) = StartPt(0): Rot1z(1) = StartPt(1): Rot1z(2) = StartPt(2)
Rot2z(0) = Rot1z(0): Rot2z(1) = Rot1z(1) - 4: Rot2z(2) = Rot1z(2)


DrawEntity.Rotate3D Rot1x, Rot2x, rotAngX
'DrawEntity.Rotate3D Rot1Y, Rot2x, rotAngY
'DrawEntity.Rotate3D Rot1z, Rot2x, rotAngz

End Sub

 

You have to move the new polyline to the startpoint's elevation before
rotating. If a UCS is active when you run this, it won't work, because the
lightweight polyline will be in the XY plane of the UCS and the move I do
only changes the Z-values, so the UCS must be parallel with World. I leave
a couple of copies of the object to see where it's created, moved to,
etc....

Good luck,
James


Sub DrawEntity()
Dim StartPt As Variant, FromPt(0 To 2) As Double, ToPt(0 To 2) As Double
Dim DrawEntity As AcadEntity
Dim DrawEntity2 As AcadEntity
Dim EntityLine As AcadLine
Dim SelectedPoint As Variant
Dim I As Integer

Dim Ln1pt(0 To 11) As Double
Dim width As Double, leng As Double

leng = 4# ' length in X direction
width = -8# 'distance in y direction

'select line to place entity at start of
With ThisDrawing.Utility
.GetEntity EntityLine, SelectedPoint, "select line"

StartPt = EntityLine.StartPoint
Ln1pt(0) = StartPt(0)
Ln1pt(1) = StartPt(1)
Ln1pt(2) = StartPt(0) + leng / 2
Ln1pt(3) = StartPt(1)
Ln1pt(4) = Ln1pt(2)
Ln1pt(5) = StartPt(1) + width
Ln1pt(6) = Ln1pt(2) - leng
Ln1pt(7) = Ln1pt(5)
Ln1pt(8) = Ln1pt(6)
Ln1pt(9) = Ln1pt(1)
Ln1pt(10) = Ln1pt(0)
Ln1pt(11) = Ln1pt(1)

End With

FromPt(0) = 0: ToPt(0) = 0
FromPt(1) = 0: ToPt(1) = 0
FromPt(2) = 0: ToPt(2) = StartPt(2)

Set DrawEntity = ThisDrawing.ModelSpace.AddLightWeightPolyline(Ln1pt)
DrawEntity.Copy 'to see where it was
DrawEntity.Move FromPt, ToPt
DrawEntity.Copy 'to see where it was


Dim Rot1x(0 To 2) As Double
Dim Rot2x(0 To 2) As Double
Dim rotAngX As Double
Dim Rot1Y(0 To 2) As Double
Dim Rot2Y(0 To 2) As Double
Dim rotAngY As Double
Dim Rot1z(0 To 2) As Double
Dim Rot2z(0 To 2) As Double
Dim rotAngz As Double

rotAngX = -90 * 3.141592 / 180#
rotAngY = 0 * 3.141592 / 180#
rotAngz = 0 * 3.141592 / 180#

Rot1x(0) = StartPt(0)
Rot1x(1) = StartPt(1)
Rot1x(2) = StartPt(2)
Rot2x(0) = StartPt(0) - 4
Rot2x(1) = StartPt(1)
Rot2x(2) = StartPt(2)

Rot1Y(0) = StartPt(0)
Rot1Y(1) = StartPt(1)
Rot1Y(2) = StartPt(2)
Rot2Y(0) = StartPt(0)
Rot2Y(1) = StartPt(1) - 4
Rot2Y(2) = StartPt(2)
Rot1z(0) = StartPt(0)
Rot1z(1) = StartPt(1)
Rot1z(2) = StartPt(2)
Rot2z(0) = Rot1z(0)
Rot2z(1) = Rot1z(1) - 4
Rot2z(2) = Rot1z(2)


DrawEntity.Rotate3D Rot1x, Rot2x, rotAngX
'DrawEntity.Rotate3D Rot1Y, Rot2x, rotAngY
'DrawEntity.Rotate3D Rot1z, Rot2x, rotAngz

End Sub

 

James
Thanks for your help. I realize that I have to explore UCS and how and what
it effects.

Bob Vetrano

 

I don't like the way the UCS affects objects created with VBA. It is not
consistent. VBA says it uses the World coord sys for everything, but if
there is a UCS active, it puts new objects in the plane of the UCS. I
don't know why they did it this way. All VBA-created 2D objects should come
in on the World X-Y plane, and then the VBA can transform them to where they
are supposed to be. Just my opinion.

James