supprimer les points dans les blocs

[G_P_TP]

Bonjour.

 

je reçois souvent des fichiers avec des blocs contenant d'inombrables points. C'est en général des export mensura vers autocad. (Ces utilisateurs ne savent pas qu'il y a une case à décocher pour ne pas encombrer inutilement les dessins :-( . je pourrais mettre la taille des points à zero mais du coup je ne vois plus mes points topo.

 

Bref en résumé, je voudrais savoir si quelqu'un aurait la chance d'avoir un petit script qui supprime toutes les entités point de tous les blocs d'un dessin... SAUF s'il y a un point au point d'insertion du bloc (en général 0,0,0).

 

merci.

[lecrabe]

Hello

 

Je suis "totalement nul" en Lisp/VLisp

mais si il s'agit de de faire une Micro-Modif, je peux y arriver ...

 

Cette routine "KPNT_BLOCK" traite TOUS les points dans TOUS les Blocs , SORRY !

 

Chargement par APPLOAD et Lancement par KPNT_BLOCK

 

Ne pas oublier un REGEN apres execution !

 

lecrabe

 

;; Supprimer (Kill) les cotations     (DIMension) dans les blocs (BLOCK) 
;; Micro-Micro Modif par lecrabe pour G_P_TP pour traiter les POINTs 
;; Supprimer (Kill) les points graphiques (POINT) dans les blocs (BLOCK)
;; Par GC le 11/03/2011 - Passage en DEFUN par Fraid 
;; Routine KDIM_BLOCK --> KPNT_BLOCK

;; (defun c:KDIM_BLOCK (/ b o) 
(defun c:KPNT_BLOCK (/ b o) 

(vl-load-com) 

(vlax-for b (vla-get-Blocks 
(vla-get-ActiveDocument 
(vlax-get-acad-object) 
) 
) 
(or 
(= (vla-get-IsLayout B) :vlax-true) 
(= (vla-get-IsXref B) :vlax-true) 
(vlax-for o b  

;; (if (wcmatch (vla-get-ObjectName o) "AcDb*Dimension") 
(if (wcmatch (vla-get-ObjectName o) "AcDb*Point") 

(vla-delete o) 
) 
) 
) 
) 
) 

[G_P_TP]

Cool. le petit script fonctionne. reste plus que le problème du point d'insertion. mais pour l'instant je m'en accomode. (j'ai rajouté le point supprimé dans un bloc).

 

merci

 

P.S. BRAVO pour la réactivité !

[VDH-Bruno]

Cool. le petit script fonctionne. reste plus que le problème du point d'insertion. mais pour l'instant je m'en accomode. (j'ai rajouté le point supprimé dans un bloc).

En repartant du code précédent la micro-modif suivante devrait solutionner le problème du point d'insertion..

 

(defun c:KPNT_BLOCK (/ b o)
 (vl-load-com)
 (vlax-for b (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
   (or (= (vla-get-IsLayout B) :vlax-true)
       (= (vla-get-IsXref B) :vlax-true)
       (vlax-for o b          
         (and (eq (vla-get-ObjectName o) "AcDbPoint")
              (not (equal '(0 0 0) (vlax-get o 'Coordinates) 1e-8))
              (vla-delete o)
         )
       )
   )
 )
 (command "regen")
 (princ)
)

 

Cordialement

[VDH-Bruno]

P.S. BRAVO pour la réactivité !

 

A ce sujet j’aurais une question plus personnel pour lecrabe, car j’ai à plusieurs reprise noté l’efficacité avec laquelle tu ressortais les diverses routines postés sur ce forum de ton disque dur, alors qu’à titre personnel réécrire une fonction est parfois plus rapide pour moi que de la retrouver dans les méandres de mes fichiers, as-tu un secret ou un type de classement particulier, car je pense que un ou deux conseil en la matière me serait des plus profitable.

 

D’avance merci,

A+ Bruno

[lecrabe]

Hello Bruno

 

SORRY mais je n'ai aucun outil specifique de recherche / classement !

 

Par contre j'ai (dans ce domaine) une assez bonne memoire (qui faiblit avec l'age - 56 ans) ...

 

Cependant mes noms de fichiers sont significatifs, ainsi par exemple

je change le nom des routines (des fichiers plutot) pour y inclure ci possible

vers la fin du nom ce dont a quoi on cause ...

 

Par exemple avec une recherche sur : *blk* ou sur *bloc*

je retrouve au moins une centaine de routines relatives aux Blocs

Apres c la memoire et le reste du nom du fichier qui n'est pas toujours significatif !?

 

Je dispose d'au moins 2 000 fichiers ... glanes sur les sites Francais et US !

 

Ta routine est OK avec conservation de l'eventuel POINT present sur le Point d'Insertion du Bloc --> MERCI

Teste sur un AutoCAD 2014 French 32 bits !

 

lecrabe

[Patrick_35]

En repartant du code précédent la micro-modif suivante devrait solutionner le problème du point d'insertion..

 

(defun c:KPNT_BLOCK (/ b o)
 (vl-load-com)
 (vlax-for b (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
   (or (= (vla-get-IsLayout B) :vlax-true)
       (= (vla-get-IsXref B) :vlax-true)
       (vlax-for o b          
         (and (eq (vla-get-ObjectName o) "AcDbPoint")
              (not (equal '(0 0 0) (vlax-get o 'Coordinates) 1e-8))
              (vla-delete o)
         )
       )
   )
 )
 (command "regen")
 (princ)
)

 

Cordialement

Salut

 

J'aurais plus fait le test dans ce sens

 

(not (equal (vlax-get b 'origin) (vlax-get o 'Coordinates) 1e-8))

 

Je dispose d'au moins 2 000 fichiers ... glanes sur les sites Francais et US !

Ce n'est plus lecrabounet qu'il faut t'appeler, mais l'écureuil du lisp ;)

 

@+

[VDH-Bruno]

Salut

J'aurais plus fait le test dans ce sens

(not (equal (vlax-get b 'origin) (vlax-get o 'Coordinates) 1e-8))

Ce n'est plus lecrabounet qu'il faut t'appeler, mais l'écureuil du lisp ;)

@+

Oui Patrick_35 a naturellement raison (comme bien souvent en matière de bloc), c’est effectivement plus juste, merci.

 

Hello Bruno

SORRY mais je n'ai aucun outil specifique de recherche / classement !

[…]

Je dispose d'au moins 2 000 fichiers ... glanes sur les sites Francais et US !

[...]

Merci de ton retour, 2 000 fichiers ça ne m’étonne pas, il faut au moins ça pour pouvoir en dégainer un pour chaque situation comme tu le fait.. Tu fais tout de même preuve d’une bonnes organisations bravo !!!

 

A+

[G_P_TP]

<mode adoration on>

 

OH DIEUX DU LISP MERCI.

 

<off>

 

vous êtes formidables. encore merci.

[vannes]

Bonjour,

 

Je suis interressé par ce lisp, mais pour effacer un wipeout au lieu d'un point.

 

Quelle modification doit être apportée alors à ce lisp?

[lecrabe]

Hello

 

A votre service ... Merci a Gilles et Fraid !

 

lecrabe

 

 


;; Supprimer (Kill) les WIPEOUTs (WIPEOUT) dans les blocs (BLOCK)
;; Par GC le 11/03/2011 - Passage en DEFUN par Fraid

(defun c:KWIPEOUT_BLOCK (/ b o)
(vl-load-com)
(vlax-for b (vla-get-Blocks
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(or
(= (vla-get-IsLayout B) :vlax-true)
(= (vla-get-IsXref B) :vlax-true)
(vlax-for o b
(if (wcmatch (vla-get-ObjectName o) "AcDb*Wipeout")
(vla-delete o)
)
)
)
)
)