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

thinhtutn

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

  • Số lượng nội dung

    16

  • Đã tham gia

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

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

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

    Em có code thế này

    Public Class Class1
    Sub Add_Line(ByVal X1, ByVal Y1, ByVal X2, ByVal Y2)
        '' Get the current document and database
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database

        '' Start a transaction
        Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()

            '' Open the Block table for read
            Dim acBlkTbl As BlockTable
            acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, DatabaseServices.OpenMode.ForRead)

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

            '' Create a line that starts at 5,5 and ends at 12,3
            Dim acLine As Line = New Line(New Point3d(X1, Y1, 0), New Point3d(X2, Y2, 0))

            acLine.SetDatabaseDefaults()

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

            '' Save the new object to the database
            acTrans.Commit()
        End Using
    End Sub
    <CommandMethod("caotrinh")> Public Sub Dien_cao_trinh()
        '' Get the current database and start the Transaction Manager
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim acCurDb As Database = acDoc.Database
        Dim P1 As PromptPointResult
        Dim P2 As PromptPointResult
        Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")

        ''Nhap ty le ban ve
        Dim tlvOpts As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "Nhập tỷ lệ khung bản vẽ: (1/...10, 20, 50, 100, ...): ")
        Dim tlbv As PromptDoubleResult = acDoc.Editor.GetDouble(tlvOpts)
        Dim TLV = tlbv.Value / 1000

        '' Prompt for the start point
        pPtOpts.Message = vbLf & "Pick điểm mốc: "
        P1 = acDoc.Editor.GetPoint(pPtOpts)

        '' Exit if the user presses ESC or cancels the command
        If P1.Status = PromptStatus.Cancel Then Exit Sub

        '' Nhap cao do moc
        Dim CDMOC_Opts As PromptDoubleOptions = New PromptDoubleOptions(vbLf & "Nhập cao độ mốc: ")
        Dim CDMOC As PromptDoubleResult = acDoc.Editor.GetDouble(CDMOC_Opts)

        While CDMOC.Value + P1.Value.Y <> 0
            '' Prompt for the end point
            pPtOpts.Message = vbLf & "Pick điểm điền cao độ: "
            pPtOpts.UseBasePoint = True
            pPtOpts.BasePoint = P1.Value
            P2 = acDoc.Editor.GetPoint(pPtOpts)

            If P2.Status = PromptStatus.Cancel Then Exit Sub

            '' Start a transaction
            Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
                Dim acBlkTbl As BlockTable
                Dim acBlkTblRec As BlockTableRecord

                '' Open Model space for write
                acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, DatabaseServices.OpenMode.ForRead)
                acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), DatabaseServices.OpenMode.ForWrite)

                Dim pKeyOpts As PromptKeywordOptions = New PromptKeywordOptions("")
                pKeyOpts.Message = vbLf & "Chọn hướng điền "
                pKeyOpts.Keywords.Add("Trai")
                pKeyOpts.Keywords.Add("Phai")
                pKeyOpts.AllowNone = False
                Dim pKeyRes As PromptResult = acDoc.Editor.GetKeywords(pKeyOpts)
                If pKeyRes.Status = PromptStatus.Cancel Then Exit Sub
                If pKeyRes.StringResult = "Phai" Then
                    '' Vẽ ký hiệu cao trình
                    Add_Line(P2.Value.X, P2.Value.Y, P2.Value.X + 3.6 * TLV, P2.Value.Y)
                    Add_Line(P2.Value.X + 3 * TLV, P2.Value.Y, P2.Value.X + 3 * TLV, P2.Value.Y + 7.5 * TLV)
                    Add_Line(P2.Value.X + 1.6 * TLV, P2.Value.Y + 3.8 * TLV, P2.Value.X + 10.6 * TLV, P2.Value.Y + 3.8 * TLV)
                    Add_Line(P2.Value.X + 3.0 * TLV, P2.Value.Y, P2.Value.X + 2.6 * TLV, P2.Value.Y + 2 * TLV)
                    Add_Line(P2.Value.X + 2.6 * TLV, P2.Value.Y + 2 * TLV, P2.Value.X + 3.4 * TLV, P2.Value.Y + 2 * TLV)
                    Add_Line(P2.Value.X + 3.4 * TLV, P2.Value.Y + 2 * TLV, P2.Value.X + 3 * TLV, P2.Value.Y)
                    '' Điền cao trình
                    Dim acText As DBText = New DBText()
                    acText.SetDatabaseDefaults()
                    acText.Position = New Point3d(P2.Value.X + 3.9 * TLV, P2.Value.Y + 4.1 * TLV, 0)
                    acText.Height = TLV * 2
                    acText.TextString = Format(CDMOC.Value - P1.Value.Y + P2.Value.Y, "00.00") ''ChuoiRes.StringResult
                    acBlkTblRec.AppendEntity(acText)
                    acTrans.AddNewlyCreatedDBObject(acText, True)
                    If P2.Status = PromptStatus.Cancel Then Exit Sub
                Else
                    '' Vẽ ký hiệu cao trình
                    Add_Line(P2.Value.X, P2.Value.Y, P2.Value.X - 3.6 * TLV, P2.Value.Y)
                    Add_Line(P2.Value.X - 3 * TLV, P2.Value.Y, P2.Value.X - 3 * TLV, P2.Value.Y + 7.5 * TLV)
                    Add_Line(P2.Value.X - 1.6 * TLV, P2.Value.Y + 3.8 * TLV, P2.Value.X - 10.6 * TLV, P2.Value.Y + 3.8 * TLV)
                    Add_Line(P2.Value.X - 3.0 * TLV, P2.Value.Y, P2.Value.X - 2.6 * TLV, P2.Value.Y + 2 * TLV)
                    Add_Line(P2.Value.X - 2.6 * TLV, P2.Value.Y + 2 * TLV, P2.Value.X - 3.4 * TLV, P2.Value.Y + 2 * TLV)
                    Add_Line(P2.Value.X - 3.4 * TLV, P2.Value.Y + 2 * TLV, P2.Value.X - 3 * TLV, P2.Value.Y)

                    '' Điền cao trình
                    Dim acText As DBText = New DBText()
                    acText.SetDatabaseDefaults()
                    acText.HorizontalMode = TextHorizontalMode.TextRight
                    acText.AlignmentPoint = New Point3d(P2.Value.X - 3.9 * TLV, P2.Value.Y + 4.1 * TLV, 0)
                    acText.Height = TLV * 2
                    acText.TextString = Format(CDMOC.Value - P1.Value.Y + P2.Value.Y, "00.00") 
                    acBlkTblRec.AppendEntity(acText)
                    acTrans.AddNewlyCreatedDBObject(acText, True)
                    If P2.Status = PromptStatus.Cancel Then Exit Sub
                End If
                '' Commit the changes and dispose of the transaction
                acTrans.Commit()
            End Using
        End While
    End Sub
End Class

    Các bác thêm giúp em phần cao độ mốc nếu không nhập trực tiếp thì có thể lấy giá trị trên màn hình với. 

×