Chuyển đến nội dung
Diễn đàn CADViet

hoathuongphuoc

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    93

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    3

Bài đăng được đăng bởi hoathuongphuoc

  12. Đã đăng · Trả lời báo cáo

    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

     

  19. Đã đăng · Trả lời báo cáo

    Đây là code lưu xuống database của mình.

     

    Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Interop
Imports AcApp = Autodesk.AutoCAD.ApplicationServices.Application
Imports form = System.Windows.Forms
Imports System.Text
Imports System
Imports System.Data.OleDb
 <CommandMethod("MYPOLY")> Public Sub MyPoly()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Dim pline As Polyline = Nothing
        ' Get the current color, for our temp graphics
        Dim col As Color = doc.Database.Cecolor
        ' Create a point collection to store our vertices
        Dim pts As Point3dCollection = New Point3dCollection()
        'Set up the selection options
        ' (used for all vertices)
        Dim opt As PromptPointOptions = New PromptPointOptions("")
        opt.Message = vbLf & "Select polyline vertex:"
        opt.AllowNone = True
        ' Get the start point for the polyline
        Dim res As PromptPointResult = ed.GetPoint(opt)
        While (res.Status = PromptStatus.OK)
            'Add the selected point to the list
            pts.Add(res.Value)
            'Drag a temp line during selection
            'of subsequent points
            opt.UseBasePoint = True
            opt.BasePoint = res.Value
            res = ed.GetPoint(opt)
            If (res.Status = PromptStatus.OK) Then
                ' For each point selected,
                'draw a temporary segment
                ed.DrawVector(pts.Item(pts.Count - 1), res.Value, col.ColorIndex, False) 'highlighted?
            End If
        End While
        If (res.Status = PromptStatus.Cancel) Then
            ' Get the current UCS
            Dim ucs As Matrix3d = ed.CurrentUserCoordinateSystem
            Dim origin As Point3d = New Point3d(0, 0, 0)
            Dim normal As Vector3d = New Vector3d(0, 0, 1)
            normal = normal.TransformBy(ucs)
            ' Create a temporary plane, to help with calcs
            Dim plane As Plane = New Plane(origin, normal)
            ' Create the polyline, specifying
            'the number of vertices up front
            pline = New Polyline(pts.Count)
            pline.Normal = normal
            For Each pt As Point3d In pts
                Dim transformedPt As Point3d = pt.TransformBy(ucs)
                pline.AddVertexAt(pline.NumberOfVertices, plane.ParameterOf(transformedPt), 0, 0, 0)
            Next
            ' Now let's add the polyline to the modelspace
            Using tr As Transaction = db.TransactionManager.StartTransaction()
                Dim bt As BlockTable = TryCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
                Dim btr As BlockTableRecord = TryCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite), BlockTableRecord)
                Dim plineId As ObjectId = btr.AppendEntity(pline)
                tr.AddNewlyCreatedDBObject(pline, True)
                tr.Commit()
                ed.WriteMessage("\nPolyline entity is: " & plineId.ToString())
            End Using
        End If
        ' ed.Regen()
        InsertTablePolyline(pline)
    End Sub
    Private Sub InsertTablePolyline(ByVal pline As Polyline)
        ''define Class DBQuery
        clsDBQuery = New DBQuery
        Dim con As New OleDbConnection(clsDBQuery.getConnectionString())
        Dim query As String = "INSERT INTO tbPolyline(Polyline) VALUES(@polyline)"
        'Create the command.
        Dim cmd As New OleDbCommand(query, con)
        cmd.Parameters.AddWithValue("@polyline", pline)
        ''insert row
        clsDBQuery.InsertRow(cmd, con)
    End Sub
 

    Và đây là database.

    http://www.cadviet.com/upfiles/3/125141_stonenumbering_1.rar

    Còn đây là class dùng để đổ dữ liệu vào database.

    http://www.cadviet.com/upfiles/3/125141_dbquery.rar

  21. Đã đăng · Trả lời báo cáo

    Chào các bạn,

    Mình không biết bỏ topic này ở đâu. Nên xin phép admin cho mình đặt nó ở đây. Mình có thực hiện việc lấy Boundary bằng lệnh ed.TraceBoundary() của 1 hình vuông trên file cad. Giờ mình muốn lưu cái boundary này xuống access nhưng không được. Bạn nào đã từng làm việc với access có thể chỉ giúp mình được không. Mình có lưu boundary này dưới bằng kiểu OLEObject nhưng không được. Thanks.

  24. Đã đăng · Trả lời báo cáo

    Chào các bạn,

    Sau khi mình tham khảo code của các bạn. Thì mình có viết lại và đã xóa được các đỉnh ở các đoạn thẳng nhưng không hiểu sao cái cung mình làm hoài không được. Các bạn giúp mình chỗ này với. Hic.

    <CommandMethod("PLineOptimize")> Public Sub PLineOptimize()
        Dim doc As Document = AcApp.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        Dim flag As Boolean = False
        Dim opts As PromptEntityOptions = New PromptEntityOptions("\nSelect a Polyline: ")
        opts.SetRejectMessage("Not a Polyline.")
        ' opts.AddAllowedClass(typeof(Polyline), true)
        Dim per As PromptEntityResult = ed.GetEntity(opts)
        If (per.Status <> PromptStatus.OK) Then
            Return
        End If
        Using tr As Transaction = db.TransactionManager.StartTransaction()
            Dim pl As Polyline = TryCast(tr.GetObject(per.ObjectId, OpenMode.ForRead), Polyline)
            Dim pline As Polyline = TryCast(pl.Clone(), Polyline)
            Dim lastIndex As Integer = pline.NumberOfVertices - 1
            Dim bul1 As Double
            Dim bul2 As Double
            Dim tempi As Integer
            Dim sta As Point2d
            Dim mid As Point2d
            Dim endd As Point2d
            Dim j As Integer = 0
            While j < lastIndex
                j = 0
                For i As Integer = 0 To lastIndex
                    If (i = lastIndex) Then
                        Exit For
                    End If
                    If (pline.GetStartWidthAt(i) <> pline.GetEndWidthAt(i)) Then
                        Continue For
                    End If
                    If (pline.GetStartWidthAt(i + 1) <> pline.GetEndWidthAt(i + 1)) Then
                        i += 1
                        Continue For
                    End If
                    If (pline.GetStartWidthAt(i) <> pline.GetEndWidthAt(i + 1)) Then
                        Continue For
                    End If
                    bul1 = pline.GetBulgeAt(i)
                    bul2 = pline.GetBulgeAt(i + 1)
                    If (bul1 <> 0) Then '' Arc
                        '' 
                        If (bul2 <> 0) Then

                            Dim circu1 As CircularArc2d = pline.GetArcSegment2dAt(i)
                            Dim circu2 As CircularArc2d = pline.GetArcSegment2dAt(i + 1)
                            Dim bugle As Double = Math.Tan(circu1.StartAngle / 2.0)
                            pline.RemoveVertexAt(i + 1)
                            pline.AddVertexAt(i, New Point2d(circu1.StartPoint.X, circu1.StartPoint.Y), bugle, 0, 0)
                            pline.SetPointAt(i + 2, New Point2d(circu2.EndPoint.X, circu2.EndPoint.Y))

                            ' pline.AddVertexAt(i + 2, New Point2d(circu2.EndPoint.X, circu2.EndPoint.Y), 0, 0, 0)
                            '  Dim L As Double = 0.5 * (2 * circu1.Radius)
                            ' Dim bugle As Double = (circu1.Radius - Math.Sqrt(circu1.Radius * circu1.Radius - L * L)) / L
                            ' pline.AddVertexAt(i + 2, pline.GetPoint2dAt(i + 2), pline.GetBulgeAt(i + 2), 0.0, 0.0)
                            '  pline.SetPointAt(i, pline.GetPoint2dAt(i))


                            '  pline.RemoveVertexAt(i + 2)
                            i -= 1
                            lastIndex -= 1
                            j -= 1
                            Continue For
                        End If
                    Else '' Line
                        If (bul2 = 0) Then

                            If (i + 2 <= lastIndex And tempi = 0) Then
                                sta = pline.GetPoint2dAt(i)
                                mid = pline.GetPoint2dAt(i + 1)
                                endd = pline.GetPoint2dAt(i + 2)
                                If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                    pline.RemoveVertexAt(i + 1)
                                    i -= 1
                                    lastIndex -= 1
                                    j -= 1
                                    Continue For
                                End If
                            Else
                                If (tempi = 0) Then
                                    tempi = i
                                    Exit For
                                ElseIf (tempi < lastIndex) Then
                                    sta = pline.GetPoint2dAt(tempi)
                                    mid = pline.GetPoint2dAt(tempi + 1)
                                    endd = pline.GetPoint2dAt(i)
                                    If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                        pline.RemoveVertexAt(tempi + 1)
                                        lastIndex -= 1
                                        j -= 1
                                        Continue For
                                    Else
                                        i -= 1
                                        tempi += 1
                                    End If
                                ElseIf (tempi = lastIndex) Then
                                    sta = pline.GetPoint2dAt(tempi)
                                    mid = pline.GetPoint2dAt(i)
                                    endd = pline.GetPoint2dAt(i + 1)
                                    If (System.Math.Abs((sta - mid).Angle - (mid - endd).Angle) < 0.001) Then
                                        pline.RemoveVertexAt(i)
                                        lastIndex -= 1
                                        i -= 1
                                        j -= 1
                                        Continue For
                                    Else
                                        i -= 1
                                        tempi += 1
                                    End If
                                ElseIf (tempi > lastIndex) Then
                                    tempi = 0
                                End If
                            End If
                        End If
                    End If
                    j += 1
                Next
            End While
            If (pline.NumberOfVertices < pl.NumberOfVertices) Then
                Dim btr As BlockTableRecord = TryCast(tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, False), BlockTableRecord)
                pline.SetDatabaseDefaults()
                pline.ColorIndex = 6
                btr.AppendEntity(pline)
                tr.AddNewlyCreatedDBObject(pline, True)
                tr.Commit()
            Else
                ed.WriteMessage("Nothing to Optimize.")
            End If
        End Using
    End Sub

    Và đây là hình mình muốn xóa bớt đỉnh.

    http://www.cadviet.com/upfiles/3/125141_arc.dwg

×