VBA pour AutoCAD Fermé

Question

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

JM · Accepted Answer

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/

VBA pour AutoCAD

1 réponse

Discussions similaires