Nombre de blocs

[JUJUZAZA]

Bonsoir,

 

Comment repérer des blocs superposés ?

peut-on les sélectionner avec une commande pour les effacer ?

 

Merci d'avance

[PHILPHIL]

hello

 

fonction "OVERKILL" des "express"

ca netoie ce qui est pile poil superpose

 

phil

[LUDWIG]

ou le lisp d'autodesk :

 

 (defun c:deldup_blk (/	    ss	   ssdup  ct	 len	e      eb
	     pt	    lay	   bname  ang	 sclx	scly   sclz
	     obj    obj_list
	     )

 (princ "\nSelect block objects.")
;Select objects and filter all but block insert objects.
 (setq ss (ssget (list (cons 0 "INSERT"))))
 (if ss ;If any valid objects were selected.
   (progn
     (princ "\nBuilding list of objects.")
     (setq ssdup (ssadd))
;Initialize new selection set to hold objects to delete
     (setq len (sslength ss))
;Find out how many objects were selected.      
     (setq ct 0)
     (while (< ct len) ;Loop through selected objects
(setq e (ssname ss ct)) ;Get an object name
(setq eb (entget e)) ;Get the entity list from the object name
(setq ct (+ ct 1)) ;Increment index into selection set
(setq pt (cdr (assoc 10 eb))) ;Access object's coordinate
(setq lay (cdr (assoc 8 eb))) ;Access object's layer
(setq bname (cdr (assoc 2 eb))) ;Access object's block name
(setq ang (cdr (assoc 50 eb))) ;Access object's rotation angle
(setq sclx (cdr (assoc 41 eb))) ;Access object's x scale
(setq scly (cdr (assoc 42 eb))) ;Access object's y scale
(setq sclz (cdr (assoc 43 eb))) ;Access object's z scale 
;Make list of object properties
(setq obj (list pt lay bname ang sclx scly sclz))

(if (not (member obj obj_list))
;If these properties are not already in list
  (setq obj_list (cons obj obj_list)) ;Add them to the list
  (ssadd e ssdup) ;Else add object to selection set to delete
  ) ;End if
) ;End of while loop

     (if (> (sslength ssdup) 0)
;If there are any objects in the selection set to delete
(progn
  (princ "\nDeleting duplicate objects.")
  (setq len (sslength ssdup))
;Find out how many many objects to delete.      
  (setq ct 0)
  (while (< ct len) ;Loop through objects and delete.
    (setq e (ssname ssdup ct)) ;Get object name
    (setq ct (+ ct 1)) ;Increment index into selection set
    (entdel e) ;Delete duplicate object
    ) ;End of while loop

  (princ ;Print the number of objects deleted to command line 
    (strcat "\nDeleted "
	    (itoa len)
	    " duplicate objects."
	    ) ;_ Fin de strcat
    ) ;_ Fin de princ
  ) ;End progn
(princ "\nNo duplicates found.")
;Else no there were no duplicates to delete.
) ;End if

     ) ;End progn
   (princ "\nNo block objects selected.")
;Else there were no valid objects selected
   ) ;End if
 (princ)
 ) ;_ Fin de defun
(prompt
 "\ndeldup_blk : Supprimer les superpositions de blocs"
 ) ;_ Fin de prompt

[JUJUZAZA]

Bonsoir,

 

Génial ça fonctionne ,

 

Merci d'avance

 

[Edité le 11/5/2009 par JUJUZAZA]