btzywoo

Boa tarde, Meu projeto seria a criação de múltiplas plaquinhas em um mesmo DWG. Consegui criar o script para adicionar o Mtext conforme a segunda coluna do Excel, e quantidade de vezes que se repete conforme a terceira coluna. Para finalizar preciso criar esse retângulo com o Mtext centralizado, mas não estou conseguindo, ele é criado mas não fica centralizado. O retângulo precisa ser 60x40. Em anexo deixei minha planilha e dwg. Sub UpdateAutoCADMTextAndCreateCopies() ' Defina a referência ao AutoCAD Dim AcadApp As Object On Error Resume Next Set AcadApp = GetObject(, "AutoCAD.Application") If AcadApp Is Nothing Then Set AcadApp = CreateObject("AutoCAD.Application") End If On Error GoTo 0 ' Defina a referência à planilha do Excel Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Plan1") ' Altere para o nome da sua planilha ' Abra o desenho do AutoCAD Dim AcadDoc As Object Set AcadDoc = AcadApp.Documents.Open(ws.Cells(1, "A").Value) ' Percorra as células na coluna B (novo valor mtext) e C (quantidade de cópias) Dim i As Long For i = 1 To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row ' Crie as cópias do mtext Dim j As Long For j = 1 To ws.Cells(i, "C").Value ' Crie um novo mtext Dim insertionPoint(0 To 2) As Double insertionPoint(0) = 2469 + (i - 1) * 100 ' X coordinate insertionPoint(1) = 1390 + (j - 1) * 100 ' Y coordinate insertionPoint(2) = 0 ' Z coordinate Dim AcadEntity As Object Set AcadEntity = AcadDoc.ModelSpace.AddMText(insertionPoint, 54, ws.Cells(i, "B").Value) AcadEntity.StyleName = "Stencil" AcadEntity.Height = 4.25 ' Crie um retângulo em volta do mtext Dim lowerLeft(0 To 2) As Double lowerLeft(0) = insertionPoint(0) - 30 ' X coordinate lowerLeft(1) = insertionPoint(1) - 20 ' Y coordinate lowerLeft(2) = 0 ' Z coordinate Dim upperRight(0 To 2) As Double upperRight(0) = insertionPoint(0) + 30 ' X coordinate upperRight(1) = insertionPoint(1) + 20 ' Y coordinate upperRight(2) = 0 ' Z coordinate Dim points(0 To 9) As Double points(0) = lowerLeft(0): points(1) = lowerLeft(1) points(2) = upperRight(0): points(3) = lowerLeft(1) points(4) = upperRight(0): points(5) = upperRight(1) points(6) = lowerLeft(0): points(7) = upperRight(1) points(8) = lowerLeft(0): points(9) = lowerLeft(1) Dim AcadRectangle As Object Set AcadRectangle = AcadDoc.ModelSpace.AddLightWeightPolyline(points) AcadRectangle.Closed = True Next j Next i ' Salve o desenho do AutoCAD AcadDoc.Save AcadDoc.Close SaveChanges:=True End Sub Dados.7z

comprei um pc usado, e gostaria de saber se a licença é original ou não. tem algum aplicativo ou algo do tipo para rodar e descobrir?

Comecei na área do TI recentemente, alguns computadores (Windows 10) que cuido estão com esse demora elevada na inicialização. Alguns ficam carregando na tela da BIOS, e outros com a imagem do Windows. Mesmo tendo SSD, as vezes fica mais de 10 minutos para ligarem. Quando limpo os arquivos temporários da uma melhorada. Podem me ajudar?