Explodir Spline em vb.net

Lembra daquele programinha para explodir spline? Que tal fazer isso em VB.NET? Veja:
(ah, usei o VISUAL STUDIO 2010 EXPRESS EDITION e AUTOCAD 2011)

Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.DatabaseServices.OpenMode


Public Module TBN2
''ponteiro para a transacao atualmente aberta
 Public CurrentTrans As Transaction = Nothing

''funcoes internas
''editor, é como o utility do vba
    Public Function ED() As Editor
        Return AcadDOC.Editor
    End Function

''documento atual, é como do thisdrawing
    Public Function AcadDOC() As Document
        Return DocumentManager.MdiActiveDocument
    End Function

''retorna o banco de dados do desenho atual
    Public Function DB() As Database
        Return AcadDOC.Database
    End Function

''adiciona uma entidade criada ao modelspace
    Public Function AddToModel(ByVal e As Entity) As ObjectId
        Dim bt As BlockTable = DB.BlockTableId.GetObject(ForRead)
        Dim btr As BlockTableRecord = bt(BlockTableRecord.ModelSpace).GetObject(ForWrite)
        AddToModel = btr.AppendEntity(e)
        CurrentTrans.AddNewlyCreatedDBObject(e, True)
    End Function

''inicia uma transacao com o desenho atual
    Public Sub StartTR()
        If CurrentTrans Is Nothing Then CurrentTrans = AcadDOC.TransactionManager.StartTransaction
    End Sub

''funcao principal: Spline2PLine
 <commandmethod("spline2pline", commandflags.usepickset)>
   Public Sub SPLINE2PLINE()
''inicia a transacao
        StartTR()
        Try
''pede a selecao das splines
            Dim ssr As PromptSelectionResult =
                ED.GetSelection(New PromptSelectionOptions,
                                New SelectionFilter(New TypedValue() {New TypedValue(0, "SPLINE")}))
            If ssr.Status <> PromptStatus.OK Then Exit Try

''pede a precisao
            Dim PPI As New PromptIntegerOptions(vbLf & "Qual a precisão?")
            PPI.UseDefaultValue = True
            PPI.DefaultValue = 10
            PPI.AllowNegative = False
            PPI.AllowZero = False
''se nao for informado, sai
            Dim ppr As PromptIntegerResult = ED.GetInteger(PPI)
            If ppr.Status <> PromptStatus.OK Then Exit Try

''em toda a selecao, repita:
            For Each ID As ObjectId In ssr.Value.GetObjectIds
                Dim S As Spline = ID.GetObject(ForWrite)
                Dim C As Entity = S.ToPolylineWithPrecision(ppr.Value)
                AddToModel(C)
            Next
'' em caso de erro na execucao:            
        Catch
''mostra o erro na linha de comando
            ED.WriteMessage(Err.Description)
        End Try

''fecha a transacao e informa ao autocad, para manter as alteracoes no banco de dados
        CurrentTrans.Commit()
    End Sub

End Module

Copie para um novo projeto do visual studio, carregue as referências:
acmgd.dll e acdbmgd.dll do autocad, compile e teste!!!



Nenhum comentário:

Postar um comentário