quyenpv Posted July 4, 2023 Posted July 4, 2023 I'm using vb.net language to write sub for autocad to draw plines with required option 1. the user enters the number of lines or plines to draw in the range from 1 to 12 2. Enter the distance between the lines above with a minimum of 3 3. The user selects the drawing position and direction on the current drawing, then the program will draw parallel plines with the entered distance. 4. When drawing the color of the lines, they will take the color list from 1 to 12 as follows 160 30 94 15 253 255 10 250 50 202 220 130 How to display the order of the first lines at the selected point of the next lines. will always be drawn parallel to the right of the first line with the input distance. Additional please create a Layer with the name SODODAUNOI, check in the current autocad file, if not, create a new one. The code I wrote is misaligning the lines when the code runs again, equidistant from each other by the interval entered <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 Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.