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!!!


Deixe um comentário

Carrinho de compras
Rolar para cima