.NET

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

Can't draw text in new UCS

242 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.

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 2 of 4 (220 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 (191 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 (185 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

You are not logged in.

Log into access your profile, ask and answer questions, share ideas and more. Haven't signed up yet? Register

Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.

Need installation help?

Start with some of our most frequented solutions to get help installing your software.

Ask the Community