.NET

Reply
Valued Contributor
hoathuongphuoc
Posts: 59
Registered: ‎11-05-2013
Message 1 of 4 (255 Views)
Accepted Solution

Can't draw text in new UCS

255 Views, 3 Replies
12-15-2013 10:29 PM

Hi al,

I have a problem, hope everybody can help me. This is, I tried change new ucs in my autocad by vb.net but when i have new UCS so i can not draw text in this new UCS. This is my code:

    <CommandMethod("ROTZ")> _
    Public Sub ShowHatchDialog()
        Dim ar As New ArrayList()
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = acDoc.Database
        Dim ucs As Matrix3d = acDoc.Editor.CurrentUserCoordinateSystem
        Dim cs As CoordinateSystem3d = ucs.CoordinateSystem3d

        Dim pro As New PromptPointOptions("")
        For i As Integer = 0 To 1
            Dim ptResult As PromptPointResult = acDoc.Editor.GetPoint(pro)
            If ptResult.Status <> PromptStatus.OK Then
                Return
            End If
            ar.Add(ptResult.Value)
        Next
        Dim pt1 As Point3d = ar.Item(0)
        Dim pt2 As Point3d = ar.Item(1)
        Dim zAxis As Vector3d = acDoc.Editor.CurrentUserCoordinateSystem.CoordinateSystem3d.Zaxis
        Dim xAxis As Vector3d = pt1.GetVectorTo(pt2)
        Dim yAxis As Vector3d = xAxis.GetPerpendicularVector
        Dim Rot As Matrix3d = Matrix3d.AlignCoordinateSystem(Point3d.Origin, Vector3d.XAxis, Vector3d.YAxis, Vector3d.ZAxis, pt1, xAxis, yAxis, zAxis)
        acDoc.Editor.CurrentUserCoordinateSystem = Rot
        acDoc.Editor.Regen()
        '' Start a transaction
        Using acTrans As Transaction = db.TransactionManager.StartTransaction()

            '' Open the Block table for read
            Dim acBlkTbl As BlockTable
            acBlkTbl = acTrans.GetObject(db.BlockTableId, OpenMode.ForRead)

            '' Open the Block table record Model space for write
            Dim acBlkTblRec As BlockTableRecord
            acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
                                            OpenMode.ForWrite)
            ''Create a single-line text object
            Dim dText As DBText = New DBText()
            dText.SetDatabaseDefaults()
            dText.Position = New Point3d(pt2.X, pt2.Y, 0).TransformBy(Rot)
            dText.Height = 1
            '' condition add floor
            dText.TextString = "6"
            '' Add the new object to the block table record and the transaction
            acBlkTblRec.AppendEntity(dText)
            acTrans.AddNewlyCreatedDBObject(dText, True)
            '' Save the new object to the database
            acTrans.Commit()
        End Using


    End Sub

Thanks All.

Not sure about if this would be a solution,

anyway try instead:

 <CommandMethod("TUCS")> _
Public Sub TestTextInNewUCS()
Dim ar As New ArrayList()
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim db As Database = acDoc.Database
Dim ucs As Matrix3d = acDoc.Editor.CurrentUserCoordinateSystem
Dim cs As CoordinateSystem3d = ucs.CoordinateSystem3d ''<-- you may want before to store current ucs to a variable say 'CUCS', then revert back at the end
Dim pro As New PromptPointOptions("Pick first point: ")
For i As Integer = 0 To 1
Dim ptResult As PromptPointResult = acDoc.Editor.GetPoint(pro)
pro.Message = vbLf + "Pick second point: "
If ptResult.Status <> PromptStatus.OK Then
Return
End If
ar.Add(ptResult.Value)
Next
Dim pt1 As Point3d = ar.Item(0)
Dim pt2 As Point3d = ar.Item(1)
Dim zAxis As Vector3d = acDoc.Editor.CurrentUserCoordinateSystem.CoordinateSystem3d.Zaxis
Dim xAxis As Vector3d = pt1.GetVectorTo(pt2).GetNormal() '<-- ! to get an init vector !
Dim yAxis As Vector3d = xAxis.GetPerpendicularVector
Dim Rot As Matrix3d = Matrix3d.AlignCoordinateSystem(Point3d.Origin, Vector3d.XAxis, Vector3d.YAxis, Vector3d.ZAxis, pt1, xAxis, yAxis, zAxis)
acDoc.Editor.CurrentUserCoordinateSystem = Rot
acDoc.Editor.Regen()
'' Start a transaction
Using acTrans As Transaction = db.TransactionManager.StartTransaction()
'' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(db.BlockTableId, OpenMode.ForRead)
'' Open the Block table record Model space for write
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
OpenMode.ForWrite)
''Create a single-line text object
Dim dText As DBText = New DBText()
dText.SetDatabaseDefaults()
dText.Position = New Point3d(pt2.X, pt2.Y, 0).TransformBy(Rot.Inverse)
'Dim pt As Point3d = New Point3d(pt2.X, pt2.Y, 0)
dText.Height = 1
'' condition add floor
dText.TextString = "6"
'' Add the new object to the block table record and the transaction
acBlkTblRec.AppendEntity(dText)
acTrans.AddNewlyCreatedDBObject(dText, True)
' Put text location to the newly created ucs
dText.TransformBy(Rot)
'' Save the new object to the database
acTrans.Commit()
End Using
End Sub

 

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 4 (233 Views)

Re: Can't draw text in new UCS

12-16-2013 03:00 AM in reply to: hoathuongphuoc

Not sure about if this would be a solution,

anyway try instead:

        <CommandMethod("TUCS")> _
        Public Sub TestTextInNewUCS()
            Dim ar As New ArrayList()
            Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
            Dim db As Database = acDoc.Database
            Dim ucs As Matrix3d = acDoc.Editor.CurrentUserCoordinateSystem
            Dim cs As CoordinateSystem3d = ucs.CoordinateSystem3d ''<-- you may want before to store current ucs to a variable say 'CUCS', then revert back at the end

            Dim pro As New PromptPointOptions("Pick first point: ")
            For i As Integer = 0 To 1
                Dim ptResult As PromptPointResult = acDoc.Editor.GetPoint(pro)
                pro.Message = vbLf + "Pick second point: "
                If ptResult.Status <> PromptStatus.OK Then
                    Return
                End If
                ar.Add(ptResult.Value)
            Next
            Dim pt1 As Point3d = ar.Item(0)
            Dim pt2 As Point3d = ar.Item(1)
            Dim zAxis As Vector3d = acDoc.Editor.CurrentUserCoordinateSystem.CoordinateSystem3d.Zaxis
            Dim xAxis As Vector3d = pt1.GetVectorTo(pt2).GetNormal() '<-- ! to get an init vector !
            Dim yAxis As Vector3d = xAxis.GetPerpendicularVector
            Dim Rot As Matrix3d = Matrix3d.AlignCoordinateSystem(Point3d.Origin, Vector3d.XAxis, Vector3d.YAxis, Vector3d.ZAxis, pt1, xAxis, yAxis, zAxis)
            acDoc.Editor.CurrentUserCoordinateSystem = Rot
            acDoc.Editor.Regen()
            '' Start a transaction
            Using acTrans As Transaction = db.TransactionManager.StartTransaction()

                '' Open the Block table for read
                Dim acBlkTbl As BlockTable
                acBlkTbl = acTrans.GetObject(db.BlockTableId, OpenMode.ForRead)

                '' Open the Block table record Model space for write
                Dim acBlkTblRec As BlockTableRecord
                acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
                                                OpenMode.ForWrite)
                ''Create a single-line text object
                Dim dText As DBText = New DBText()
                dText.SetDatabaseDefaults()
                dText.Position = New Point3d(pt2.X, pt2.Y, 0).TransformBy(Rot.Inverse)
                'Dim pt As Point3d = New Point3d(pt2.X, pt2.Y, 0)

                dText.Height = 1
                '' condition add floor
                dText.TextString = "6"
                '' Add the new object to the block table record and the transaction
                acBlkTblRec.AppendEntity(dText)
                acTrans.AddNewlyCreatedDBObject(dText, True)
                ' Put text location to the newly created ucs
                dText.TransformBy(Rot)
                '' Save the new object to the database
                acTrans.Commit()
            End Using


        End Sub

 

_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Valued Contributor
hoathuongphuoc
Posts: 59
Registered: ‎11-05-2013
Message 3 of 4 (204 Views)

Re: Can't draw text in new UCS

12-16-2013 06:29 PM in reply to: Hallex

Thanks so much. I have find good solution. This is, I instead 

dText.Position=New Point3d(pt2.X, pt2.Y,o).TransformBy(ucs)

for

 dText.Position = New Point3d(pt2.X, pt2.Y, 0).TransformBy(Rot)
*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 4 of 4 (198 Views)

Re: Can't draw text in new UCS

12-16-2013 09:23 PM in reply to: hoathuongphuoc
Glad if I could help
Cheers :smileyhappy:
_____________________________________
C6309D9E0751D165D0934D0621DFF27919
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.