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
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.
@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
Відповідь корисна? Клікніть на "ВПОДОБАЙКУ" цім повідомленням! | Do you find the posts helpful? "LIKE" these posts!
Находите сообщения полезными? Поставьте "НРАВИТСЯ" этим сообщениям!
На ваше запитання відповіли? Натисніть кнопку "ПРИЙНЯТИ РІШЕННЯ" | Have your question been answered successfully? Click "ACCEPT SOLUTION" button.
На ваш вопрос успешно ответили? Нажмите кнопку "УТВЕРДИТЬ РЕШЕНИЕ"
Alexander Rivilis / Александр Ривилис / Олександр Рівіліс
Programmer & Teacher & Helper / Программист - Учитель - Помощник / Програміст - вчитель - помічник
Facebook | Twitter | LinkedIn
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
@Alexander.Rivilis wrote:
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:
@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