Ola,
Preciso exportar texto de algumas celulas para o AutoCAD e gostaria de fazer isso via VBA.
Alguem sabe como faze-lo?
Por exemplo
Na celula B4 eu tenho o texto: "Armação Secundária"
Este texto iria para a área do autoCad automaticamente.
Pela Internet eu achei o seguinte código, mas NÃO funciona:
Opção Explicit
Sub Ex_Acad()
Dim oAcad As Object
Dim oDoc As AcadDocument
Dim oPaper As AcadPaperSpace
Dim Pts1(0 To 2) As Double
Dim Pts2(0 To 2) As Double
Dim Pts3(0 To 2) As Double
Dim Pts4(0 To 2) Como Dupla
Dim Pts5(0 A 2) Como Dupla
Dim Pts6(0 A 2) Como Dupla
Dim Pts7(0 A 2) Como Dupla
Dim Pts8(0 A 2) Como Dupla
Dim Pontos(0 A 43) Como Dupla
Dim blockObj As AcadBlock
Dim blockRefObj As AcadBlockReference
Dim pLine As AcadLWPolyline
Dim x As Double
Dim i As Integer
Dim sht As Worksheet
Dim dtxt As AcadText
Dim mtxt As AcadMText
Dim varAtt As Variant
On Error GoTo ERRORMSG 'Se o Autocad não estiver rodando, mensagem e sair
Set oAcad = GetObject(, "Autocad.Application") 'Obter a instância aberta do AutoCad
On Error GoTo 0 'Reset Error
Set oDoc = oAcad.ActiveDocument 'Set the Active Desenho
Set oPaper = oDoc.PaperSpace
Set sht = ActiveWorkbook.Sheets(1) 'Definir a planilha
If sht.Cells(4, 2) = "" Then Exit Sub 'Check for Info to Export - If Cell B4 is Blank Quit
oDoc. ActiveLayer = oDoc.Layers("0_TABL") 'Definir Camada
Pts1(0) = 0: Pts1(1) = 0: Pts1(2) = 0 'Definir Ponto de Inserção para
Conjunto de Blocos Temp blockObj = oDoc.Blocks.Add(Pts1 , "Temperatura") 'Criar Bloqueio Temporário para Fronteira
Pontos(0) = 0: Pontos(1) = 0: Pontos(2) = 0: Pontos(3) = 9,21: Pontos(4) = 12,4: Pontos(5) = 9,21
Pontos(6) = 12,4: Pontos( 7) = 0: Pontos(8) = 12,4: Pontos(9) = 9,21: Pontos(10) = 82,4: Pontos(11) = 9,21
Pontos(12) = 82,4: Pontos(13) = 0: Pontos(14) = 82,4: Pontos(15) = 9,21: Pontos(16) = 92,4: Pontos(17) = 9,21
Pontos(18) = 92,4: Pontos(19) = 0: Pontos(20) = 92,4: Pontos(21) = 9,21 : Pontos(22) = 122,4: Pontos(23) = 9,21
Pontos(24) = 122,4: Pontos(25) = 0: Pontos(26) = 122,4: Pontos(27) = 9,21: Pontos(28) = 152,4: Pontos (29) = 9,21
Pontos(30) = 152,4: Pontos(31) = 0: Pontos(32) = 152,4: Pontos(33) = 9,21: Pontos(34) = 164,4: Pontos(35) = 9,21
Pontos(36) = 164,4: Pontos(37) = 0: Pontos(38) = 164,4: Pontos(39) = 9,21: Pontos(40) = 180,8: Pontos(41) = 9,21
Pontos(42) = 180,8: Pontos( 43) = 0
Defina pLinha = blocoObj. AddLightWeightPolyline(Points) 'Desenhar Borda
Pts1(0) = 205: Pts1(1) = 71.6: Pts1(2) = 0 'Ponto de inserção para conjunto de blocos de cabeçalho
blockRefObj = oPaper.InsertBlock(Pts1, "TABL_poz", 1#, 1 #, 1#, 0) 'Insira seu bloco de cabeçalho
Pts1(0) = 24.2: Pts1(1) = 72.79: Pts1(2) = 0 'Defina pontos de partida para deslocamento
Pts2(0) = 30.4: Pts2(1) = 75,67: Pts2(2) = 0
Pts3(0) = 38,6: Pts3(1) = 77,4: Pts3(2) = 0
Pts4(0) = 111,6: Pts4(1) = 76,16: Pts4(2) = 0
Pts5( 0) = 131,6: Pts5(1) = 77,4: Pts5(2) = 0
Pts6(0) = 161,6: Pts6(1) = 77,4: Pts6(2) = 0
Pts7(0) = 187,35: Pts7(1) = 76,21: Pts7(2) = 0
Pts8(0) = 203,03: Pts8(1 ) = 76.16: Pts8(2) = 0
x = 9.21 'Offset for Temp Block
oDoc.ActiveTextStyle = oDoc.TextStyles("Romans") 'Set Text Style
For i = 4 To sht.Cells(100, 2).End( xlUp). Etapa 2
da Linha Pts1(1) = Pts1(1) + x: Pts2(1) = Pts2(1) + x: Pts3(1) = Pts3(1) + x: Pts4(1) = Pts4(1) ) + x 'Definir Pontos de Inserção (Offset)
Pts5(1) = Pts5(1) + x: Pts6(1) = Pts6(1) + x: Pts7(1) = Pts7(1) + x: Pts8(1) = Pts8(1) + x Set blockRefObj = oPaper.InsertBlock(Pts1, "Temp", 1#, 1#, 1#, 0) 'Inserir Borda
Set dtxt = oPaper.AddText(sht.Cells(i, 2).Text, Pts2, 3.5) 'Insert Text
dtxt.Alignment = acAlignmentCenter 'Set Text Alignment
dtxt.TextAlignmentPoint = Pts2
dtxt.Color = acCyan
Set mtxt = oPaper.AddMText (Pts3, 70, sht.Cells(i, 3).Text) 'Inserir texto
mtxt.Height = 2.4
mtxt.AttachmentPoint = acAttachmentPointMiddleLeft
mtxt.InsertionPoint = Pts3
Definir dtxt = oPaper.AddText(sht.Cells(i, 6). Texto, Pts4, 2.4) 'Inserir texto
dtxt.Alignment = acAlignmentCenter 'Definir alinhamento de texto
dtxt.TextAlignmentPoint = Pts4
Definir mtxt = oPaper.AddMText(Pts5, 30, sht.Cells(i, 4).Text) 'Inserir texto
mtxt.Height = 2.4
mtxt.AttachmentPoint = acAttachmentPointMiddleCenter
mtxt .InsertionPoint = Pts5
Set mtxt = oPaper.AddMText(Pts6, 30, sht.Cells(i, 5).Text) 'Insertion Text
mtxt.Height = 2.4
mtxt.AttachmentPoint = acAttachmentPointMiddleCenter
mtxt.InsertionPoint = Pts6
Set dtxt = oPaper.AddText (sht.Cells(i, 7).Texto, Pts7, 2.4) 'Inserir texto
dtxt.Alignment = acAlignmentRight 'Definir alinhamento de texto
dtxt.TextAlignmentPoint = Pts7
Definir dtxt = oPaper.AddText(sht.Cells(i, 8).Text, Pts8, 2.4) 'Inserir texto
dtxt.Alignment = acAlignmentRight 'Definir alinhamento de texto
dtxt. TextAlignmentPoint = Pts8
Próximo i
oDoc.ActiveLayer = oDoc.Layers("2DM_OBV") 'Definir Camada para Bloco de Resumo de Peso
Pts1(0) = Pts1(0) + 140.36: Pts1(1) = Pts1(1) + 15 'Definir Inserção para conjunto de blocos de resumo de peso
blockRefObj = oPaper.InsertBlock(Pts1, "TABL_suma", 1#, 1#, 1#, 0) 'Inserir bloco de resumo de peso
varAtt = blockRefObj.GetAttributes
varAtt(0).TextString = sht.Cells(100, 7).End(xlUp).Text 'Modificar Atributo oDoc.ActiveLayer = oDoc.Layers("0") 'Reset Default Layer Exit Sub ERRORMSG: 'Se o Autocad não estiver aberto, isso executará MsgBox "Autocad deve estar aberto" End Sub