Good morning,
Do you know of a command, trick, or program that would prevent someone from drawing in an area? Example, in the image I want us to be able to draw in the area with black hatching or beyond, but not in the red area, knowing that this red area can be repeated several times on the same plane. A sort of inversion of the LIMITS command. (Other than a simple indication on the plan).
Traduction GOGGLE.
Thank you in advance
[Post modified for formatting. CGBenner 12/5/24]
Salut @DOMICREA ,
Est-il possible d'avoir un peu plus de précision sur ta demande ?
Je pense que ta demande d'exclusion de certaines zones est réalisable en .NET ou C# via des ExtensionMethod sur l'évènement du clic gauche de la souris et une commande comme celle ci-dessous pour vérifier à chaque clic s'il est dans une zone d'exclusion.
Public Shared Function InsidePolygon(ByVal pol As Polyline, ByVal pt As Point3d) As Boolean
'ATTENTION CETTE METHODE NE FONCTIONNE QUE SI LA
'POLYLIGNE N'EST CONSITUTEE QUE DES DROITES (PAS D'ARC)
Dim n As Integer = pol.NumberOfVertices
Dim angle As Double = 0
Dim pt1, pt2 As Point
For i As Integer = 0 To n - 1
pt1.X = pol.GetPoint2dAt(i).X - pt.X
pt1.Y = pol.GetPoint2dAt(i).Y - pt.Y
pt2.X = pol.GetPoint2dAt((i + 1) Mod n).X - pt.X
pt2.Y = pol.GetPoint2dAt((i + 1) Mod n).Y - pt.Y
angle += Angle2D(pt1.X, pt1.Y, pt2.X, pt2.Y)
Next
If Math.Abs(angle) < Math.PI Then Return False Else Return True
End Function
Par contre, je suppose que tu ne veux pas non plus pouvoir générer des polylignes, cercles ou autres éléments qui 'traverseraient' tes zones d'exclusions comme le montre l'image ci-dessous. (Aucun point lors de la création de la polyligne ou du cercle n'a été sélectionné dans la zone)
Dans ce cas là, il faudrait plutôt partir sur une méthodologie avec des 'REGION' afin de pouvoir utiliser des commandes comme UNION, SOUSTRACTION et INTERSECT mais la ça devient un peu plus compliqué (et plus long) car il faudrait généré des commandes de vérification pour chaque type d'objet.
e te convient pas.
Cette gestion d'évènements pourraient être lancer au chargement de la DLL avec des commandes du genre
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices
Public Class MyClass1
'VB style
Private Shared WithEvents docEvents As DocumentCollection
Private Shared Sub docEvents_DocumentCreated(
ByVal sender As Object, ByVal e As DocumentCollectionEventArgs) _
Handles docEvents.DocumentCreated
MsgBox(e.Document.Name & " opened")
End Sub
' .NET style
Private Shared docDestroyedEvent As DocumentDestroyedEventHandler
Public Shared Sub OnDocumentDestroyed(
ByVal sender As Object, ByVal e As DocumentDestroyedEventArgs)
MsgBox(e.FileName & " closed")
End Sub
<CommandMethod("StartEventHandling")> _
Public Sub Asdkcmd1()
' Start VB Style handling – all docEvents related event
' handling is started
docEvents = Application.DocumentManager
' Start .NET style handling – only this specific event
' handling is started
Dim docs As DocumentCollection = Application.DocumentManager
If docDestroyedEvent Is Nothing Then
docDestroyedEvent =
New DocumentDestroyedEventHandler(
AddressOf OnDocumentDestroyed)
AddHandler docs.DocumentDestroyed, docDestroyedEvent
End If
End Sub
<CommandMethod("StopEventHandling")> _
Public Sub Asdkcmd2()
' Stop VB style handling – all docEvents related event handling
' is stopped
docEvents = Nothing
' Stop .NET style handling – only this specific event handling
' is stopped
Dim docs As DocumentCollection = Application.DocumentManager
If Not docDestroyedEvent is Nothing Then
RemoveHandler docs.DocumentDestroyed, docDestroyedEvent
docDestroyedEvent = Nothing
End If
End Sub
End Class
A+ Yoan
Yoan AUBRY
Rebonjour,
Ci-joint deux DLL : l'une pour les version 2021 à 2024 et l'autre pour la version 2025 d'AutoCAD.
Nota : Je ne suis pas encore très habitué avec la gestion du transfert vers .NET 8.0 nécessaire pour 2025 donc j'espère que ça fonctionnera.
Le nom de la commande : EXCLUSION_SETTINGS pour définir le calque sur lesquels se trouvent les zones d'exclusions.
Le programme est composée :
- D'une classe 'ClZoneExclusion'
Imports Autodesk.AutoCAD.DatabaseServices
Public Class ClZoneExclusion
Public NomCalque As String
Public LstPol As List(Of Polyline)
Public Sub New()
LstPol = New List(Of Polyline)
End Sub
End Class
- D'une boite de dialogue pour le choix du calque
- D'une classe 'CmdINITIALISATION' contenant les évènements et commandes
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
Imports System.Windows.Forms
Imports System.Linq
Public Class CmdINITIALISATION
'#####################################################################################################################################
'EXTENSION APPLICATION
Implements IExtensionApplication
Public ZoneExclusion As ClZoneExclusion
'Chargement lors de l'ouverture de la DLL
Public Sub Initialize() Implements IExtensionApplication.Initialize
Dim docs As DocumentCollection = AcadAp.DocumentManager
'Création de l'évenement l'acivation d'un fichier DWG
AddHandler docs.DocumentActivated, AddressOf DocumentActivated
'Création de l'évenement lié à la désactivation d'un fichier DWG
AddHandler docs.DocumentToBeDeactivated, AddressOf DocToBeDeactivated
End Sub
'Chargement lors de la fermeture de la DLL
Public Sub Terminate() Implements IExtensionApplication.Terminate
'Console.WriteLine("Cleaning up...")
End Sub
Public Sub DocumentActivated()
Dim doc As Document = AcadAp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
AddHandler ed.PointMonitor, AddressOf Ed_PointMonitor
Dim LstCalque As List(Of String) = LayersToList(db)
Dim NomCalque As String = My.Settings.NomCalqueExclusion
If LstCalque.Contains(NomCalque) Then
ZoneExclusion = CHARGER_ZONE_EXCLUSION(NomCalque)
End If
End Sub
Public Sub DocToBeDeactivated()
Dim doc As Document = AcadAp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
RemoveHandler ed.PointMonitor, AddressOf Ed_PointMonitor
End Sub
Private Sub Ed_PointMonitor(ByVal sender As Object, ByVal e As PointMonitorEventArgs)
Dim PtAV As Point3d = New Point3d(e.Context.ComputedPoint.X, e.Context.ComputedPoint.Y, 0)
Dim bInside As Boolean = False
If Not IsNothing(ZoneExclusion) Then
If ZoneExclusion.LstPol.Count > 0 Then
For i As Integer = 0 To ZoneExclusion.LstPol.Count - 1
Dim PolEC As Polyline = ZoneExclusion.LstPol(i)
If InsidePolyline(PolEC, PtAV) = True Then
bInside = True
Exit For
End If
Next
End If
End If
If bInside = True Then MsgBox("Vous ne pouvez pas mettre de point dans cette zone", MsgBoxStyle.Exclamation)
End Sub
Private Structure Point
Public X, Y As Double
End Structure
Private Function InsidePolyline(ByVal pol As Polyline, ByVal pt As Point3d) As Boolean
'ATTENTION CETTE METHODE NE FONCTIONNE QUE SI LA POLYLIGNE NE CONTIENT QUE DES DROITES , PAS D'ARC
Dim n As Integer = pol.NumberOfVertices
Dim angle As Double = 0
Dim pt1, pt2 As Point
For i As Integer = 0 To n - 1
pt1.X = pol.GetPoint2dAt(i).X - pt.X
pt1.Y = pol.GetPoint2dAt(i).Y - pt.Y
pt2.X = pol.GetPoint2dAt((i + 1) Mod n).X - pt.X
pt2.Y = pol.GetPoint2dAt((i + 1) Mod n).Y - pt.Y
angle += Angle2D(pt1.X, pt1.Y, pt2.X, pt2.Y)
Next
If Math.Abs(angle) < Math.PI Then Return False Else Return True
End Function
Private Function Angle2D(ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double) As Double
Dim dtheta, theta1, theta2 As Double
theta1 = Math.Atan2(y1, x1)
theta2 = Math.Atan2(y2, x2)
dtheta = theta2 - theta1
While dtheta > Math.PI
dtheta -= (Math.PI * 2)
End While
While dtheta < -Math.PI
dtheta += (Math.PI * 2)
End While
Return (dtheta)
End Function
'Liste des calques dans le fichier en cours
Private Function LayersToList(ByVal db As Database) As List(Of String)
Dim lstlay As List(Of String) = New List(Of String)()
Dim layer As LayerTableRecord
Using tr As Transaction = db.TransactionManager.StartOpenCloseTransaction()
Dim lt As LayerTable = TryCast(tr.GetObject(db.LayerTableId, OpenMode.ForRead), LayerTable)
For Each layerId As ObjectId In lt
layer = TryCast(tr.GetObject(layerId, OpenMode.ForWrite), LayerTableRecord)
lstlay.Add(layer.Name)
Next
End Using
Return lstlay
End Function
Public Function CHARGER_ZONE_EXCLUSION(NomCalque As String) As ClZoneExclusion
Dim ZoneExclusion = New ClZoneExclusion With {.NomCalque = NomCalque}
'Parcours l 'ensemble des entités
Dim lName As String = "Model"
Dim doc As Document = AcadAp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim acPol As Polyline = Nothing
Try
Using tr As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = TryCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
Dim btfw As BlockTable = TryCast(tr.GetObject(db.BlockTableId, OpenMode.ForWrite), BlockTable)
For Each id As ObjectId In bt
Dim btr As BlockTableRecord
btr = TryCast(tr.GetObject(id, OpenMode.ForRead), BlockTableRecord)
If btr.IsLayout Then
Dim lid As ObjectId = btr.LayoutId
Dim lt As Layout = TryCast(tr.GetObject(lid, OpenMode.ForWrite), Layout)
If lt.LayoutName <> lName Then
Continue For
Else
Dim etypePol As RXClass = RXObject.GetClass(GetType(Polyline))
For Each eid As ObjectId In btr
Dim ent As Entity
Dim pol As Polyline
ent = TryCast(tr.GetObject(eid, OpenMode.ForWrite), Entity)
If eid.ObjectClass.IsDerivedFrom(etypePol) Then
pol = ent
acPol = DirectCast(ent, Polyline)
If acPol.Layer = NomCalque Then 'Polyligne du NET
ZoneExclusion.LstPol.Add(acPol)
End If
End If
Next 'eid
End If
End If
Next 'id
tr.Commit()
tr.Dispose()
ed.Regen()
End Using 'tr
Catch ex As System.Exception
MsgBox(ex.ToString)
ed.WriteMessage(vbLf & ex.Message & vbLf & ex.StackTrace)
End Try
Return ZoneExclusion
End Function
'Commande EXCLUSION_SETTINGS : Défintion du choix du calque d'exclusion
<CommandMethod("CHOIX_DU_CALQUE_D_EXCLUSION", "EXCLUSION_SETTINGS", CommandFlags.Modal + CommandFlags.UsePickSet)>
Public Sub CHOIX_DU_CALQUE_D_EXCLUSION()
Dim doc As Document = AcadAp.DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Dim ed As Editor = doc.Editor
Dim LstCalque As List(Of String) = LayersToList(db)
LstCalque.Sort()
Dim Dlg As New DlgCALQUE
Dim NomCalqueChoisi As String = String.Empty
For i As Integer = 0 To LstCalque.Count - 1
Dlg.CbLayerName.Items.Add(LstCalque(i))
Next
Dim result As DialogResult = AcadAp.ShowModalDialog(Dlg)
If result = DialogResult.OK Then
NomCalqueChoisi = Dlg.CbLayerName.Text
With My.Settings
.NomCalqueExclusion = NomCalqueChoisi
.Save()
End With
CHARGER_ZONE_EXCLUSION(NomCalqueChoisi)
End If
End Sub
End Class
A+ Yoan
Yoan AUBRY
Pour rappel (mais je pense que tu n'as pas besoin de ce genre d'informations étant formateur)
Il est conseillé pour la bonne utilisation de :
- Mettre les DLL dans un dossier présent dans les chemins de recherche de fichiers de support de travail (dans les OPTIONS)
- D'ajouter la ligne ci-dessous dans le fichier acaddoc.lsp (ou le créer et le mettre dans un dossier présent dans les chemins de recherche de fichiers de support de travail)
(if (findfile "EXCLUSION_ZONE.dll") (command "netload" "EXCLUSION_ZONE.dll"))
Sinon malheureusement pour l'instant, le programme ne fait qu'afficher un message lors du survol des zones d'exclusions avec la souris
A+ Yoan
Yoan AUBRY
