Cette macro permet de noter le nom d'un bloc sélectionné à l'aide d'une ligne de repère. En adaptant le code on pourrait extraire la valeur d'un attribut ou extraire la longueur d'une spline ou une aire quelconque.

'Cette macro permet de noter dans une ligne de repère le nom du bloc sélectionné
Sub NoterNomBloc()
Dim Pt As Variant, Pp As Variant, Pp1 As Variant
Dim Entite As AcadEntity
Dim NomBloc As String
Dim Points(0 To 5) As Double
Dim Echelle As Double
Dim F1 As Integer, F2 As Integer
Dim i As Long
Dim Calque As String, NomStyle As String
Dim oML As AcadMLeader

On Error GoTo Err_NoterNomBloc

'Initialisation des variables :
Echelle = 1 'Echelle de la "Leaderline" (A régler en fonction de l'échelle du dessin)
Calque = "0" 'Nom du calque où sera inséré le repère (Attention ! il faut qu'il soit présent dans le dessin !)
NomStyle = "Standard" 'Nom du style de la leaderline

'Fonctionnement de la macro en boucle
'Taper  pour quitter
    Do
    'Sélection du bloc :
        Do
            ThisDrawing.Utility.GetEntity Entite, Pt, "Sélectionner le bloc"
            If Entite.ObjectName = "AcDbBlockReference" Then Exit Do
            MsgBox "L'objet cliqué n'est pas un bloc !", vbExclamation, "Erreur de sélection !"
        Loop

    'Extraire le nom du bloc :
        NomBloc = Entite.Name

    'Insérer une ligne repère
        'Sélection des points d'insertion :
        Pp = ThisDrawing.Utility.GetPoint(, "Saisir emplacement")
        Pp1 = ThisDrawing.Utility.GetPoint(Pp, "Saisir position")
        'La position de la leaderline n'est pas très évoluée, je la repositionne plus finement après.
        If Pp(0) > Pp1(0) Then
            F1 = -1
        Else
            F1 = 1
        End If
        If Pp(1) > Pp1(1) Then
            F2 = -1
        Else
            F2 = 1
        End If
        Points(0) = Pp(0):  Points(1) = Pp(1):  Points(2) = 0
        Points(3) = Pp(0) + 50 * F1:  Points(4) = Pp(1) + 50 * F2:  Points(5) = 0
        'Insertion du repère dans le dessin :
        Set oML = ThisDrawing.ModelSpace.AddMLeader(Points, i)
        'Ajout du nom du bloc "En dur" dans le repère :
        oML.TextString = NomBloc
        'On place le repère dans le bon calque
        oML.Layer = Calque
        'avec le bon style
        oML.StyleName = NomStyle
        'et à la bonne échelle
        oML.ScaleFactor = Echelle
    Loop

'Gestion des erreurs
Err_NoterNomBloc:
    If Err.Number <> -2147352567 Then
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") dans la procédure NoterNomBloc."
    End If
End Sub
Coloration syntaxique vb/vba/vb.net

Lier une ligne de repère à un nom de bloc

Partager cet article