Aligning Object by points

[Anonymous]

Hi All,

Is it possible to align object by 2/3 point using .net?

Its easy to do with autocad, but I can't find a way to do it using .NET

Thanks in advance

[DiningPhilosopher]

You can use Matrix3d.AlignCoordinateSystem() and Entity.TransformBy() to do thiat.  Search the discussion groups and  any other resources you have access to for 'Matrix3d.AlignCoordinateSystem', and you should find some code that will help show how its done.

[Anonymous]

---

@DiningPhilosopher wrote:

You can use Matrix3d.AlignCoordinateSystem() and Entity.TransformBy() to do thiat.  Search the discussion groups and  any other resources you have access to for 'Matrix3d.AlignCoordinateSystem', and you should find some code that will help show how its done.

---

Hi DiningPhilosopher,

I follow your suggestion. But get an error when doing the transformation

Error Code: Autodesk.AutoCAD.Runtime.Exception : {"eCannotScaleNonUniformly"}

Did I miss something?

Here is my code :

<CommandMethod("tal")> _
Public Sub TestAlignment()
   Dim doc As Document = AcApp.DocumentManager.MdiActiveDocument
   Dim db As Database = HostApplicationServices.WorkingDatabase
   Dim ed As Editor = doc.Editor
    

   Using tr As Transaction = db.TransactionManager.StartTransaction
      Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
      Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
 

     Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Select 1 Origin")
     Dim pt1 As Point3d = ppr.Value

     ppr = ed.GetPoint(vbLf & "Select 2 Origin")
     Dim pt2 As Point3d = ppr.Value

     ppr = ed.GetPoint(vbLf & "Select 1 dest")
     Dim pt3 As Point3d = ppr.Value

     ppr = ed.GetPoint(vbLf & "Select 2 dest")
     Dim pt4 As Point3d = ppr.Value

     Dim l1 As Line = New Line(pt1, pt2)

     Dim dist As Double = l1.Length

     Dim vc As Vector3d = pt1.GetVectorTo(pt2)
     vc = vc.GetNormal

     Dim cs0 As CoordinateSystem3d = New CoordinateSystem3d(pt1, vc, vc.CrossProduct(l1.Normal).Negate)

     Dim l2 As Line = New Line(pt3, pt4)
     Dim vc1 As Vector3d = pt3.GetVectorTo(pt4)
     vc1 = vc1.GetNormal
     pt4 = l2.GetPointAtDist(dist)
     l2.EndPoint = pt4

     Dim cs1 As CoordinateSystem3d = New CoordinateSystem3d(pt3, vc1, vc.CrossProduct(l2.Normal).Negate)

     Dim mtx As Matrix3d = Matrix3d.AlignCoordinateSystem(pt1, cs0.Xaxis, cs0.Yaxis, cs0.Zaxis, pt3, _
                                         cs1.Xaxis, cs1.Yaxis, cs1.Zaxis)

     Dim per As PromptEntityResult = ed.GetEntity(vbLf & "Select Object to align")
     Dim ent As Entity = tr.GetObject(per.ObjectId, OpenMode.ForWrite)
     ent.TransformBy(mtx) --> Error Here : Autodesk.AutoCAD.Runtime.Exception : {"eCannotScaleNonUniformly"}

      tr.Commit()
   End Using
End Sub

[Alexander.Rivilis]

Example: http://adndevblog.typepad.com/autocad/2012/04/finding-transformation-matrix-for-aligning-two-entitie...

[Hallex]

Try to do it without changing UCS, here is a quick scratch

expand them to your suit:

        <CommandMethod("Agn")> _
        Public Shared Sub TestAlignObject()
            Dim db As Database = HostApplicationServices.WorkingDatabase

            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor

            Dim tr As Transaction = db.TransactionManager.StartTransaction()

            Using tr

                Try
                    ' Prompt for the object to align

                    Dim pso As New PromptSelectionOptions()
                    pso.MessageForRemoval = vbLf & "Invalid Selection."
                    pso.MessageForAdding = vbLf & "Select object:"

                    Dim per As PromptSelectionResult = ed.GetSelection(pso)

                    If per.Status <> PromptStatus.OK Then
                        Return
                    End If

                    Dim sset As SelectionSet = per.Value
                    Dim id As ObjectId = sset.GetObjectIds()(0)
                    Dim obj As Entity = TryCast(tr.GetObject(id, OpenMode.ForWrite), Entity)
                    Dim ps1 As Point3d = ed.GetPoint(vbLf & "First source point: ").Value
                    Dim pt1 As Point3d = ed.GetPoint(vbLf & "First destination point: ").Value
                    Dim ps2 As Point3d = ed.GetPoint(vbLf & "Second source point: ").Value
                    Dim pt2 As Point3d = ed.GetPoint(vbLf & "Second destination point: ").Value
                    Dim plan As Plane = obj.GetPlane()
                    Dim ang1 As Double = (pt1 - pt2).AngleOnPlane(plan)
                    Dim ang2 As Double = (ps1 - ps2).AngleOnPlane(plan)
                    Dim ang As Double = ang1 - ang2
                    Dim mtx As Matrix3d = Matrix3d.Rotation(ang, Vector3d.ZAxis, ps1)
                    obj.TransformBy(mtx)
                    mtx = Matrix3d.Displacement(pt1 - ps1)
                    obj.TransformBy(mtx)


                    tr.Commit()
                Catch ex As Autodesk.AutoCAD.Runtime.Exception
                    ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                    Return
                End Try
            End Using
        End Sub

[Anonymous]

---

@Alexander.Rivilis wrote:

Example: http://adndevblog.typepad.com/autocad/2012/04/finding-transformation-matrix-for-aligning-two-entitie...

---

Hi Alexander,

I have try your code. But it align perpendicularly, and also it will align entity size (when possible).

I'm trying to do it by making a mirror line in the middle of 1st origin and destination and 2nd origin and destination point.

The problem is if origins and destinations already in parallel, the code can't align to the opposite.

Here is my code:

<CommandMethod("tal")> _

        Public Sub TestAlignment()

            Dim doc As Document = AcApp.DocumentManager.MdiActiveDocument

            Dim db As Database = HostApplicationServices.WorkingDatabase

            Dim ed As Editor = doc.Editor

            Using tr As Transaction = db.TransactionManager.StartTransaction

                Dim bt As BlockTable = tr.GetObject(db.BlockTableId, OpenMode.ForRead)

                Dim btr As BlockTableRecord = tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)

                Dim per As PromptEntityResult = ed.GetEntity(vbLf & "Select block to align")

                Dim br As BlockReference = tr.GetObject(per.ObjectId, OpenMode.ForWrite)

                'select point origin

                Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Select 1 Origin")

                Dim pt1 As Point3d = ppr.Value

                'This will be origin point

                Dim ptO As Point3d = pt1

                ppr = ed.GetPoint(vbLf & "Select 2 Origin")

                Dim pt2 As Point3d = ppr.Value

                'select point destination

                ppr = ed.GetPoint(vbLf & "Select 1 dest")

                Dim pt3 As Point3d = ppr.Value

                ppr = ed.GetPoint(vbLf & "Select 2 dest")

                Dim pt4 As Point3d = ppr.Value

                'This will be destination point

                Dim ptD As Point3d = pt4

                'Create temporary line for origin and destination points

                Dim l1 As Line = New Line(pt1, pt2)

                Dim l2 As Line = New Line(pt3, pt4)

                'Make sure distance between origin and destination points are same

                If l2.Length > l1.Length Then

                    pt4 = l2.GetPointAtDist(l1.Length)

                    l2.EndPoint = pt4

                ElseIf l2.Length < l1.Length Then

                    pt2 = l1.GetPointAtDist(l2.Length)

                    l1.EndPoint = pt2

                End If

                'Find middle point of 1st & 2nd origin and destination

                Dim m1 As Point3d = New Point3d((pt1.X + pt3.X) * 0.5, (pt1.Y + pt3.Y) * 0.5, (pt1.Z + pt3.Z) * 0.5)

                Dim m2 As Point3d = New Point3d((pt2.X + pt4.X) * 0.5, (pt2.Y + pt4.Y) * 0.5, (pt2.Z + pt4.Z) * 0.5)

                'Create temporary line for mirroring purpose

                Dim l5 As Line3d = New Line3d(m1, m2)

                br.TransformBy(Matrix3d.Mirroring(l5))

                br.TransformBy(Matrix3d.Displacement(br.Position.GetVectorTo(ptD)))

                'br.Rotation = br.Rotation * -1

                tr.Commit()

            End Using

        End Sub

regards

Abufaisal

[Anonymous]

---

@Hallex wrote:

Try to do it without changing UCS, here is a quick scratch

expand them to your suit:

        <CommandMethod("Agn")> _
        Public Shared Sub TestAlignObject()
            Dim db As Database = HostApplicationServices.WorkingDatabase

            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim ed As Editor = doc.Editor

            Dim tr As Transaction = db.TransactionManager.StartTransaction()

            Using tr

                Try
                    ' Prompt for the object to align

                    Dim pso As New PromptSelectionOptions()
                    pso.MessageForRemoval = vbLf & "Invalid Selection."
                    pso.MessageForAdding = vbLf & "Select object:"

                    Dim per As PromptSelectionResult = ed.GetSelection(pso)

                    If per.Status <> PromptStatus.OK Then
                        Return
                    End If

                    Dim sset As SelectionSet = per.Value
                    Dim id As ObjectId = sset.GetObjectIds()(0)
                    Dim obj As Entity = TryCast(tr.GetObject(id, OpenMode.ForWrite), Entity)
                    Dim ps1 As Point3d = ed.GetPoint(vbLf & "First source point: ").Value
                    Dim pt1 As Point3d = ed.GetPoint(vbLf & "First destination point: ").Value
                    Dim ps2 As Point3d = ed.GetPoint(vbLf & "Second source point: ").Value
                    Dim pt2 As Point3d = ed.GetPoint(vbLf & "Second destination point: ").Value
                    Dim plan As Plane = obj.GetPlane()
                    Dim ang1 As Double = (pt1 - pt2).AngleOnPlane(plan)
                    Dim ang2 As Double = (ps1 - ps2).AngleOnPlane(plan)
                    Dim ang As Double = ang1 - ang2
                    Dim mtx As Matrix3d = Matrix3d.Rotation(ang, Vector3d.ZAxis, ps1)
                    obj.TransformBy(mtx)
                    mtx = Matrix3d.Displacement(pt1 - ps1)
                    obj.TransformBy(mtx)


                    tr.Commit()
                Catch ex As Autodesk.AutoCAD.Runtime.Exception
                    ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                    Return
                End Try
            End Using
        End Sub

---

Hi Hallex,

I tried your code, but it only worked in 2D. I need it to work in 3D space. I think it's because you use zAxis as vector, but I don't know either how to determine the vector. I have tried to make some code, but still not perfect, maybe you have some idea how to perfect it.

I already upload my code in my reply to Alexander

Regards

Abufaisal