Cuando se inicia una aplicación mediante programación, se utiliza memoria del ordenador. Salga de la aplicación en cuanto termine de utilizarla para que queden libres los recursos del sistema.
Aunque cada Modelo de objetos es distinto, casi todos tienen un método Quit para el objeto Application, que se puede utilizar para cerrar la aplicación correctamente. Por ejemplo, si se utilizan las declaraciones de variable de la sección anterior, la siguiente línea de código ejecuta la salida de Excel:
ExcelAppObj.Application.Quit
Enumeración de atributos de AutoCAD en una hoja de cálculo de Excel
Esta subrutina localiza todas las referencias de bloque del dibujo actual. A continuación, encuentra los atributos enlazados a dichas referencias de bloque y los presenta en una hoja de cálculo de Excel. Para ejecutar este ejemplo, siga estos pasos:
- Abra un dibujo que contenga referencias a bloque con atributos (el dibujo de ejemplo sample/activeX/attrib.dwg contiene referencias a bloque de este tipo).
- Abra el IDE de VBA utilizando el comando VBAIDE de AutoCAD.
- En el IDE de VBA, elija Herramientas
Referencias y seleccione Microsoft Excel 8.0 Object Model. - Copie esta subrutina en una ventana de código de VBA y ejecútela.
Sub Ch12_Extract()
Dim Excel As Excel.Application
Dim ExcelSheet As Object
Dim ExcelWorkbook As Object
Dim RowNum As Integer
Dim Header As Boolean
Dim elem As AcadEntity
Dim Array1 As Variant
Dim Count As Integer
' Launch Excel.
Set Excel = New Excel.Application
' Create a new workbook and find the active sheet.
Set ExcelWorkbook = Excel.Workbooks.Add
Set ExcelSheet = Excel.ActiveSheet
ExcelWorkbook.SaveAs "Attribute.xls"
RowNum = 1
Header = False
' Iterate through model space finding
' all block references.
For Each elem In ThisDrawing.ModelSpace
With elem
' When a block reference has been found,
' check it for attributes
If StrComp(.EntityName, "AcDbBlockReference", 1) _
= 0 Then
If .HasAttributes Then
' Get the attributes
Array1 = .GetAttributes
' Copy the Tagstrings for the
' Attributes into Excel
For Count = LBound(Array1) To UBound(Array1)
If Header = False Then
If StrComp(Array1(Count).EntityName, _
"AcDbAttribute", 1) = 0 Then
ExcelSheet.Cells(RowNum, _
Count + 1).value = _
Array1(Count).TagString
End If
End If
Next Count
RowNum = RowNum + 1
For Count = LBound(Array1) To UBound(Array1)
ExcelSheet.Cells(RowNum, Count + 1).value _
= Array1(Count).textString
Next Count
Header = True
End If
End If
End With
Next elem
Excel.Application.Quit
End Sub