[Résolu] Z=0 et élévation=0 aussi...

[DenisHen]

Bonjour à la communauté...

 

Voilà, pour des collègues qui sont sous AutoCAD OEM (qui n'ont donc pas les Express Tools) je cherche à faire une petite macro qui place les blocs à z=0 mais aussi les élévations des polylignes à 0.

 

Pour les blocs, est-ce qu'un simple "_move" suffirait ou une autre méthode plus simple et rapide ?

 

Pour les LWPOLYLINE, je bien trouvé le code DXF de l'élévation (38) mais comment le mettre à 0 ?

 

Cette macro fera partie d'une autre beaucoup plus longue, pour que mes collègues de terrain ne fassent pas des tonnes de manipulations sous la pluie...

 

Si quelqu'un a une astuce ou une idée, je suis preneur...

 

Denis...

[DenisHen]

Re,

 

J'ai fais ce code pour les blocs à Z=0 qui ne fonctionne pas...

(if (setq js (ssget "X" (list (cons 0 "INSERT"))))
 (progn (setq n 0)
        (while (setq bl (ssname js n))
          (setq att       (entget (entnext bl))
                Lst       (entget bl)
                Coord     (cdr (assoc 10 elst))
                CoordSrc  (strcat (rtos (car Coord) 2 3)
                                  ","
                                  (rtos (cadr Coord) 2 3)
                                  ","
                                  (rtos (caddr Coord) 2 3)
                          ) ;_ Fin de strcat
                CoordDest (strcat (rtos (car Coord) 2 3) "," (rtos (cadr Coord) 2 3) ",0.00")
          ) ;_ Fin de setq
;;;
          (command "_move" js CoordSrc CoordDest)
;;;
        ) ;_ Fin de while
 ) ;_ Fin de progn
) ;_ Fin de if

 

Si quelqu'un a une idée ou un conseil...

 

Denis...

[(gile)]

Salut,

 

un exemple en utilisant la fonction entmod qui modifie une entité à l'aide d'une liste DXF telle que retournée avec entget, et la fonction subst pour modifier la liste retournée par entget en substituant un des éléments de la liste.

 

(if (setq ss (ssget "_X" '((0 . "INSERT,LWPOLYLINE"))))
   (progn
     (setq i 0)
     (while (setq ent (ssname ss i))
(setq i (1+ i)
      elst (entget ent))
(if (= (cdr (assoc 0 elst)) "INSERT")
  (progn
    (setq dxf10 (assoc 10 elst))
    (entmod
      (subst
	(list 10 (cadr dxf10) (caddr dxf10) 0.0)
	dxf10
	elst
      )
    )
  )
  (entmod (subst (cons 38 0.0) (assoc 38 elst) elst))
)
     )
   )
 )

 

Un autre exemple en utilisant les (nouvelles) fonctions LISP getpropertyvalue et setpropertyvalue pour directement obtenir ou attribuer les valeurs des propriétés d'une entité (utiliser dumpallproperties pour voir toutes les propriétés de l'entité).

 

(if (setq ss (ssget "_X" '((0 . "INSERT,LWPOLYLINE"))))
   (progn
     (setq i 0)
     (while (setq ent (ssname ss i))
(setq i (1+ i))
(if (= (getpropertyvalue ent "LocalizedName")
       "Référence de bloc"
    )
  (progn
    (setq insPt (getpropertyvalue ent "Position"))
    (setpropertyvalue
      ent
      "Position"
      (list (car inspt) (cadr insPt) 0.0)
    )
  )
  (setpropertyvalue ent "Elevation" 0.0)
)
     )
   )
 )

 

Une dernière en utilisant "Visual LISP"

 

(if (ssget "_X" '((0 . "INSERT,LWPOLYLINE")))
   (progn
     (vlax-for	obj (setq ss (vla-get-ActiveSelectionSet
		       (vla-get-ActiveDocument
			 (vlax-get-acad-object)
		       )
		     )
	    )
(if (= (vla-get-ObjectName obj) "AcDbBlockReference")
  (progn
    (setq insPt (vlax-get obj 'InsertionPoint))
    (vla-put-InsertionPoint
      obj
      (vlax-3d-point (list (car insPt) (cadr insPt) 0.0))
    )
  )
  (vla-put-Elevation obj 0.0)
)
     )
     (vla-Delete ss)
   )
 )

[DenisHen]

Bonjour (gile), et merci pour cette réponse...

 

Je vais préférer ton premier code qui est à ma portée, car les deux autres vont crescendo dans la difficulté pour moi...

 

Merci encore...

[DenisHen]

J'ai "forcément" un problème... Rassure-toi tout de suite, il vient de moi... :unsure:

 

Mon code va juste qu'à la fin et mes blocs sont bien à Z = 0, mais les élévations des LWpolyline sont restés comme avant...

 

Voici ce code :

  (ade_projsetwscode "NTF.Lambert-E")
 (setq ss nil)
 (princ
   "\nRemplissage des données géographiques des nouveaux blocs..............................................\n"
 ) ;_ Fin de princ
 (if (setq ss (ssget "_X" (list (cons 0 "INSERT,LWPOLYLINE"))))
   (progn
     (setq i 0)
     (while (setq ent (ssname ss i))
       (setq i (1+ i))
       (if (= (cdr (assoc 0 elst)) "INSERT")
         (progn
           (setq dxf10 (assoc 10 elst))
           (entmod (subst (list 10 (cadr dxf10) (caddr dxf10) 0.0) dxf10 elst))
           (setq att   (entget (entnext ent))
                 elst  (entget ent)
                 Coord (cdr (assoc 10 elst))
           ) ;_ Fin de setq
           (ade_projsetsrc (ade_projgetwscode))
           (ade_projsetdest "LL-RGF93")
           (setq pntLLRGF93 (ade_projptforward Coord))
           (while (/= (cdr (assoc 0 att)) "SEQEND")
             (if (= (cdr (assoc 2 att)) "X")
               (progn (setq att (subst (cons 1 (rtos (car pntLLRGF93) 2 15)) (assoc 1 att) att))
                      (entmod att)
               ) ;_ Fin de progn
             ) ;_ Fin de if
             ;.............. Je te passe les autres lignes              
             (setq att (entget (entnext (cdr (assoc -1 att)))))
           ) ;_ Fin de while
         ) ;_ Fin de progn
         (entmod (subst (cons 38 0.0) (assoc 38 elst) elst))
       ) ;_ Fin de if
     ) ;_ Fin de while
   ) ;_ Fin de progn
 ) ;_ Fin de if

Je cherche mais je ne trouve rien...

 

Pourtant, ça fonctionne très bien :

  (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
   (progn (setq i 0)
          (while (setq ent (ssname ss i))
            (setq i    (1+ i)
                  elst (entget ent)
            ) ;_ Fin de setq
            (entmod (subst (cons 38 0.0) (assoc 38 elst) elst))
          ) ;_ Fin de while
   ) ;_ Fin de progn
 ) ;_ Fin de if

Et merci encore, Denis...

[(gile)]

J'en vois au moins une énorme : tu fais (setq dxf10 (assoc 10 elst)) avant d'avoir fait (setq elst ...).

 

Et déclare bien tes variables pour les ré-initialiser.

[DenisHen]

Rôôôô... Honte à moi... :unsure:

 

En plus, quelques lignes plus bas, je le fais...

 

Quel âne je suis...

 

Ok pour la déclaration des variables, j'oublie toujours de faire "propre"...

 

Encore merci...

[DenisHen]

Par contre, je viens de m'apercevoir d'un truc bizarre...

 

Les attributs à l'intérieur des blocs sont restés à leur altitudes premières... :o

 

Mes attributs ont donc une altitude alors que le bloc est à 0...

 

J'ai raté un truc ?

[(gile)]

Si la position des attributs n'est pas verrouillée, c'est normal, il faut aussi les déplacer en Z = 0.

 

PS: la déclaration des variable, c'est pas seulement pour faire propre c'est aussi pour éviter des comportements imprévus (bugs) difficilement localisables.

[DenisHen]

Si la position des attributs n'est pas verrouillée, c'est normal, il faut aussi les déplacer en Z = 0.

Merci (gile) pour cette réponse.

 

Le plus simple, je pense, serait de les "verrouiller" avant la réaffectation de leurs coordonnées (avec le nouveau Z à 0), mais je ne sais pas comment...

 

Aurais-tu une idée ?

 

PS: la déclaration des variable, c'est pas seulement pour faire propre c'est aussi pour éviter des comportements imprévus (bugs) difficilement localisables.

J'ai compris en te lisant que c'est surtout une question de "sécurité"...

 

Denis...

[DenisHen]

J'ai trouvé un LISP de Patrick_35 mais je ne le comprend pas :

  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vlax-for bl (vla-get-blocks doc)
   (vlax-for ent bl
     (if (eq (vla-get-objectname ent) "AcDbAttributeDefinition")
       (vla-put-lockposition ent :vlax-false)
     ) ;_ Fin de if
   ) ;_ Fin de vlax-for
 ) ;_ Fin de vlax-for
 (if (ssget "x" (list (cons 0 "insert") (cons 66 1)))
   (progn (vlax-for bl (setq sel (vla-get-activeselectionset doc))
            (foreach ent (vlax-invoke bl 'getattributes)
              (setq att (entget (vlax-vla-object->ename ent))
                    att (subst (cons 280 0) (assoc 280 att) att)
              ) ;_ Fin de setq
              (entmod att)
            ) ;_ Fin de foreach
          ) ;_ Fin de vlax-for
          (vla-delete sel)
   ) ;_ Fin de progn
 ) ;_ Fin de if

Si quelqu'un a ça en AutoLisp... Je suis preneur...

[(gile)]

Le plus simple, je pense, serait de les "verrouiller" avant la réaffectation de leurs coordonnées (avec le nouveau Z à 0), mais je ne sais pas comment...

Je ne suis vraiment pas sûr que ce soit le plus simple en plus, je crains d'avoir dit une bêtise, ça n'a rien à voir avec verrouillé ou pas.

Ce qu'on appelle généralement "attribut de bloc" est en fait une référence d'attribut qui n'est qu'une référence à une définition d'attribut (comme pour les références et définitions de bloc). Les attributs ne sont pas proprement parlé des composants du bloc comme les autres entités qui le composent. Quand on programme avec les listes DXF, le programme doit s'occuper de traiter les attributs de blocs séparément (les insérer quand on insère un bloc par exemple) et dons les déplacer quand on déplace le bloc.

 

Une méthode consisterait à appeler la commande ATTSYNC sur tous les blocs, mais comme tu accèdes aux attributs dans ton code, tu peux très bien les déplacer à ce moment là.

 

Tu peux utiliser une sous routine qui te servira à déplacer aussi bien un bloc que ces attributs en lui passant la liste DXF du bloc ou de l'attribut. Comme les attributs peuvent être justifiés il faut aussi traiter le groupe DXF 11,.

La routine suivante peut donc servir pour toutes les entités dont la position est déterminée par le groupe DXF 10 comme les points, les cercles, les références de bloc et/ou par le groupe 11 comme les textes, les attributs, les lignes.

 

(defun z0 (elst / flat dxf10 dxf11)
 (defun flat (dxf)
   (list (car dxf) (cadr dxf) (caddr dxf) 0.0)
 )
 (if (setq dxf11 (assoc 11 elst))
   (setq elst (subst (flat dxf11) dxf11 elst))
 )
 (setq dxf10 (assoc 10 elst))
 (entmod (subst (flat dxf10) dxf10 elst))
)

 

Tu appelles cete routine pour déplacer le bloc, puis les attributs

 

          (progn
           (z0 elst)
           (setq att   (entget (entnext ent))
                 Coord (cdr (assoc 10 elst))
           ) ;_ Fin de setq
           (ade_projsetsrc (ade_projgetwscode))
           (ade_projsetdest "LL-RGF93")
           (setq pntLLRGF93 (ade_projptforward Coord))
           (while (/= (cdr (assoc 0 att)) "SEQEND")
      (z0 att)
             (if (= (cdr (assoc 2 att)) "X")
               (progn (setq att (subst (cons 1 (rtos (car pntLLRGF93) 2 15)) (assoc 1 att) att))
                      (entmod att)
               ) ;_ Fin de progn
             ) ;_ Fin de if
             ;.............. Je te passe les autres lignes              
             (setq att (entget (entnext (cdr (assoc -1 att)))))
           ) ;_ Fin de while
         ) ;_ Fin de progn

 

PS: en appelant la commande DEPLACER (_MOVE) pour chacun des blocs on aurait pas eu besoin de faire tout ça mais tu aurais appris beaucoup moins...

[Patrick_35]

Salut

 

Un exemple qui passe en revue les attributs d'un sélection de blocs en autolisp

(if (setq js (ssget "_x" (list (cons 0 "insert"))))
 (progn
   (setq n 0)
   (while (setq ent (ssname js n))
     (setq ent (entget ent)
    n (1+ n)
     )
     (if (= (cdr (assoc 66 ent)) 1)
(progn
  (setq sub (entget (entnext (cdr (assoc -1 ent)))))
  (while (/= (cdr (assoc 0 sub)) "SEQEND")
    (if (eq (cdr (assoc 0 sub)) "ATTRIB")
      (progn
	(princ "\nC'est un attribut")
      )
    )
    (setq sub (entget (entnext (cdr (assoc -1 sub)))))
  )
)
     )
   )
 )
)

 

@+

[DenisHen]

Mille merci (gile) pour ton aide précieuse...

 

Je n'arrive pas à faire fonctionner ton z0 et comme je ne le comprend pas à 100% (mais j'ai déjà pas mal appris aujourd'hui) j'ai préféré la méthode (command "_move" que je maitrise mieux...:

;;;Déplacement des blocs à l'altitude 0************
 (princ "\nDéplacement des blocs à l'altitude 0..............")
 (setq ss nil)
 (if (setq ss (ssget "_X" '((0 . "INSERT"))))
   (progn (setq i 0)
          (while (setq ent (ssname ss i))
            (setq i         (1+ i)
                  elst      (entget ent)
                  Coord     (cdr (assoc 10 elst))
                  CoordSrc  (strcat (rtos (car Coord) 2 3)
                                    ","
                                    (rtos (cadr Coord) 2 3)
                                    ","
                                    (rtos (caddr Coord) 2 3)
                            ) ;_ Fin de strcat
                  CoordDest (strcat (rtos (car Coord) 2 3) "," (rtos (cadr Coord) 2 3) ",0.00")
            ) ;_ Fin de setq
            (command "_move" ent "" "_non" CoordSrc "_non" CoordDest)
          ) ;_ Fin de while
   ) ;_ Fin de progn
 ) ;_ Fin de if

Pour ceux que ça peut intéresser...

 

Et merci Patrick_35, c'est plus à ma portée...

 

Denis... Très reconnaissant envers CadXP et ses membres...

[(gile)]

Avec DEPLACER, tu peux faire plus simple.

Pas besoin de construire de chaînes de caractère pour spécifier les points et avec l'option "Déplacement" ("_Displacement") tu n'as qu'un vecteur à spécifier (pas de problème d'accrochage aux objets).

 

;;;Déplacement des blocs à l'altitude 0************
 (princ "\nDéplacement des blocs à l'altitude 0..............")
 (if (setq ss (ssget "_X" '((0 . "INSERT"))))
   (progn (setq i 0)
          (while (setq ent (ssname ss i))
            (setq i         (1+ i)
                  elst      (entget ent)
                  coordZ    (cadddr (assoc 10 elst))
            ) ;_ Fin de setq
            (command "_move" ent "" "_displacement" (list 0 0 (- coordZ)))
          ) ;_ Fin de while
   ) ;_ Fin de progn
 ) ;_ Fin de if

[DenisHen]

Alors là, chapeau... Je ne connaissais pas du tout cette astuce...

 

Encore merci (gile)...

 

Et pour ceux que ça peut intéresser, voici un code qui place tous les blocs à l'altitude 0 et place les élévations des polylignes (LW) à 0 :

;;;Déplacement des blocs à l'altitude 0 et les élévations à 0 ************
 (princ "\nDéplacement des blocs à l'altitude 0 et des élévation à 0..............")
 (setq ss nil)
 (if (setq ss (ssget "_X" '((0 . "INSERT,LWPOLYLINE"))))
   (progn (setq i 0)
          (while (setq ent (ssname ss i))
            (setq i      (1+ i)
                  elst   (entget ent)
                  CoordZ (cadddr (assoc 10 elst))
            ) ;_ Fin de setq
            (cond ((= (cdr (assoc 0 elst)) "INSERT")
                   (command "_move" ent "" "_displacement" (list 0 0 (- CoordZ)))
                  )
                  ((= (cdr (assoc 0 elst)) "LWPOLYLINE")
                   (entmod (subst (cons 38 0.0) (assoc 38 elst) elst))
                  )
            ) ;_ Fin de cond
          ) ;_ Fin de while
   ) ;_ Fin de progn
 ) ;_ Fin de if

Encore un grand merci à tous...

 

Denis...