Effacer des entites dans un bloc sans le décomposer

[BIM G CO]

Qui n'as pas eu la mauvaise surprise de recevoir des plans avec des blocs contenant des hachures de type SOLID multicolore!

 

Difficile de l'imprimer en monochrome san risquer d'avoir une grosse masse noire dans le plan.

 

J'ai tenté une ébauche mais malheureusement rien ne s'efface : (mais tout est bien sélectionné

 

(setq selection (ssget "X" (list (cons 0 "INSERT") (cons 2 "HATCH*"))))
(setq liste (mapcar '(lambda (x) (nth 1 x)) (ssnamex selection)))
(foreach n liste
 (setq efface nil)
 (setq	entite
 (entget
   (cdr
     (assoc -2 (tblsearch "BLOCK" (cdr (assoc 2 (entget n)))))
   )
 )
 )
 (while (and (entnext (cdr (assoc -1 entite)))
      (/= (cdr (assoc 2 entite)) "SOLID")
 )
   (setq efface (append efface (list (cdr (assoc -1 entite)))))
   (setq entite
   (entget
     (entnext (cdr (assoc -1 entite)))
   )
   )
 )
 (if efface
   (progn
     (foreach m efface (entdel m))
     (entmod (entget n))
     )
   )
 )
(princ)

 

 

 

[Edité le 24/11/2006 par Maximilien]

[Tramber]

Il faut passer par un VLAX-FOR, c'est bien + puissant.

 

Si personne ne le fait avant moi, je te publie un petit exemple ce soir.

Pour le moment, je dois me déconnecter.

 

 

[Patrick_35]

Salut

 

Un petit truc vite fait

 

(defun c:eff(/ ent js n obj)
 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (while (setq ent (nentsel))
   (setq obj (vlax-ename->vla-object (car ent)))
   (vla-delete obj)
   (if (eq (type (car (last ent))) 'ENAME)
     (progn
       (setq js (ssget "x" (list (cons 0 "INSERT") (assoc 2 (entget (car (last ent)))))) n 0)
       (while (setq ent (ssname js n))
         (entmod (entget ent))
         (setq n (1+ n))
       )
     )
   )
 )
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
)

 

ps : tu as aussi la commande _editref

 

@+

[BIM G CO]

J'ai modifié le code car j'ai trouvé le problème de la liste "efface"!

un problème de booléen mal interprété! (ouf heureusement que c'est dans Débuter en LISP)

 

PS la commande Editref n'est pas mieux pour près de 220 blocs HATCH_001 à HATCH_221 :casstet:

 

[Edité le 24/11/2006 par Maximilien]

[Patrick_35]

(setq liste (mapcar '(lambda (x) (nth 1 x)) (ssnamex selection)))

Tu parcours deux fois pour rien ta liste. Tout ça pour utiliser un foreach

Reste avec une boucle while et un ssname, c'est plus simple

 

ps : je n'avais pas compris ton lisp dans ce sens et le traitement de +200 blocs

 

@+

[BIM G CO]

  (if efface
   (progn
     (foreach m efface
(vla-delete (vlax-ename->vla-object m)))
     (entmod (entget n))
     )
   )
 )

 

le (vla-delete (vlax-ename->vla-object m)))ne me donne rien de plus

ma liste "efface" contient pourtant pour chaque bloc la liste des éléments à effacer.

 

(efface est une liste de type entite : < Nom d'entité: 7e7e1a08 >)

 

effectivement je pourrais faire plus rapide avec

 

sslength (nombre de blocs sélectionnés)

while une boucle parcourant la liste

et ssname pour avoir le bloc

 

mon principal problème c'est Pourquoi çà n'efface pas!

 

 

[Edité le 24/11/2006 par Maximilien]

[Patrick_35]

Test celui-ci

 

(defun c:ebl(/ bl bls ent hac)
 (vl-load-com)
 (vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
 (setq bls (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
 (vlax-for bl bls
   (setq ent nil)
   (if (not (vlax-property-available-p bl 'Path))
     (if (vlax-property-available-p bl 'EffectiveName)
       (if (vl-string-search "HATCH" (strcase (vla-get-EffectiveName bl)))
         (setq ent bl)
       )
       (if (vl-string-search "HATCH" (strcase (vla-get-Name bl)))
         (setq ent bl)
       )
     )
   )
   (if ent
     (vlax-for hac ent
       (if (eq (vla-get-ObjectName hac) "AcDbHatch")
         (if (eq (vla-get-PatternName hac) "SOLID")
           (vla-delete hac)
         )
       )
     )
   )
 )
 (vla-regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
 (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
 (princ)
)

 

@+

 

ps : testé mais non vérifié car je n'ai pas de blocs HATCH* et de solide qui vont avec

 

nb : Extrait de l'aide

Warning! You can use entmod to modify entities within a block definition, but doing so can create a self-referencing block, which will cause AutoCAD to stop.

(en clair, je ne pense pas que tu puisses modifier la table des blocs en effaçant ou en ajoutant des objets)

 

[Edité le 24/11/2006 par Patrick_35]

[(gile)]

Dans le même registre que la dernière de Patick_35.

 

(defun c:DeleteSolidHathInBlocks (/ AcDoc)
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-StartUndoMark AcDoc)
 (vlax-for b (vla-get-Blocks AcDoc)
   (vlax-for e	b
     (if (and (= "AcDbHatch" (vla-get-ObjectName e))
       (= "SOLID" (vla-get-PatternName e))
  )
(vla-delete e)
     )
   )
 )
 (vla-EndUndoMark AcDoc)
 (vla-regen AcDoc acActiveViewport)
 (princ)
) 

 

Pour Patrick_35, d'après mes tests "EffectiveName" ne concerne que les références de bloc, pour les définitions de bloc, c'est toujours "Name"

[Patrick_35]

Ah ok, merci

 

@+

[BIM G CO]

çà marche! mais maintenant je dois le comprendre

1 pourquoi le mien ne fonctionne pas

2 pourquoi celui-ci fonctionne

3 que fait les fonctions :

vla-get-ActiveDocument

vlax-get-acad-object

vla-StartUndoMark

vla-get-Blocks

vla-get-ObjectName

vla-get-PatternName

vla-EndUndoMark

vla-regen

acActiveViewport

 

Ce document sera imprimé c'est dans ce but que les fonctions qui me sont inconnues sont écrites. (je rechercherais par mes propres moyens me permettant de bien mémoriser

 

[Edité le 27/11/2006 par Maximilien]

[Patrick_35]

1 pourquoi le mien ne fonctionne pas

Il me semble t'avoir déjà répondu

nb : Extrait de l'aide

Warning! You can use entmod to modify entities within a block definition, but doing so can create a self-referencing block, which will cause AutoCAD to stop.

(en clair, je ne pense pas que tu puisses modifier la table des blocs en effaçant ou en ajoutant des objets)

 

2 pourquoi celui-ci fonctionne

S'il ne fonctionnait pas, on ne l'aurait pas publié ;)

Plus sérieusement, le vlisp offre des possibilités que ne possède pas autolisp

 

3 que fait les fonctions :

vlax-get-acad-object --> C'est pour pointer sur l'application Autocad

vla-get-ActiveDocument --> C'est pour pointer sur le dessin courant

vla-StartUndoMark --> équivaut à un (command "_undo" "_group") ou (command "_undo" "_begin")

vla-EndUndoMark --> équivaut à un (command "_undo" "_end")

vla-get-Blocks --> pointer sur la table des blocs

vla-get-ObjectName --> Connaitre le type d'entité, équivaut au code dxf 100

vla-get-PatternName --> Connaitre le nom de l'hachure, équivaut au code dxf 2

vla-regen --> équivaut à la commande regen

acActiveViewport --> Regen sur la fenetre courante

acAllViewports --> Regen sur toutes les fenêtres

 

@+

[BIM G CO]

Effectivement mais je me sers de ma réponse précédente comme de nota personnelle pour "m'obliger" à comprendre pourquoi je dois faire ceci et non cela. Il est clair qu'en imprimant et en lisant sur papier ce sujet les deux questions ce sont résolues d'elles-mêmes.

 

Concernant la 3ème, merci de tes explications, je les teste sur la ligne de commande me permettant de comprendre chacun de leurs comportement!

 

On apprend beaucoup en comprenant et en testant pas à pas les routines inconnues!

 

Le fait que je les imprime permet de les classer et de les mettre à disposition du BE.

[BIM G CO]

Effacer des Wipeout contenu dans les blocs

 

(defun c:deleteWipeOutInBlocks (/ AcDoc)
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
 (vla-StartUndoMark AcDoc)
 (vlax-for b (vla-get-Blocks AcDoc)
   (vlax-for e	b
     (if (= "AcDbWipeout" (vla-get-ObjectName e))

(vla-delete e)
     )
   )
 )
 (vla-EndUndoMark AcDoc)
 (vla-regen AcDoc acActiveViewport)
 (princ)
)

utile pour alléger des plans d'architectes (mettre un Wipeout dans le blocs de surface mais quelle idée!)

 

[Edité le 30/11/2006 par Maximilien]

[Patrick_35]

Year...

Tu commences à maitriser le vlisp :cool:

 

@+

[BIM G CO]

ce n'était pas si compliqué vla-get-ObjectName correspond à la valeur 100 (le deuxième) du code DXF

 

bon maintenant je vais regarder ce que je peux effacer :

pour l'instant nous avons

vla-get-ObjectName = AcDbHatch et AcDbWipeout

imaginons les possibilités

Point : AcDbPoint

des lignes de longueur 0 (bonuscad l'a fait en autolisp ....)

et.... je ne vois pas d'autres choses ...

 

Dans le but de faire une seul fonction capable d'effacer suivant un argument

Faire la liste les entités possibles (c'est çà qui sera long)

Cas des hachures (utilisation de vla-get-PatternName)

voir donc pour les entités complexes

 

fonction du genre:

(defun deleteVisualLispInBlocks (ARGUMENT / AcDoc b e)
(if (not ARGUMENT) (setq ARGUMENT (getstring "\nSaisissez l'ObjectName ")))
(setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-StartUndoMark AcDoc)
(vlax-for b (vla-get-Blocks AcDoc)
(vlax-for e b
(if (= ARGUMENT (vla-get-ObjectName e))
(vla-delete e)
)
)
)
(vla-EndUndoMark AcDoc)
(vla-regen AcDoc acActiveViewport)
(princ)

(defun c:deleteVisualLispInBlocks ()
(deleteVisualLispInBlocks nil)
)
)

 

[Edité le 30/11/2006 par Maximilien]

[Patrick_35]

Tu peux faire un (if (member (vla-get-ObjectName (list "AcDbHatch" "AcDbWipeout" ....)))

 

@+

[ASTERIXII]

Est-il possible d'allez plus loin ?

Une fenêtre de selection

Au lieu d'effacer les hachures, les placer dans un autre calque avec couleur du calque

créer le calque si il n'existe pas avec une couleur d'estompage

 

[Patrick_35]

Est-il possible d'allez plus loin ?

Ben oui, c'est possible

Une fenêtre de selection

Pas pour traiter un bloc, sinon il faut en recréer un autre

 

@+