Dim OPoint As Point3d = New Point3d(BlkRef.Position.X, BlkRef.Position.Y, BlkRef.Position.Z)
Dim NPoint As Point3d= New Point3d(BlkRef.Position.X, BlkRef.Position.Y+100, BlkRef.Position.Z)
BlkRef.TransformBy(Matrix3d.Displacement(OPoint.GetVectorTo(NPoint)))
this is function to move my block from OPoint to NPoint , in Y direction
so if the ucs changed , my code use the old y direction not current you dirction
so how can i tell my code to take new y and x directions (current ucs)
Can you please try this ?
' Moves by 10 units along WCS Y Axis 'Dim disp As Matrix3d = Matrix3d.Displacement(Vector3d.YAxis * 10.0) ' Moves by 10 units along UCS Y Axis Dim disp As Matrix3d = Matrix3d.Displacement((Vector3d.YAxis * 10.0).TransformBy(ed.CurrentUserCoordinateSystem)) Dim nPt As Point3d = opt.Position.TransformBy(disp)
i can't understand any thing ,
i have two block attribute , so i move the block by difference between it's texts attributes
this is function that i need to edit it in my class , see it
Private Shared Sub ChangePostionLevel(MySelSet As SelectionSet, BPoint As Point2d, BValue As String, Unit As Double) Dim Tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction() If MySelSet IsNot Nothing Then For Each BlKID In MySelSet.GetObjectIds() Dim BlkRef As BlockReference = Tr.GetObject(BlKID, OpenMode.ForWrite) Dim objId As ObjectId = BlkRef.AttributeCollection.Item(0) Dim attRef As AttributeReference = Tr.GetObject(objId, OpenMode.ForWrite) Dim ucs As Matrix3d = Application.DocumentManager.MdiActiveDocument.Editor.CurrentUserCoordinateSystem Dim OPoint As Point3d = New Point3d(BlkRef.Position.X, BlkRef.Position.Y, BlkRef.Position.Z) Dim NPoint As Point3d If attRef.TextString > BValue Then NPoint = New Point3d(BlkRef.Position.X, (BPoint.Y + (Val(attRef.TextString) - Val(BValue)) * Unit), BlkRef.Position.Z) ElseIf attRef.TextString < BValue Then NPoint = New Point3d(BlkRef.Position.X, (BPoint.Y - (Val(BValue) - Val(attRef.TextString)) * Unit), BlkRef.Position.Z) ElseIf attRef.TextString = BValue Then 'Dim NPoint As Point3d = New Point3d(BlkRef.Position.X, (BPoint.Y + (Val(attRef.TextString) - Val(BValue)) * Unit), BlkRef.Position.Z) End If BlkRef.TransformBy(Matrix3d.Displacement(OPoint.GetVectorTo(NPoint))) Next End If Tr.Commit() Tr.Dispose() End Sub
i hope to correct it for me
Hi,
To understand what I meant, please try this :
1. Open the attached drawing
2. Try running the following command and select the point. The point always moves along the UCS Y Axis by 10 units.
Change to a different UCS and try the command again.
<CommandMethod("MP")> _ Public Shared Sub MovePoint() Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor Dim db As Database = Application.DocumentManager.MdiActiveDocument.Database Dim selectedEntity As PromptEntityResult = ed.GetEntity("Please select an point : ") Dim objectId As ObjectId = selectedEntity.ObjectId Try Using trans As Transaction = db.TransactionManager.StartTransaction() Dim ent As Entity = TryCast(trans.GetObject(objectId, OpenMode.ForWrite), Entity) If TypeOf ent Is DBPoint Then Dim opt As DBPoint = TryCast(ent, DBPoint) ' Moves by 10 units along UCS Y Axis Dim disp As Matrix3d = Matrix3d.Displacement((Vector3d.YAxis * 10.0).TransformBy(ed.CurrentUserCoordinateSystem)) Dim nPt As Point3d = opt.Position.TransformBy(disp) opt.Position = nPt End If trans.Commit() End Using Catch ex As System.Exception ed.WriteMessage(ex.Message) End Try End Sub
About correcting your code, I will need more info to understand the problem. Can you provide the drawing and explain what the expected / actual behavior is ?
yes i understand you code
but i can't edit my code to get me what i want
see this is my try
Private Shared Sub ChangePostionLevel(MySelSet As SelectionSet, BPoint As Point3d, BValue As String, Unit As Double) Dim Tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction() If MySelSet IsNot Nothing Then For Each BlKID In MySelSet.GetObjectIds() Dim BlkRef As BlockReference = Tr.GetObject(BlKID, OpenMode.ForWrite) Dim objId As ObjectId = BlkRef.AttributeCollection.Item(0) Dim attRef As AttributeReference = Tr.GetObject(objId, OpenMode.ForWrite) Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor Dim OPoint As Point3d = New Point3d(BlkRef.Position.X, BlkRef.Position.Y, BlkRef.Position.Z) Dim NPoint As Point3d If attRef.TextString > BValue Then Dim disp As Matrix3d = Matrix3d.Displacement((Vector3d.YAxis * (BPoint.Y + (Val(attRef.TextString) - Val(BValue)) * Unit)).TransformBy(ed.CurrentUserCoordinateSystem)) NPoint = BPoint.TransformBy(disp) ElseIf attRef.TextString < BValue Then Dim disp As Matrix3d = Matrix3d.Displacement((Vector3d.YAxis * (BPoint.Y - (Val(BValue) - Val(attRef.TextString)) * Unit)).TransformBy(ed.CurrentUserCoordinateSystem)) NPoint = BPoint.TransformBy(disp) ElseIf attRef.TextString = BValue Then End If BlkRef.TransformBy(Matrix3d.Displacement(OPoint.GetVectorTo(NPoint))) Next End If Tr.Commit() Tr.Dispose() End Sub
but don't give me the correct position for block
can you help me plz
Can you please provide a sample drawing to test with ?
Also I would like to know the parameters that you are using with "ChangePostionLevel" method.
If you can simply attach a buildable sample project and a simple test drawing, that would be help.
It is little hard for me to visualize the kind of displacement that you are trying to achieve for the block reference.
Imports Autodesk.AutoCAD.EditorInput Imports Autodesk.AutoCAD.ApplicationServices Imports Autodesk.AutoCAD.DatabaseServices Imports Autodesk.AutoCAD.Geometry Public NotInheritable Class CheckLevels Public Shared Sub CheckLevel() Dim Unit As Double = Val(GetSetting("AMR LISP", "Check Level", "Unit", 1000)) Dim Method As String = GetSetting("AMR LISP", "Check Level", "Method", "Custom") Dim LFormat As String = GetSetting("AMR LISP", "Check Level", "Format", "0.00") Dim LastMethod As String = GetSetting("AMR LISP", "Check Level", "LastMethod", "Change") Dim BPoint As Point3d, BValue As Double, BlockName As String Dim Trans As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction() Dim AcEntOption As PromptEntityOptions = New PromptEntityOptions(vbLf & "Select base block") AcEntOption.Keywords.Add("Unit") AcEntOption.Keywords.Add("Method") AcEntOption.Keywords.Add("Format") AcEntOption.SetRejectMessage(vbLf & "You must pick a block try again ...") AcEntOption.AddAllowedClass(GetType(BlockReference), False) L1: Dim AcEntResult As PromptEntityResult = Application.DocumentManager.MdiActiveDocument.Editor.GetEntity(AcEntOption) If AcEntResult.Status = PromptStatus.OK Then Dim BlkRef As BlockReference = Trans.GetObject(AcEntResult.ObjectId, OpenMode.ForRead) If (BlkRef.AttributeCollection.Count) > 0 Then Dim objId As ObjectId = BlkRef.AttributeCollection.Item(0) Dim attRef As AttributeReference = Trans.GetObject(objId, OpenMode.ForRead) BValue = Val(attRef.TextString) BlockName = BlkRef.Name BPoint = New Point3d(BlkRef.Position.X, BlkRef.Position.Y, BlkRef.Position.Z) Else Application.DocumentManager.MdiActiveDocument.Editor.WriteMessage(vbLf & "you are selected invalid block doesn't have any attributes") Exit Sub End If ' start select blocks which we want to edit it ' create selection filter with typedvalues Dim TypedValues(0) As TypedValue TypedValues.SetValue(New TypedValue(DxfCode.BlockName, BlockName), 0) Dim AcSelFtr As SelectionFilter = New SelectionFilter(TypedValues) 'create keywords options for selection Dim AcSelOption As PromptSelectionOptions = New PromptSelectionOptions AcSelOption.MessageForAdding = ("Select other (" & BlockName & ") blocks that you want to change") 'start selectionset with keywords and filter Dim AcSelResult As PromptSelectionResult AcSelResult = Application.DocumentManager.MdiActiveDocument.Editor.GetSelection(AcSelOption, AcSelFtr) If AcSelResult.Status = PromptStatus.OK Then Select Case Method Case "Change" ChangeTextLevel(AcSelResult.Value, BPoint, BValue, Unit, LFormat) Case "Move" ChangePostionLevel(AcSelResult.Value, BPoint, BValue, Unit) Case "Custom" Dim AcKwrdOption As PromptKeywordOptions = New PromptKeywordOptions(vbLf & "Which method will execute [Change/Move] : ", "Change Move") AcKwrdOption.Keywords.Default = LastMethod Dim AcKwrdResult As PromptResult = Application.DocumentManager.MdiActiveDocument.Editor.GetKeywords(AcKwrdOption) If AcKwrdResult.Status = PromptStatus.OK Then Select Case AcKwrdResult.StringResult Case "Change" ChangeTextLevel(AcSelResult.Value, BPoint, BValue, Unit, LFormat) Case "Move" ChangePostionLevel(AcSelResult.Value, BPoint, BValue, Unit) End Select LastMethod = AcKwrdResult.StringResult SaveSetting("AMR LISP", "Check Level", "LastMethod", LastMethod) End If End Select End If ' end code ElseIf AcEntResult.Status = PromptStatus.Keyword Then Select Case AcEntResult.StringResult Case "Unit" Dim AcDblOption As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "Enter the calculation unit (Meter Unit) ") AcDblOption.AllowNone = False AcDblOption.DefaultValue = Unit AcDblOption.AllowNegative = False Dim AcDblResult As PromptDoubleResult = Application.DocumentManager.MdiActiveDocument.Editor.GetDouble(AcDblOption) If AcDblResult.Status = PromptStatus.OK Then Unit = AcDblResult.Value SaveSetting("AMR LISP", "Check Level", "Unit", Unit) GoTo L1 End If GoTo L1 Case "Method" Dim AcKwrdOption As PromptKeywordOptions = New PromptKeywordOptions(vbLf & "Which method you will use [Change/Move/cuStom] : ", "Change Move Custom") AcKwrdOption.Keywords.Default = Method Dim AcKwrdResult As PromptResult = Application.DocumentManager.MdiActiveDocument.Editor.GetKeywords(AcKwrdOption) If AcKwrdResult.Status = PromptStatus.OK Then Method = AcKwrdResult.StringResult SaveSetting("AMR LISP", "Check Level", "Method", Method) End If GoTo L1 Case "Format" Dim AcStrOption As PromptStringOptions = New PromptStringOptions("Enter text format that you want :") AcStrOption.DefaultValue = LFormat Dim AcStrResult As PromptResult = Application.DocumentManager.MdiActiveDocument.Editor.GetString(AcStrOption) If AcStrResult.Status = PromptStatus.OK Then LFormat = AcStrResult.StringResult SaveSetting("AMR LISP", "Check Level", "Format", LFormat) End If GoTo L1 End Select End If Trans.Commit() Trans.Dispose() End Sub Private Shared Sub ChangeTextLevel(MySelSet As SelectionSet, BPoint As Point3d, BValue As String, Unit As Double, LFormat As String) Dim Tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction() If MySelSet IsNot Nothing Then For Each BlKID In MySelSet.GetObjectIds() Dim BlkRef As BlockReference = Tr.GetObject(BlKID, OpenMode.ForWrite) Dim objId As ObjectId = BlkRef.AttributeCollection.Item(0) Dim attRef As AttributeReference = Tr.GetObject(objId, OpenMode.ForWrite) If BlkRef.Position.Y > BPoint.Y Then attRef.TextString = LevelFormat((BValue + (BlkRef.Position.Y - BPoint.Y) / Unit), LFormat) ElseIf BlkRef.Position.Y < BPoint.Y Then attRef.TextString = LevelFormat((BValue - (BPoint.Y - BlkRef.Position.Y) / Unit), LFormat) ElseIf BlkRef.Position.Y = BPoint.Y Then attRef.TextString = LevelFormat((BValue), LFormat) End If Next End If Tr.Commit() Tr.Dispose() End Sub Private Shared Function LevelFormat(LValue As Double, LFormat As String) As String If LValue > 0 Then Return ("+" & Format(LValue, LFormat)) ElseIf LValue < 0 Then Return (Format(LValue, LFormat)) ElseIf LValue = 0 Then Return ("±" & Format(LValue, LFormat)) Else Return "" End If End Function Private Shared Sub ChangePostionLevel(MySelSet As SelectionSet, BPoint As Point3d, BValue As String, Unit As Double) Dim Tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction() If MySelSet IsNot Nothing Then For Each BlKID In MySelSet.GetObjectIds() Dim BlkRef As BlockReference = Tr.GetObject(BlKID, OpenMode.ForWrite) Dim objId As ObjectId = BlkRef.AttributeCollection.Item(0) Dim attRef As AttributeReference = Tr.GetObject(objId, OpenMode.ForWrite) Dim OPoint As Point3d = New Point3d(BlkRef.Position.X, BlkRef.Position.Y, BlkRef.Position.Z) Dim NPoint As Point3d If attRef.TextString > BValue Then NPoint = New Point3d(BlkRef.Position.X, (BPoint.Y + (Val(attRef.TextString) - Val(BValue)) * Unit), BlkRef.Position.Z) ElseIf attRef.TextString < BValue Then NPoint = New Point3d(BlkRef.Position.X, (BPoint.Y - (Val(BValue) - Val(attRef.TextString)) * Unit), BlkRef.Position.Z) ElseIf attRef.TextString = BValue Then 'Dim NPoint As Point3d = New Point3d(BlkRef.Position.X, (BPoint.Y + (Val(attRef.TextString) - Val(BValue)) * Unit), BlkRef.Position.Z) End If BlkRef.TransformBy(Matrix3d.Displacement(OPoint.GetVectorTo(NPoint))) Next End If Tr.Commit() Tr.Dispose() End Sub End Class
this is my all code , and i attaced level block atrribute
Thanks for providing more info.
In your original post, the displacement was by a constant 100 units which is not the case in your recent code sample.
The amount of displacement calculated using "(BPoint.Y + (Val(attRef.TextString) - Val(BValue)) * Unit)" may not be what you want actually when the UCS is changed.
Here is a part of your code sample that moves the selected block reference along the UCS Y direction. Depending on how you want to align the block references, you may have to change the distance.
Private Shared Sub ChangePostionLevel(MySelSet As SelectionSet, BPoint As Point3d, BValue As String, Unit As Double) Using Tr As Transaction = Application.DocumentManager.MdiActiveDocument.TransactionManager.StartTransaction() If MySelSet IsNot Nothing Then For Each BlKID In MySelSet.GetObjectIds() Dim BlkRef As BlockReference = Tr.GetObject(BlKID, OpenMode.ForWrite) Dim objId As ObjectId = BlkRef.AttributeCollection.Item(0) Dim attRef As AttributeReference = Tr.GetObject(objId, OpenMode.ForWrite) Dim OPoint As Point3d = New Point3d(BlkRef.Position.X, BlkRef.Position.Y, BlkRef.Position.Z) Dim ed As Editor = Application.DocumentManager.MdiActiveDocument.Editor Dim yAxis As Vector3d yAxis = ed.CurrentUserCoordinateSystem.CoordinateSystem3d.Yaxis Dim distance As Double ' Change the distance according to your requirement distance = ((BPoint.Y + (Val(attRef.TextString) - Val(BValue)) * Unit) - BlkRef.Position.Y) Dim dispVector As Vector3d = distance * yAxis BlkRef.TransformBy(Matrix3d.Displacement(dispVector)) Next End If Tr.Commit() End Using End Sub
Can't find what you're looking for? Ask the community or share your knowledge.