LISP - Purger les Xrefs "introuvables"

[jl_bajard]

Bonjour,

J'ai testé 2 routines existantes sur les forums pour supprimer automatiquement les Xrefs "introuvables" .

Aucune des 2 ne semble faire le job.

- La première "extraite" de la célèbre routine JAV.lsp

;;; Effacer les xrefs orphelins
(defun C:toto1 ()
(vlax-for ent (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(or (eq (vla-get-isxref ent) :vlax-false)
(ssget "_x" (list (cons 0 "insert") (cons 2 (vla-get-name ent))))
(progn
(or (vl-catch-all-error-p (vl-catch-all-apply 'vla-detach (list ent)))
(setq tot (1+ tot))
)
)
)
)
)

et la deuxième, réponse de Patrick_35, trouvée sur le forum de https://cadxp.com/topic/31151-lisp-pour-d%C3%A9tacher-tous-les-xref-inutiles/

(defun C:toto2 ()

(vlax-for bl (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(or (eq (vla-get-isxref bl) :vlax-false)
(findfile (vla-get-path bl))
(vla-detach bl)
)
)

)

Quelqu'un aurait-il une solution qui fonctionne ?

Merci

[Y.AUBRY · Accepted solution]

Bonjour,

Les lisps ci-dessus ne fonctionnent pas car les éléments que tu cherches à détacher sont des images.

Ce lisp devrait effectué ta demande

(defun c:detachall ( / mspcoll dictcoll)
(vl-load-com)
(vl-cmdf "_.-xref" "D" "*")
(vl-cmdf "_.-image" "D" "*")
(setq mspcoll (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for ent mspcoll
(if
(or
(eq (vl-catch-all-apply 'vla-get-objectname (list ent)) "AcDbDwfReference")
(eq (vl-catch-all-apply 'vla-get-objectname (list ent)) "AcDbPdfReference")
(eq (vl-catch-all-apply 'vla-get-objectname (list ent)) "AcDbDgnReference")
(eq (vl-catch-all-apply 'vla-get-objectname (list ent)) "AcDbOle2Frame")
)
(vla-delete ent)
)
)
(setq dictcoll (vla-get-dictionaries (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for di dictcoll
(if
(or
(eq (vl-catch-all-apply 'vla-get-name (list di)) "ACAD_IMAGE_DICT")
(eq (vl-catch-all-apply 'vla-get-name (list di)) "ACAD_PDFDEFINITIONS")
(eq (vl-catch-all-apply 'vla-get-name (list di)) "ACAD_DGNDEFINITIONS")
(eq (vl-catch-all-apply 'vla-get-name (list di)) "ACAD_DWFDEFINITIONS")
)
(progn
(vlax-for d di
(vla-delete d)
)
(vla-delete di)
)
)
)
(vl-cmdf "_.externalreferences")
(princ)
)

A+ Yoan

[jl_bajard]

merci champion

[jl_bajard]

Bonjour,

je m’aperçois que les commandes Xref et Image ne fonctionnent pas de la même façon

1) qu'il existe ou non une Xref à décharger la commande est toujours la même

basiquement    (command "-Xref" "D" "*")

2) avec l'image ce n'est pas pareil

a) si l'image existe (command "-Image" "D" "*")

b) si l'image n'existe pas (command "-Image" "D" ) --> on rajoute donc pas l'étoile

donc pour ne pas planter la routine, il faudrait tester s'il existe des images pour choisir la bonne option.

Avez-vous la fonction pour tester ?

Merci

[Y.AUBRY]

Bonjour,

Ci-joint une commande pour lister les images

(defun ListLoadedImages (/ imagedict images result)
	(setq imagedict (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")
		images (mapcar 'cons
					(sublist imagedict 3)
					(sublist imagedict 350)
				) ;_ end of mapcar
	) ;_ end of setq
	(foreach image images
		(if (= 1 (cdr (assoc 280 (entget (cdr image)))))
			(setq result (cons (car image) result))
		) ;_ end of if
	) ;_ end of foreach
	result
) ;_ end of defun

(defun sublist (alist key)
	(apply 'append
		(mapcar '(lambda (item)
					(if (eq (car item) key)
						(list (cdr item))
					) ;_ end of if
				) ;_ end of lambda
			alist
		) ;_ end of mapcar
	) ;_ end of apply
) ;_ end of defun

A+ Yoan

[Y.AUBRY]

Bonjour,

Une autre commande pour détacher les images

(defun RemoveAllRaster ( doc / _catchapply dict lockd )
	(vl-load-com)
	(defun _catchapply ( method params / result )
		(if
			(not
				(vl-catch-all-error-p
					(setq result (vl-catch-all-apply method params))
				)
			)
			result
		)
	)
	(vlax-for layer (vla-get-layers doc)
		(if (eq :vlax-true (vla-get-lock layer))
			(vla-put-lock (car (setq lockd (cons layer lockd))) :vlax-false)
		)
	)
	(vlax-for block (vla-get-blocks doc)
		(vlax-for object block
			(if (member (vla-get-objectname object) '("AcDbOle2Frame" "AcDbRasterImage"))
				(_catchapply 'vla-delete (list object))
			)
		)
	)
	(if (setq dict (_catchapply 'vla-item (list (vla-get-dictionaries doc) "ACAD_IMAGE_DICT")))
		(progn
			(vlax-for object dict
				(_catchapply 'vla-delete (list object))
			)
			(_catchapply 'vla-delete (list dict))
		)
	)
	(if (setq dict (_catchapply 'vla-item (list (vla-get-dictionaries doc) "ACAD_IMAGE_VARS")))
		(_catchapply 'vla-delete (list dict))
	)
	(foreach layer lockd (vla-put-lock layer :vlax-true))
	(vla-regen doc acallviewports)
	(princ)
)
 
(defun c:RemoveAllPics nil
	(RemoveAllRaster (vla-get-activedocument (vlax-get-acad-object)))
	(princ)
)
 
(vl-load-com)

A+ Yoan

[jl_bajard]

Je vous remercie,

puis-je prendre encore de votre temps, au début de mon premier POST, j'avais indiqué une routine pour effacer les Xrefs "introuvables".

cette routine fonctionne correctement MAIS j'ai un message d'erreur à la fin et donc je ne peux pas l'intégrer dans mon programme général.

Avez-vous une idée, il manque peut-être un petit quelque-chose ?

Je vous la remet en pièce jointe :

;**** routine qui vire les Xrefs "introuvables" donc lorsque le chemin d'accès n'existe plus ou a été modifié
(defun C:test ()

; attention cette routine met une ALERTE d'erreur à la fin qui oblige à cliquer dessus donc cela interrompt le programme général
; il faudrait trouver la parade

(prompt "\n....Détache les Xrefs introuvables....Patientez quelques instants...")

(vlax-for bl (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(or (eq (vla-get-isxref bl) :vlax-false)
(findfile (vla-get-path bl))
(vla-detach bl)
)
)

)

Je vous remercie pour votre attention