Est ce possible ?

chris_mtp · le 7 novembre 2009

Bonjour à tous,

Je ne sais pas si c'est possible mais bon, ...

J'ai fait un petit dcl qui liste le nom des calques et des blocs d'un dessin.

L'utilisateur avec des popup choisit le calque et le nom du bloc à traiter.

Voici le dcl :

(defun ssDialog (/ tmp file dcl_id result lstc lstb lst1 lst2 lst lay nom_lay bloc nom_bloc)

;; créer un fichier temporaire et l'ouvrir en écriture
(setq tmp  (vl-filename-mktemp "tmp.dcl")
     file (open tmp "w"))

;; écrire dans le fichier

(write-line (strcat "SpecialInputBox:dialog {
 label = \"LISTING ATTRIBUTS D'UN PLAN\";
 initial_focus = \"lst1\";
 :row{
   fixed_width = true;
  :popup_list {
   key = \"lst1\";
   label = \"CALQUE\";
   edit_width = 13;
 }
 :popup_list {
   key = \"lst2\";
   label = \"BLOC\";
   edit_width = 13;
 }}
 :row{
           fixed_width = true;
           alignment = centered;
          :button{
            label=\"Sélectionner\";
            key=\"ss\";
            edit_width=4;
            fixed_width = true;
          }
          :button{
            label=\"Lister\";
            key=\"li\";
            edit_width=4;
            fixed_width = true;
          }
          :button{
            label=\"Zoom\";
            key=\"zo\";
            edit_width=4;
            fixed_width = true;
          }
          :button{
            label=\"Export\";
            key=\"ex\";
            edit_width=4;
            fixed_width = true;
          }}
 spacer;
 ok_cancel;
}
")
file
)

;; fermer le fichier
(close file)

;; charger le fichier
(setq dcl_id (load_dialog tmp))

;; Appeler la boite de dialogue
(if (not (new_dialog "SpecialInputBox" dcl_id))
(exit)
)

;;; initialisation de la boite
(while 
(setq lay (tblnext "LAYER" (not lay)))
(setq nom_lay (cdr (assoc 2 lay)))
(setq lstc (cons nom_lay lstc))
)


(while 
(setq blo (tblnext "BLOCK" (not blo)))
(setq nom_bloc (cdr (assoc 2 blo)))
(setq lstb (cons nom_bloc lstb))
)

(setq lstb (reverse lstb))

;; initialiser la liste 1
(start_list "lst1")
(mapcar 'add_list lstc)
(end_list)

;; initialiser la liste 2
(start_list "lst2")
(mapcar 'add_list lstb)
(end_list)

;; action si l'utilisateur clique "OK" :
;; lst = liste des entrées et fermeture de la boite
(action_tile
"accept"
"(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog)"
)

;; afficher la boite de dialogue
(start_dialog)
;; décharger la boite de dialogue
(unload_dialog dcl_id)
;; supprimer le fichier
(vl-file-delete tmp)
lst
)

(defun c:ss1 ( / lst noml nomb ss)
(setq lst (ssDialog))
(setq noml (nth 0 lst))
(setq nomb (nth 1 lst))
(if (= (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 nomb) (cons 8 noml)))) nil)
(alert "\nPas de blocs dans le calque sélectionné ")
(prompt (strcat "\nNombre de bloc " nomb " dans le calque " noml " = " (itoa (sslength ss))))
)
(prin1)
)

Avec les boutons, Lister, est il possible dans le boite de dialogue dcl elle-même d'afficher sous forme de tableau les blocs à lister avec pour le tableau une première colonne index, trois colonnes pour les coordonnées d'insertion du bloc et ensuite la liste des attributs.

Donc si j'ai dans mon dessin 3 blocs de même nom, ce bloc comportant 4 attributs, le tabelau à l'intérieur de la dcl comportera 8 colonnes.

Le tableau doit être incorporer dans le dcl pour pouvoir aussi utiliser le bouton zoomer.

Si vous avez des idées ou des pistes, merci par avance.

John

chris_mtp · le 8 novembre 2009

Salut,

Comment faire quand la boite de dialogue s'affiche et quand j'active la sélection dans on dessin pour que les valeurs dans mes deux popup sélectionnés avant d'appuyer sur le bouton "Activer Sélection" Soit encore active ?

De plus, j'ai un autre problème car ma sélection ne s'active que si la boite de dialogue est fermée or je voudrais que la sélection se fasse dynamiquement, est ce possible ?

Et de plus, pour afficher la liste de tous les blocs d'un même calque en dessous la série des 4 boutons, avez vous une idée ??

Merci par avance de votre aide.

Voici le dcl que j'ai modifié mais encore des soucis ...

 (defun ssDialog (/ tmp file dcl_id result lstc lstb lst1 lst2 lst lay nom_lay bloc nom_bloc ss li zo ext)
(vl-load-com)
;; créer un fichier temporaire et l'ouvrir en écriture
(setq tmp  (vl-filename-mktemp "tmp.dcl")
     file (open tmp "w"))

;; écrire dans le fichier

(write-line (strcat "SpecialInputBox:dialog {
 label = \"LISTING ATTRIBUTS et BLOCS D'UN PLAN\";
 initial_focus = \"lst1\";
 :row{
   fixed_width = true;
  :popup_list {
   key = \"lst1\";
   label = \"CALQUE\";
   edit_width = 13;
 }
 :popup_list {
   key = \"lst2\";
   label = \"BLOC\";
   edit_width = 13;
 }}
 :row{
           fixed_width = true;
           alignment = centered;
          :button{
            label=\"Activer Sélection\";
            key=\"ss\";
            edit_width=5;
            fixed_width = true;
          }
          :button{
            label=\"Lister\";
            key=\"li\";
            edit_width=4;
            fixed_width = true;
          }
          :button{
            label=\"Zoom\";
            key=\"zo\";
            edit_width=4;
            fixed_width = true;
          }
          :button{
            label=\"Export\";
            key=\"ext\";
            edit_width=4;
            fixed_width = true;
          }}
 spacer;
 ok_cancel;
}
")
file
)

;; fermer le fichier
(close file)

;; charger le fichier
(setq dcl_id (load_dialog tmp)
     loop 2)


(while 
(setq lay (tblnext "LAYER" (not lay)))
(setq nom_lay (cdr (assoc 2 lay)))
(setq lstc (cons nom_lay lstc))
)


(while 
(setq blo (tblnext "BLOCK" (not blo)))
(setq nom_bloc (cdr (assoc 2 blo)))
(setq lstb (cons nom_bloc lstb))
)
(setq lstb (reverse lstb))


(while (< 1 loop)
(if (not (new_dialog "SpecialInputBox" dcl_id))
(exit)
)


;; initialiser la liste 1
(start_list "lst1")
(mapcar 'add_list lstc)
(end_list)
;; initialiser la liste 2
(start_list "lst2")
(mapcar 'add_list lstb)
(end_list)






;; action si l'utilisateur clique "OK" :
;; lst = liste des entrées et fermeture de la boite
(action_tile
"accept"
"(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 1)"
)

(action_tile "ss" "(done_dialog 3)")
(action_tile "ext" "(done_dialog 6)")

;; afficher la boite de dialogue
(setq loop (start_dialog))

(cond
((= loop 1) 
(if (= (setq ss (ssget "X" (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst))))) nil)
(prompt "\nPas de blocs dans le calque sélectionné ")
(prompt (strcat "\nNombre de bloc " (nth 1 lst) " dans le calque " (nth 0 lst) " = " (itoa (sslength ss))))
)
)

((= loop 3)
(setq lst (ssDialog))
(sssetfirst nil (ssget "X" (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst)))))


)


)

)




;; décharger la boite de dialogue
(unload_dialog dcl_id)
;; supprimer le fichier
(vl-file-delete tmp)
lst
)




(defun c:sa1 ( / lst)
(prompt "\nRECAPITULATIF ATTRIBUTS et BLOCS D'UN PLAN")
(setq lst (ssDialog))

(prin1)
)

John

chris_mtp · le 13 novembre 2009

Bonjour Gile

Peux tu m'aider pour faire ce lisp car j'en ai réellement besoin ?

Peut être que mes demandes sont confuses mais j'ai seulement deux questions pour le moment, le reste je pense que je peux m'en sortir mais la je suis bloqué depuis une semaine.

Voici mes deux questions à partir du lisp posté en réponse 1

Comment faire quand la boite de dialogue s'affiche et quand je clique sur le bouton Activer Sélection pour que les valeurs dans mes deux popup sélectionnés soit les mêmes que quand la boite de dialogue s'affiche à nouveau ?

Les listes se réinitialisent et je ne sais pas comment contourner ce problème ?

De plus, j'ai un autre problème car ma sélection ne s'active que si la boite de dialogue est fermée or je voudrais que la sélection se fasse dynamiquement, est ce possible ?

Merci par avance de ton aide.

John

(gile) · le 14 novembre 2009

Salut

Comment faire quand la boite de dialogue s'affiche et quand je clique sur le bouton Activer Sélection pour que les valeurs dans mes deux popup sélectionnés soit les mêmes que quand la boite de dialogue s'affiche à nouveau ?

en uilisant la fonction set_tile avec le contenu de ta variable lst.

Comme à la première ouverture de la BD, lst est nil, il faut faire :

(if lst
 (progn
   (set_tile "lst1" (itoa (car lst)))
   (set_tile "lst2" (itoa (cadr lst)))
 )
)

chris_mtp · le 14 novembre 2009

Bonjour Gilles,

Voici le code que j'ai pu faire mais rien à faire, toujours les valeurs intiales dans les deux popup malgré l'ajout de tes lignes de codes

Je pense qu'il doit y avoir un problème avec les radio_boutons

Si tu as 2 min pour y jeter un oeil merci par avance.

 (defun ssDialog (/      tmp    file   dcl_id result lstc   lstb   lst1   lst2
                lb1    lst    lay    nom_lay       bloc   nom_bloc      ss
                li     zo     ext1   ext2   lst3
               )
 (vl-load-com)
 ;; créer un fichier temporaire et l'ouvrir en écriture
 (setq tmp  (vl-filename-mktemp "tmp.dcl")
       file (open tmp "w")
 )

 ;; écrire dans le fichier
 (write-line
   (strcat
     "SpecialInputBox:dialog {
 label = \"LISTING ATTRIBUTS ET BLOCS D'UN PLAN\";
 initial_focus = \"lst1\";
 :row{
   alignment = centered;
   fixed_width = true;
  :popup_list {
   key = \"lst1\";
   label = \"CALQUE\";
   edit_width = 15;
 }
 :popup_list {
   key = \"lst2\";
   label = \"BLOC\";
   edit_width = 15;
 }}
 :row{
           fixed_width = true;
           alignment = centered;
          :button{
            label=\"Activer Sélection\";
            key=\"ss\";
            edit_width = 4;
          }
          :button{
            label=\"Lister\";
            key=\"li\";
            edit_width=3;
          }
          :button{
            label=\"Zoom\";
            key=\"zo\";
            edit_width=3;
          }
          :button{
            label=\"Export .txt\";
            key=\"ext1\";
            edit_width=4;
          }
          :button{
            label=\"Export .xls\";
            key=\"ext2\";
            edit_width=4;
          }}
          
: list_box {
  key=\"lb1\";	
  label=\"Listing Attributs\";
  allow_accept = true;
  height = 15;
  width = 70;
}
 
 spacer;
 ok_cancel;
}
"   )
   file
 )

 ;; fermer le fichier
 (close file)

 (while
   (setq lay (tblnext "LAYER" (not lay)))
    (setq nom_lay (cdr (assoc 2 lay)))
    (setq lstc (cons nom_lay lstc))
 )
 (setq lstc (vl-sort lstc '<))

 (while
   (setq blo (tblnext "BLOCK" (not blo)))
    (setq nom_bloc (cdr (assoc 2 blo)))
    (setq lstb (cons nom_bloc lstb))
 )
 (setq lstb (vl-sort lstb '<))

 ;; charger le fichier
 (setq dcl_id (load_dialog tmp))
 (setq loop 2)

 (while (< 1 loop)
   (if (not (new_dialog "SpecialInputBox" dcl_id))
     (exit)
   )

   ;; initialiser la liste 1
   (start_list "lst1")
   (mapcar 'add_list lstc)
   (end_list)

   ;; initialiser la liste 2
   (start_list "lst2")
   (mapcar 'add_list lstb)
   (end_list)

   (if lst
     (progn
       (set_tile "lst1" (itoa (car lst)))
       (set_tile "lst2" (itoa (cadr lst)))
     )
   )

   ;; action si l'utilisateur clique "OK" :
   ;; lst = liste des entrées et fermeture de la boite
   (action_tile
     "accept"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 1)"
   )

   (action_tile "ss" "(done_dialog 3)")
   (action_tile "ext" "(done_dialog 6)")

   ;; afficher la boite de dialogue
   (setq loop (start_dialog))

   (cond
     ((= loop 1)
      (if (= (setq ss1 (ssget "X"
                              (list (cons 0 "INSERT")
                                    (cons 2 (nth 1 lst))
                                    (cons 8 (nth 0 lst))
                              )
                       )
             )
             nil
          )
        (prompt "\nPas de blocs dans le calque sélectionné ")
        (prompt (strcat "\nNombre de bloc "
                        (nth 1 lst)
                        " dans le calque "
                        (nth 0 lst)
                        " = "
                        (itoa (sslength ss1))
                )
        )
      )
     )

     ((= loop 3)
      (setq lst (ssDialog))
      (sssetfirst
        nil
        (ssget
          "X"
          (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst)))
        )
      )
     )


   )

 )

 ;; décharger la boite de dialogue
 (unload_dialog dcl_id)
 ;; supprimer le fichier
 (vl-file-delete tmp)
 lst
)

(defun c:sa1 (/ lst)
 (prompt "\nRECAPITULATIF ATTRIBUTS ET BLOCS D'UN PLAN")
 (setq lst (ssDialog))
 (prin1)
)

John

(gile) · le 14 novembre 2009

Remplace :

(setq lstc (vl-sort lstc '

par :
[code](setq lstb (vl-sort lstb '        lay  "0"
       blk  "0"
 )

chris_mtp · le 14 novembre 2009

Merci Gile pour ton aide.

J'ai pu m'en sortir en modifiant le code selon tes indications mais dernière petite question avant de finaliser le lisp

Dans une list_box, on ne peut pas définir des entêtes de colonnes avec comme titre de ces entêtes les étiquettes des attributs des blocs sélectionnés ?

Voici le lisp déjà réalisé qui peut être très utile dans certains cas

(defun ssDialog (/      tmp    file   lst1   lst2   ss     li     zo     ext1
                ext2   lb1    lstp   lay    nom_lay       lstc   blo
                nom_bloc      lstb   blk    dcl_id loop   lst    ss     ss1
                i      ent    i      blks   coord  layi   elst   etyp   attlist
               )
 (vl-load-com)
 ;; créer un fichier temporaire et l'ouvrir en écriture
 (setq tmp  (vl-filename-mktemp "tmp.dcl")
       file (open tmp "w")
 )

 ;; écrire dans le fichier

 (write-line
   (strcat
     "SpecialInputBox:dialog {
 label = \"LISTING ATTRIBUTS ET BLOCS D'UN PLAN\";
 initial_focus = \"lst1\";
 :row{
   alignment = centered;
   fixed_width = true;
  :popup_list {
   key = \"lst1\";
   label = \"CALQUE\";
   edit_width = 15;
 }
 :popup_list {
   key = \"lst2\";
   label = \"BLOC\";
   edit_width = 15;
 }}
 :row{
           fixed_width = true;
           alignment = centered;
          :button{
            label=\"Activer Sélection\";
            key=\"ss\";
            edit_width = 4;
          }
          :button{
            label=\"Lister\";
            key=\"li\";
            edit_width=3;
          }
          :button{
            label=\"Zoom\";
            key=\"zo\";
            edit_width=3;
          }
          :button{
            label=\"Export .txt\";
            key=\"ext1\";
            edit_width=4;
          }
          :button{
            label=\"Export .xls\";
            key=\"ext2\";
            edit_width=4;
          }}
          
: list_box {
  key=\"lb1\";	
  label=\"Listing Attributs\";
  allow_accept = true;
  height = 15;
  width = 70;
}
 
 spacer;
 ok_cancel;
}
"   )
   file
 )

 ;; fermer le fichier
 (close file)

 (setq lstp nil)


 (while
   (setq lay (tblnext "LAYER" (not lay)))
    (setq nom_lay (cdr (assoc 2 lay)))
    (setq lstc (cons nom_lay lstc))
 )
 (setq lstc (vl-sort lstc '<))

 (while
   (setq blo (tblnext "BLOCK" (not blo)))
    (setq nom_bloc (cdr (assoc 2 blo)))
    (setq lstb (cons nom_bloc lstb))
 )
 (setq lstb (vl-sort lstb '<))
 (setq lay "0")
 (setq blk "0")


 ;; charger le fichier
 (setq dcl_id (load_dialog tmp))
 (setq loop 2)

 (while (< 1 loop)
   (if (not (new_dialog "SpecialInputBox" dcl_id))
     (exit)
   )


   ;; initialiser la liste 1
   (start_list "lst1")
   (mapcar 'add_list lstc)
   (end_list)

   ;; initialiser la liste 2
   (start_list "lst2")
   (mapcar 'add_list lstb)
   (end_list)

   (start_list "lb1")
   (mapcar 'add_list lstp)
   (end_list)

   (set_tile "lst1" lay)
   (set_tile "lst2" blk)
   (action_tile "lst1" "(setq lay $value)")
   (action_tile "lst2" "(setq blk $value)")



   ;; action si l'utilisateur clique "OK" :
   ;; lst = liste des entrées et fermeture de la boite
   (action_tile
     "accept"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 1)"
   )

   (action_tile
     "ss"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 3)"
   )

   (action_tile
     "li"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 4)"
   )



   (action_tile
     "zo"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
(atoi (get_tile \"lb1\"))
))
(done_dialog 5)"
   )

   (action_tile
     "ext1"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 6)"
   )

   (action_tile
     "ext2"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 7)"
   )

   ;; afficher la boite de dialogue
   (setq loop (start_dialog))

   (cond

     ((= loop 1)
      (if (= (setq ss (ssget "X"
                             (list (cons 0 "INSERT")
                                   (cons 2 (nth 1 lst))
                                   (cons 8 (nth 0 lst))
                             )
                      )
             )
             nil
          )
        (prompt "\nPas de blocs dans le calque sélectionné ")
        (prompt (strcat "\nNombre de bloc "
                        (nth 1 lst)
                        " dans le calque "
                        (nth 0 lst)
                        " = "
                        (itoa (sslength ss))
                )
        )
      )
     )

     ((= loop 3)
      (sssetfirst
        nil
        (ssget
          "X"
          (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst)))
        )
      )
     )

     ((= loop 4)
      (setq lstp nil)
      (setq ss1 (ssget "X"
                       (list (cons 0 "INSERT")
                             (cons 2 (nth 1 lst))
                             (cons 8 (nth 0 lst))
                       )
                )
      )
      (if (= ss1 nil)
        (prompt "\nPas de blocs dans sélection")
        (progn
          (setq i 0)
          (repeat (sslength ss1)
            (setq ent (ssname ss1 i))
            (setq lstp (cons (lst2strg (atts_to_list ent) " - ") lstp))
            (setq i (1+ i))
          )
          (setq lstp (reverse lstp))
          (setq lstp (subst "Pas d'attributs pour ce bloc" "nil" lstp))
        )
      )
     )

     ((= loop 5)
      (setq ss1 (ssget "X"
                       (list (cons 0 "INSERT")
                             (cons 2 (nth 1 lst))
                             (cons 8 (nth 0 lst))
                       )
                )
      )
      (if (= ss1 nil)
        (prompt "\nPas de blocs dans sélection")
        (progn
          (setq blks (ssname ss1 (nth 2 lst)))
          (setq ent (entget blks))
          (setq coord (cdr (assoc 10 ent)))
          (command "_zoom" "c" coord 20)
          (setq layi (getvar "CLAYER"))
          (setvar "CLAYER" "0")
          (setvar "CECOLOR" "3")
          (command "_text" "bc" coord 5 100 (rtos (nth 2 lst) 2 0))
          (setvar "CECOLOR" "DUCALQUE")
          (setvar "CLAYER" layi)
        )
      )
     )

     ((= loop 6)
      (prompt "\nSélection des blocs/attributs à lister dans fichier .txt")
      (setq ss
             (ssget
               "X"
               (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst)))
             )
      )
      (if (= ss nil)
        (progn
          (prompt "\nPas de blocs sélectionnés")
          (exit)
        )
        (progn
          (setq file (open "C:/txtatt.txt" "w"))
          (write-line
            (strcat "Index" " " "X" " " "Y" " " "Z" " " "Bloc" "  " "Calque")
            file
          )
          (setq i 0)
          (repeat (sslength ss)
            (setq ent (ssname ss i))
            (setq elst (entget ent))
            (setq etyp (cdr (assoc 0 elst)))
            (if (= etyp "INSERT")
              (progn
                (setq coord (cdr (assoc 10 elst)))
                (if (assoc 66 elst)
                  (progn
                    (setq attlist (lst2strg (atts_to_list ent) "  "))
                    (write-line (strcat (rtos i 2 0)
                                        " "
                                        (rtos (car coord) 2 3)
                                        " "
                                        (rtos (cadr coord) 2 3)
                                        " "
                                        (rtos (caddr coord) 2 3)
                                        " "
                                        (nth 1 lst)
                                        "  "
                                        (nth 0 lst)
                                        "  "
                                        attlist
                                )
                                file
                    )
                  )
                  (write-line (strcat (rtos i 2 0)
                                      " "
                                      (rtos (car coord) 2 3)
                                      " "
                                      (rtos (cadr coord) 2 3)
                                      " "
                                      (rtos (caddr coord) 2 3)
                                      " "
                                      (nth 1 lst)
                                      "  "
                                      (nth 0 lst)
                                      "  "
                                      "Ce bloc ne contient aucun attributs"
                              )
                              file
                  )
                )
              )
            )
            (setq i (+ i 1))
          )
          (close file)
          (command "_.shell" "start notepad C:\\txtatt.txt")
        )
      )
     )

     ((= loop 7)
      (prompt "\nSélectionner les blocs/attributs à lister dans fichier .xls")
      (setq ss
             (ssget
               "X"
               (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst)))
             )
      )
      (if (= ss nil)
        (progn
          (prompt "\nPas de blocs sélectionnés")
          (exit)
        )
        (progn
          (setq file (open "C:/xlsatt.xls" "w"))

          (write-line (strcat "Index" "\t" "X" "\t" "Y" "\t" "Z" "\t" "Bloc"
                              "\t" "Calque")
                      file
          )
          (setq i 0)
          (repeat (sslength ss)
            (setq ent (ssname ss i))
            (setq elst (entget ent))
            (setq etyp (cdr (assoc 0 elst)))
            (if (= etyp "INSERT")
              (progn
                (setq coord (cdr (assoc 10 elst)))
                (if (assoc 66 elst)
                  (progn
                    (setq attlist (lst2strg (atts_to_list ent) "\t"))
                    (write-line (strcat (rtos i 2 0)
                                        "\t"
                                        (rtos (car coord) 2 3)
                                        "\t"
                                        (rtos (cadr coord) 2 3)
                                        "\t"
                                        (rtos (caddr coord) 2 3)
                                        "\t"
                                        (nth 1 lst)
                                        "\t"
                                        (nth 0 lst)
                                        "\t"
                                        attlist
                                )
                                file
                    )
                  )
                  (write-line (strcat (rtos i 2 0)
                                      "\t"
                                      (rtos (car coord) 2 3)
                                      "\t"
                                      (rtos (cadr coord) 2 3)
                                      "\t"
                                      (rtos (caddr coord) 2 3)
                                      "\t"
                                      (nth 1 lst)
                                      "\t"
                                      (nth 0 lst)
                                      "\t"
                                      "Ce bloc ne contient aucun attributs"
                              )
                              file
                  )
                )
              )
            )
            (setq i (+ i 1))
          )
          (close file)
          (OpenExcel "C:\\xlsatt.xls" nil T)
        )
      )
     )

   )

 )




 ;; décharger la boite de dialogue
 (unload_dialog dcl_id)
 ;; supprimer le fichier
 (vl-file-delete tmp)
 lst
)


(defun ATTS_TO_LIST (ENAM / X)
 (setq X (vlax-ename->vla-object ENAM))
 (if (= (cdr (assoc 66 (entget ENAM))) 1)
   (progn
     (mapcar '(lambda (X) (cons (vla-get-tagstring X) (vla-get-textstring X)))
             (vlax-safearray->list
               (variant-value (vla-getattributes (vlax-ename->vla-object ENAM)))
             )
     )
   )
 )
)

(defun c:sa7 (/ lst)
 (prompt "\nRECAPITULATIF ATTRIBUTS ET BLOCS D'UN PLAN")
 (setq lst (ssDialog))
 (prin1)
)

Certes, ce code n'est pas parfait mais il marche à peu près correctement.

Attention, je me sers de ta fonction lst2strg dans ce lisp qui doit être chargé dans Autocad avant le lancement du lisp.

Merci par avance de ton aide.

John

(gile) · le 14 novembre 2009

Dans une list_box, on ne peut pas définir des entêtes de colonnes avec comme titre de ces entêtes les étiquettes des attributs des blocs sélectionnés ?

Je ne suis pas sûr d'avoir compris, mais il ne me semble pas que ce soit possible.

Tu pourrais refaire la boite "à la volée" depuis le LISP en fonction des attributs du bloc choisi avec une list_box par attribut et un texte en en-tête, mais bon courage...

PS : S'il te plait, formate ton code dans l'éditeur avant de le poster (Ctrl+Alt+F) pour que le sujet reste lisible.

Je l'ai fait pour toi encore une fois, mais c'est la dernière...

PPS : Il semble que tu aies renommé la routine lst2str en lst2strg et tu ne l'as pas jointe au code...

chris_mtp · le 14 novembre 2009

Il ne faut pas plusieurs list_box mais une seule avec plusieurs colonnes

Ce que je demande, c'est

Peut-on réaliser en dcl une list_box un peu comme la boite de dialogue des calques d'un dessin AutoCAD avec une list_box contenant des colonnes avec entêtes comme Nom du Calque, Geler, Libérer ... ?

Si c'est possible, j'aimerais le faire, sinon, c'est pas grave.

Merci par avance pour ton aide.

John

(gile) · le 15 novembre 2009

C'est bien parce qu'à ma connaissance il n'est pas possible de faire ce que tu demandes en DCL*, que je te propose une alternative.

* Ça s'appelle un contrôle ListView et c'est faisable avec OpenDCL ou ObjectDCL, avec VBA, avec .NET etc...

chris_mtp · le 15 novembre 2009

Merci Gile mais le VBA et OpenDCL je ne connais pas du tout.

Si quelqu'un voudrait s'en occuper je suis preneur mais bon les fonctions développés dans le code correspondent à mon besoin.

Merci encore pour ton aide.

John.

lili2006 · le 15 novembre 2009

Bonjour à toutes et tous,

J'ai testé par curiosité, après avoir rajouté en fin de lisp =>

(defun lst2strg (lst sep)

(if (cadr lst)

(strcat (vl-princ-to-string (car lst))

sep

(lst2str (cdr lst) sep)

)

(vl-princ-to-string (car lst))

)

)

Et les fichiers Excel et/ou txt ne se génère pas !

Est-ce normal ou ais-je raté une étape ,

Merci d'avance,

(gile) · le 15 novembre 2009

Salut Lilian,

J'ai fait remarqué à John (chris_mtp) qu'il utilisait une fonction renommée sans en donner le code (et c'est pas sympa pour ceux qui voudraient tester son LISP mais ne savent pas comment résoudre ce problème).

2 solutions :

- soit ajouter au code de chris_mtp la fonction "originale" lst2str :

;; lst2str (gile)
;; Concatène une liste et un séparateur en une chaine
;;
;; Arguments
;; lst : la liste à transformer en chaine
;; sep : le séparateur

(defun lst2str (lst sep)
 (if (cdr lst)
   (strcat (vl-princ-to-string (car lst)) sep (lst2str (cdr lst) sep))
   (vl-princ-to-string (car lst))
 )
)

et remplacer dans le code tous les lst2strg par lst2str ;

- soit ajouter au code une fonction lst2strg (comme tu as fait) en remplaçant dans le code de la fonction originale tous les lst2str (et oui, il y en a 2, c'est fonction récursive) par lst2strg

(defun [surligneur]lst2strg[/surligneur] (lst sep)
 (if (cdr lst)
   (strcat (vl-princ-to-string (car lst)) sep ([surligneur]lst2strg[/surligneur] (cdr lst) sep))
   (vl-princ-to-string (car lst))
 )
)

lili2006 · le 15 novembre 2009

Re,

Salut Gilles,

Merci pour tes explications, je vais regarder ça,...

Bon dimanche,

lili2006 · le 15 novembre 2009

Re,

J'ai fait ça =>

(defun ssDialog (/      tmp    file   lst1   lst2   ss     li     zo     ext1

                ext2   lb1    lstp   lay    nom_lay       lstc   blo

                nom_bloc      lstb   blk    dcl_id loop   lst    ss     ss1

                i      ent    i      blks   coord  layi   elst   etyp   attlist

               )

 (vl-load-com)

 ;; créer un fichier temporaire et l'ouvrir en écriture

 (setq tmp  (vl-filename-mktemp "tmp.dcl")

       file (open tmp "w")

 )



 ;; écrire dans le fichier



 (write-line

   (strcat

     "SpecialInputBox:dialog {

 label = \"LISTING ATTRIBUTS ET BLOCS D'UN PLAN\";

 initial_focus = \"lst1\";

 :row{

   alignment = centered;

   fixed_width = true;

  :popup_list {

   key = \"lst1\";

   label = \"CALQUE\";

   edit_width = 15;

 }

 :popup_list {

   key = \"lst2\";

   label = \"BLOC\";

   edit_width = 15;

 }}

 :row{

           fixed_width = true;

           alignment = centered;

          :button{

            label=\"Activer Sélection\";

            key=\"ss\";

            edit_width = 4;

          }

          :button{

            label=\"Lister\";

            key=\"li\";

            edit_width=3;

          }

          :button{

            label=\"Zoom\";

            key=\"zo\";

            edit_width=3;

          }

          :button{

            label=\"Export .txt\";

            key=\"ext1\";

            edit_width=4;

          }

          :button{

            label=\"Export .xls\";

            key=\"ext2\";

            edit_width=4;

          }}

          

: list_box {

  key=\"lb1\";	

  label=\"Listing Attributs\";

  allow_accept = true;

  height = 15;

  width = 70;

}

 

 spacer;

 ok_cancel;

}

"   )

   file

 )



 ;; fermer le fichier

 (close file)



 (setq lstp nil)





 (while

   (setq lay (tblnext "LAYER" (not lay)))

    (setq nom_lay (cdr (assoc 2 lay)))

    (setq lstc (cons nom_lay lstc))

 )

 (setq lstc (vl-sort lstc '


 (while

   (setq blo (tblnext "BLOCK" (not blo)))

    (setq nom_bloc (cdr (assoc 2 blo)))

    (setq lstb (cons nom_bloc lstb))

 )

 (setq lstb (vl-sort lstb '
 (setq lay "0")

 (setq blk "0")





 ;; charger le fichier

 (setq dcl_id (load_dialog tmp))

 (setq loop 2)



 (while (
   (if (not (new_dialog "SpecialInputBox" dcl_id))

     (exit)

   )





   ;; initialiser la liste 1

   (start_list "lst1")

   (mapcar 'add_list lstc)

   (end_list)



   ;; initialiser la liste 2

   (start_list "lst2")

   (mapcar 'add_list lstb)

   (end_list)



   (start_list "lb1")

   (mapcar 'add_list lstp)

   (end_list)



   (set_tile "lst1" lay)

   (set_tile "lst2" blk)

   (action_tile "lst1" "(setq lay $value)")

   (action_tile "lst2" "(setq blk $value)")







   ;; action si l'utilisateur clique "OK" :

   ;; lst = liste des entrées et fermeture de la boite

   (action_tile

     "accept"

     "(setq lst (list

(nth (atoi (get_tile \"lst1\")) lstc)

(nth (atoi (get_tile \"lst2\")) lstb)

))

(done_dialog 1)"

   )



   (action_tile

     "ss"

     "(setq lst (list

(nth (atoi (get_tile \"lst1\")) lstc)

(nth (atoi (get_tile \"lst2\")) lstb)

))

(done_dialog 3)"

   )



   (action_tile

     "li"

     "(setq lst (list

(nth (atoi (get_tile \"lst1\")) lstc)

(nth (atoi (get_tile \"lst2\")) lstb)

))

(done_dialog 4)"

   )







   (action_tile

     "zo"

     "(setq lst (list

(nth (atoi (get_tile \"lst1\")) lstc)

(nth (atoi (get_tile \"lst2\")) lstb)

(atoi (get_tile \"lb1\"))

))

(done_dialog 5)"

   )



   (action_tile

     "ext1"

     "(setq lst (list

(nth (atoi (get_tile \"lst1\")) lstc)

(nth (atoi (get_tile \"lst2\")) lstb)

))

(done_dialog 6)"

   )



   (action_tile

     "ext2"

     "(setq lst (list

(nth (atoi (get_tile \"lst1\")) lstc)

(nth (atoi (get_tile \"lst2\")) lstb)

))

(done_dialog 7)"

   )



   ;; afficher la boite de dialogue

   (setq loop (start_dialog))



   (cond



     ((= loop 1)

      (if (= (setq ss (ssget "X"

                             (list (cons 0 "INSERT")

                                   (cons 2 (nth 1 lst))

                                   (cons 8 (nth 0 lst))

                             )

                      )

             )

             nil

          )

        (prompt "\nPas de blocs dans le calque sélectionné ")

        (prompt (strcat "\nNombre de bloc "

                        (nth 1 lst)

                        " dans le calque "

                        (nth 0 lst)

                        " = "

                        (itoa (sslength ss))

                )

        )

      )

     )



     ((= loop 3)

      (sssetfirst

        nil

        (ssget

          "X"

          (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst)))

        )

      )

     )



     ((= loop 4)

      (setq lstp nil)

      (setq ss1 (ssget "X"

                       (list (cons 0 "INSERT")

                             (cons 2 (nth 1 lst))

                             (cons 8 (nth 0 lst))

                       )

                )

      )

      (if (= ss1 nil)

        (prompt "\nPas de blocs dans sélection")

        (progn

          (setq i 0)

          (repeat (sslength ss1)

            (setq ent (ssname ss1 i))

            (setq lstp (cons (lst2str (atts_to_list ent) " - ") lstp))

            (setq i (1+ i))

          )

          (setq lstp (reverse lstp))

          (setq lstp (subst "Pas d'attributs pour ce bloc" "nil" lstp))

        )

      )

     )



     ((= loop 5)

      (setq ss1 (ssget "X"

                       (list (cons 0 "INSERT")

                             (cons 2 (nth 1 lst))

                             (cons 8 (nth 0 lst))

                       )

                )

      )

      (if (= ss1 nil)

        (prompt "\nPas de blocs dans sélection")

        (progn

          (setq blks (ssname ss1 (nth 2 lst)))

          (setq ent (entget blks))

          (setq coord (cdr (assoc 10 ent)))

          (command "_zoom" "c" coord 20)

          (setq layi (getvar "CLAYER"))

          (setvar "CLAYER" "0")

          (setvar "CECOLOR" "3")

          (command "_text" "bc" coord 5 100 (rtos (nth 2 lst) 2 0))

          (setvar "CECOLOR" "DUCALQUE")

          (setvar "CLAYER" layi)

        )

      )

     )



     ((= loop 6)

      (prompt "\nSélection des blocs/attributs à lister dans fichier .txt")

      (setq ss

             (ssget

               "X"

               (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst)))

             )

      )

      (if (= ss nil)

        (progn

          (prompt "\nPas de blocs sélectionnés")

          (exit)

        )

        (progn

          (setq file (open "C:/txtatt.txt" "w"))

          (write-line

            (strcat "Index" " " "X" " " "Y" " " "Z" " " "Bloc" "  " "Calque")

            file

          )

          (setq i 0)

          (repeat (sslength ss)

            (setq ent (ssname ss i))

            (setq elst (entget ent))

            (setq etyp (cdr (assoc 0 elst)))

            (if (= etyp "INSERT")

              (progn

                (setq coord (cdr (assoc 10 elst)))

                (if (assoc 66 elst)

                  (progn

                    (setq attlist (lst2str (atts_to_list ent) "  "))

                    (write-line (strcat (rtos i 2 0)

                                        " "

                                        (rtos (car coord) 2 3)

                                        " "

                                        (rtos (cadr coord) 2 3)

                                        " "

                                        (rtos (caddr coord) 2 3)

                                        " "

                                        (nth 1 lst)

                                        "  "

                                        (nth 0 lst)

                                        "  "

                                        attlist

                                )

                                file

                    )

                  )

                  (write-line (strcat (rtos i 2 0)

                                      " "

                                      (rtos (car coord) 2 3)

                                      " "

                                      (rtos (cadr coord) 2 3)

                                      " "

                                      (rtos (caddr coord) 2 3)

                                      " "

                                      (nth 1 lst)

                                      "  "

                                      (nth 0 lst)

                                      "  "

                                      "Ce bloc ne contient aucun attributs"

                              )

                              file

                  )

                )

              )

            )

            (setq i (+ i 1))

          )

          (close file)

          (command "_.shell" "start notepad C:\\txtatt.txt")

        )

      )

     )



     ((= loop 7)

      (prompt "\nSélectionner les blocs/attributs à lister dans fichier .xls")

      (setq ss

             (ssget

               "X"

               (list (cons 0 "INSERT") (cons 2 (nth 1 lst)) (cons 8 (nth 0 lst)))

             )

      )

      (if (= ss nil)

        (progn

          (prompt "\nPas de blocs sélectionnés")

          (exit)

        )

        (progn

          (setq file (open "C:/xlsatt.xls" "w"))



          (write-line (strcat "Index" "\t" "X" "\t" "Y" "\t" "Z" "\t" "Bloc"

                              "\t" "Calque")

                      file

          )

          (setq i 0)

          (repeat (sslength ss)

            (setq ent (ssname ss i))

            (setq elst (entget ent))

            (setq etyp (cdr (assoc 0 elst)))

            (if (= etyp "INSERT")

              (progn

                (setq coord (cdr (assoc 10 elst)))

                (if (assoc 66 elst)

                  (progn

                    (setq attlist (lst2str (atts_to_list ent) "\t"))

                    (write-line (strcat (rtos i 2 0)

                                        "\t"

                                        (rtos (car coord) 2 3)

                                        "\t"

                                        (rtos (cadr coord) 2 3)

                                        "\t"

                                        (rtos (caddr coord) 2 3)

                                        "\t"

                                        (nth 1 lst)

                                        "\t"

                                        (nth 0 lst)

                                        "\t"

                                        attlist

                                )

                                file

                    )

                  )

                  (write-line (strcat (rtos i 2 0)

                                      "\t"

                                      (rtos (car coord) 2 3)

                                      "\t"

                                      (rtos (cadr coord) 2 3)

                                      "\t"

                                      (rtos (caddr coord) 2 3)

                                      "\t"

                                      (nth 1 lst)

                                      "\t"

                                      (nth 0 lst)

                                      "\t"

                                      "Ce bloc ne contient aucun attributs"

                              )

                              file

                  )

                )

              )

            )

            (setq i (+ i 1))

          )

          (close file)

          (OpenExcel "C:\\xlsatt.xls" nil T)

        )

      )

     )



   )



 )









 ;; décharger la boite de dialogue

 (unload_dialog dcl_id)

 ;; supprimer le fichier

 (vl-file-delete tmp)

 lst

)





(defun ATTS_TO_LIST (ENAM / X)

 (setq X (vlax-ename->vla-object ENAM))

 (if (= (cdr (assoc 66 (entget ENAM))) 1)

   (progn

     (mapcar '(lambda (X) (cons (vla-get-tagstring X) (vla-get-textstring X)))

             (vlax-safearray->list

               (variant-value (vla-getattributes (vlax-ename->vla-object ENAM)))

             )

     )

   )

 )

)



(defun c:sa7 (/ lst)

 (prompt "\nRECAPITULATIF ATTRIBUTS ET BLOCS D'UN PLAN")

 (setq lst (ssDialog))

 (prin1)

) 

;; lst2str (gile)

;; Concatène une liste et un séparateur en une chaine

;;

;; Arguments

;; lst : la liste à transformer en chaine

;; sep : le séparateur



(defun lst2str (lst sep)

 (if (cdr lst)

   (strcat (car lst) sep (lst2str (cdr lst) sep))

   (car lst)

 )

)

Mais ne fonctionne toujours pas bien,..

Activer Sélection et Zoom ne donne rien !

Je n'arrive pas à lister,.. Je sors alors de la BD et j'ai une sélection à l'écran des blocs en question,..

Commande:
Commande: (LOAD "C:/Users/Lilian/Desktop/sa7.lsp") LST2STR
Commande: sa7
RECAPITULATIF ATTRIBUTS ET BLOCS D'UN PLAN
Pas de blocs dans sélection; erreur: type d'argument incorrect: stringp
("NUMEROAXE" . "A")
Commande:

Et lorsque je veux exporter en .txt ou en .xls

Commande:
SA7
RECAPITULATIF ATTRIBUTS ET BLOCS D'UN PLAN
Pas de blocs dans sélection
Sélection des blocs/attributs à lister dans fichier .txt
Pas de blocs sélectionnés; erreur: quitter / sortir abandon
Commande:
Commande:
SA7
RECAPITULATIF ATTRIBUTS ET BLOCS D'UN PLAN
Sélectionner les blocs/attributs à lister dans fichier .xlsIndex X Y Z
Bloc Calque
; erreur: type d'argument incorrect: stringp ("NUMEROAXE" . "A")
Commande:

Merci d'avance,...

(gile) · le 15 novembre 2009

Désolé, il y eu 2 versions de lst2str une qui accepte tout type de liste et transforme en chaîne chaque élément avec vl-princ-to-string et un autre (celle que j'ai donnée) qui n'accepte que les listes de chaînes.

Pour le LISP de chris_mtp, il faut utiliser la première :

(defun lst2str (lst sep)
 (if (cdr lst)
   (strcat (vl-princ-to-string (car lst)) sep (lst2str (cdr lst) sep))
   (vl-princ-to-string (car lst))
 )
)

PS : Je n'utilise plus cette version car elle a des "effets de bord" indésirables avec les nombres réels qu'elle arrondit :

(lst2str '(9.87654321 0.123456789 0.0) ",") retourne "9.87654,0.123457,0.0"

PPS : je corrige ça dans le message précédent pour les éventuels testeurs et je m'arrête de faire le boulot de chris_mtp à sa place.

PPPS : le LISP de chris_mtp appelle aussi la routine GetExcel qui n'est pas fournie...

lili2006 · le 15 novembre 2009

Re,

Ok !

toujours pas d'export possible, mais c'est peut-être normal ??!!!

Commande:
SA7
RECAPITULATIF ATTRIBUTS ET BLOCS D'UN PLAN
Sélectionner les blocs/attributs à lister dans fichier .xlsIndex X Y Z
Bloc Calque
0 72069.399 112204.752 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
1 72071.891 112242.114 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
2 72034.513 112536.034 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
3 71745.456 112732.81 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
4 71214.687 112810.026 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
5 71082.618 112568.414 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
6 71356.67 112244.006 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
7 71528.663 112055.301 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
8 71887.493 112207.242 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
9 72059.432 112516.107 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
10 72114.253 112762.7 0 N° Axe BAC AXES TEXTE (NUMEROAXE . A)
11 71685.651 112618.231 0 N° Axe BAC AXES TEXTE (NUMEROAXE
. A)
[surligneur] ; erreur: type d'argument incorrect: streamp nil[/surligneur]
Commande:

Il est peut-être préférable d'utiliser alors la seconde méthode que tu exposes en Réponse 12 ?

Merci encore Gilles,

(gile) · le 15 novembre 2009

Il est peut-être préférable d'utiliser alors la seconde méthode que tu exposes en Réponse 12 ?

Ça ne changera rien, là l'erreur vient d'ailleurs.

À voir avec l'auteur...

lili2006 · le 15 novembre 2009

Re,

Vu !

Merci encore Gilles,

À voir avec l'auteur...

L'appel est lancé, ;)

chris_mtp · le 15 novembre 2009

Bonjour Lilli

Voici le code complet avec les fonctions utilisés (j'ai cité les sources Gilles et j'ai reformaté le code avec L'éditeur AutoLisp).

J'ai modifié aussi un peu le code.

L'export vers un fichier texte est superflu, plus facile à gérer sous excel.

Par contre, Lili, pour l'export, sous C: fais un nouveau répertoire appelé Taritement sinon tu auras l'erreur stream nil.

En espérant avoir été clair et pas trop "confu" (je rigole Gilles)

 (defun ssDialog	(/	tmp    file   lst1   lst2   ss	   li
	 zo	ext1   ext2   lb1    lstp   lay	   nom_lay
	 lstc	blo    nom_bloc	     lstb   blk	   dcl_id
	 loop	lst    ss     ss1    i	    ent	   i
	 blks	coord  layi   elst   etyp   attlist
	 liste	titl   titla  num
	)
 (vl-load-com)
 ;; créer un fichier temporaire et l'ouvrir en écriture
 (setq	tmp  (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
 )

 ;; écrire dans le fichier

 (write-line
   (strcat
     "SpecialInputBox:dialog {
 label = \"RECAPITULATIF ATTRIBUTS ET BLOCS D'UN PLAN\";
 initial_focus = \"lst1\";
 :boxed_radio_row{
   height = 1;
   label =\"Choisissez le nom du calque et le nom du bloc des entités à sélectionner : \";
   fixed_width = true;
   alignment = centered;
  :popup_list {
   key = \"lst1\";
   edit_width = 15;
 }
 :popup_list {
   key = \"lst2\";
   edit_width = 15;
 }
          :button{
            label=\"Activer Sélection\";
            key=\"ss\";
          }
          :button{
            label=\"Lister\";
            key=\"li\";
          }
          :button{
            label=\"Zoom\";
            key=\"zo\";
          }
          :button{
            label=\"Export .xls\";
            key=\"ext2\";
           }}
          
: list_box {
  key=\"lb1\";	
  height = 15;
  width = 30;
}

 spacer;
 ok_cancel;
}
"   )
   file
 )

 ;; fermer le fichier
 (close file)

 (setq lstp nil)


 (while
   (setq lay (tblnext "LAYER" (not lay)))
    (setq nom_lay (cdr (assoc 2 lay)))
    (setq lstc (cons nom_lay lstc))
 )
 (setq lstc (vl-sort lstc '<))

 (while
   (setq blo (tblnext "BLOCK" (not blo)))
    (setq nom_bloc (cdr (assoc 2 blo)))
    (setq lstb (cons nom_bloc lstb))
 )
 (setq lstb (vl-sort lstb '<))
 (setq lay "0")
 (setq blk "0")
 (setq num "0")


 ;; charger le fichier
 (setq dcl_id (load_dialog tmp))
 (setq loop 2)

 (while (< 1 loop)
   (if	(not (new_dialog "SpecialInputBox" dcl_id))
     (exit)
   )


   ;; initialiser la liste 1
   (start_list "lst1")
   (mapcar 'add_list lstc)
   (end_list)

   ;; initialiser la liste 2
   (start_list "lst2")
   (mapcar 'add_list lstb)
   (end_list)

   (start_list "lb1")
   (mapcar 'add_list lstp)
   (end_list)

   (set_tile "lst1" lay)
   (set_tile "lst2" blk)
   (set_tile "lb1" num)

   (action_tile "lst1" "(setq lay $value)")
   (action_tile "lst2" "(setq blk $value)")
   (action_tile "lb1" "(setq num $value)")


   ;; action si l'utilisateur clique "OK" :
   ;; lst = liste des entrées et fermeture de la boite
   (action_tile
     "accept"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 1)"
   )

   (action_tile
     "ss"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 3)"
   )

   (action_tile
     "li"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
initial_focus = \"lb1\";
(done_dialog 4)"
   )



   (action_tile
     "zo"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
(atoi (get_tile \"lb1\"))
))
(done_dialog 5)"
   )

   (action_tile
     "ext2"
     "(setq lst (list
(nth (atoi (get_tile \"lst1\")) lstc)
(nth (atoi (get_tile \"lst2\")) lstb)
))
(done_dialog 7)"
   )

   ;; afficher la boite de dialogue
   (setq loop (start_dialog))

   (cond

     ((= loop 1)
      (if (= (setq ss (ssget "X"
		      (list (cons 0 "INSERT")
			    (cons 2 (nth 1 lst))
			    (cons 8 (nth 0 lst))
		      )
	       )
      )
      nil
   )
 (prompt "\nPas de blocs dans le calque sélectionné ")
 (prompt (strcat "\nNombre de bloc "
		 (nth 1 lst)
		 " dans le calque "
		 (nth 0 lst)
		 " = "
		 (itoa (sslength ss))
	 )
 )
      )
     )

     ((= loop 3)
      (sssetfirst
 nil
 (ssget	"X"
	(list (cons 0 "INSERT")
	      (cons 2 (nth 1 lst))
	      (cons 8 (nth 0 lst))
	)
 )
      )
     )

     ((= loop 4)
      (setq lstp nil)
      (setq ss1 (ssget	"X"
		(list (cons 0 "INSERT")
		      (cons 2 (nth 1 lst))
		      (cons 8 (nth 0 lst))
		)
	 )
      )
      (if (= ss1 nil)
 (prompt "\nPas de blocs dans sélection")
 (progn
   (setq i 0)
   (repeat (sslength ss1)
     (setq ent (ssname ss1 i))
     (setq liste (lst2str (atts_to_list ent) "  --  "))
     (setq liste (vl-string-subst
		   "Pas d'attributs pour ce bloc"
		   "nil"
		   liste
		 )
     )
     (setq lstp (cons (strcat (rtos i 2 0) " -- " liste) lstp))
     (setq i (1+ i))
   )
   (setq lstp (reverse lstp))
 )
      )
     )

     ((= loop 5)
      (setq ss1 (ssget	"X"
		(list (cons 0 "INSERT")
		      (cons 2 (nth 1 lst))
		      (cons 8 (nth 0 lst))
		)
	 )
      )
      (if (= ss1 nil)
 (prompt "\nPas de blocs dans sélection")
 (progn
   (setq blks (ssname ss1 (nth 2 lst)))
   (setq ent (entget blks))
   (setq coord (cdr (assoc 10 ent)))
   (command "_zoom" "c" coord 20)
   (setq layi (getvar "CLAYER"))
   (setvar "CLAYER" "0")
   (setvar "CECOLOR" "3")
   (command "_text" "bc" coord 5 100 (rtos (nth 2 lst) 2 0))
   (setvar "CECOLOR" "DUCALQUE")
   (setvar "CLAYER" layi)
 )
      )
     )


     ((= loop 7)
      (setq ss	(ssget "X"
	       (list (cons 0 "INSERT")
		     (cons 2 (nth 1 lst))
		     (cons 8 (nth 0 lst))
	       )
	)
      )
      (if (= ss nil)
 (progn (prompt "\nPas de blocs sélectionnés"))
 (progn
   (prompt
     "\nSélectionner les blocs/attributs à lister dans fichier .xls"
   )
   (setq i 0)
   (repeat (sslength ss)
     (setq ent (ssname ss i))
     (setq elst (entget ent))
     (setq etyp (cdr (assoc 0 elst)))
     (setq coord (cdr (assoc 10 elst)))
     (if (= (cdr (assoc 0 (entget ent))) "INSERT")
       (progn
	 (if (= (cdr (assoc 66 (entget ent))) 1)
	   (progn
	     (setq titl nil)
	     (setq liste nil)
	     (while
	       (if ent
		 (not (= (cdr (assoc 0 (entget ent))) "SEQEND"))
	       )
		(if (= (cdr (assoc 0 (entget ent))) "ATTRIB")
		  (setq
		    liste (append
			    liste
			    (list (cdr (assoc 1 (entget ent))))
			  )
		  )
		)
		(setq ent (entnext ent))
		(if (= i 0)
		  (setq
		    titl (append
			   titl
			   (list (cdr (assoc 2 (entget ent))))
			 )
		  )
		)
	     )
	   )
	   (setq liste nil)
	 )
       )
     )
     (if (= liste nil)
       (progn
	 (if (= i 0)
	   (progn
	     (setq file (open "C:/Traitement/BLOCS.xls" "w"))
	     (write-line
	       (strcat "Index" "\t"    "X"     "\t"    "Y"
		       "\t"    "Z"     "\t"    "Bloc"  "\t"
		       "Calque"
		      )
	       file
	     )
	   )
	 )
	 (write-line
	   (strcat (rtos i 2 0)
		   "\t"
		   (rtos (car coord) 2 5)
		   "\t"
		   (rtos (cadr coord) 2 5)
		   "\t"
		   (rtos (caddr coord) 2 5)
		   "\t"
		   (nth 1 lst)
		   "\t"
		   (nth 0 lst)
		   "\t"
		   "Ce bloc ne contient aucun attributs"
	   )
	   file
	 )
       )
       (progn
	 (if (= i 0)
	   (progn
	     (setq titla (lst2str titl "\t"))
	     (setq file (open "C:/Traitement/BLOCS.xls" "w"))
	     (write-line
	       (strcat "Index" "\t"    "X"     "\t"    "Y"
		       "\t"    "Z"     "\t"    "Bloc"  "\t"
		       "Calque"	       "\t"    titla
		      )
	       file
	     )
	   )
	 )
	 (setq attlist (lst2str liste "\t"))
	 (write-line
	   (strcat (rtos i 2 0)
		   "\t"
		   (rtos (car coord) 2 5)
		   "\t"
		   (rtos (cadr coord) 2 5)
		   "\t"
		   (rtos (caddr coord) 2 5)
		   "\t"
		   (nth 1 lst)
		   "\t"
		   (nth 0 lst)
		   "\t"
		   attlist
	   )
	   file
	 )
       )
     )
     (setq i (+ i 1))
   )
   (close file)
   (OpenExcel "C:\\Traitement\\BLOCS.xls" nil T)
 )
      )
     )

   )
 )

 ;; décharger la boite de dialogue
 (unload_dialog dcl_id)
 ;; supprimer le fichier
 (vl-file-delete tmp)
 lst
)

;; Fonction réalisée par Gilles de Cadxp
(defun lst2str (lst sep)
 (if (cadr lst)
   (strcat (vl-princ-to-string (car lst))
    sep
    (lst2str (cdr lst) sep)
   )
   (vl-princ-to-string (car lst))
 )
)

;; Fonction récupéré sur Afralisp
(defun ATTS_TO_LIST (ENAM / X)
 (setq X (vlax-ename->vla-object ENAM))
 (if (= (cdr (assoc 66 (entget ENAM))) 1)
   (progn
     (mapcar '(lambda (X)
	 (cons (vla-get-tagstring X) (vla-get-textstring X))
       )
      (vlax-safearray->list
	(variant-value
	  (vla-getattributes (vlax-ename->vla-object ENAM))
	)
      )
     )
   )
 )
)

;; Fonction réalisée par Gilles de Cadxp en collaboration avec Terry Miller (A confirmer)
(defun OpenExcel
      (ExcelFile$ SheetName$ Visible / Sheet$ Sheets@ Worksheet)
 (if (= (type ExcelFile$) 'STR)
   (if	(findfile ExcelFile$)
     (setq *ExcelFile$ ExcelFile$)
     (progn
(alert (strcat "FichierExcel " ExcelFile$ " non trouvé."))
(exit)
     )
   )
   (setq *ExcelFile$ "")
 )
 (gc)
 (if (setq *ExcelApp% (vlax-get-object "Excel.Application"))
   (progn
     (vlax-release-object *ExcelApp%)
     (gc)
   )
 )
 (setq *ExcelApp% (vlax-get-or-create-object "Excel.Application"))
 (if ExcelFile$
   (if	(findfile ExcelFile$)
     (vlax-invoke-method
(vlax-get-property *ExcelApp% 'WorkBooks)
'Open
ExcelFile$
     )
     (vlax-invoke-method
(vlax-get-property *ExcelApp% 'WorkBooks)
'Add
     )
   )
   (vlax-invoke-method
     (vlax-get-property *ExcelApp% 'WorkBooks)
     'Add
   )
 )
 (if Visible
   (vla-put-visible *ExcelApp% :vlax-true)
 )
 (if (= (type SheetName$) 'STR)
   (progn
     (vlax-for	Sheet$ (vlax-get-property *ExcelApp% "Sheets")
(setq Sheets@ (append Sheets@
		      (list (vlax-get-property Sheet$ "Name"))
	      )
)
     )
     (if (member SheetName$ Sheets@)
(vlax-for Worksheet (vlax-get-property *ExcelApp% "Sheets")
  (if (= (vlax-get-property Worksheet "Name") SheetName$)
    (vlax-invoke-method Worksheet "Activate")
  )
)
(vlax-put-property
  (vlax-invoke-method
    (vlax-get-property *ExcelApp% "Sheets")
    "Add"
  )
  "Name"
  SheetName$
)
     )
   )
 )
 (princ)
)

(defun c:sel_blk (/ lst)
 (if (not (tblsearch "STYLE" "ZOOM-TXT"))
   (command "-style" "ZOOM-TXT" "Verdana" 0 1 0 "N" "N")
 )
 (setvar "TEXTSTYLE" "ZOOM-TXT")
 (setq lst (ssDialog))
 (prin1)
)

John

lili2006 · le 15 novembre 2009

Re,

Salut John,

Merci ! Tout fonctionne bien, :D

Quelques questions cependant,

Pourquoi est-ce qu'un numéro s'affiche dans le calque "o" près du bloc visualisé par l'option Zoom ?

Pour le repérer facilement je suppose ,

En même tps, je n'imprime jamais le calque "0", mais j'aime bien qu'il soit vide,...

Peut-on alors pointer ces numéros dans un autre calque (exemple "N° Zoom, ou Zoom txt, comme le nom de la police,...)

J'ai pas bien compris à quoi peut servir le bouton "Activer Sélection" ?

Peut-on changer le chemin du répertoire "Traitements" ?

Comme tu l'as écrit toi même, ce lisp peut-être très utile parfois,..

Merci d'avance,

chris_mtp · le 15 novembre 2009

Lilli j'ai fait ce code pour une utilisation bien particulière pour mon entreprise mais tu peux le modifier à ton aide.

Si tu veux modifier le nom du calque du zoom, modifie les lignes suivantes

(setq layi (getvar "CLAYER"))
(setvar "CLAYER" "0")

par

(setq layi (getvar "CLAYER"))
(setvar "CLAYER" "ZOOM")

Mais attention le calque ZOOM doit être présent dans ton dessin.

Pour le chemin d'export et le répertoire Traitement, modifie les lignes

(setq file (open "C:/Traitement/BLOCS.xls" "w"))

par

(setq file (open "C:/......CHEMIN D'EXPORT SOUHAITE....../BLOCS.xls" "w"))

La list_box peut être amélioré comme je l'ai dit en réponse 10 mais la faut demander aux cadors du lisp ou du vlisp et de vba.

John

lili2006 · le 15 novembre 2009

Re,

Merci de ta réponse John,

entre tps, j'ai fait les modifs utiles,...

Manquant de confiance en prog, je pose les questions avant de tester,...

Il faut maintenant que je fasse l'inverse, tester, puis poser les questions si vraiment ça bloque,... ;)

Merci encore et chapeau pour ce prog, :D

@+,

Est ce possible ?

Messages recommandés

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Information importante