I port my autolisp routines to NET.A simple autolisp routine changes the UCS to another one.The change needs no regeneration and is immediate.But in NET i have to use "UpdateTiledViewportsFromDatabase".When the dwg is loaded with lots of objects it takes quite a lot of time to regen.Is there a way to have an immediate change using NET just like when using autolisp command?Also why autolisp needs no regen?
Solved! Go to Solution.
Solved by Alfred.NESWADBA. Go to Solution.
Hi,
>> But in NET i have to use "UpdateTiledViewportsFromDatabase"
I never used this .... but multiple times used different UCS (of course I do not use tiled-viewports, because when I need multiple viewports I take a layout for that job). Could you show the code-snippet (or a short sample) to get your phenomen reproduced?
- alfred -
Try UCSV from autocad command line.
It prompts you to select two points.
It creates a ucs using the first point selected (but with zero elevation) as the origin and
the xaxis passing through the second point (also with zero elevation)
the yaxis is passing vertical above the origin.
Public Class class_AutoCAD_Utilities
<CommandMethod("UCSv")> PublicSub UCSvertical()
SetToWCS()'routine of mine-code comes next
Dim Pt1 As Autodesk.AutoCAD.Geometry.Point3d = CAD.NET.SelectPointAsPoint3D("Select origin ")
If IsNothing(Pt1) ThenExit Sub
Dim Pt2 As Autodesk.AutoCAD.Geometry.Point3d = CAD.NET.SelectPointAsPoint3D("Select a point on axis X ")
If IsNothing(Pt2) ThenExit Sub
Dim ORGN AsNew Autodesk.AutoCAD.Geometry.Point3d(Pt1.X, Pt1.Y, 0)
Dim Xaxis AsNew Autodesk.AutoCAD.Geometry.Vector3d((Pt2.X - Pt1.X), (Pt2.Y - Pt1.Y), 0)
Dim Yaxis AsNew Autodesk.AutoCAD.Geometry.Vector3d(0, 0, 1)
Dim CS AsNew Autodesk.AutoCAD.Geometry.CoordinateSystem3d(ORGN, Xaxis, Yaxis)
Dim acadDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acadDB As Autodesk.AutoCAD.DatabaseServices.Database = acadDoc.Database
Dim acadEditor As Autodesk.AutoCAD.EditorInput.Editor = acadDoc.Editor
Using acadTRNS As Autodesk.AutoCAD.DatabaseServices.Transaction = acadDB.TransactionManager.StartTransaction()
Dim acadUCSTbl As Autodesk.AutoCAD.DatabaseServices.UcsTable
acadUCSTbl =
CType(acadTRNS.GetObject(acadDB.UcsTableId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), Autodesk.AutoCAD.DatabaseServices.UcsTable)
Dim acadUCSTblRec As Autodesk.AutoCAD.DatabaseServices.UcsTableRecord = New Autodesk.AutoCAD.DatabaseServices.UcsTableRecord
acadUCSTbl.UpgradeOpen()
acadUCSTbl.Add(acadUCSTblRec)
acadTRNS.AddNewlyCreatedDBObject(acadUCSTblRec,
True)
With acadUCSTblRec
.Origin = CS.Origin
.XAxis = CS.Xaxis
.YAxis = CS.Yaxis
EndWith
acadTRNS.Commit()
EndUsing
UCS.SetActiveViewportToUCS(CS, True)'routine of mine-code comes next
EndSub
PublicFunction SetToWCS(OptionalByVal ShowNameNotFoundMessage AsBoolean = True) AsBoolean
Dim acadDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acadDB As Autodesk.AutoCAD.DatabaseServices.Database = acadDoc.Database
Try
Using acadTRNS As Autodesk.AutoCAD.DatabaseServices.Transaction = acadDB.TransactionManager.StartTransaction
Dim acadVPortsTableRecord As Autodesk.AutoCAD.DatabaseServices.ViewportTableRecord = CType(acadTRNS.GetObject(acadDoc.Editor.ActiveViewportId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), Autodesk.AutoCAD.DatabaseServices.ViewportTableRecord)
acadVPortsTableRecord.SetUcsToWorld()
acadDoc.Editor.UpdateTiledViewportsFromDatabase()
acadTRNS.Commit()
ReturnTrue
EndUsing
Catch ex AsException
If ShowNameNotFoundMessage Then MsgBox("Failed to set WCS current" + vbNewLine + ex.Message, MsgBoxStyle.Information, "Info")
ReturnFalse
EndTry
EndFunction
PublicFunction SetActiveViewportToUCS(ByVal UCSis As Autodesk.AutoCAD.Geometry.CoordinateSystem3d, OptionalByVal ShowErrorMessage AsBoolean = True) AsBoolean
Dim acadDoc As Autodesk.AutoCAD.ApplicationServices.Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acadDB As Autodesk.AutoCAD.DatabaseServices.Database = acadDoc.Database
Try
Using acadTRNS As Autodesk.AutoCAD.DatabaseServices.Transaction = acadDB.TransactionManager.StartTransaction
Dim acadVPortsTableRecord As Autodesk.AutoCAD.DatabaseServices.ViewportTableRecord = CType(acadTRNS.GetObject(acadDoc.Editor.ActiveViewportId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead), Autodesk.AutoCAD.DatabaseServices.ViewportTableRecord)
acadVPortsTableRecord.SetUcs(UCSis.Origin, UCSis.Xaxis, UCSis.Yaxis)
acadDoc.Editor.UpdateTiledViewportsFromDatabase()
acadTRNS.Commit()
Return True
EndUsing
Catch ex AsException
If ShowErrorMessage Then MsgBox("Failed to set UCS current" + vbNewLine + ex.Message, MsgBoxStyle.Information, "Info")
ReturnFalse
EndTry
EndFunction
End Class
Hi,
was a lot of work to get the lost spaces back from your codesnippet ... e.g. "EndFunction" "EndTry" "EndUsing" ... (without space)
Please use next time the icon for "Code insert" 😉
Ok, have a try to that code, does it work for you (without unnecessary regen's)?
<Autodesk.AutoCAD.Runtime.CommandMethod("UCSv")> _ Public Sub UCSvertical() Dim tAcadDoc As Document = Application.DocumentManager.MdiActiveDocument tAcadDoc.Editor.CurrentUserCoordinateSystem = Matrix3d.Identity 'set to origin = world Try 'get new origin and x-direction Dim tPt1 As Autodesk.AutoCAD.Geometry.Point3d = getPnt("Select origin ", False, Nothing) Dim tPt2 As Autodesk.AutoCAD.Geometry.Point3d = getPnt("Select a point on axis X ", True, tPt1) 'create a matrix for new origin and x-direction(rotation) Dim tMat As Matrix3d = Matrix3d.Displacement(New Vector3d(tPt1.X, tPt1.Y, 0)) tMat *= Matrix3d.Rotation(New Vector2d((tPt2.X - tPt1.X), (tPt2.Y - tPt1.Y)).Angle, New Vector3d(0, 0, 1), Point3d.Origin) 'make it to active ucs tAcadDoc.Editor.CurrentUserCoordinateSystem = tMat Catch ex As Exception 'TODO error-analyses End Try End Sub Private Function getPnt(ByVal Msg As String, ByVal UseDragBasePnt As Boolean, ByVal DragBasePnt As Point3d) As Point3d Dim tRetVal As Point3d = Point3d.Origin Dim tED As Editor = Application.DocumentManager.MdiActiveDocument.Editor Dim tPrompt As PromptPointOptions = New PromptPointOptions(Msg) If UseDragBasePnt Then tPrompt.BasePoint = DragBasePnt tPrompt.UseBasePoint = True End If Dim tRes As PromptPointResult = tED.GetPoint(Msg) If tRes.Status = PromptStatus.OK Then tRetVal = tRes.Value Else Throw New Exception("Error selecting Point") End If Return tRetVal End Function
HTH, - alfred -
Totally different approach . I coded by the autodesk online help .Your approach gives the EXACT result that i needed ! Two fast internet responses . And a perfect solution . Thank you so much .
You are right about the "Insert code" button .
I apologise that i do not know all the available features .
Double thanks for your time fixing my Copy+Paste code through the wrong way.
By the way,how did you develop this approach ?
Good math knowledge and/or an other tutorial than the original autodesk ?
I have to admit that i am amazed for both immediate response and exact solution !!!