Translate

quarta-feira, 11 de maio de 2011

VB.NET - Criar infinitas layers, dando respectiva cor

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Colors

Public Class class1
    <CommandMethod("criarlayerx")> _
    Public Sub criarlayer()

        Dim db As Database
        Dim mydwg As Document
        mydwg = Application.DocumentManager.MdiActiveDocument
        Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument

        Using Trans As Transaction = mydwg.TransactionManager.StartTransaction()
            db = Application.DocumentManager.MdiActiveDocument.Database
            Dim TabelaLayer As LayerTable
            TabelaLayer = Trans.GetObject(db.LayerTableId, OpenMode.ForWrite)

            Dim contador As Integer = InputBox("Quantas layers quer criar ? ")

            For contador = 0 To contador

                Dim NomeLayer(contador) As String
                NomeLayer(contador) = InputBox("qual o nome da layer? ")

                Dim CorLayer(contador) As Integer
                CorLayer(contador) = InputBox("qual o número da cor? ")

                If TabelaLayer.Has(NomeLayer(contador)) = False Then
                    Dim Novalayer As LayerTableRecord = New LayerTableRecord()
                   
                    Novalayer.Name = NomeLayer(contador)
                    TabelaLayer.Add(Novalayer)
                    Novalayer.Color = Color.FromColorIndex(ColorMethod.ByAci, CorLayer(contador))
                    contador = contador + 1
                 
                    Trans.AddNewlyCreatedDBObject(Novalayer, True)
                   
                End If
               
            Next
           
            Trans.Commit()
        End Using
    End Sub
End Class

Sem comentários:

Enviar um comentário