block en doublons

[bipbip]

Bien le bonjour,

 

Suite a des quantitatifs fait avec bcnt (lisp de l'excellent Gilles) je suis confronte au probleme

de blocs inseres en doublons.

 

J'ai essaye OVERKILL des express ..... Ca semble ne rien faire .... Suite aux recherches dans

cadxp j'ai lu qu' OVERKILL ne faisait rien aux blocks ...... J'ai vu le lisp propose par Ludwig et je

l'ai pas encore essaye.

 

Ma question est de savoir si le lisp de Ludwig va bien ? D'autre part y a t'il d'autres solutions

pour venir a bout de doublons dans l'hypotese que les blocs ne soient pas exactement les memes (points d'insertion .... nom .... unite ..... etc ....)

 

J'espere avoir ennonce mon souci assez clairement.

 

Merci de vos suggestions.

[(gile)]

Salut,

 

Le problème, comme tu le dis n'est pas aisé.

 

J'ai essayé quelque chose en comparant la géométrie (point d'insertion, rotation, normale, échelles X Y et Z) et éventuellement les propriétés dynamiques et les valeurs d'attribut des blocs de même nom.

 

Si des blocs ayant des noms différents ont la même géométrie, ce serait plutôt la collection de blocs du dessin qu'il faudrait nettoyer.

 

;;; OVERKILL-BLK (gile)
;;; Supprime les blocs superposés de même nom de même géométrie (rotation, normale, échelles)
;;; et eventuellement ayant les mêmes valeurs de propriétés dynamiques et d'attribut.

(defun c:overkill-blk (/	   getGeomProps		   getDynProps
	       getAttValues	       name	   ss
	       lst	   ref	       geom-props  dyn-props
	       atts
	      )
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))

 (defun getGeomProps (ref)
   (mapcar
     (function (lambda (x) (vlax-get ref x)))
     '(InsertionPoint		 Rotation
Normal			 XEffectiveScaleFactor
YEffectiveScaleFactor	 ZEffectiveScaleFactor
      )
   )
 )
 (defun getDynProps (ref)
   (mapcar
     (function (lambda (x) (vla-get-Value x)))
     (vlax-invoke ref 'getDynamicBlockProperties)
   )
 )

 (defun getAttValues (ref)
   (mapcar
     (function (lambda (x) (vla-get-TextString x)))
     (vlax-get ref 'Attributes)
   )
 )

 (vlax-for b *blocks*
   (if
     (and
(= (vla-get-IsLayout b) :vlax-false)
(= (vla-get-IsXref b) :vlax-false)
     )
      (progn
 (setq name (vla-get-Name b))
 (if
   (ssget "_X"
	  (list '(0 . "INSERT") (cons 2 (strcat name ",`*U*")))
   )
    (progn
      (vlax-for	i (setq ss (vla-get-ActiveSelectionSet *acdoc*))
	(if (vlax-property-available-p i 'EffectiveName)
	  (if (= (vla-get-EffectiveName i) name)
	    (setq lst (cons i lst))
	  )
	  (setq lst (cons i lst))
	)
      )
      (vla-delete ss)
      (while (cdr lst)
	(setq ref (car lst)
	      lst (cdr lst)
	)
	(setq geom-props
	       (getGeomProps ref)
	      dyn-props	nil
	      atts nil
	)
	(if (= (vla-get-IsDynamicBlock ref) :vlax-true)
	  (setq dyn-props (getDynProps ref))
	)
	(if (= (vla-get-HasAttributes ref) :vlax-true)
	  (setq atts (getAttValues ref))
	)
	(foreach b lst
	  (if
	    (and
	      (equal geom-props (getGeomProps b))
	      (or (not dyn-props)
		  (equal dyn-props (getDynProps b))
	      )
	      (or (not atts)
		  (equal atts (getAttValues b))
	      )
	    )
	     (and (setq lst (vl-remove b lst)) (vla-delete b))
	  )
	)
      )
    )
 )
      )
   )
 )
 (princ)
) 

[bipbip]

salut Gilles,

 

Un enorme merci pour avoir pris sur ton temps en me repondant si rapidement.

 

Je ne sais pas le boulot que peut representer la mis au point d'un lisp de la sorte.

De toutes facons je vais essayer des lundi et ne manquerais pas de te tenir

informe des resultats. Au vue de ce que j'utilise en ce moment et qui est vraiment parfait

je n'ai aucun doute sur l'efficacite de ce nettoyeur.

 

Un bon WE.

 

Encore MERCI.