Bonjour @marion.lino94,
Tu trouveras dans le fichier MLEADER_ALIGN.zip ci-joint une DLL contenant le code ci-dessous :
Imports AcadAp = Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Runtime
Public Class CmdMLEADER
<CommandMethod("MLEADER_LEFT_ALIGN", "MLLA", CommandFlags.Modal)>
Public Sub MLEADER_LEFT_ALIGN()
Dim doc As Document = AcadAp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim scu As Matrix3d = ed.CurrentUserCoordinateSystem
'Demande de la position du point d'alignement
Dim ptStart As Point3d
Dim pPtRes As PromptPointResult
Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
PosX:
pPtOpts.Message = vbLf & "Emplacement en X du point d'alignement : "
pPtRes = doc.Editor.GetPoint(pPtOpts)
If pPtRes.Status <> PromptStatus.OK Then GoTo PosX
ptStart = pPtRes.Value.TransformBy(scu)
Dim X As Double = ptStart.X
'Demande de sélection des lignes de repère multiple (MLeader en anglais)
Dim filter(0) As TypedValue
Try
filter.SetValue(New TypedValue(DxfCode.Start, "MULTILEADER"), 0)
Dim sf As SelectionFilter = New SelectionFilter(filter)
Dim psr As PromptSelectionResult = ed.GetSelection(sf)
Dim ss As SelectionSet = psr.Value
If ss.Count > 0 Then
Using tr As Transaction = doc.Database.TransactionManager.StartTransaction()
For Each id As ObjectId In ss.GetObjectIds()
Dim ent As Entity = TryCast(tr.GetObject(id, OpenMode.ForWrite), Entity)
If TypeOf ent Is MLeader Then
Dim acML As MLeader = CType(ent, MLeader)
If acML.TextAlignmentType = TextAlignmentType.RightAlignment Then 'Si la ligne de repère multiple a un texte avec un alignement à droite
'Alors on déplace la ligne de repère au niveau de la coordonnée en X préalablement définie
acML.TextLocation = New Point3d(X, acML.TextLocation.Y, acML.TextLocation.Z)
End If
End If
Next
tr.Commit()
End Using
End If
Catch ex As System.Exception
MsgBox(ex.ToString)
End Try
End Sub
<CommandMethod("MLEADER_RIGHT_ALIGN", "MLRA", CommandFlags.Modal)>
Public Sub MLEADER_RIGHT_ALIGN()
Dim doc As Document = AcadAp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim scu As Matrix3d = ed.CurrentUserCoordinateSystem
'Demande de la position du point d'alignement
Dim ptStart As Point3d
Dim pPtRes As PromptPointResult
Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
PosX:
pPtOpts.Message = vbLf & "Emplacement en X du point d'alignement : "
pPtRes = doc.Editor.GetPoint(pPtOpts)
If pPtRes.Status <> PromptStatus.OK Then GoTo PosX
ptStart = pPtRes.Value.TransformBy(scu)
Dim X As Double = ptStart.X
'Demande de sélection des lignes de repère multiple (MLeader en anglais)
Dim filter(0) As TypedValue
Try
filter.SetValue(New TypedValue(DxfCode.Start, "MULTILEADER"), 0)
Dim sf As SelectionFilter = New SelectionFilter(filter)
Dim psr As PromptSelectionResult = ed.GetSelection(sf)
Dim ss As SelectionSet = psr.Value
If ss.Count > 0 Then
Using tr As Transaction = doc.Database.TransactionManager.StartTransaction()
For Each id As ObjectId In ss.GetObjectIds()
Dim ent As Entity = TryCast(tr.GetObject(id, OpenMode.ForWrite), Entity)
If TypeOf ent Is MLeader Then
Dim acML As MLeader = CType(ent, MLeader)
If acML.TextAlignmentType = TextAlignmentType.LeftAlignment Then 'Si la ligne de repère multiple a un texte avec un alignement à gauche
'Alors on déplace la ligne de repère au niveau de la coordonnée en X préalablement définie
acML.TextLocation = New Point3d(X, acML.TextLocation.Y, acML.TextLocation.Z)
End If
End If
Next
tr.Commit()
End Using
End If
Catch ex As System.Exception
MsgBox(ex.ToString)
End Try
End Sub
<CommandMethod("MLEADER_TOP_ALIGN", "MLTA", CommandFlags.Modal)>
Public Sub MLEADER_TOP_ALIGN()
Dim doc As Document = AcadAp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim scu As Matrix3d = ed.CurrentUserCoordinateSystem
'Demande de la position du point d'alignement
Dim ptStart As Point3d
Dim pPtRes As PromptPointResult
Dim pPtOpts As PromptPointOptions = New PromptPointOptions("")
PosY:
pPtOpts.Message = vbLf & "Emplacement en Y du point d'alignement : "
pPtRes = doc.Editor.GetPoint(pPtOpts)
If pPtRes.Status <> PromptStatus.OK Then GoTo PosY
ptStart = pPtRes.Value.TransformBy(scu)
Dim Y As Double = ptStart.Y
Dim filter(0) As TypedValue
Try
filter.SetValue(New TypedValue(DxfCode.Start, "MULTILEADER"), 0)
Dim sf As SelectionFilter = New SelectionFilter(filter)
Dim psr As PromptSelectionResult = ed.GetSelection(sf)
Dim ss As SelectionSet = psr.Value
If ss.Count > 0 Then
Using tr As Transaction = doc.Database.TransactionManager.StartTransaction()
For Each id As ObjectId In ss.GetObjectIds()
Dim ent As Entity = TryCast(tr.GetObject(id, OpenMode.ForWrite), Entity)
If TypeOf ent Is MLeader Then
Dim acML As MLeader = CType(ent, MLeader)
'On déplace la ligne de repère au niveau de la coordonnée en Y préalablement définie
acML.TextLocation = New Point3d(acML.TextLocation.X, Y, acML.TextLocation.Z)
End If
Next
tr.Commit()
End Using
End If
Catch ex As System.Exception
MsgBox(ex.ToString)
End Try
End Sub
End Class
Pour pouvoir utiliser cette DLL :
- Il faut parfois les débloquer lorsqu'elle sont passé par internet : pour cela, faire un clic-droit dessus puis "Propriétés" puis dans l'onglet général cocher la case "Débloquer"
(Si cette case n'est pas présente c'est que la DLL est déjà débloquée)
Une fois débloquée, taper la commande "NETLOAD" dans AutoCAD et pointer sur le fichier "MLEADER_ALIGN.dll"
Nota : Il est conseillé de mettre cette DLL dans un dossier faisant parti des chemins de recherche de fichiers de support : voir Menu Outils\Options\ onglet fichier
Une fois la DLL chargée, les commandes sont :
- MLLA (pour MLEADER_LEFT_ALIGN) : alignement à gauche de la ligne de repère multiple
- MLRA (pour MLEADER_RIGHT_ALIGN) : alignement à droite de la ligne de repère multiple
- MLTA(pour MLEADER_TOP_ALIGN) : alignement en haut de la ligne de repère multiple (mais peut servir en bas également)
Cette DLL est prévue pour un fonctionnement sur les versions de 2021 à 2024 (.NET Framework 4.8) d'AutoCAD, si nécessaire revenir vers moi pour les versions précédentes.
A+ Yoan
Yoan AUBRY
