VBA pour AutoCAD

akram-ing Messages postés 11 Statut Membre -  
 JM -
Bonjour,
j'arrive pas à faire un code VBA qui peut extraire les coordonnées des tous les points des toutes les entités dessinés sur la feuille de dessin de l'AutoCAD 2009
(par exemple dans le cas d'un polyline je peux seulement extraire le endpoint et le startpoint mais je veux extraire tous les points)
dans le cas d'un spline je veux extraire plusieurs points qui appartiennent à ce spline
Configuration: Windows Vista
Firefox 3.0.7

1 réponse

  1. JM
     
    Voilà un exemple vite fait sur le gaz qui répond en partie à ta question. Je n'ai pas fait la routine qui parcourt toutes les entités d'un dessin, mais l'idée est là.
    Tu sélectionnes une entité sur ton dessin et la macro vba extrait les coordonnées des point (qui sont affichés dans la fenêtre de débogage).
    Ca fonctionne pour une polyligne, une spline, un trait simple et un cercle. Pour les autres élements, ça répond "Inconnu" et c'est à toi de compléter suivant tes besoins.

    Conseil pour la polyligne (et autres éléments ACAD) :
    Les coordonnées sont toujours rangées dans une variable Variant de type tableau. Par exemple, les points composant la polyligne sont rangé dans le tableau coordinates et commence toujours par 0. Par exemple, le premier point de la polyligne sera :
    P1:
    x1= coordinates(0)
    y1= coordinates(1)
    P2:
    x2= coordinates(2)
    y2= coordinates(3)
    etc.
    (non, il n'y a pas de valeur en z car une polyligne est toujours en 2D)

    C'est identique pour les splines, sauf que là, il y a les valeurs en x,y,z et que le tableau où sont rangés s'appelle FitPoints
    P1:
    x1= FitPoints(0)
    y1= FitPoints(1)
    z1= FitPoints(2)
    etc.

    Quand tu ne sais pas trop comment le tableau s'appelle, je te conseille de regarder la fenêtre des variables quand tu fais tourner la macro en pas à pas.

    Ceci fait en préliminaire, voici le code :
    Sub ExtrairePoints()
    Dim objSelectionne As AcadObject
    Dim pntPoint As Variant
    Dim i As Integer
    
    On Error GoTo GestErrCdG 'Si la touche Echap est appuyée
    
    Do 'mise en boucle de la fonction
        'Sélection de la région
        ThisDrawing.Utility.GetEntity objSelectionne, pntPoint, "Selectionner une polyligne ou cliquer dans le vide pour quitter  "
        
        'Vérification de l'objet sélectionné
        Select Case objSelectionne.ObjectName
        
        Case "AcDbPolyline" 'Cas d'une polyligne
            Dim objPoly As AcadLWPolyline
            Set objPoly = objSelectionne
            Debug.Print "Polyligne :"
            For i = 0 To UBound(objPoly.Coordinates) Step 2
                Debug.Print "x=" & objPoly.Coordinates(i) & " , " & "y = " & objPoly.Coordinates(i + 1); ""
            Next
        
        Case "AcDbSpline" 'cas d'une spline
            Dim objSpline As AcadSpline
            Set objSpline = objSelectionne
            Debug.Print "Spline :"
            For i = 0 To UBound(objSpline.FitPoints) Step 3
                Debug.Print "x=" & objSpline.FitPoints(i) & " , " & "y = " & objSpline.FitPoints(i + 1) _
                & ", z = " & objSpline.FitPoints(i + 2)
            Next
        
        Case "AcDbLine" 'Cas d'une ligne simple
            Dim objligne As AcadLine
            Set objligne = objSelectionne
            Debug.Print "Ligne simple :"
            Debug.Print "x=" & objligne.StartPoint(0) & " , " & "y = " & objligne.StartPoint(1) _
                & ", z = " & objligne.StartPoint(2)
            Debug.Print "x=" & objligne.EndPoint(0) & " , " & "y = " & objligne.EndPoint(1) _
                & ", z = " & objligne.EndPoint(2)
        
        Case "AcDbCircle" 'Cas d'un cercle
            Dim objCercle As AcadCircle
            Set objCercle = objSelectionne
            Debug.Print "Cercle :"
            Debug.Print "Centre x=" & objCercle.Center(0) & " , " & "y = " & objCercle.Center(1) _
                & ", z = " & objCercle.Center(2)
            Debug.Print "Rayon= " & objCercle.Radius
            
        Case Else 'Autre cas
            MsgBox "Element non reconnu !"
        'End If
        End Select
    Loop
    
    GestErrCdG: 'Gestionnaire d'erreur : sort de la macro quand ECHAP est actionné
    Exit Sub
    
    End Sub
    


    Bonne chance,

    Jean-Marc @ http://autocadvba.canalblog.com/
    6