Lisp pour mettre tous les Z des entités d'un dessin à 0

[autospeed]

Quelqu'un d'entre vous aurait-il un lisp permettant de remettre à zéro les Z de toutes les entités d'un dessin ?

J'en ai un , je vous le joint mais il n'est pas pratique car il demande une validation , puis la hauteur et enfin la selection des entités. J'en voudrais un qui ne pose aucune question , il prends toutes les entités , mais les z à zéro et basta !

[Fraid]

Bonjour,

 

un standard

 

(defun C:z=0 nil
(command "_.move" "_all" "" '(0 0 1e99) ""
"_.move" "_p" "" '(0 0 -1e99) "")
(princ)
)

[autospeed]

Bonjour,

 

un standard

 

(defun C:z=0 nil
(command "_.move" "_all" "" '(0 0 1e99) ""
"_.move" "_p" "" '(0 0 -1e99) "")
(princ)
)

 

Merci , je l'ai testé celui la mais il n'a pas l'air de toucher aux entités des blocs.

[Fraid]

mais il n'a pas l'air de toucher aux entités des blocs

 

je ne pouvait pas deviner que tu voulait intervenir a l’intérieur des blocs

 

la c'est une autre histoire...

 

je vais regarder si j'ai cela dans ma collection...

[Fraid]

Pourrai tu nous dire ce que contiennent tes blocs?

[Fraid]

voila un exemple de traitement des objets contenus dans des blocs

 

ici pour effacer les hachures

 

(defun c:DeleteSolidHathInBlocks (/ AcDoc)
(vl-load-com)
 (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
 
           listBlocs (ssget  (list (cons 0 "INSERT")))
    vlalistbloc (vlax-ename->vla-object listBlocs)
 )
 (vla-StartUndoMark AcDoc)
 (vlax-for b 	vlalistbloc
   (vlax-for e	b
     (if (and (= "AcDbHatch" (vla-get-ObjectName e));;;ici les objets que tu doit traiter
       (= "SOLID" (vla-get-PatternName e))
  )
(vla-delete e);;;ici le traitement
     )
   )
 )
 (vla-EndUndoMark AcDoc)
 (vla-regen AcDoc acActiveViewport)
 (princ)
) 

 

a toi d'adapter

 

merci au experts lispiens du forum pour ce code

[GEGEMATIC]

Salut,

Il doit y avoir plus joli (Gile, Patrick, Bruno ???) , mais voici une vieille collection de fonctions pour traiter ce problème.

le pré requi est d'avoir PowerClic installé :

http://g-eaux.over-blog.com/article-installation-et-mise-a-jour-de-powerclic-pour-autocad-98003399.html

 

Si les z incriminés viennent d'une application tierce, et dépassent les 10⁹⁹, aucune commande à l'intérieur d'Autocad ne marchera. (pas même en arx, on avait vu ça avec Kamal Boutora)

La SEULE solution, c'est d'exporter au format DXF, et de changer les z pourris avec un editeur, genre Notepad ++.

 

 

 

;; distribué tel quel, sans garantie.
; G-EAUX Gérald Lemoine  1/6/2005
;;****************************************************************************************
;;§/dxf/definit tous les cordonées en z à 0/none
;;ne permet pas de choisir les entitées, mais traite toutes les entitées, 3dpoly incluses
;
(defun c:proj2d_all ( / z)

(defun to_Z0 ( ent / tmp eg)
  (setq eg (entget ent))

  (if (setq  z (cadddr (setq tmp (assoc 10 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (list 10 (cadr tmp) (caddr tmp) 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

  (if (setq  z (cadddr (setq tmp (assoc 11 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (list 11 (cadr tmp) (caddr tmp) 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

  (if (setq  z (cadddr (setq tmp (assoc 12 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (list 12 (cadr tmp) (caddr tmp) 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

  (if (setq  z (cadddr (setq tmp (assoc 13 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (list 13 (cadr tmp) (caddr tmp) 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

  (if (setq z (cdr (setq tmp (assoc 38 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (cons 38 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

)

(setq ent (entnext))
(to_Z0 ent)
;(print eg)
(while (setq ent (entnext ent))
 (to_Z0 ent)
 ;(print eg)
)
;;aplati les blocs
(c:block_def_to_z0)
)

;;****************************************************************************************
;;§/dxf/definit tous les cordonées en z à 0 des entités choisies/none
;;permet de choisir les entitées, mais traite ne traite pas toutes les entitées
;
(defun c:proj2d ( / z )

(defun to_Z0 ( eg / tmp )

  (if (setq  z (cadddr (setq tmp (assoc 10 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (list 10 (cadr tmp) (caddr tmp) 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

  (if (setq  z (cadddr (setq tmp (assoc 11 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (list 11 (cadr tmp) (caddr tmp) 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

  (if (setq  z (cadddr (setq tmp (assoc 12 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (list 12 (cadr tmp) (caddr tmp) 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

  (if (setq  z (cadddr (setq tmp (assoc 13 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (list 13 (cadr tmp) (caddr tmp) 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )

  (if (setq z (cdr (setq tmp (assoc 38 eg))))
   (if (not (= 0 z))
    (progn
     (setq repl (cons 38 0))
     (setq eg (subst repl tmp eg))
     (entmod eg)
    ;(print	 eg)
     (entupd ent)
    )
   )
  )
)

(setq sel (ssget))
(setq lsel (pw_listsel sel))

 
;(print eg)
(foreach ent lsel
 (setq eg (entget ent))
 (to_Z0 eg)
 (setq tp_ent (cdr (assoc 0 eg)))
 (cond
   ((= "3DPOLY" tp_ent)
    (prompt "\n3dpoly pas applatie !")
   )
   ((= "INSERT" tp_ent)
    (prompt "\napplati la definition du bloc ...")
    (setq nbl (cdr (assoc 2 eg)))
    (block_def_z0 nbl)
   )
 )
 ;(print eg)
)
)
;; ****************************************************************************
;;§/dxf/aplati la definition de tous les blocs du dessin /none
(defun c:block_def_to_z0 ( / lbloc nbl)

 (setq lbloc (pw_list_tabl "BLOCK"))
 (setq lxref (PW_LIST_XREF))

 (setq lbloc (pw_l1-l2 lbloc lxref))
 
(foreach nbl lbloc

    (prompt "\napplati la definition du bloc ...")
    (print nbl)
    (block_def_z0 nbl)
   )
)

; ****************************************************************************
;;§/dxf/applati la definition d'un bloc /nombloc
;;nombloc = intitulé du bloc
;;
(defun block_def_z0 ( nb / i ldef )
  (setq ldef (pw_block_def nb))
  (foreach def ldef
   (setq def (mapcar 'pw_zfromlist_to_zero def))
   (prompt "\nmodifie 1")
   (print (entmod def))
  )
)
;;****************************************************************************
;;§/dxf/pour un element d'une liste de entget, place z à 0/lst
;;lst du gener '(10 105.65 120.36 47.0) -> (10 105.65 120.36 0)

(defun pw_zfromlist_to_zero ( lst / z )
  (cond
    ((=  10 (car lst))
     (setq  z (last lst)) 
     (if (not (= 0 z))
      (list 10 (cadr lst) (caddr lst) 0.0)
      lst
     )
   )
   ((=  11 (car lst))
     (setq  z (last lst)) 
     (if (not (= 0 z))
      (list 11 (cadr lst) (caddr lst) 0.0)
      lst
     )
   )
   ((=  12 (car lst))
     (setq  z (last lst)) 
     (if (not (= 0 z))
      (list 12 (cadr lst) (caddr lst) 0.0)
      lst
     )
   )
   ((=  13 (car lst))
     (setq  z (last lst)) 
     (if (not (= 0 z))
      (list 13 (cadr lst) (caddr lst) 0.0)
      lst
     )
   )
   ((=  38 (car lst))
     (setq  z (cdr lst)) 
     (if (not (= 0 z))
      (cons 38  0.0)
      lst
     )
   )
;;;    ((pw_listp (car lst))
;;;     (pw_zfromlist_to_zero lst)
;;;    )
   (T
    lst
   )
  )
)

[VDH-Bruno]

Bonjour,

Ma version à tester, écrite un peu à la volé mais en théorie elle devrait plutôt bien fonctionner…

;; 27-04-2012 VDH-Bruno
;; My Z=0, Affecte toute la base de données du dessin EO, EP, Bloc ect... 
(defun c:z=0 ()
 (vl-load-com)
 (vlax-map-collection
   (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
   '(lambda (block)
      (vlax-map-collection
 block
 '(lambda (obj)
    (cond
      ((vlax-method-applicable-p obj 'Move)
       (vla-Move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point '(0 0 1e99)))
       (vla-Move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point '(0 0 -1e99)))
      )
    )
  )
      )
    )
 )
 (princ)  
)

 

A+

[autospeed]

super merci , je vais tester ça !

[boototom]

Bonjour,

Ma version à tester, écrite un peu à la volé mais en théorie elle devrait plutôt bien fonctionner…

 

Bonjour,

 

Ce script est très (trop?) efficace mais il passe les échelles en Z des blocs à 0, ce qui est plutôt problématique pour certains blocs et provoque des bugs (cotation sur un bloc complètement). J'ai essayer de regarder si je pouvais modifier le code mais je n'ai rien trouvé d'explicite à modifier.

 

En attendant, je vais tester les autres scripts, un peu plus "superficiels" qui ont été proposés.

[lecrabe]

Hello

 

Je pense que traiter le Z a l'interieur des Blocs 2D/3D peut s'averer tres complique !?

Vu le nbr d'entites differentes que peut contenir un Bloc ...

sans oublier les Blocs 2D/3D imbriques dans des Blocs 2D/3D !!

 

Il y a de nombreux cas particuliers a traiter UN PAR UN ...

 

Par exemple : doit on remettre a ZERO toutes les Elevations et Hauteurs d'objets ?

Quelque soit l'objet ?

 

Par exemple : si on rencontre une 3DPOLY, on fait quoi ?

 

lecrabe

[jalna]

Salut,

Il doit y avoir plus joli (Gile, Patrick, Bruno ???)

 

Sympa pour Fraid!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

[VDH-Bruno]

Bonjour,

 

Ce script est très (trop?) efficace mais il passe les échelles en Z des blocs à 0, ce qui est plutôt problématique pour certains blocs et provoque des bugs (cotation sur un bloc complètement).

C’est un peu le but de ce code et dans le post précédent, il s’applique à tout le dessin bloc et imbrications de bloc.

 

 

J'ai essayer de regarder si je pouvais modifier le code mais je n'ai rien trouvé d'explicite à modifier.

Ce qu’il est possible d’adapter aisément sans faire une usine à gaz (comme rappeler par lecrabe) :

 

 

Il est possible de limité son action aux seuls espaces objet et papier comme ceci…

;; 05-09-2013 VDH-Bruno
;; My Z=0, Affecte toutes les espaces de dessin (EO, EP) et exclut les définitions de bloc 
(defun c:Spacez=0 ()
 (vl-load-com)
 (vlax-map-collection
   (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
   '(lambda (block)
      (and (wcmatch (vla-get-name block) "`*Model_Space,`*Paper_Space*")
           (vlax-map-collection
             block
             '(lambda (obj)
                (cond ((vlax-method-applicable-p obj 'Move)
                       (vla-Move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point '(0 0 1e99)))
                       (vla-Move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point '(0 0 -1e99)))
                      )
                )
              )
           )
      )
    )
 )
 (princ)
)

 

 

 

Ou bien dans un cadre plus spécifique il est facile d’exclure les définitions de blocs qui ne doivent pas être "aplati ", en les spécifiant au moyen d’une boite de dialogue (avec la fonction ListBox de (gile))

 

;; 05-09-2013 VDH-Bruno
;; My Z=0, Affecte toutes les espaces de dessin (EO, EP) 
;; Exclut les définitions de bloc spécifié dans la boite de dialogue

(defun c:Blocz=0 (/ l bl)
 (vl-load-com)
 (setq l (acad_strlsort
           (vl-remove-if
             (function (lambda (n) (= (substr n 1 1) "*")))
             (while (setq bl (tblnext "BLOCK" (not bl))) (setq l (cons (cdr (assoc 2 bl)) l)))
           )
         )
       l (listbox "Blocs à exclure" "Sélectionnez des définitions blocs" (mapcar 'cons l l) 2)
 )
 (vlax-map-collection
   (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-acad-object)))
   '(lambda (block)
      (if (not (and (vlax-property-available-p block 'EffectiveName) (member (vla-get-EffectiveName block) l)))
           (vlax-map-collection
             block
             '(lambda (obj)
                (cond ((vlax-method-applicable-p obj 'Move)
                       (vla-Move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point '(0 0 1e99)))
                       (vla-Move obj (vlax-3d-point '(0 0 0)) (vlax-3d-point '(0 0 -1e99)))
                      )
                )
              )
           )
      )
    )
 )
 (princ)
)


;;============================================================================;;

;; ListBox (gile)
;; Boite de dialogue permettant un ou plusieurs choix dans une liste
;;
;; Arguments
;; title : le titre de la boite de dialogue (chaîne)
;; msg ; message (chaîne), "" ou nil pour aucun
;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = liste déroulante
;;        1 = liste choix unique
;;        2 = liste choix multipes
;;
;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2)
;;
;; Exemple d'utilisation
;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 2)

(defun ListBox (title msg keylab flag / tmp file dcl_id choice)
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )
 (write-line
   (strcat "ListBox:dialog{label=\"" title "\";")
   file
 )
 (if (and msg (/= msg ""))
   (write-line (strcat ":text{label=\"" msg "\";}") file)
 )
 (write-line
   (cond
     ((= 0 flag) "spacer;:popup_list{key=\"lst\";")
     ((= 1 flag) "spacer;:list_box{key=\"lst\";")
     (T "spacer;:list_box{key=\"lst\";multiple_select=true;")
   )
   file
 )
 (write-line "}spacer;ok_cancel;}" file)
 (close file)
 (setq dcl_id (load_dialog tmp))
 (if (not (new_dialog "ListBox" dcl_id))
   (exit)
 )
 (start_list "lst")
 (mapcar 'add_list (mapcar 'cdr keylab))
 (end_list)
 (action_tile
   "accept"
   "(or (= (get_tile \"lst\") \"\")
   (if (= 2 flag) (progn
   (foreach n (str2lst (get_tile \"lst\") \" \")
   (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
   (setq choice (reverse choice)))
   (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
   (done_dialog)"
 )
 (start_dialog)
 (unload_dialog dcl_id)
 (vl-file-delete tmp)
 choice
)

 

 

En attendant, je vais tester les autres scripts, un peu plus "superficiels" qui ont été proposés.

 

En plus de la commande flatten des outils Express d’AutoCAD, avec un peu de recherche tu trouveras pléthore de routine pour Z=0, dans le lot je suis sûr que tu trouveras ton bonheur..

 

Cordialement,

(Ps : Les codes proposé sont tapés à la volée et peu ou pas testé, je suis retourné pour quelques temps à l’éxé pas trop le temps de finasser les lisps).

[(gile)]

salut,

 

Voir aussi le LISP SuperFlatten de Joe Burke.

[boototom]

Bonjour,

 

C’est un peu le but de ce code et dans le post précédent, il s’applique à tout le dessin bloc et imbrications de bloc.

 

Merci beaucoup, je testerai le script modifié. Le hic c'est que le premier lisp touche aussi aux Echelles en Z et une échelle égale à 0 pour un bloc, c'est pas glop, surtout avec des blocs mis à l'échelle uniformément (ce qui permet de préserver les poignées dynamiques et autres subtilités du genre pouvoir coter le diamètre d'un bloc circulaire).

 

Le dernier lien posté par gile ne fonctionne pas mais une brève recherche google m'a permis de trouver la fonction superflatten ici:

 

http://forums.autodesk.com/t5/Visual-LISP-AutoLISP-and-General/SuperFlatten/td-p/2046602