RESPONDER UNA PREGUNTA

Si para responder la pregunta, crees necesario enviar un archivo adjunto, puedes hacerlo a traves del correo [email protected]

Pregunta:	67332 - AUTOCAD CERRAR PLANOS CORRECTAMENTE
Autor:	Enrique Larrosa
Hola he creado una macro VBA en un plano autocad. Podria crear una aplicacion escritorio con Vb Studio y ejecutar desde esta los comandos Excel y Autocad. Adjunto codigo para mas informacion: Public ExcelApp As Excel.Application Dim FullaExcel As String Public Wrkbook As Excel.Workbooks Dim llistaDWG As AcadDocuments Dim dwg As AcadDocument Dim rutaFitxerDWG As String Dim nomFixerDWG As String Dim rutaNomDWG As String Dim StrnumDWG As String Dim IntnumDWG As Integer Dim numTotalDWG As Integer Dim StrNumPagNomemclatures As String Dim StrIndexBlocksEnDWG As String Dim indexBlocksDWGArray() As String Dim contadorFullesExcel As Variant Dim acEntidad As AcadEntity Dim acadBlkRef As AcadBlockReference Dim varAttributes As Variant '============================================ Public Sub CreanomBlockArray() 'convertimos contenido string a Array siendo el valor de cada posición el que hay entre el separador / StrIndexBlocksEnDWG = "2/1/4/5/6/7/8/9/10/11/12/13/14/15/16/17/18/19/20/21/22/23/24/25/26/" StrIndexBlocksEnDWG = StrIndexBlocksEnDWG + "27/28/29/30/31/32/33/34/35/36/37/38/39/40/41/42/43/44/45/46/47/48/49/50" indexBlocksDWGArray = Split(StrIndexBlocksEnDWG, "/") End Sub '================================================= Function ExcelConnect() ' This function connects excel with autocad On Error Resume Next Set ExcelApp = GetObject(, "Excel.Application") If Err Then Err.Clear Set ExcelApp = CreateObject("Excel.Application") ExcelApp.Visible = True If Err Then MsgBox Err.Description Exit Function End If End If End Function '================================================== Function ExcelClose() 'cerramos fichero Excel ' Application.DisplayAlerts = False Application.Quit ' cierra conexion entre Autocad y excel Set ExcelApp = Nothing End Function '=================================================== Public Sub CreaStocklist() rutaFitxerDWG = ThisDrawing.Path nomFixerDWG = AutoCAD.ActiveDocument.Name rutaNomDWG = rutaFitxerDWG & "/" & nomFitxerDWG CreanomBlockArray ExcelConnect Workbooks.Open FileName:="C:dwgStocklist_N.xlsx" contadorFullesExcel = ActiveWorkbook.Worksheets.Count For numFullaExcel = 1 To contadorFullesExcel FullaExcel = "hoja" & CStr(numFullaExcel) Excel.Worksheets(FullaExcel).Activate If numFullaExcel = 1 Then IntnumDWG = CInt(Excel.Worksheets(FullaExcel).Cells(1, 9).Value) numTotalDWG = CInt(Excel.Worksheets(FullaExcel).Cells(1, 9).Value) + (contadorFullesExcel - 1) Else IntnumDWG = (IntnumDWG + 1) End If If IntnumDWG < 100 Then StrnumDWG = "0" & CStr(IntnumDWG) Else StrnumDWG = CStr(IntnumDWG) End If StrNumPagNomemclatures = Excel.Worksheets(FullaExcel).Cells(1, 3).Value 'recorremos el array de todos los bloques que hay en el dibujo For recorrer = LBound(indexBlocksDWGArray) To UBound(indexBlocksDWGArray) 'guardamos el bloque en un objeto entidad Set acEntidad = ThisDrawing.ModelSpace.Item(CInt(indexBlocksDWGArray(recorrer))) Set acadBlkRef = acEntidad 'como estoy modificando atributos hago una funcion 'acadBlkRef = OmplirBlock(acadBlkRef, recorrer) varAttributes = acadBlkRef.GetAttributes varAttributes(0).TextString = CStr(ExcelApp.ActiveSheet.Cells(recorrer + 1, 1)) varAttributes(1).TextString = CStr(ExcelApp.ActiveSheet.Cells(recorrer + 1, 2)) varAttributes(2).TextString = CStr(ExcelApp.ActiveSheet.Cells(recorrer + 1, 3)) varAttributes(3).TextString = CStr(ExcelApp.ActiveSheet.Cells(recorrer + 1, 4)) varAttributes(4).TextString = CStr(ExcelApp.ActiveSheet.Cells(recorrer + 1, 5)) varAttributes(5).TextString = CStr(ExcelApp.ActiveSheet.Cells(recorrer + 1, 6)) varAttributes(6).TextString = CStr(ExcelApp.ActiveSheet.Cells(recorrer + 1, 7)) varAttributes(7).TextString = CStr(ExcelApp.ActiveSheet.Cells(recorrer + 1, 8)) Next recorrer ThisDrawing.Regen (acActiveViewport) AutoCAD.AcadApplication.ZoomExtents ThisDrawing.SaveAs (StrnumDWG) If numFullaExcel > contadorFullesExcel Then Set dwg = acad.ActiveDocument dwg.Open rutaNomDWG End If Next numFullaExcel ActiveWindow.Close Workbooks.Close Set llistaDWG = AutoCAD.Application.Documents For Each dwg In llistaDWG dwg.Close Next AutoCAD.AcadApplication.Quit End Sub la intención de todo esto es que todo el codigo este en la aplicacion y las plantillas de autocad de y excel no tengan codigo VBA. que es como las enttrega el cliente.