Ver originales (Francés)

VBA para AutoCAD y Excel

JP -  
 JP -
Hola,

te explico mi problema: hacer VBA con if o select case. Yo logro hacerlo porque no es muy complicado, pero al no haber tenido formación en VBA me bloqueo por completo. Me pasaron una fórmula que me permite recuperar en AutoCAD los datos de los atributos en los bloques hacia Excel.
Mi problema es el siguiente: si no abro Excel, eso no funciona.
Lo que me gustaría es que cuando ejecute este programa se abra mi archivo de Excel llamado "ESSAI.xls" ubicado en la ruta: "C:\Users\msi\Documents\ESSAI.xls"

aquí está el programa:

'Programación Visual BASIC en AutoCAD
Dim AcadDoc As Object, ExcelApp As Object, ExcelSheet As Object

Private Sub Liste_Click()
Dim Collection As Object, Objet As Object
Dim i As Integer
Dim P As Variant, Attributes As Variant, Column As Integer, colonne As Integer

'AcadDoc es un enlace al dibujo actual
Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument
'ExcelApp es un enlace a la aplicación Excel en uso
Set ExcelApp = GetObject(, "Excel.application")
' creo que aquí es donde debo indicar
'la ruta de mi archivo Excel, pero no sé cómo
'ExcelSheet es un enlace a la hoja de cálculo llamada Feuil1
Set ExcelSheet = ExcelApp.activeworkbook.sheets("Feuil2")

'Relleno en la fila nº1 de la hoja Feuil1 de los encabezados de columnas
ExcelSheet.Cells(1, 1) = "ID"
ExcelSheet.Cells(1, 2) = "POIDS_HA"
ExcelSheet.Cells(1, 3) = "POIDS_TS"
ExcelSheet.Cells(1, 4) = "TYPE"

'collection representa el conjunto de entidades gráficas contenidas en el espacio de objetos
Set Collection = AcadDoc.ModelSpace
i = 2
'Para cada objeto de la colección
For Each Objet In Collection
'Relleno en Excel, fila por fila a partir de la segunda
'línea de la hoja, indicando el identificador, el tipo de entidad
'Línea, Arco, Círculo ... etc
ExcelSheet.Cells(i, 4) = Objet.Handle

If Objet.EntityType = 7 Then
Attributes = Objet.GetAttributes
For j = LBound(Attributes) To UBound(Attributes)
Select Case Attributes(j).TagString
Case "POIDS_HA": colonne = 1
Case "POIDS_TS": colonne = 2
Case "TYPE": colonne = 3

End Select
ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
'Attributes = Objet.GetAttributes(j)
i = i + 1
Next j
End If
Next
End Sub

Si alguien pudiera ayudarme. Gracias de antemano

JP
Configuración: Windows Vista / Safari 535.11

1 respuesta

  1. Yoda
     
    Hola,

    En VBA Editor, en el menú Herramientas Referencias verifica que Microsoft Excel 11.0 Object Library esté marcado
    Aquí tienes tu código con algunas modificaciones. 

    'Programación Visual BASIC en AutoCAD Dim AcadDoc As Object, ExcelApp As Object, ExcelSheet As Excel.Worksheet, ExcelWorkBook As Excel.Workbooks Private Sub Liste_Click() Dim Collection As Object, Objet As Object Dim i As Integer Dim P As Variant, Attributes As Variant, Column As Integer, colonne As Integer 'ExcelApp es un enlace a la aplicación de Excel en curso On Error Resume Next 'Verifica si Excel está abierto y si no, ábrelo. Set objExcel = GetObject(, "Excel.Application") If Err.Number > 0 Then Set objExcel = CreateObject("Excel.Application") End If objExcel.Visible = True Set ExcelWorkBook = objExcel.Workbooks.Open("C:\Users\msi\Documents\ESSAI.xls") Set ExcelSheet = objExcel.ActiveWorkbook.Sheets("Feuil2") 'AcadDoc es un enlace al dibujo en curso Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument 'Relleno en la fila n°1 de la hoja Feuil1 de los encabezados de columnas ExcelSheet.Cells(1, 1) = "ID" ExcelSheet.Cells(1, 2) = "POIDS_HA" ExcelSheet.Cells(1, 3) = "POIDS_TS" ExcelSheet.Cells(1, 4) = "TYPE" 'colección representa el conjunto de entidades gráficas contenidas en el espacio de objetos Set Collection = AcadDoc.ModelSpace i = 2 'Para cada objeto de la colección For Each Objet In Collection 'Relleno en Excel, fila por fila a partir de la segunda 'línea de la hoja, indicando la identificación, el tipo de entidad 'Línea, Arco, Círculo ...etc ExcelSheet.Cells(i, 4) = Objet.Handle If Objet.EntityType = 7 Then Attributes = Objet.GetAttributes For j = LBound(Attributes) To UBound(Attributes) Select Case Attributes(j).TagString Case "POIDS_HA": colonne = 1 Case "POIDS_TS": colonne = 2 Case "TYPE": colonne = 3 End Select ExcelSheet.Cells(i, colonne) = Attributes(j).TextString 'Attributes = Objet.GetAttributes(j) i = i + 1 Next j End If Next End Sub
    0
    1. jp
       
      Hola Gracias, funciona Tengo otro problema, sin embargo: Tengo muchos bloques pero quiero recuperar solo los atributos de dos bloques que se llaman Nomenclature y HA_Nomenclature Nomenclature tiene como atributos TYPE, TYPE1, REP, NB_HA HA_Nomenclature tiene como atributos TYPE1, NB_HA Mi objetivo es que me marque un error y me resalte esa línea "ExcelSheet.Cells(i, columna) = Attributes(j).TextString" y ahí me quedo atascado. Si sabes qué pasa, gracias
      0
    2. Yoda
       
      Hola,
      Creo que eso viene del valor de la columna. Si columna=0 entonces falla.
      Además no filtras los bloques. Deberías tratar los bloques en hojas separadas.

      aquí está lo que pondría para filtrar el bloque Nomenclature 

      If Objet.EntityType = 7 And Objet.Nane = "Nomenclature" Then Attributes = Objet.GetAttributes For j = 0 To UBound(Attributes) Select Case Attributes(j).TagString Case "TYPE": columna = 1 Case "TYPE1": columna = 2 Case "REP": columna = 3 Case "NB_HA": columna = 4 End Select ExcelSheet.Cells(i, colonne) = Attributes(j).TextString Next j i = i + 1 'on passe à la ligne suivante pour le prochain End If
      0
    3. jp
       
      Gracias
      todavía no lo he probado, te mantendré informado. por cierto, para mi caso no veo interés en hacer una hoja para cada atributo. entonces si no me equivoco, tendría que hacer un select case como el de abajo para los bloques y los atributos que quiero.

      If Objet.EntityType = 7 Then
      select case Objet.Nane
      case"Nomenclature
      Attributes = Objet.GetAttributes
      For j = 0 To UBound(Attributes)
      Select Case Attributes(j).TagString
      Case "TYPE": columna = 1
      Case "TYPE1": columna = 2
      Case "REP": columna = 3
      Case "NB_HA": columna = 4
      End Select
      ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
      Next j
      i = i + 1 'pasamos a la siguiente línea para la próxima
      End If
      Case"HA_Nomenclature
      Attributes = Objet.GetAttributes
      For j = 0 To UBound(Attributes)
      Select Case Attributes(j).TagString
      Case "TYPE1": colonne = 1
      Case "NB_HA": colonne = 2
      End Select
      ExcelSheet.Cells(i, colonne) = Attributes(j).TextString
      Next j
      i = i + 1 'pasamos a la siguiente línea para la próxima
      End If

      JP
      0
    4. Yoda
       
      Hola,

      Ya he desarrollado este programa con Autolisp, por lo que por experiencia sé que hay que tratar los bloques individualmente. Así es como procedo:
      - pido al usuario que seleccione (en la pantalla) el bloque a tratar
      - recupero el nombre del bloque, verifico que tenga atributos y escribo en la primera línea las etiquetas (tags)
      - pido hacer una selección de objetos (captura, todo, ...)
      - en la selección, extraigo los atributos de todos los bloques que corresponden al bloque elegido y escribo sus valores en la segunda línea y siguientes.

      Este es el algoritmo básico. Puedes procesar todos los bloques a la vez pero clasificándolos y usando una hoja de Excel diferente para cada serie.

      ;)
      0
    5. JP
       
      Hola El programa funciona a las maravillas, muchas gracias. Seguí tus indicaciones: una hoja para cada atributo. Sin embargo, tengo un último problema. Recupero bien solo los atributos del bloque cuyo nombre he indicado (aquí Nomenclature), pero obtengo el "Handles" de todos los bloques, cuando yo quiero únicamente los de los Bloques Nomenclature. Programación Visual BASIC en AutoCAD Dim AcadDoc As Object, ExcelApp As Object, ExcelSheet As Excel.Worksheet, ExcelWorkBook As Excel.Workbooks Private Sub Liste_Click() Dim Collection As Object, Objet As Object Dim i As Integer Dim P As Variant, Attributes As Variant, Column As Integer, colonne As Integer 'ExcelApp es un vínculo a la aplicación Excel en curso On Error Resume Next 'Verifica si Excel está abierto y si no, abrirlo. Set objExcel = GetObject(, "Excel.Application") If Err.Number > 0 Then Set objExcel = CreateObject("Excel.Application") End If objExcel.Visible = True Set ExcelWorkBook = objExcel.Workbooks.Open("f:\Projet LP CAODAO\Projet 2.0\EXCEL\TESTE.xls") Set ExcelSheet = objExcel.ActiveWorkbook.Sheets("Extraction") 'AcadDoc es un vínculo al dibujo actual Set AcadDoc = GetObject(, "Autocad.application").ActiveDocument 'Reemplazo en la fila n°1 de la hoja Feuil1 de los encabezados de columnas ExcelSheet.Cells(1, 1) = "ID" ExcelSheet.Cells(1, 2) = "TYPE" ExcelSheet.Cells(1, 3) = "TYPE1" ExcelSheet.Cells(1, 4) = "NBRE_ELEMENT" ExcelSheet.Cells(1, 5) = "REP" ExcelSheet.Cells(1, 6) = "NB_HA" ExcelSheet.Cells(1, 7) = "DIAM_HA" ExcelSheet.Cells(1, 8) = "LONG_HA" ExcelSheet.Cells(1, 9) = "E_HA" 'collection représente l'ensemble des entités graphiques contenues dans l'espace objet Set Collection = AcadDoc.ModelSpace i = 2 'Pour chaque objet de la collection For Each Objet In Collection 'Remplissage dans Excel, ligne par ligne à partir de la deuxième 'ligne de la feuille, en indiquant l'identifiant, le type d'entité If Objet.Nane = "Nomenclature" Then ExcelSheet.Cells(i, 1) = Objet.GetAttributes.Handle If Objet.EntityType = 7 Then Attributes = Objet.GetAttributes For j = 0 To UBound(Attributes) Select Case Attributes(j).TagString Case "TYPE": colonne = 2 Case "TYPE1": colonne = 3 Case "NBRE_ELEMENT": colonne = 4 Case "REP": colonne = 5 Case "NB_HA": colonne = 6 Case "DIAM_HA": colonne = 7 Case "LONG_HA": colonne = 8 Case "E_HA": colonne = 9 End Select ExcelSheet.Cells(i, colonne) = Attributes(j).TextString Next j i = i + 1 'on passe à la ligne suivante pour le prochain End If End If Next End Sub Merci
      0