Sửa code vẽ các đường thẳng song song với khoảng cách nhập vào

[quyenpv 2]

Em đang dùng ngôn ngữ vb.net viết sub cho autocad để vẽ các đường pline với tuỳ chọn yêu cầu

1. người nhập nhập vào số đường line hay pline cần vẽ nằm trong khoảng từ 1 đến 12

2. Nhập khoảng cách giữa các đường trên với số nhỏ nhất là 3

3. Người dùng chọn vị trí và hướng vẽ trên bản vẽ hiện hành sau đó chương trình sẽ vẽ các đường pline song song với nhau bằng khoảng cách đã nhập

4. Khi vẽ màu của các đường thẳng sẽ lấy theo danh sách màu từ 1 đến 12 như sau 160 30 94 15 253 255 10 250 50 202 220 130 Cách hiển thị thứ tự các đường thứ nhất tại điểm được chọn các đường tiếp theo sẽ luôn được vẽ song song bên phải của đường thứ nhất với khoảng cách nhập vào Bổ sung thêm hãy tạo Layer với tên SODODAUNOI, kiểm tra trong file autocad hiện hành nếu chưa có hãy tạo mới ngược lại thì thôi

Code em viết đang vị sai các đường thẳng khi code chạy lại thẳng hàng nhau cách đều bằng khoảng đã nhập

<CommandMethod("DrawLines2")>
    Public Sub DrawPLines()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor

        ' Lấy số lượng đường cần vẽ từ người dùng
        Dim numLines As Integer = GetNumberFromUser("Nhập số lượng đường (từ 1 đến 12): ", 1, 12)

        ' Lấy khoảng cách giữa các đường từ người dùng
        Dim distance As Double = GetNumberFromUser("Nhập khoảng cách giữa các đường (số nhỏ nhất là 3): ", 3, Double.MaxValue)

        ' Danh sách mã màu cho các đường
        Dim colors() As Integer = {160, 30, 94, 15, 253, 255, 10, 250, 50, 202, 220, 130}

        ' Kiểm tra nếu Layer "SODODAUNOI" chưa tồn tại, tạo mới
        If Not LayerExists("SODODAUNOI") Then
            CreateLayer("SODODAUNOI")
        End If

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

            ' Vẽ đường thứ nhất
            Dim startPoint As New Point3d(0, 0, 0)
            Dim endPoint As New Point3d(distance, 0, 0)
            Dim pLine As New Polyline()
            pLine.AddVertexAt(0, New Point2d(startPoint.X, startPoint.Y), 0, 0, 0)
            pLine.AddVertexAt(1, New Point2d(endPoint.X, endPoint.Y), 0, 0, 0)

            pLine.ColorIndex = colors(0)
            pLine.Layer = "SODODAUNOI"
            btr.AppendEntity(pLine)
            trans.AddNewlyCreatedDBObject(pLine, True)

            ' Vẽ các đường tiếp theo
            For i As Integer = 1 To numLines - 1
                startPoint = New Point3d(startPoint.X + distance, startPoint.Y, startPoint.Z)
                endPoint = New Point3d(endPoint.X + distance, endPoint.Y, endPoint.Z)
                pLine = New Polyline()
                pLine.AddVertexAt(0, New Point2d(startPoint.X, startPoint.Y), 0, 0, 0)
                pLine.AddVertexAt(1, New Point2d(endPoint.X, endPoint.Y), 0, 0, 0)
                pLine.ColorIndex = colors(i Mod colors.Length)
                pLine.Layer = "SODODAUNOI"
                btr.AppendEntity(pLine)
                trans.AddNewlyCreatedDBObject(pLine, True)

                ' Cập nhật điểm khởi đầu cho đường tiếp theo
                startPoint = New Point3d(startPoint.X + distance, startPoint.Y, startPoint.Z)
                endPoint = New Point3d(endPoint.X + distance, endPoint.Y, endPoint.Z)
            Next



            trans.Commit()
        End Using

        ed.WriteMessage("Đã vẽ xong các đường PLINE.")
    End Sub

    Private Function GetNumberFromUser(prompt As String, minValue As Double, maxValue As Double) As Double
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim ed As Editor = doc.Editor

        While True
            Dim result As PromptDoubleResult = ed.GetDouble(New PromptDoubleOptions(prompt))
            If result.Status = PromptStatus.OK Then
                Dim value As Double = result.Value
                If value >= minValue AndAlso value <= maxValue Then
                    Return value
                End If
            End If

            ed.WriteMessage("Giá trị không hợp lệ. Vui lòng nhập lại." & vbLf)
        End While
    End Function

    Private Function LayerExists(layerName As String) As Boolean
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForRead)
            If lt.Has(layerName) Then
                Return True
            End If
        End Using

        Return False
    End Function

    Private Sub CreateLayer(layerName As String)
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim lt As LayerTable = trans.GetObject(db.LayerTableId, OpenMode.ForWrite)
            Dim newLayer As New LayerTableRecord()
            newLayer.Name = layerName
            lt.Add(newLayer)
            trans.AddNewlyCreatedDBObject(newLayer, True)
            trans.Commit()
        End Using
    End Sub

 

[gia_bach 1.549]

Bạn tham khảo code : 

    <CommandMethod("DrawLines2")>
    Public Sub DrawPLines()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor

        ' Lấy số lượng đường cần vẽ từ người dùng
        Dim numLines As Integer = 7 ' GetNumberFromUser("Nhập số lượng đường (từ 1 đến 12): ", 1, 12)

        ' Lấy khoảng cách giữa các đường từ người dùng
        Dim distance As Double = 12 ' GetNumberFromUser("Nhập khoảng cách giữa các đường (số nhỏ nhất là 3): ", 3, Double.MaxValue)

        ' Danh sách mã màu cho các đường
        Dim colors() As Integer = {160, 30, 94, 15, 253, 255, 10, 250, 50, 202, 220, 130}

        '' Kiểm tra nếu Layer "SODODAUNOI" chưa tồn tại, tạo mới
        'If Not LayerExists("SODODAUNOI") Then
        '    CreateLayer("SODODAUNOI")
        'End If

        Dim length As Double = distance * 5

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

            ' Vẽ đường thứ nhất
            Dim startPoint As New Point2d(0, 0)
            Dim endPoint As New Point2d(length, 0)
            Dim pLine As New Polyline()
            pLine.AddVertexAt(0, New Point2d(startPoint.X, startPoint.Y), 0, 0, 0)
            pLine.AddVertexAt(1, New Point2d(endPoint.X, endPoint.Y), 0, 0, 0)

            pLine.ColorIndex = colors(0)
            'pLine.Layer = "SODODAUNOI"
            btr.AppendEntity(pLine)
            trans.AddNewlyCreatedDBObject(pLine, True)

            ' Vẽ các đường tiếp theo
            For i As Integer = 1 To numLines - 1
                startPoint = New Point2d(startPoint.X, startPoint.Y + distance)
                endPoint = New Point2d(endPoint.X, endPoint.Y + distance)
                pLine = New Polyline()
                pLine.AddVertexAt(0, startPoint, 0, 0, 0)
                pLine.AddVertexAt(1, endPoint, 0, 0, 0)
                pLine.ColorIndex = colors(i Mod colors.Length)
                'pLine.Layer = "SODODAUNOI"
                btr.AppendEntity(pLine)
                trans.AddNewlyCreatedDBObject(pLine, True)

                ' Cập nhật điểm khởi đầu cho đường tiếp theo
                'startPoint = New Point2d(startPoint.X, startPoint.Y + distance)
                'endPoint = New Point2d(endPoint.X, endPoint.Y + distance)
            Next

            trans.Commit()
        End Using

        ed.WriteMessage("Đã vẽ xong các đường PLINE.")
    End Sub

 

[quyenpv 2]

Code chỉ vẽ các đường nằm ngang còn em muốn vẽ theo hướng bất kỳ anh ạ và thứ tự đúng ra phải là thế này

Nhưng code đang vẽ kiểu ngược lại

 

[quyenpv 2]

Tiện đây anh gia_bach có thể cho em xin code chuyển đổi tiếng việt trong autocad được không ạ. Em gửi tin nhắn riêng mà không được ạ

Zalo em số: 0363456868, anh nhắn giúp em số điện thoại anh với ạ

 

  

[gia_bach 1.549]

Góc tính theo radian:

    Public Function PolarPoint(ByVal basePt As Point2d, ByVal angle As Double, ByVal distance As Double) As Point2d
        Dim x As Double = basePt(0) + distance * Math.Cos(angle)
        Dim y As Double = basePt(1) + distance * Math.Sin(angle)
        Dim point As Point2d = New Point2d(x, y)
        Return point
    End Function

    <CommandMethod("DrawLines2")>
    Public Sub DrawPLines()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor

        ' Lấy số lượng đường cần vẽ từ người dùng
        Dim numLines As Integer = 7 ' GetNumberFromUser("Nhập số lượng đường (từ 1 đến 12): ", 1, 12)

        ' Lấy khoảng cách giữa các đường từ người dùng
        Dim distance As Double = 12 ' GetNumberFromUser("Nhập khoảng cách giữa các đường (số nhỏ nhất là 3): ", 3, Double.MaxValue)

        ' Danh sách mã màu cho các đường
        Dim colors() As Integer = {160, 30, 94, 15, 253, 255, 10, 250, 50, 202, 220, 130}

        ' Kiểm tra nếu Layer "SODODAUNOI" chưa tồn tại, tạo mới
        'If Not LayerExists("SODODAUNOI") Then
        '    CreateLayer("SODODAUNOI")
        'End If

        Dim length As Double = distance * 5
        Dim angle As Double = System.Math.PI / 3

        Dim insertPt As Point3d

        Dim ppr As PromptPointResult = ed.GetPoint("\nInsertion point: ")
        If ppr.Status <> PromptStatus.OK Then Return
        insertPt = ppr.Value

        Using trans As Transaction = db.TransactionManager.StartTransaction()
            Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)

            ' Vẽ đường thứ nhất
            Dim startPoint As New Point2d(insertPt.X, insertPt.Y)
            Dim endPoint As New Point2d()
            endPoint = PolarPoint(startPoint, angle, length)

            Dim pLine As New Polyline()
            pLine.AddVertexAt(0, New Point2d(startPoint.X, startPoint.Y), 0, 0, 0)
            pLine.AddVertexAt(1, New Point2d(endPoint.X, endPoint.Y), 0, 0, 0)

            pLine.ColorIndex = colors(0)
            'pLine.Layer = "SODODAUNOI"
            btr.AppendEntity(pLine)
            trans.AddNewlyCreatedDBObject(pLine, True)

            ' Vẽ các đường tiếp theo
            For i As Integer = 1 To numLines - 1
                startPoint = PolarPoint(startPoint, angle - System.Math.PI / 2, distance)
                endPoint = PolarPoint(endPoint, angle - System.Math.PI / 2, distance)
                pLine = New Polyline()
                pLine.AddVertexAt(0, startPoint, 0, 0, 0)
                pLine.AddVertexAt(1, endPoint, 0, 0, 0)
                pLine.ColorIndex = colors(i Mod colors.Length)
                'pLine.Layer = "SODODAUNOI"
                btr.AppendEntity(pLine)
                trans.AddNewlyCreatedDBObject(pLine, True)

                ' Cập nhật điểm khởi đầu cho đường tiếp theo
                'startPoint = New Point2d(startPoint.X, startPoint.Y + distance)
                'endPoint = New Point2d(endPoint.X, endPoint.Y + distance)
            Next

            trans.Commit()
        End Using

        ed.WriteMessage("Đã vẽ xong các đường PLINE.")
    End Sub

 

[quyenpv 2]

Có thể tự chọn điểm vẽ và hướng vẽ không anh

[gia_bach 1.549]

9 giờ trước, quyenpv đã nói:

Có thể tự chọn điểm vẽ và hướng vẽ không anh

update: 

- chọn điểm vẽ.

- hướng vẽ: có thể sử dụng hàm GetNumberFromUser 

 hoặc yêu cầu user pick thêm 1 điểm và tính góc qua 2 điểm này.

 

code nhiều, thử nhiều lần sẽ lên tay thôi.

[quyenpv 2]

Em tay ngang qua anh giúp em với ạ. Anh sử dụng hàm GetNumberFromUser

[quyenpv 2]

Code đã điều chỉnh và xử lý tất cả các trường hợp xong rồi