Rotating UCS and Plan command
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi All,
I have two questions about UCS creation/rotation and the AutoCAD PLAN command:
Question 1) I am creating a new UCS, rotating it based on user picks and saving it. The problem is that it saves the new UCS origin location, but it will not save the rotation. The code I am using was pieced together from a couple of different sources (.NET developers guide and code from Tony T from an old thread) How can I make the new UCS "save" the rotation as well?
Question 2) Once I have the new UCS created, I want to esentially use the AutoCAD PLAN command and rotate to the name of the new UCS that was just created. I cannot find ANY info anywhere on the internet on how to replicate the PLAN command using .NET. Any advice?
Here is the code I am using to create, rotate and save the UCS:
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim acEd As Editor = acDoc.Editor
Dim acEnt As Entity = Nothing
Dim Zaxis As Vector3d
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
Try
' Check for the exisitence of required blocks ***************************************************************************
' Declare block variables
Dim strBlockName As String = "UCS-View"
Dim strLayerName As String = "DEFPOINTS"
Dim strSource As String = "W:\EnConDesignContent\Templates\ECDT_NW_11x17_ShopBorder_Template.dwg"
Functions.CheckBlockInsert(strBlockName, strSource)
Dim strtPnt As Point3d = Nothing
Dim endPnt As Point3d = Nothing
Dim myPromptPointFirst As New PromptPointOptions("")
Dim myPromptPointFirst_Res As PromptPointResult
Dim myPromptPointSecond As New PromptPointOptions("")
Dim myPromptPointSecond_Res As PromptPointResult
myPromptPointFirst.Message = vbCr & "Select first UCS point"
myPromptPointFirst.AllowArbitraryInput = False
myPromptPointFirst.AllowNone = False
RePick1:
myPromptPointFirst_Res = acEd.GetPoint(myPromptPointFirst)
'' If pick is ok, then continue
If myPromptPointFirst_Res.Status = PromptStatus.OK Then
myPromptPointSecond.BasePoint = myPromptPointFirst_Res.Value
myPromptPointSecond.UseBasePoint = True '' Applies rubberband effect after first pick
myPromptPointSecond.Message = vbCr & "Select second UCS point"
RePick2:
myPromptPointSecond_Res = acEd.GetPoint(myPromptPointSecond)
'' If pick is ok, then continue
If myPromptPointSecond_Res.Status = PromptStatus.OK Then
strtPnt = myPromptPointFirst_Res.Value
endPnt = myPromptPointSecond_Res.Value
Dim acLine As Line = New Line(strtPnt, endPnt)
Functions.AddToModelSpace(HostApplicationServices.WorkingDatabase, acLine)
acEnt = acLine
Dim dblAngle As Double = acLine.Angle
Zaxis = acEnt.Ecs.CoordinateSystem3d.Zaxis
'' Open the UCS table for read
Dim acUCSTbl As UcsTable
acUCSTbl = acTrans.GetObject(acCurDb.UcsTableId, OpenMode.ForRead)
Dim acUCSTblRec As UcsTableRecord
'' Check to see if the "New_UCS" UCS table record exists (if not, create it)
If acUCSTbl.Has("New_UCS") = False Then
acUCSTblRec = New UcsTableRecord()
acUCSTblRec.Name = "New_UCS"
'' Open the UCSTable for write
acUCSTbl.UpgradeOpen()
'' Add the new UCS table record
acUCSTbl.Add(acUCSTblRec)
acTrans.AddNewlyCreatedDBObject(acUCSTblRec, True)
Else
acUCSTblRec = acTrans.GetObject(acUCSTbl("New_UCS"), OpenMode.ForWrite)
End If
'' Set origin of UCS icon
acUCSTblRec.Origin = New Point3d(strtPnt.X, strtPnt.Y, strtPnt.Z)
'' Open the active viewport
Dim acVportTblRec As ViewportTableRecord
acVportTblRec = acTrans.GetObject(acDoc.Editor.ActiveViewportId, OpenMode.ForWrite)
'' Display the UCS Icon at the origin of the current viewport
acVportTblRec.IconAtOrigin = True
acVportTblRec.IconEnabled = True
'' Set the UCS current
acVportTblRec.SetUcs(acUCSTblRec.ObjectId)
'acDoc.Editor.UpdateTiledViewportsFromDatabase()
'' Rotate the UCS
Dim mat As Matrix3d = acEd.CurrentUserCoordinateSystem
mat *= Matrix3d.Rotation(dblAngle, Zaxis, strtPnt)
acEd.CurrentUserCoordinateSystem = mat
'' Display the name of the current UCS
Dim acUCSTblRecActive As UcsTableRecord
acUCSTblRecActive = acTrans.GetObject(acVportTblRec.UcsName, OpenMode.ForRead)
Application.ShowAlertDialog("The current UCS is: " & acUCSTblRecActive.Name)
'' Insert view block and rotate it to angle based on UCS selection
Dim acBT As BlockTable = acCurDb.BlockTableId.GetObject(OpenMode.ForRead)
Dim acBtr As BlockTableRecord = acBT(BlockTableRecord.ModelSpace).GetObject(OpenMode.ForWrite)
Dim blkref As New BlockReference(strtPnt, acBT(strBlockName))
blkref.Layer = strLayerName
blkref.Rotation = dblAngle
Functions.AddToModelSpace(HostApplicationServices.WorkingDatabase, blkref)
'' Zoom to the extents of the blockref
Dim chkId As ObjectId = blkref.ObjectId
Functions.ZoomObjects(New ObjectIdCollection() From {chkId})
ElseIf myPromptPointSecond_Res.Status = PromptStatus.Cancel Then
Exit Sub
ElseIf myPromptPointSecond_Res.Status = PromptStatus.Error Then
MsgBox("Not a vaild point. Please try again!", , "Invalid Point")
GoTo RePick1
ElseIf myPromptPointSecond_Res.Status = Nothing Then
'' Missed pick... retry
GoTo RePick1
End If
ElseIf myPromptPointFirst_Res.Status = PromptStatus.Cancel Then
Exit Sub
ElseIf myPromptPointFirst_Res.Status = PromptStatus.Error Then
MsgBox("Not a vaild point. Please try again!", , "Invalid Point")
GoTo RePick2
ElseIf myPromptPointFirst_Res.Status = Nothing Then
'' Missed pick... retry
GoTo RePick2
End If
Catch acErrTB As Autodesk.AutoCAD.Runtime.Exception
MsgBox("An error has occured. Contact your system adminstrator." & vbLf & vbLf & acErrTB.Message & vbLf & acErrTB.StackTrace)
Finally
End Try
acTrans.Commit()
End Using
Thanks!