align ucs to a line

how can I align(crate a new) ucs to a line?

 

UCS / OB / <<pick the line>>
___

 

by definition a ucs describes a plane, a line does not.
you could make some assumption about how you wanted to interpret the line
relative to the plane you want, like the line could be the x vector and a
line perpendicular to it could be the y - vector or visaversa or some other
relationship, that would be for you to decide how you wanted to use it.

 

looking at Paul's post I may be all wrong on this!

 

Public Sub UcsAlignObject(ByRef objEnt As AcadEntity)
Dim dblOrigin As Variant
Dim dblAngle As Double
Dim dblXvector As Variant, dblYvector As Variant
Dim objUcs As AcadUCS
Dim objLine As AcadLine
Dim objText As AcadText
Dim objMtext As AcadMText
Dim objAttribute As AcadAttribute
Dim strUcsName As String

With objAcadDoc
If TypeOf objEnt Is AcadLine Then
Set objLine = objEnt
If objLine.StartPoint(0) = objLine.EndPoint(0) Then
If objLine.StartPoint(1) < objLine.EndPoint(1) Then
dblOrigin = objLine.StartPoint
dblAngle = pi / 2
Else
dblOrigin = objLine.EndPoint
dblAngle = pi / 2
End If
ElseIf objLine.StartPoint(0) < objLine.EndPoint(0) Then
dblOrigin = objLine.StartPoint
dblAngle = .Utility.AngleFromXAxis(dblOrigin, objLine.EndPoint)
Else
dblOrigin = objLine.EndPoint
dblAngle = .Utility.AngleFromXAxis(dblOrigin, objLine.StartPoint)
End If
Set objLine = Nothing
ElseIf TypeOf objEnt Is AcadText Then
Set objText = objEnt
dblOrigin = objText.InsertionPoint
dblAngle = objText.Rotation
Set objText = Nothing
ElseIf TypeOf objEnt Is AcadMText Then
Set objMtext = objEnt
dblOrigin = objMtext.InsertionPoint
dblAngle = objMtext.Rotation
Set objMtext = Nothing
ElseIf TypeOf objEnt Is AcadAttribute Then
Set objAttribute = objEnt
dblOrigin = objAttribute.InsertionPoint
dblAngle = objAttribute.Rotation
Set objAttribute = Nothing
Else
MsgBox TypeName(objEnt)
ReDim dblOrigin(2) As Double
dblOrigin(0) = 0: dblOrigin(1) = 0: dblOrigin(2) = 0
dblAngle = 0
End If
dblXvector = .Utility.PolarPoint(dblOrigin, dblAngle, 1)
dblYvector = .Utility.PolarPoint(dblOrigin, dblAngle + pi / 2, 1)
strUcsName = "_ActiveAligned"
Set objUcs = .UserCoordinateSystems.Add(dblOrigin, dblXvector, dblYvector,
strUcsName)
.ActiveUCS = objUcs
End With
Set objUcs = Nothing
End Sub

 

Chuck,
&nbsp;&nbsp;
Am I right in thinking this will only work for objects with no Z value?
&nbsp;&nbsp;
Regards
&nbsp;&nbsp;
Wayne Ivory
IT Analyst Programmer
Wespine Industries Pty Ltd

 

Yes. That function is actually part of a larger project, and for my purposes I
only needed to rotate the UCS about the Z-axis. I should have mentioned that in
my original post. I don't think it would be difficult to extend the
functionality though.