Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
4 replies to this topic

#1 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 12 February 2014 - 10:53 AM

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

 


  • 0

#2 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 12 February 2014 - 04:38 PM

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


  • 0

#3 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 12 February 2014 - 07:04 PM

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.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#4 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1435 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 13 February 2014 - 02:25 PM

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)


  • 0

#5 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 13 February 2014 - 02:55 PM

tại sao lại như vậy nhỉ.


  • 0