petite amelioration lisp kill hatch

[ahbv]

Bonjour,

 

je souhaiterais améliorer le Lisp "KHATCH_BLOCK-SOLID" à savoir qu'il efface toutes les hachures de type solide et sur des calques "définis" ,le Lisp fonctionne a merveille mais il efface toutes les hachures solides de tous les calques et je voudrais qu'il m'efface que ceux qui seraient dans une selection/défini, j'avais pensé a rajouter une ligne du style "vla-get-layer" après la ligne " (= (vla-get-PatternName o) "SOLID")" mais cela ne fonctionne pas (et c'est normal car je n'y connais pas grand chose,je tatonne mais sans grand résultat, je sais c'est un métier) donc si une âme charitable pouvait m'aider svp?

merci d'avance.

AHBV

 

(defun c:KHATCH_BLOCK-SOLID (/ b o)  
 (vl-load-com)
 (vlax-for b (vla-get-Blocks
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
                 )
               )    ;(setq b(vla-item(vla-get-Blocks(vla-get-ActiveDocument(vlax-get-acad-object)))0))
   (or
     (and (= (vla-get-IsLayout B) :vlax-true)(/= (vla-get-Name B)"*Model_Space"))
     (= (vla-get-IsXref B) :vlax-true)
     (vlax-for o b     ;(setq o(vla-item b 3))
       (if (and(wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
               (= (vla-get-PatternName o) "SOLID"))
         (vla-delete o)
         )
       )
     )
   )
 )
(c:KHATCH_BLOCK-SOLID)
(command "regen")

[lecrabe]

Hello

 

Ci-dessous la "vraie" derniere version de cette routine !

 

J'aime BIEN quand on laisse les noms des auteurs et Commentaires !

 

Bien entendu il faut que un Pro du Lisp/VLisp l'ameliore suivant ta demande ...

 

Bye, lecrabe

 

;; 
;; http://cadxp.com/topic/42821-modif-lis-khatch-block/page__pid__243487
;; 
;; Routine: KHATCH_BLOCK_SOLID par GC + Tramber
;; 
;; Efface les Hachures DANS les Blocs mais SEULEMENT les Hachures SOLID
;; + Test pour ne traiter que les objets dans l'Espace Objet/Model 
;; 
;; ----- Anciens commentaires ----- 
;; Supprimer (Kill) les hachures (HATCH) dans les blocs (BLOCK)
;; Par GC le 11/03/2011 - Passage en DEFUN par Fraid
;; 

(defun c:KHATCH_BLOCK_SOLID (/ b o)  
 (vl-load-com)
 (vlax-for b (vla-get-Blocks
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
                 )
               )    ;(setq b(vla-item(vla-get-Blocks(vla-get-ActiveDocument(vlax-get-acad-object)))0))
   (or
     (and (= (vla-get-IsLayout B) :vlax-true)(/= (vla-get-Name B)"*Model_Space"))
     (= (vla-get-IsXref B) :vlax-true)
     (vlax-for o b     ;(setq o(vla-item b 3))
       (if (and(wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
               (= (vla-get-PatternName o) "SOLID"))
         (vla-delete o)
         )
       )
     )
   )
 )

(c:KHATCH_BLOCK)
(command "_regen")

[ahbv]

oups milles excuses pour la "bourde"

merci mister "lecrabe"

 

 

Hello

 

Ci-dessous la "vraie" derniere version de cette routine !

 

J'aime BIEN quand on laisse les noms des auteurs et Commentaires !

 

Bien entendu il faut que un Pro du Lisp/VLisp l'ameliore suivant ta demande ...

 

Bye, lecrabe

 

;; 
;; http://cadxp.com/topic/42821-modif-lis-khatch-block/page__pid__243487
;; 
;; Routine: KHATCH_BLOCK_SOLID par GC + Tramber
;; 
;; Efface les Hachures DANS les Blocs mais SEULEMENT les Hachures SOLID
;; + Test pour ne traiter que les objets dans l'Espace Objet/Model 
;; 
;; ----- Anciens commentaires ----- 
;; Supprimer (Kill) les hachures (HATCH) dans les blocs (BLOCK)
;; Par GC le 11/03/2011 - Passage en DEFUN par Fraid
;; 

(defun c:KHATCH_BLOCK_SOLID (/ b o)  
 (vl-load-com)
 (vlax-for b (vla-get-Blocks
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
                 )
               )    ;(setq b(vla-item(vla-get-Blocks(vla-get-ActiveDocument(vlax-get-acad-object)))0))
   (or
     (and (= (vla-get-IsLayout B) :vlax-true)(/= (vla-get-Name B)"*Model_Space"))
     (= (vla-get-IsXref B) :vlax-true)
     (vlax-for o b     ;(setq o(vla-item b 3))
       (if (and(wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
               (= (vla-get-PatternName o) "SOLID"))
         (vla-delete o)
         )
       )
     )
   )
 )

(c:KHATCH_BLOCK)
(command "_regen")

[Patrick_35]

Salut

 

Tu remplaces

(and (wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
    (= (vla-get-PatternName o) "SOLID")
)

par

(and (wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
    (= (vla-get-PatternName o) "SOLID")
    (not (vl-position (vla-get-layer o) '("Calque 1" "Calque 2" "Calque 3")))
)

 

@+

[lecrabe]

Hello Patrick

 

MERCI pour TOUTES tes contributions !

 

Bon Appetit, Bye, lecrabe

[ahbv]

zut je me suis emporté trop vite, la modification efface toutes les hachures et non pas que celle s'appellant "Calque 1" "Calque 2"

question: est ce que l'on peut mettre des caractére générique style "*truc?*"

 

MILLES MERCI Patrick_35 :)

 

 

Salut

 

Tu remplaces

(and (wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
    (= (vla-get-PatternName o) "SOLID")
)

par

(and (wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
    (= (vla-get-PatternName o) "SOLID")
    (not (vl-position (vla-get-layer o) '("Calque 1" "Calque 2" "Calque 3")))
)

 

@+

[ahbv]

j'ai mis la maj suivante:

 

(defun c:KHATCH_BCK-LAYERS (/ b o)  
 (vl-load-com)
 (vlax-for b (vla-get-Blocks
               (vla-get-ActiveDocument
                 (vlax-get-acad-object)
                 )
               )    ;(setq b(vla-item(vla-get-Blocks(vla-get-ActiveDocument(vlax-get-acad-object)))0))
   (or
     (and (= (vla-get-IsLayout B) :vlax-true)(/= (vla-get-Name B)"*Model_Space"))
     (= (vla-get-IsXref B) :vlax-true)
     (vlax-for o b     ;(setq o(vla-item b 3))
       (if (and (wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
    (= (vla-get-PatternName o) "SOLID")
    (not (vl-position (vla-get-layer o) '("Model?Unit?-?Zone?Category" "Model?Unit?-?Zone?Category_Pen_No__*")))
)
         (vla-delete o)
         )
       )
     )
   )
 )

(c:KHATCH_BCK-LAYERS)
(command "_regen")

cependant cela efface toutes les hachures (alors que je ne veux effacer que celles qui sont sur la ligne "(not (vl-position (vla-get-layer o) '" ?? une idée

 

 

Salut

 

Tu remplaces

(and (wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
    (= (vla-get-PatternName o) "SOLID")
)

par

(and (wcmatch (vla-get-ObjectName o) "AcDb*Hatch")
    (= (vla-get-PatternName o) "SOLID")
    (not (vl-position (vla-get-layer o) '("Calque 1" "Calque 2" "Calque 3")))
)

 

@+

[Patrick_35]

Oui, en remplaçant

(not (vl-position (vla-get-layer o) '("Calque 1" "Calque 2" "Calque 3")))

par

(not (wcmatch (vla-get-layer o) "truc?*"))

 

Une aide sur les caractères génériques (wilcard)

 

@+

[ahbv]

exact, j'ai spécifié un calque "*Model?Unit?-?Zone?Category" donc normalement le lisp devrait n'effacer que les hachures de type "solide" sur le calque "*Model?Unit?-?Zone?Category" non ?

 

Oui, en remplaçant

(not (vl-position (vla-get-layer o) '("Calque 1" "Calque 2" "Calque 3")))

par

(not (wcmatch (vla-get-layer o) "truc?*"))

 

Une aide sur les caractères génériques (wilcard)

 

@+

[Patrick_35]

Dans le nom du calque, tu as des points d'interrogations et dans le lien que je t'ai indiqué, le ? signifie un caractère unique.

Pour que le point d'interrogation reste tel quel et non un caractère spécial, il faut ajouter devant l'apostrophe inversé.

Donc, ceci devrait fonctionner

(wcmatch (vla-get-layer o) "*Model`?Unit`?-`?Zone`?Category")

 

@+

[ahbv]

j'ai essayé avec cette modification mais le soucis et qu'il efface toutes les hachures solides quelle que soit la valeur du code (wcmatch (vla-get-layer o) , donc a priori il ne filtre pas les layer ??

 

merci quand même pour ta réponse.

 

Dans le nom du calque, tu as des points d'interrogations et dans le lien que je t'ai indiqué, le ? signifie un caractère unique.

Pour que le point d'interrogation reste tel quel et non un caractère spécial, il faut ajouter devant l'apostrophe inversé.

Donc, ceci devrait fonctionner

(wcmatch (vla-get-layer o) "*Model`?Unit`?-`?Zone`?Category")

 

@+