Code:
Public Shared Function criarDefinicaoBloco(ByVal nomeBloco As String, _
ByVal nomeLayer As String) As ObjectId
Dim db As Database = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
Using trans As Transaction = db.TransactionManager.StartTransaction
Try
'abrir a tabela de blocos
Dim bTable As BlockTable = trans.GetObject(db.BlockTableId, _
OpenMode.ForRead)
'verificar se o bloco existe
If (bTable.Has(nomeBloco)) Then Return bTable.Item(nomeBloco)
'não existe, vamos criar
Dim novoBloco As New BlockTableRecord
novoBloco.Name = nomeBloco
'adicionar a table de blocos
bTable.UpgradeOpen()
bTable.Add(novoBloco)
trans.AddNewlyCreatedDBObject(novoBloco, True)
'criar os objetos de geometria
Dim linhaVertical As New Line
Dim linhaHorizontal As New Line
Dim circulo As New Circle
Dim texto As New AttributeDefinition(Point3d.Origin, _
"DEFAULT", _
"TAG", _
"PROMPT", _
db.Textstyle)
'criar o layer
Dim layerId As ObjectId = criarLayer(nomeLayer)
'configurar objetos de geometria
linhaVertical.StartPoint = New Point3d(0, -10, 0)
linhaVertical.EndPoint = New Point3d(0, 10, 0)
linhaVertical.LayerId = layerId
linhaHorizontal.StartPoint = New Point3d(-10, 0, 0)
linhaHorizontal.EndPoint = New Point3d(10, 0, 0)
linhaHorizontal.LayerId = layerId
circulo.Center = Point3d.Origin 'New Point3d(0,0,0)
circulo.Radius = 8.0
circulo.LayerId = layerId
'adicionar ao bloco
novoBloco.AppendEntity(linhaVertical)
novoBloco.AppendEntity(linhaHorizontal)
novoBloco.AppendEntity(circulo)
novoBloco.AppendEntity(texto)
'informar a transacao
trans.AddNewlyCreatedDBObject(linhaHorizontal, True)
trans.AddNewlyCreatedDBObject(linhaVertical, True)
trans.AddNewlyCreatedDBObject(circulo, True)
trans.AddNewlyCreatedDBObject(texto, True)
trans.Commit()
'retornar o id do bloco criado
Return novoBloco.ObjectId
Catch ex As Exception
trans.Abort()
End Try
End Using
End Function
Public Shared Sub criarReferenciaBloco(ByVal pontoInsercao As Point3d, _
ByVal textoBloco As String, _
ByVal infoBloco As String)
Dim db As Database = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Database
Using trans As Transaction = db.TransactionManager.StartTransaction
Try
'criar a definicao de bloco
Dim blockDefId As ObjectId = criarDefinicaoBloco("b1", "l1")
'criar a referencia de bloco
Dim blockRef As New BlockReference(pontoInsercao, blockDefId)
'vamos adicionar a referencia de bloco no BTR corrente(ativo)
Dim currSpace As BlockTableRecord = trans.GetObject( _
db.CurrentSpaceId, _
OpenMode.ForWrite)
'adicionar ao espaco corrente
currSpace.AppendEntity(blockRef)
trans.AddNewlyCreatedDBObject(blockRef, True)
'o ext dic pode não existir, neste caso como é uma nova entidade
'ele não vai existir, mas vamos verificar assim mesmo
If Not (blockRef.ExtensionDictionary.IsValid) Then
'não existe, vamos criar
blockRef.CreateExtensionDictionary()
End If
'aqui já existe (sempre), vamos abrir
Dim extDic As DBDictionary = trans.GetObject( _
blockRef.ExtensionDictionary, _
OpenMode.ForWrite)
'vamos criar o nosso dicionário
'neste caso não é verificar se existe antes de criar
'pq acabamos de criar a entidade (blockRef) - não existe nada nela
Dim extDicCurso As New DBDictionary
extDic.SetAt(NOME_NOD, extDicCurso)
trans.AddNewlyCreatedDBObject(extDicCurso, True)
'criar uma array de typed values (array de 1 elemento)
Dim tpvals As TypedValue() = {New TypedValue(DxfCode.Text, infoBloco)}
'criar um result buffer pra armazenar a array de typedValues
Dim resbuf As New ResultBuffer(tpvals)
'criar um XRecord com o result buffer
Dim xrec As New Xrecord
xrec.Data = resbuf
'guardar o xrec no extDicCurso e informar a transacao
extDicCurso.SetAt("Info", xrec)
trans.AddNewlyCreatedDBObject(xrec, True)
'percorrer a definicao de bloco procurando as definicoes de attributo
Dim blockDef As BlockTableRecord = trans.GetObject(blockDefId, _
OpenMode.ForRead)
'para cada ObjectId dentro da definicao de bloco
For Each entId As ObjectId In blockDef
'abra a entidade para leitura
Dim ent As Entity = trans.GetObject(entId, OpenMode.ForRead)
'tente converter para att def
Dim attDef As AttributeDefinition = TryCast(ent, AttributeDefinition)
'se a conversao foi possivel, então não é vazia (nothing)
If (attDef IsNot Nothing) Then
'se temos a def de att, então vamos criar uma ref de att
Dim attRef As New AttributeReference
attRef.SetAttributeFromBlock(attDef, blockRef.BlockTransform)
attRef.TextString = textoBloco
'adicionar a colecao de attributos da ref de bloco
blockRef.AttributeCollection.AppendAttribute(attRef)
trans.AddNewlyCreatedDBObject(attRef, True)
End If
Next
trans.Commit()
Catch ex As Exception
trans.Abort()
End Try
End Using
End Sub
<CommandMethod("criarBlocoOpcoes")> _
Public Sub criarReferenciaBlocoComOpcoes()
Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor
'valores padrão, caso o usuário não selecione as opcoes
Dim textoPadrao As String = "Texto Padrao"
Dim infoPadrao As String = "Info padrão"
Dim pontoInsercao As Point3d 'irá armazenar o ponto
'configuracoes iniciais do prompt de ponto
Dim opcoesPonto As New PromptPointOptions("Ponto de insercao")
opcoesPonto.Keywords.Add("Texto")
opcoesPonto.Keywords.Add("inFo")
Do
'pede para o usuário clicar no ponto ou uma keyword
Dim resultadoPonto As PromptPointResult = ed.GetPoint(opcoesPonto)
If (resultadoPonto.Status = PromptStatus.OK) Then
'neste caso ele clicou no ponto
pontoInsercao = resultadoPonto.Value
Exit Do
ElseIf (resultadoPonto.Status = PromptStatus.Keyword) Then
'neste caso ele digitou uma keyword
Select Case resultadoPonto.StringResult
Case "Texto"
Dim opcoesTexto As New PromptStringOptions("Texto do bloco: ")
opcoesTexto.DefaultValue = textoPadrao
opcoesTexto.UseDefaultValue = True
opcoesTexto.AllowSpaces = True
Dim resultadoTexto As PromptResult = ed.GetString(opcoesTexto)
If (resultadoTexto.Status <> PromptStatus.OK) Then Exit Sub
textoPadrao = resultadoTexto.StringResult
Case "inFo"
Dim opcoesInfo As New PromptStringOptions("Entre com a info: ")
opcoesInfo.DefaultValue = infoPadrao
opcoesInfo.UseDefaultValue = True
opcoesInfo.AllowSpaces = True
Dim resultadoInfo As PromptResult = ed.GetString(opcoesInfo)
If (resultadoInfo.Status <> PromptStatus.OK) Then Exit Sub
infoPadrao = resultadoInfo.StringResult
End Select
Else
'no caso de qualquer coisa inválida (diferente de OK ou Keyword)
Exit Sub
End If
Loop While (True)
'chamar o método que cria a referencia de bloco
criarReferenciaBloco(pontoInsercao, textoPadrao, infoPadrao)
End Sub