Extraction d'attributs Acad vers ...

Question

Voila ma problematique:
Après ouverture d'un fichier Autocad (manuellement ou via un script).
Je souhaiterais "récupérer" les informations contenu dans un ou plusieurs Blocs (dénommés "cart_1, cart_2, etc...)
situé dans un ou plusieurs onglets (Objet, Présentation1 ou Presentation2).
Ces blocs (des cartouches donc ...) sont composés d'attibuts (homogénéité des noms des attributs quelque soit le nom du bloc).
L'extraction de ces Informations pourrait se faire vers Access ou Excel (peu importe), dans un seul et unique fichier (par exemple: ListeDesPlans.*).
Dans la mesure du possible, il y aurait dans ce fichier les noms des fichiers autocad (dwgname) suivi eventuellement du ou des noms des blocs, mais surtout des attributs de ces blocs... 

Merci par avance


Ps: Je suis débutant en VB. Utilisateur d'Autocad depuis 1991 (V10 sous Unix) :-)
Actuellement avec Acad 2005

pile_poil · Answer

pour exemple voici ce que j'utilise personnellement. mon cartouche est sur le layer "cartouche" et se nomme "CART"  à toi de mettre tes propres dénominations 
   
    Dim tableau(3) as  String
    Dim I as integer
    Set toto = ThisDrawing.PaperSpace
     For Each ACADobj In toto
        With ACADobj
            If LCase(.Layer) = "cartouche" Then
                If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
                    If .Name = "CART" Then
                        ObjData = .GetAttributes
                        for i = 0 to 3
                             tableau(I) = ObjData(I).TextString
                        next I
                    End If
                End If
            End If
        End With
    Next ACADobj
    
    On Error Resume Next
    Set ExcelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Err.Clear
        Set ExcelApp = CreateObject("Excel.Application")
    End If
    Set feuille = ExcelApp.Sheets("feuil1")
    feuille.Activate
    feuille.Range(feuille.Cells(1, 1), feuille.Cells(3, 1)) = tableau

En espérant que cet exemple te sera utile !

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE

comurhex11 · Answer

Comme je l'ai déja indiqué, je suis débutant ... Donc ...


Il me faudrais un peu plus d'explication ... j'ai essayé un certain nombre de possibilité générant systématiquement une erreur sur "Set toto = ThisDrawing.PaperSpace", entres autres ...


Est ce à copier dans une macro VB sous Autocad ou sous Excel ?
Quelles "références" cochées ?

Merci

pile_poil · Answer

aucune référence à cocher
macro à mettre dans autocad
à propos de :
Set toto = ThisDrawing.PaperSpace
toto doit être déclaré 
Dim toto as Object
si ton cartouche est dans l'espace objet il devient:
Set toto = ThisDrawing.ModelSpace

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE

comurhex11 · Answer

Il y a quelque chose qui 
Excel ne s'ouvre pas 


D'ou proviens cette erreur ???

Merci







Sub ExtractCart()



Dim tableau(3) As String
Dim toto As Object
Dim I As Integer
Set toto = ThisDrawing.PaperSpace
For Each acadObj In toto
With acadObj
If LCase(.Layer) = "cartouche" Then
If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
If .Name = "CART_1" Then
ObjData = .GetAttributes
For I = 0 To 3
tableau(I) = ObjData(I).TextString
Next I
End If
End If
End If
End With
Next acadObj
On Error Resume Next
Set ExcelApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set ExcelApp = CreateObject("Excel.Application")
End If
Set feuille = ExcelApp.Sheets("feuil1")
feuille.Activate
feuille.Range(feuille.Cells(1, 1), feuille.Cells(3, 1)) = tableau

End Sub

CTAC · Answer

Salut,

Peut être avec ExcelApp.Visible = True

ctac

pile_poil · Answer

en effet ! CTAC a raison 
il faut rajouter en toute dernière ligne 
ExcelApp.Visible = True

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE

Extraction d'attributs Acad vers ...

6 réponses

Votre réponse

Discussions similaires