Tạo Layer AutoCAD bằng VB.Net

Public Sub CreateAndAssignALayer(ByVal Ten, ByVal Mau, ByVal Loai)
        '' 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()
            acCurDb.Ltscale = 1.2
            '' Open the Layer table for read
            Dim acLyrTbl As LayerTable
            acLyrTbl = acTrans.GetObject(acCurDb.LayerTableId, DatabaseServices.OpenMode.ForRead)

            Dim sLayerName As String = Ten

            If acLyrTbl.Has(sLayerName) = False Then
                Dim acLyrTblRec As LayerTableRecord = New LayerTableRecord()
                Dim acLineTypTbl As LinetypeTable
                acLineTypTbl = acTrans.GetObject(acCurDb.LinetypeTableId, DatabaseServices.OpenMode.ForRead)
                Dim sLineTypName As String = Loai
                If acLineTypTbl.Has(sLineTypName) = False Then
                    acCurDb.LoadLineTypeFile(sLineTypName, "acad.lin")
                End If

                '' Assign the layer the ACI color 1 and a name
                acLyrTblRec.Color = Color.FromColorIndex(ColorMethod.ByAci, Mau)
                acLyrTblRec.Name = sLayerName
                acLyrTblRec.LinetypeObjectId = acLineTypTbl(sLineTypName)

                '' Upgrade the Layer table for write
                acLyrTbl.UpgradeOpen()

                '' Append the new layer to the Layer table and the transaction
                acLyrTbl.Add(acLyrTblRec)
                acTrans.AddNewlyCreatedDBObject(acLyrTblRec, True)
            End If

            '' Save the changes and dispose of the transaction
            acTrans.Commit()
        End Using
    End Sub


**************************
Ví dụ gọi hàm:
CreateAndAssignALayer("LAYER_CHINH", 1, "CONTINUOUS")

Không có nhận xét nào:

Đăng nhận xét