[Résolu] Purger les blocs à la fermeture d'autocad

[Circus]

bonjour,

 

Je cherche une solution pour purger les blocs à la fermeture d'autocad

 

J'ai une solution mais celle-ci est trop radicale car cela purge tout le dessin (blocs claques...)

 

Private Sub AcadDocument_BeginSave(ByVal FileName As String)
ThisDrawing.PurgeAll
End Sub

 

J'ai trouvé un truc mais je n'arrive pas à l'exploiter :

ThisDrawing.SendCommand "-Purge" & vbCr & "B" & vbCr & "*" & vbCr & "N" & vbCr

Ca ressemble à ce que j'utilise pour un des boutons que j'ai créer pour purger :

ID_UserButton_1 [_Button("Purger blocs", "purgerbloc.bmp", "RCDATA_16_BLANK")]^C^C-purger b * n

 

Merci d'avance

 

Cordialement

 

Circus

[Circus]

Bonjour,

 

Personne pour m'aider ? Il y a peut etre un forum un peu plus dédié au vba sur autocad que l'on pourrait me conseiller ?

 

Cdt

 

Circus

[(gile)]

Salut,

 

Je ne connais pas le VBA, mais dans tous les autres environnements de programmation que je pratique il n'est pas possible d'invoquer la ligne de commande d'AutoCAD dans un gestionnaire d'évènement, j'imagine que c'est pareil en VBA.

 

Il faut donc que tu te fasses une routine (Sub) qui supprime de la table des blocs ceux qui ne sont pas référencés. Ça, je sais le faire en LISP ou en .NET (très facile) si ça t'intéresse, mais pas en VBA...

[LrDb]

Bonjour,

en cherchant un peu, on trouve ceci

Cordialement

LrDb

[(gile)]

Bonjour,

en cherchant un peu, on trouve ceci

Cordialement

LrDb

 

Oui, effectivement, on peut simplement essayer de supprimer toutes les définitions de bloc...

Mais je trouve la méthode pour le moins "brutale", et peu efficiente. De plus, elle ne purgera pas les éventuels blocs imbriqués.

[Circus]

Oula...merci

 

Je met 3 heures a envoyer une réponse.

 

en cherchant un peu, on trouve ceci

 

Il aurait fallu que j'ouvres les yeux, car je l'ai vu et lu mais mal semble t'il...j'ai le lien dans mes favoris...

 

Ca me plait bien ce code

 

on error resume next
dim objBlock as AcadBlock
for each objBlock in thisdrawing.Blocks
  objBlock.delete
next

 

Même si la purge n'est pas efficace à 100%, elle purge au moins le principale par rapport a mon besoin. (Lors d'une mise en prod d'un dossier, on utilise notre gabarit de pord en glissant le fichier commercial, et c'est donc ce bloc issu du fichier que je veux purger)

[(gile)]

Si tu n'as qu'un bloc à purger, ce n'est pas la peine d'essayer de les purger tous.

on error resume next
ThisDrawing.Blocks.Item("LeNomDuBlocAPurger").Delete()

Devrait suffire.

 

Sinon, cette méthode brutale consistant à essayer de supprimer toutes les définitions de blocs en passant en force avec un gestionnaire d'erreur me rappelle ce sujet où Tramber essaye la même chose en Visual LISP. Sujet qui m'a fait me pencher sur les codes DXF des définitions de bloc pour y retrouver toutes les références du bloc insérées dans le dessin ou dans d'autres blocs.

On peut ainsi supprimer uniquement les définitions de blocs non référencés et, en le faisant dans une boucle tant qu'on en trouve, on a la garantie d'avoir purgé les blocs imbriqués.

 

Donc, en LISP pour purger automatiquement tous les blocs à chaque enregistrement du dessin, il suffit de copier le code suivant dans un fichier de chargement automatique des fichiers LISP (acaddoc.lsp ou un fichier MNL du même nom qu'un CUI(X))

 

(vl-load-com)

(setq *PurgeBlocksOnSave* (vlr-dwg-reactor nil '((:vlr-beginSave . gc:PurgeAllBlocks))))

(defun gc:PurgeAllBlocks (doc filename / blk name blst loop)
 (while (setq blk (tblnext "BLOCK" (not blk)))
   (if
     (< (cdr (assoc 70 (setq elst (entget (tblobjname "BLOCK" (cdr (assoc 2 blk))))))) 4)
     (setq blst (cons (cdr (assoc 330 elst)) blst))
   )
 )
 (setq loop T)
 (while (and loop blst)
   (setq loop nil)
   (foreach b blst
     (or (vl-some 'entget (gc:massoc 331 (entget B)))
       (progn
         (setq blk (vlax-ename->vla-object B))
         (vlax-for o blk
           (if (= (vla-get-ObjectName o) "AcDbBlockReference")
             (vla-Delete o)
           )
         )
         (vla-delete blk)
         (setq blst (vl-remove b blst))
         (setq loop T)
       )
     )
   )
 )
)

(defun gc:massoc (code alst)
 (if (setq alst (member (assoc code alst) alst))
   (cons (cdar alst) (gc:massoc code (cdr alst)))
 )
)

 

 

La classe Database de l'API .NET d'AutoCAD fournit une méthode Purge() qui sert à trouver les objets non référencés (blocs, mais aussi calques, typeslignes, etc.). On lui passe en argument une collection d'ObjectId et elle supprime de cette collection tous ceux qui sont référencés, il suffit alors d'effacer ceux qui restent (toujours dans une boucle pour les éléments imbriqués).

En .NET une classe qui implémente l'interface IExtensionApplication est exécutée automatiquement au démarrage d'AutoCAD. Il suffit, depuis cette classe, d'abonner tout nouveau document au gestionnaire de l’évènement BeginSave.

 

En VB ça donnerait :

Imports System.Linq
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime

<Assembly: ExtensionApplication(GetType(PurgeBlocksOnSave.Initialization))> 

Namespace PurgeBlocksOnSave

   Public Class Initialization
       Implements IExtensionApplication

       Private docs As DocumentCollection = Application.DocumentManager

       Public Sub Initialize() Implements IExtensionApplication.Initialize
           AddHandler docs.DocumentCreated, AddressOf onDocumentCreated
           For Each doc As Document In docs
               AddHandler doc.Database.BeginSave, AddressOf onBeginSave
           Next
       End Sub

       Public Sub Terminate() Implements IExtensionApplication.Terminate
       End Sub

       Private Sub onDocumentCreated(sender As Object, e As DocumentCollectionEventArgs)
           If e.Document IsNot Nothing Then
               AddHandler e.Document.Database.BeginSave, AddressOf onBeginSave
           End If
       End Sub

       Private Sub onBeginSave(sender As Object, e As DatabaseIOEventArgs)
           Dim db As Database = docs.MdiActiveDocument.Database
           Using tr As Transaction = db.TransactionManager.StartOpenCloseTransaction()
               Dim bt As BlockTable = DirectCast(tr.GetObject(db.BlockTableId, OpenMode.ForRead), BlockTable)
               While True
                   Dim ids As New ObjectIdCollection(bt.Cast(Of ObjectId)().ToArray())
                   db.Purge(ids)
                   If ids.Count = 0 Then
                       Exit While
                   End If
                   For Each id As ObjectId In ids
                       tr.GetObject(id, OpenMode.ForWrite).Erase()
                   Next
               End While
               tr.Commit()
           End Using
       End Sub

   End Class

End Namespace

 

et en F#" (juste pour faire mentir ceux qui disent qu'avec .NET on écrit deux fois plus de code qu'en LISP).

module PurgeBlocksOnSave

open Autodesk.AutoCAD.ApplicationServices
open Autodesk.AutoCAD.DatabaseServices
open Autodesk.AutoCAD.Runtime

let docs = Application.DocumentManager

type Initialization() =
   let onBeginSave args =
       let db = docs.MdiActiveDocument.Database
       use tr = db.TransactionManager.StartOpenCloseTransaction()
       let bt = tr.GetObject(db.BlockTableId, OpenMode.ForRead) :?> BlockTable
       let rec purge() =
           let ids = new ObjectIdCollection(bt |> Seq.cast |> Seq.toArray)
           db.Purge(ids)
           if ids.Count > 0 then
               for id in ids do tr.GetObject(id, OpenMode.ForWrite).Erase()
               purge()
       purge()
       tr.Commit()

   interface IExtensionApplication with
       member x.Initialize() =
           docs.DocumentCreated.Add (fun e ->
               if e.Document <> null then
                   e.Document.Database.BeginSave.Add onBeginSave)
           for doc in docs |> Seq.cast<Document> do doc.Database.BeginSave.Add onBeginSave
       member x.Terminate() = ()

[<assembly: ExtensionApplication(typeof<Initialization>)>]
do()

[Circus]

Si tu n'as qu'un bloc à purger, ce n'est pas la peine d'essayer de les purger tous.

on error resume next
ThisDrawing.Blocks.Item("LeNomDuBlocAPurger").Delete()


Devrait suffire.

 

En faite j'ai plusieur bloc sur le même principe, des blocs de fichiers glissé dans mon plan. Et je ne connais pas forcement le nom.

 

 

Le code que LrDb m'a remi sous le nez, j'avais surment tenté de le coller direct dans la private sub, c'est pour cela qu'à l'époque j'avais pas retenu ce code car cela ne fonctionnait pas. Donc merci (gile) de m'avoir éguillé vers l'utilisation d'une routine.

 

Je regarderai plus en détail plus tard, en particulier ta version VB

Merci pour les explications.

 

Cdt

 

Circus