Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
hoathuongphuoc

Nhờ fix lỗi khi thay đổi UCS

Các bài được khuyến nghị

Chào các bạn,

Các bạn fix giùm mình với. Mình viết cái chương trình khi click chọn 1 polyline bất kỳ thì chương trình sẽ vẽ vào trong polyline đó 1 chữ a ở tâm của polyline ấy. Nhưng khi mình thay đổi UCS thì chữ a lại nằm chỗ khác. Mặc dù mình có dùng tranformby() nhưng không được. Thanks các bạn.

 <CommandMethod("AddRegion")> Public Sub Addr()
        '' Get the current document and database
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim ed As Editor = acDoc.Editor
        Dim ucs As Matrix3d = ed.CurrentUserCoordinateSystem.Inverse()

        Dim peo As New PromptEntityOptions(vbLf & "Select a  polyline : ")
        peo.SetRejectMessage(vbLf & "You have to select polyline only!")
        peo.AddAllowedClass(GetType(Polyline), False)
        Dim res As PromptEntityResult = ed.GetEntity(peo)
        If res.Status <> PromptStatus.OK Then
            Return
        End If

        '' Start a transaction
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
            Dim origin As Point2d = Point2d.Origin
            Dim poly As Polyline = DirectCast(acTrans.GetObject(res.ObjectId, OpenMode.ForRead), Polyline)
            '' Open the Block table for read
            Dim acBlkTbl As BlockTable
            acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)

            '' Open the Block table record Model space for write
            Dim acBlkTblRec As BlockTableRecord
            acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), _
                                            OpenMode.ForWrite)

            '' Adds the circle to an object array
            Dim acDBObjColl As DBObjectCollection = New DBObjectCollection()
            acDBObjColl.Add(poly)
            '' Calculate the regions based on each closed loop
            Dim myRegionColl As DBObjectCollection = New DBObjectCollection()
            myRegionColl = Region.CreateFromCurves(acDBObjColl)
            Dim acRegion As Region = myRegionColl(0)
            ''
            Dim Solid As New Solid3d()
            Solid.Extrude(acRegion, 1, 0)
            Dim centroid As New Point2d(Solid.MassProperties.Centroid.X, Solid.MassProperties.Centroid.Y)
            Dim dtext As New DBText
            dtext.Position = New Point3d(centroid.X, centroid.Y, 0).TransformBy(ucs)
            dtext.TextString = "a"
            dtext.Height = 125

            '' Add the new object to the block table record and the transaction
            acBlkTblRec.AppendEntity(dtext)
            acTrans.AddNewlyCreatedDBObject(dtext, True)

            '' Dispose of the in memory object not appended to the database

            '' Save the new object to the database
            acTrans.Commit()
        End Using
    End Sub

 

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Có ai giúp mình với. hic.

Hề hề hề,

Rất tiếc là minh chả biết gì về autocad net cả nên khó giúp. Song cứ suy luận như trong lisp thì để tọa độ text không nhảy loạn khi bạn thay đổi Ucs thì khi tạo text bạn phải sữ dụng hệ tọa độ world. Rất có thể do chương trìnhba5an viết text được tạo khi thay đổi hệ trục tọa độ về object để phù hợp với từng đối tượng riêng chăng. Trong lisp thì có hàm (trans p1 1 0) để chuyển điểm p1 từ hệ tọa độ đang sử dụng về hệ tọa độ world. Bạn thử kiếm trong net cái hàm tương tự coi sao.

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

 

Chào các bạn,

Các bạn fix giùm mình với. Mình viết cái chương trình khi click chọn 1 polyline bất kỳ thì chương trình sẽ vẽ vào trong polyline đó 1 chữ a ở tâm của polyline ấy. Nhưng khi mình thay đổi UCS thì chữ a lại nằm chỗ khác. Mặc dù mình có dùng tranformby() nhưng không được. Thanks các bạn.

 <CommandMethod("AddRegion")> Public Sub Addr()
........
            dtext.Position = New Point3d(centroid.X, centroid.Y, 0).TransformBy(ucs)
........
    End Sub

Đơn giản là xóa TransformBy đi.

dtext.Position = New Point3d(centroid.X, centroid.Y, 0)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×