Rendre des objets non-purgeables

[(gile)]

Salut,

 

Même si je pense que ceci est a utiliser avec beaucoup de modération/précaution, la question de rendre certains objets (calques, blocs, ...) non-purgeables est souvent posée.

 

Une méthode consiste à utiliser un pointeur matériel (hard pointer) avec l'identifiant de l'objet dans un dictionnaire d'extension d'un objet nativement non-purgeable. L'objet est ainsi référencé même s'il n'est pas utilisé par ailleurs.

Il m'a semblé logique d'utiliser le dictionnaire d'extension de la table de l'objet (à créer s'il n'existe pas) ainsi les les calques non-purgeables seront référencés dans le dictionnaire d'extension de la table des calques, ceux des blocs dans celle des blocs, etc.

 

La routine gc:SetUnPurgeable requiert comme argument le nom de la table et la clé du symbole dans cette table (comme tblobjname), elle utilise d'autres routines facilitant la lecture ou l'écriture de dictionnaires et de xrecords.

Je ne donne pas de commande directement utilisable par l'utilisateur final, parce que je pense que ce type de manipulation est à réserver aux développeurs (les dictionnaires ne sont accessible que par programmation).

 

;; gc:GetExtDict (gile)
;; Retourne le dictionnaire d'extension de l'objet (ou nil)
;;
;; Argument : obj (ENAME)

(defun gc:GetExtDict (obj)
 (cdadr (member '(102 . "{ACAD_XDICTIONARY") (entget obj)))
)

;; gc:GetOrCreateExtDict (gile)
;; Retourne le dictionnaire d'extension de l'objet
;; Le dictionnaire est créé s'il n'existe pas
;;
;; Argument : obj (ENAME)

(defun gc:GetOrCreateExtDict (ent / dict)
 (cond
   ((cdadr (member '(102 . "{ACAD_XDICTIONARY") (setq elst (entget ent)))))
   ((setq dict	(entmakex
	  '((0 . "DICTIONARY") (100 . "AcDbDictionary"))
	)
    )
    (entmod
      (vl-list*
        (assoc -1 elst)
        (assoc 0 elst)
        (assoc 5 elst)
        (cons 102 "{ACAD_XDICTIONARY")
        (cons 360 dict)
        (cons 102 "}")
        (vl-remove-if (function (lambda (x) (member (car x) '(-1 0 5)))) elst)
      )
    )
    dict
   )
 )
)

;; gc:SetXrecData  (gile)
;; Retourne le ENAME du xrecord auquel sont affectées mes données
;;
;; Arguments
;; dict : ENAME du dictionnaire parent
;; key : nom du Xrecord
;; data : liste de paires pointées contenant les données

(defun gc:SetXrecData (dict key data / xrec)
 (if (snvalid key)
   (progn
     (and (setq xrec (dictsearch dict key))
   (entdel (cdr (assoc -1 xrec)))
     )
     (dictadd
dict
key
(entmakex
  (append
    (list '(0 . "XRECORD")
	  '(100 . "AcDbXrecord")
    )
    data
  )
)
     )
   )
 )
)

;; gc:GetXrecData  (gile)
;; Retourne la liste des données affectées au Xrecord (liste de paires pointées)
;;
;; Arguments
;; dict : ENAME du dictionnaire parent
;; key : nom du Xrecord

(defun gc:GetXrecData (dict key / xrec)
 (if (and
(setq xrec (dictsearch dict key))
(= (cdr (assoc 0 xrec)) "XRECORD")
     )
   (cdr (member (assoc 280 xrec) xrec))
 )
)

;; gc:SetUnpurgeable  (gile)
;; Rend l'enregistrement de la table (AcDbSymbolTableRecord) non purgeable
;; Retourne T si l'opération a réussi, nil si elle a échoué
;;
;; Arguments
;; table : le nom de la table
;; name : le nom de l'enregistrement

(defun gc:SetUnPurgeable (table name / symbol record xdict)
 (and
   (setq symbol (tblobjname table name))
   (setq record (cdr (assoc 330 (entget symbol))))
   (setq xdict (gc:GetOrCreateExtDict
                 (cdr (assoc -1 (entget (cdr (assoc 330 (entget record))))))
               )
   )
   (gc:SetXrecData
     xdict
     "UnPurge"
     (cons (cons 340 record) (gc:GetXrecData xdict "UnPurge"))
   )
 )
)

;; gc:ResetPurgeable  (gile)
;; Rend à nouveau purgeable l'enregistrement de la table (AcDbSymbolTableRecord)
;;
;; Arguments
;; table : le nom de la table
;; name : le nom de l'enregistrement

(defun gc:ResetPurgeable (table name / symbol record xdict)
 (and
   (setq symbol (tblobjname table name))
   (setq record (cdr (assoc 330 (entget symbol))))
   (setq xdict (gc:GetOrCreateExtDict (cdr (assoc 330 (entget record)))))
   (setq data (gc:GetXrecData xdict "UnPurge"))
   (member (cons 340 record) data)
   (or
     (and (= 1 (length data)) (dictremove xdict "UnPurge"))
     (gc:SetXrecData
       xdict
       "UnPurge"
       (vl-remove (cons 340 symbol) data)
     )
   )
 )
)

;; gc:ResetAllPurgeable  (gile)
;; Rend à nouveau purgeables tous les enregistrement rendus précédemment non-purgeables

(defun gc:ResetAllPurgeable (/ name record xdict)
 (foreach table '("LAYER" "LTYPE" "VIEW" "STYLE" "BLOCK" "UCS" "APPID" "DIMSTYLE" "VPORT")
   (and
     (setq name (cdr (assoc 2 (tblnext table T))))
     (setq record (cdr (assoc 330 (entget (tblobjname table name)))))
     (setq xdict (gc:GetExtDict (cdr (assoc 330 (entget record)))))
     (gc:GetXrecData xdict "UnPurge")
     (dictremove xdict "UnPurge")
   )
 )
)

[sbosarl]

Bonjour,

Je me permet d’intervenir un élément non purgeable sur un plan "Ok bien"

,mais très dangereux à long terme (un plan peu devenir un bloc ) .

Autodesk à déjà eu ce type de problème avec les listes d’échelle

Donc prévoir de base avec ton lisp la remise en mode purgeable « normal »

sinon je reste admiratif

[(gile)]

sbosarl,

 

Tu as parfaitement raison, et je pense avoir bien insisté sur le fait d'utiliser ce code avec précaution et modération.

 

Petite précision tout de même, un WBLOCK (deep cloning) à partir d'un dessin dans lequel des objets sont non-purgeable conserve ces objets dans le nouveau fichier créé.

Par contre, insérer un fichier (ou un wbloc) dans lequel il y a des objets non-purgeables ne les importe pas dans le dessin cible : les tables du fichier source ne sont pas importées.

 

J'ai ajouté deux routines gc:ResetPurgeable et gc:ResetAllPurgeable pour rendre à nouveau purgeable respectivement l'enregistrement spécifié ou tous les enregistrements.