Nomenclatures autocad vers excel

Commenter

Contenu du snippet

Mon programme (en VBA AutoCAD) permet de transférer des nomenclatures autoCAD vers une feuille Excel, ce qui peut se revélé bien pratique.

Explication : Pour créer des nomenclatures sous autoCAD créez d'abord pour chacune de vos pièces de plan un info-point (ou référence de pièce), celà alimente une nomenclature dans autoCAD. LA nomenclature est ainsi géré automatiquement par AutoCAD
Cette nomenclature se met a jour à chaque modification de vos info point, et gere automatiquement les quentité de pièce,etc...

Comment l'utiliser : Ouvrez Excel, et créez une nouvelle feuille. Enuite ouvrez un plan autoCAD avec des references de pièces, et lancez la macro.

Il se peut que vous ayez à modifier la macro pour l'adapter à vos besoins !

Source / Exemple : 


'**************************************
'*                                    *
'* EXPORT DE NOMENCLATURE AUTOCAD     *
'* VERS MICROSOFT EXCEL               *
'*                                    *
'* Ecrit par LEVEUGLE Damien (c) 2005 *
'*                                    *
'**************************************

Option Explicit

Public Enum EXCELCOL
    IGNORE = 0
    REFERE = 1
    REPER = 2
    DESIGN = 4
    MATIERE = 5
    NUM_DE_PLAN = 7
    CODE_ARTICLE = 9
    MASSE = 10
    DESCR = 11
End Enum

Public Sub subExtracToXL()
    
    '****************
    '* DECLARATIONS *
    '****************
    Const REEL69SS = "REEL_PARTREFERENCE"
    
    Dim objExelApp      As Excel.Application
    Dim objExelSheet    As Excel.Worksheet
    Dim gpCode(0)       As Integer
    Dim dataValue(0)    As Variant
    Dim groupCode       As Variant
    Dim dataCode        As Variant
    Dim MySelectionSet  As AcadSelectionSet
    Dim MyMPR           As McadPartReference
    Dim I               As Integer
    Dim LigneExcel      As Integer
    Dim ColonneExcel    As EXCELCOL

    '******************
    '* INITIALISATION *
    '******************
       
    On Error Resume Next    ' Gestion erreurs
    
    ThisDrawing.SelectionSets(REEL69SS).Delete
    Set MySelectionSet = ThisDrawing.SelectionSets.Add(REEL69SS)
    
    gpCode(0) = 0
    dataValue(0) = "ACMPARTREF"
    groupCode = gpCode
    dataCode = dataValue
    LigneExcel = 9
    ColonneExcel = IGNORE

    '*************
    '* SELECTION *
    '*************
    
    ThisDrawing.SelectionSets(REEL69SS).Select acSelectionSetAll, , , groupCode, dataCode
    If ThisDrawing.SelectionSets(REEL69SS).Count = 0 Then
        MsgBox "Aucune pièce dans la nomenclature présente.", vbInformation, "Pas de pièces"
        Exit Sub
    End If

    Err.Clear

    '*********************
    '* APPLICATION EXCEL *
    '*********************

    Set objExelApp = GetObject(, "excel.application") ' ouvre le classeur courant

    If Err Then    ' si excel non ouvert on en crée un !
        Err.Clear
        Set objExelApp = Nothing
        Set objExelApp = CreateObject("excel.application")
        If Err Then
            Err.Clear
            MsgBox "L'application Excel n'est pas présente sur votre poste", vbCritical, "EXCEL"
            Exit Sub
        End If
    End If

    objExelApp.Visible = True

    Set objExelSheet = objExelApp.ActiveSheet

    On Error GoTo 0
    
    '**********************************
    '* PLACE PIECE TROUVER DANS EXCEL *
    '**********************************
    
    For Each MyMPR In ThisDrawing.SelectionSets(REEL69SS)       ' Parcoure chaque ligne de la NT
        
        If IsEmpty(MyMPR.Data) Then
            MsgBox "Nomenclature vide", vbInformation, "Vide"
            GoTo final
        Else

            LigneExcel = LigneExcel + 1                         ' position dans excel

            objExelSheet.Cells(LigneExcel, 3).Value = MyMPR.Quantity

            For I = LBound(MyMPR.Data) To UBound(MyMPR.Data)    ' Lit chaque champs de la ligne

                Select Case MyMPR.Data(I, 0)
                    Case "REF": ColonneExcel = REFERE           ' Associe les champs de nomenclature AutoCAD
                    Case "REPERE": ColonneExcel = REPER         ' aux colonnes d'Excel
                    Case "NAME": ColonneExcel = DESIGN
                    Case "MATERIAL": ColonneExcel = MATIERE
                    Case "N°_DE_PLAN": ColonneExcel = NUM_DE_PLAN
                    Case "CODE_ARTICLE": ColonneExcel = CODE_ARTICLE
                    Case "MASS": ColonneExcel = MASSE
                    Case "DESCR": ColonneExcel = DESCR
                Case Else
                    ColonneExcel = IGNORE
                End Select

                If ColonneExcel <> IGNORE Then objExelSheet.Cells(LigneExcel, ColonneExcel).Value = MyMPR.Data(I, 1)

            Next I

        End If

    Next

'*******************
'* TRIE DANS EXCEL *
'*******************

    objExelSheet.Range("B10:J600").Sort Key1:=objExelSheet.Columns("B"), Order1:=xlAscending, MatchCase:=False, Orientation:=xlTopToBottom
    objExelSheet.Range("A10").Select
    
final:

    '*********************
    '* LIBERE LA MEMOIRE *
    '*********************

    Set objExelApp = Nothing
    Set objExelSheet = Nothing
    Set MySelectionSet = Nothing

End Sub

Conclusion :


J'ai trimé pour trouver comment faire, et je n'ai trouvé aucune source sur le net ni même de documentation pour l'utilisation des nomenclatures sous AutoCAD, donc si c'est mal codé priere de m'escuser.

Sinon je suis preneur pour les vos améliorations et vos insultes (lol)

NB : Des fois VBA vous renvoi des erreurs, ceci peut être du à des references (librairies) non coché !

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (elguevel)