supprimer les xdata

[PHILPHIL]

hello

j'ai récupéré pas mal de lisp sur le net concernant les xdata.  @gile @bonuscad @АлексЮстасу

je les ai testé, et aucun ne fonctionne pour supprimer ou mettre a jour les XDATA.

en avez vous un qui "marche" ??

 

Merci

 

Phil

 

[didier]

Bonjour @PHILPHIL

J'ai un doute en voyant la référence à @АлексЮстасу.
Tu parles bien de XDATA?
Car ce nom est connu pour gérer surtout les Object DATA. (MAP 3D)

Pour supprimer les xdatas si c'est réellement la question, j'ai un truc qui fonctionne avec un simple entmod.

Amicalement

[PHILPHIL]

hello @didier

 

ceci expliquerait cela .

pourtant le lisp  XDTOOLS_VEDIT   concerne bien les XDATA.

XDATA XDTOOLS_VEDIT.lsp

je parle bien de XDATA oui et non Objet DATA.

je suis preneur du truc qui fonctionne.

Merci

 

Phil

 

[didier]

Pour supprimer les Xdatas : (pas les OD)

(setq ent (car (entsel "\nChoix de l'entité.\n")))
(setq entlst (entget ent '("*")))
(foreach item (cdr (assoc -3 entlst))
    (setq tmplst (cons -3 (list (cons (car item) nil)))
          entlst (subst tmplst (assoc -3 entlst) entlst)
          entlst (entmod entlst)
 )
    )

Amicalement

[lecrabe]

Hello @PHILPHIL et @didier

Voir la routine "Remove_Xdata" de Bonuscad / Bruno pour un grand nettoyage des XDatas ...

Bye, lecrabe

 

 
;; 
;; https://cadxp.com/topic/50142-effacer-une-ou-plusieurs-applications-de-xdata/
;;
;; Routine: Remove_Xdata____v100__Bonuscad - CADaSchtroumpf

;; J'ai un membre (russe:alexander) d'un forum autodesk (surtout autocad map) 
;; qui me sollicite assez souvent pour ameliorer des routines: 
;; il a toujours des remarques fondees et des suggestions 
;; pour rendre l'application fonctionnelle a bon nombres d'utilisateurs.
;; 
;; Sa derniere demande concernait les Xdata (donc version classique ou Map)
;; 
;; Il desirait pouvoir effacer certaines application XData et en garder d'autres.
;; 
;; Ce qui m'a valu de pondre une version generique de cette fonction 
;; (avec une fonction:listbox que j'utilise beaucoup: un grand merci a gilles Chanteau)
;; 
;; 
;; edite pour amelioration de la selection qui n'est plus tous les objets, 
;; tri alphabetique des applications dans la boite de dialogue...
;;
;; Voici le code que j'ai transmit a Alexander, qu'il pourra eventuellement publier aussi sur son site.
;; 

(vl-load-com)

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste deroulante
;; 1 = liste choix unique
;; 2 = liste choix multipes
;;
;; Retour : la cle de l'option (flag = 0 ou 1) ou la liste des cles des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Presentation" "Choisir une presentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)

(defun str2lst (str sep / pos)
  (if (setq pos (vl-string-search sep str))
    (cons
      (substr str 1 pos)
      (str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
  )
) 

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
  (setq
    tmp (vl-filename-mktemp "tmp.dcl")
    file (open tmp "w")
  )
  (write-line
    (strcat "ListBox:dialog{label=\"" title "\";")
    file
  )
  (if (and msg (/= msg ""))
    (write-line (strcat ":text{label=\"" msg "\";}") file)
  )
  (write-line
    (cond
      ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
      ((= 1 flag) "spacer;:list_box{key=\"lst\";width=32;")
      (T "spacer;:list_box{key=\"lst\";width=32;multiple_select=true;")
    )
    file
  )
  (write-line "}spacer;ok_button;}" file)
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "ListBox" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list (mapcar 'cdr keylab))
  (end_list)
  (action_tile
    "accept"
    "(or (= (get_tile \"lst\") \"\")
      (if (= 2 flag)
        (progn
          (foreach n (str2lst (get_tile \"lst\") \" \")
            (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))
          )
          (setq choice (reverse choice))
        )
        (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))
      )
    )
    (done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  choice
)

(defun c:Remove_Xdata ( / js n ent_name dxf_ent apps lst_apps sel_app new_ent lnew_ent dxf_next)
  (princ "\nSelectionner les objets auxquels retirer des XData.")
  (or
    (setq js (ssget "_I" (list (list -3 (list "*")))))
    (setq js (ssget "_P" (list (list -3 (list "*")))))
  )
  (cond
    (js
      (sssetfirst nil js)
      (initget "Existant Nouveau _Existent New")
      (if (eq (getkword "\nTraiter jeu de selection [Existant/Nouveau] <Existant>: ") "New")
        (progn
          (sssetfirst nil nil)
          (setq js (ssadd) js (ssget (list (list -3 (list "*")))))
        )
      )
    )
    (T
      (setq js (ssget (list (list -3 (list "*")))))
    )
  )
  (cond
    (js
      (sssetfirst nil js)
      (repeat (setq n (sslength js))
        (setq
          ent_name (ssname js (setq n (1- n)))
          dxf_ent (entget ent_name (list "*"))
          apps (cdr (assoc -3 dxf_ent))
        )
        (foreach el apps
          (if (not (member (car el) lst_apps)) (setq lst_apps (cons (car el) lst_apps)))
        )
      )
      (setq lst_apps (vl-sort lst_apps '<))
      (setq sel_app (listbox "Applications" "Choisir l'application" (mapcar 'cons lst_apps lst_apps) 2))
      (cond
        (sel_app
          (setq js (ssget (list (list -3 (list (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app)))))))
          (cond
            (js
              (repeat (setq n (sslength js))
                (setq
                  ent_name (ssname js (setq n (1- n)))
                  dxf_ent (entget ent_name (list (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app))))
                  new_ent
                  (append
                    (entget ent_name)
                    (list
                      (cons -3
                        (vl-remove-if
                          '(lambda (x)
                            (member (car x) sel_app)
                          )
                          (cdr (assoc -3 (entget ent_name (list "*"))))
                        )
                      )
                    )
                  )
                  lnew_ent nil
                )
                (cond
                  ((or (member (cdr (assoc 0 dxf_ent)) '("INSERT" "POLYLINE")) (eq (cdr (assoc 66 dxf_ent)) 1))
                    (while (setq dxf_next (entnext (cdar dxf_ent)))
                      (setq dxf_ent (entget dxf_next))
                      (if (eq (cdar new_ent) (cdr (assoc 330 dxf_ent)))
                        (setq lnew_ent (cons dxf_ent lnew_ent))
                      )
                    )
                  )
                )
                (entdel ent_name)
                (entmake new_ent)
                (if lnew_ent
                  (foreach el (reverse lnew_ent)
                    (entdel (cdar el))
                    (entmake el)
                  )
                )
              )
            )
            (T (princ "\nPas d application correspondante trouvee ! "))
          )
        )
      )
    )
  )
  (prin1) 
) 

 

[PHILPHIL]

Hello @didier @lecrabe

ce lisp

(DEFUn c:xdata_nom_fenetre_tout_supprimer ()
(setq ent (car (entsel "\nChoix de l'entité.\n")))
(setq entlst (entget ent '("NOM_FENETRE")))
(foreach item (cdr (assoc -3 entlst))
    (setq tmplst (cons -3 (list (cons (car item) nil)))
          entlst (subst tmplst (assoc -3 entlst) entlst)
          entlst (entmod entlst)
 )
    )
  )

je le teste sur une entite "wiewport"  ( donc espace papier )  ca ne fonctionne pas

je le teste sur une entite "POLYLIGNE"  (dans l'espace objet )  ca fonctionne

je le teste sur une entite "POLYLIGNE"  (dans l'espace papier )  ca fonctionne

 

le lisp "remove_Xdata"

je le teste sur une entite "wiewport"  ( donc espace papier )  ca efface la fenetre

je le teste sur une entite "POLYLIGNE"  (dans l'espace objet )  ca fonctionne

je le teste sur une entite "POLYLIGNE"  (dans l'espace papier )  ca fonctionne

 

Phil

[bonuscad]

@lecrabe

Merci Patrice, mais Alexender m'avait fait encore des remarques sur ma routine.

Notamment sur les calques verrouillés et sur les Xdata utilisés par des applications internes d'Autocad qu'il convenait de ne pas supprimer.

Donc la dernière version que je lui avait adressé

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;; 1 = liste choix unique
;; 2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1)
(vl-load-com)
(defun str2lst (str sep / pos)
  (if (setq pos (vl-string-search sep str))
    (cons
      (substr str 1 pos)
      (str2lst (substr str (+ (strlen sep) pos 1)) sep)
    )
    (list str)
  )
)
(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
  (setq
    tmp (vl-filename-mktemp "tmp.dcl")
    file (open tmp "w")
  )
  (write-line
    (strcat "ListBox:dialog{label=\"" title "\";")
    file
  )
  (if (and msg (/= msg ""))
    (write-line (strcat ":text{label=\"" msg "\";}") file)
  )
  (write-line
    (cond
      ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
      ((= 1 flag) "spacer;:list_box{key=\"lst\";width=32;")
      (T "spacer;:list_box{key=\"lst\";width=32;multiple_select=true;")
    )
    file
  )
  (write-line "}ok_cancel_err;}" file)
  (close file)
  (setq dcl_id (load_dialog tmp))
  (if (not (new_dialog "ListBox" dcl_id))
    (exit)
  )
  (start_list "lst")
  (mapcar 'add_list (mapcar 'cdr keylab))
  (end_list)
  (action_tile
    "accept"
    "(or (= (get_tile \"lst\") \"\")
      (if (= 2 flag)
        (progn
          (foreach n (str2lst (get_tile \"lst\") \" \")
            (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice))
          )
          (setq choice (reverse choice))
        )
        (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))
      )
    )
    (done_dialog)"
  )
  (start_dialog)
  (unload_dialog dcl_id)
  (vl-file-delete tmp)
  choice
)
(defun c:remove_Xdata ( / AcDoc lay_obj lay_lock js flag n ent_name dxf_ent apps lst_apps lstlk_apps sel_app count)
  (setq lay_obj (vla-get-layers (setq AcDoc (vla-get-activedocument (vlax-get-acad-object)))))
  (vla-startundomark AcDoc)
  (vlax-for for-item lay_obj
    (if (eq (vla-get-lock for-item) :vlax-true)
      (setq lay_lock (cons (vla-get-name for-item) lay_lock))
    )
  )
  (if (null (setq js (ssget "_I" '((-3 ("*"))))))
    (progn
      (princ "\nSélectionner des objets <Tout>:")
      (if (null (setq js (ssget '((-3 ("*")))))) (setq js (ssget "_X" '((-3 ("*")))) flag T))
    )
  )
  (cond
    (js
      (repeat (setq n (sslength js))
        (setq
          ent_name (ssname js (setq n (1- n)))
          dxf_ent (entget ent_name (list "*"))
          apps (cdr (assoc -3 dxf_ent))
        )
        (if (not (member (cdr (assoc 8 dxf_ent)) lay_lock))
          (foreach el apps
            (if (not (member (car el) lst_apps)) (setq lst_apps (cons (car el) lst_apps)))
          )
          (foreach el apps
            (if (not (member (car el) lstlk_apps)) (setq lstlk_apps (cons (car el) lstlk_apps)))
          )
        )
      )
      (setq lst_apps (vl-sort lst_apps '<))
      (foreach el '("ACAD" "ACAD_DSTYLE_DIM*" "GradientColor#ACI" "PE_URL" "IRD" "VIA_WD_*" "ACE_TABLE_*" "CIM_WD_*" "AVE_*")
        (mapcar '(lambda (x) (if (wcmatch x el) (setq lst_apps (vl-remove x lst_apps)))) lst_apps)
      )
      (if lst_apps
        (setq sel_app (listbox "Applications" "Choisir l'application" (mapcar 'cons lst_apps lst_apps) 2))
        (setq lst_apps nil)
      )
      (cond
        (sel_app
          (setq js (ssadd) js (ssget "_P" (list (list -3 (list (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app)))))))
          (initget "Oui Non _Yes No")
          (cond
            ((and js (eq (getkword "\nEtes vous sur de vouloir supprimer les applications sélectionnées [Oui/Non]? <Non>: ") "Yes"))
              (if (not flag)
                (if (eq (sslength js) (sslength (ssget "_X" (list (list -3 (list (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app)))))))) (setq flag T))
              )
              (setq count 0)
              (sssetfirst nil js)
              (repeat (setq n (sslength js))
                (setq
                  ent_name (ssname js (setq n (1- n)))
                  dxf_ent (entget ent_name '("*"))
                )
                (if (not (member (cdr (assoc 8 dxf_ent)) lay_lock))
                  (progn
                    (setq count (1+ count))
                    (foreach el sel_app
                      (entmod (list (cons -1 ent_name) (list -3 (list el))))
                    )
                  )
                )
              )
              (if flag
                (foreach el sel_app
                  (if (not (member el lstlk_apps))
                    (vla-delete (vla-item (vla-get-registeredapplications AcDoc) el))
                  )
                )
              )
              (princ (strcat "\nLes applications " (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app)) " ont été supprimées pour " (itoa count) " objets" (if flag " et purgées du dessin si l'application n'était pas sur un calque verrouillé." ".")))
            )
            (T (princ "\nPas d'applications corespondantes trouvées pour la sélection"))
          )
        )
        (T (princ "\nAucune application sélectionnée ou il y a des applications réservées ou/et des objets sur un calque verrouillé."))
      )
    )
    (T (princ "\nAucune application trouvée dans la sélection."))
  )
  (vla-endundomark AcDoc)
  (prin1)
)

 

[didier]

Coucou @PHILPHIL

En allant voir dans l'aide, on y trouve :
You cannot use the entmod function to modify a viewport entity.
Vous ne pouvez pas utiliser la fonction entmod pour modifier une entité viewport.

Tout est dit.

Amicalement

[PHILPHIL]

hello

OK @didier   pas grave, je sais comment modifier les "viewport" en réécrivant tout, pas grave si ca reste éternellement

personne ira cherche l'info a part moi, je pense

Phil