Subtilité lisp BLOC

[zara]

Bonjour,

J'utilise le lisp suivant pour éditer les blocs d'un dessin.

Cela fonctionne très bien mais je souhaiterai ne pas toucher aux hachures des blocs juste les lignes concernant le changement de couleur.

Auriez-vous une idée pour modifier le lisp pour que cela fonctionne?

 

Merci par avance

 

(defun c:norm (/ *error* adoc lst_layer func_restore-layers)
 (defun *error* (msg)
   (func_restore-layers)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun

 (defun func_restore-layers ()
   (foreach item lst_layer
     (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
     (vl-catch-all-apply
       '(lambda ()
          (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
          ) ;_ end of lambda
       ) ;_ end of vl-catch-all-apply
     ) ;_ end of foreach
   ) ;_ end of defun

 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-startundomark
 (vlax-for item (vla-get-layers adoc)
   (setq lst_layer (cons (list item
                               (cons "lock" (vla-get-lock item))
                               (cons "freeze" (vla-get-freeze item))
                               ) ;_ end of list
                         lst_layer
                         ) ;_ end of cons
         ) ;_ end of setq
   (vla-put-lock item :vlax-false)
   (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
   ) ;_ end of vlax-for
 (vlax-for blk (vla-get-blocks adoc)
   (if (and (equal (vla-get-islayout blk) :vlax-false)
            (equal (vla-get-isxref blk) :vlax-false)
            ) ;_ end of and
     (progn
       (vlax-for subent blk
         (vla-put-layer subent "0")
         (vla-put-color subent 0)
         (vla-put-lineweight subent aclnwtbyblock)
         (vla-put-linetype subent "byblock")
         ) ;_ end of vlax-for
       ) ;_ end of progn
     ) ;_ end of if
   ) ;_ end of vlax-for
 (func_restore-layers)
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

[(gile)]

Salut,

 

Remplace l'expression (à la fin) :

      (progn
       (vlax-for subent blk
         (vla-put-layer subent "0")
         (vla-put-color subent 0)
         (vla-put-lineweight subent aclnwtbyblock)
         (vla-put-linetype subent "byblock")
         ) ;_ end of vlax-for
       ) ;_ end of progn

par celle là :

      (progn
       (vlax-for subent blk
         (if (/= (vla-get-ObjectName subent) "AcDbHatch")
           (progn
             (vla-put-layer subent "0")
             (vla-put-color subent 0)
             (vla-put-lineweight subent aclnwtbyblock)
             (vla-put-linetype subent "byblock")
           );_ end of progn
         );_ end of if
       ) ;_ end of vlax-for
     ) ;_ end of progn

[zara]

Salut,

Merci pour cette réponse.

C'est un honneur pour moi de converser avec "le boss" gile.

 

J'ai remplacer la fin comme indiqué mais le lisp ne se lance plus du tout. :mellow:

Aurais je oublié quelque chose?

merci encore

 

(defun c:xcv (/ *error* adoc lst_layer func_restore-layers)
 (defun *error* (msg)
   (func_restore-layers)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun

 (defun func_restore-layers ()
   (foreach item lst_layer
     (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
     (vl-catch-all-apply
       '(lambda ()
          (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
          ) ;_ end of lambda
       ) ;_ end of vl-catch-all-apply
     ) ;_ end of foreach
   ) ;_ end of defun

 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-startundomark
 (vlax-for item (vla-get-layers adoc)
   (setq lst_layer (cons (list item
                               (cons "lock" (vla-get-lock item))
                               (cons "freeze" (vla-get-freeze item))
                               ) ;_ end of list
                         lst_layer
                         ) ;_ end of cons
         ) ;_ end of setq
   (vla-put-lock item :vlax-false)
   (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
   ) ;_ end of vlax-for
 (vlax-for blk (vla-get-blocks adoc)
   (if (and (equal (vla-get-islayout blk) :vlax-false)
            (equal (vla-get-isxref blk) :vlax-false)
            ) ;_ end of and
     (progn
       (vlax-for subent blk
         (if (/= (vla-get-ObjectName subent) "AcDbHatch")
           (progn
             (vla-put-layer subent "0")
             (vla-put-color subent 0)
             (vla-put-lineweight subent aclnwtbyblock)
             (vla-put-linetype subent "byblock")
           );_ end of progn
         );_ end of if
       ) ;_ end of vlax-for
     ) ;_ end of progn

[(gile)]

Tu n'as pas remplacé juste l'expression (progn ...), tu as remplacé toute la fin de la routine...

 

La programmation ne supporte pas l'approximation.

 

(defun c:norm (/ *error* adoc lst_layer func_restore-layers)
 (defun *error* (msg)
   (func_restore-layers)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun

 (defun func_restore-layers ()
   (foreach item lst_layer
     (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
     (vl-catch-all-apply
       '(lambda ()
          (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
          ) ;_ end of lambda
       ) ;_ end of vl-catch-all-apply
     ) ;_ end of foreach
   ) ;_ end of defun

 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-startundomark
 (vlax-for item (vla-get-layers adoc)
   (setq lst_layer (cons (list item
                               (cons "lock" (vla-get-lock item))
                               (cons "freeze" (vla-get-freeze item))
                               ) ;_ end of list
                         lst_layer
                         ) ;_ end of cons
         ) ;_ end of setq
   (vla-put-lock item :vlax-false)
   (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
   ) ;_ end of vlax-for
 (vlax-for blk (vla-get-blocks adoc)
   (if (and (equal (vla-get-islayout blk) :vlax-false)
            (equal (vla-get-isxref blk) :vlax-false)
            ) ;_ end of and
     (progn
       (vlax-for subent blk
         (if (/= (vla-get-ObjectName subent) "AcDbHatch")
           (progn
             (vla-put-layer subent "0")
             (vla-put-color subent 0)
             (vla-put-lineweight subent aclnwtbyblock)
             (vla-put-linetype subent "byblock")
           );_ end of progn
         );_ end of if
       ) ;_ end of vlax-for
     ) ;_ end of progn
   ) ;_ end of if
 ) ;_ end of vlax-for
 (func_restore-layers)
 (vla-endundomark adoc)
 (princ)
) ;_ end of defun

[nosset]

Tu as trop supprimé !

 

Ajoute à la fin

) ;_ end of if

) ;_ end of vlax-for

(func_restore-layers)

(vla-endundomark adoc)

(princ)

) ;_ end of defun

[zara]

C'est parfait!!!! :D

 

Merci à vous deux.

Très bon week-end!!!!

[zara]

Bonjour,

 

Je m'excuse d’insister après plusieurs essais infructueux je n'arrive pas à faire la même chose sur ce code.

Objectif tout mettre dans la couleur ducalque sauf les hachures.

Je ne sait pas ou placer cette ligne" (if (/= (vla-get-ObjectName subent) "AcDbHatch")"

Cela doit demander une bonne connaissance du langage lisp que je n'ai pas...

 

(defun c:test (/ doc ods)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 ;;fix all dimstyles
 (setq ods (getvar "dimstyle"))
 (vlax-for d (vla-get-dimstyles doc)
   (vla-put-activedimstyle doc d)
   (foreach n '("dimclrt" "dimclrd" "dimclre")
     (setvar n 256)
   )
   (vla-copyfrom d doc)
 )
 ;;need more code to fix mleader styles, and table styles.  Consider stripmtext by others.
				;.........
 ;;fix all objects (does not include mtext color encoding)
 (vlax-for b (vla-get-blocks doc)
   (if	(= (vla-get-isxref B) :vlax-false)
     (vlax-for	n b
(if (wcmatch (vla-get-objectname n) "*Dim*")
  (vla-put-stylename n (vla-get-stylename n))
  (vl-catch-all-apply 'vla-put-color (list n 256))
))))
 (setvar "dimstyle" ods)
 (vla-regen doc acallviewports)
)

 

Merci

Zara