Instopo avec matricule COD

[guess0169]

Bonjour,

Je possède un LISP pour insérer des points topo, à partir d'un fichier .csv ou .txt.

Mais vous devez surement bien le connaitre ce lisp.

 

Cependant, il ne possède que deux attribut (mat & alt) j'ai besoin d'en rajouter un autre, "cod"

Car mon fichier ce trouve sous la forme suivante.

 

Mat,x,y,Cod

 

Si vous pouvez modifier le lisp ci-dessous pour intégrer ce nouveau attribut.

 

Merci.

 

;;; INSTOPO (gile)
;;; Insère le bloc "PointBloc" sur les points décrit dans un fichier ascii (.txt .csv ou autre)
;;;
;;; Modification : possibilité d'insérer un point 02/12/2009

(defun c:instopo (/        *error*  makeblock         filename tmp
                 file     layers   clay     ptlay    blklay   data-sep
                 dec-sep  mat-p    mat      alt      scl      point
                 bloc     dcl_id   space    line     coords   matric
                 insert
                )

 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*)))

 ;;---------------------------------------------------;;

 (defun *error* (msg)
   (or (= msg "Fonction annulée")
       (princ (strcat "Erreur: " msg))
   )
   (and file (close file))
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 ;;---------------------------------------------------;;

 ;; MakeBlock
 ;; Crée le bloc PointBloc
 (defun makeblock (/ block)
   (vl-load-com)
   (setq block (vla-add *blocks*
                        (vlax-3d-point '(0. 0. 0.))
                        "TCPOINT"
               )
   )
   (vla-put-Layer
     (vla-addPoint block (vlax-3d-point '(0. 0. 0.)))
     "0"
   )
   (vla-put-Layer
     (vla-addAttribute
       block
       2.5
       acAttributeModePreset
       ""
       (vlax-3d-point '(1. 0.5 0.))
       "MAT"
       ""
     )
     "0"
   )
   (vla-put-Layer
     (vla-addAttribute
       block
       2.5
       acAttributeModePreset
       ""
       (vlax-3d-point '(1. -3. 0.))
       "ALT"
       ""
     )
     "0"
   )
 )

 ;;---------------------------------------------------;;

 (if (setq filename (getfiled "Sélectionner un fichier point"
                              ""
                              "txt;csv;*"
                              0
                    )
     )
   (progn
     ;; Création du fichier DCL temporaire
     (setq tmp  (vl-filename-mktemp "Tmp.dcl")
           file (open tmp "w")
     )
     (write-line
       "InsTopo
:dialog{label=\"InsTopo\";
:boxed_row{label=\"Format du fichier\";
:boxed_radio_column{label=\"Séparateur de données\";key=\"data-sep\";
:radio_button{label=\"Virgule\";key=\"44\";value =\"1\";}
:radio_button{label=\"Point-virgule\";key =\"59\";}
:radio_button{label=\"Espace\";key=\"32\";}
:radio_button{label=\"Tabulation\";key =\"9\";}}
:column{
:boxed_radio_column{label=\"Séparateur décimal\";key=\"dec-sep\";
:radio_button{label=\"Virgule\";key =\"com\";}
:radio_button{label=\"Point\";key=\"dot\";value=\"1\";}}
:boxed_radio_column{label=\"Matricule\";key=\"mat-p\";
:radio_button{label=\"Présent\";key=\"present\";value=\"1\";}
:radio_button{label=\"Absent\";key=\"absent\";}}}}
:boxed_column{label=\"Point\";
:row{
:toggle{label=\"Insérer des points\";key=\"point\";value=\"1\";}
:popup_list{label=\"Calque\";key =\"ptlay\";edit_width = 24;}}
spacer;}
:boxed_column{label=\"Bloc\";
:toggle{label=\"Insérer de blocs\";key=\"bloc\";value=\"1\";}
:row{
:boxed_column{label=\"Attributs\";
:toggle{label=\"Matricule\";key=\"mat\";value=\"1\";}
:toggle{label=\"Altitude\";key=\"alt\";value=\"1\";}}
spacer;
:column{spacer;
:popup_list{label=\"Calque\";key =\"blklay\";edit_width = 24;}
:edit_box{label=\"Echelle  \";key=\"scl\";value=\"1.0\";fixed_width=true;}
spacer;}}}
ok_cancel;}"
       file
     )
     (close file)

     (vlax-for l (vla-get-Layers *acdoc*)
       (setq layers (cons (vla-get-Name l) layers))
     )
     (setq layers   (vl-sort layers '<)
           clay     (getvar "CLAYER")
           ptlay    clay
           blklay   clay
           data-sep "44"
           dec-sep  "dot"
           mat-p    "present"
           mat      "1"
           alt      "1"
           scl      1.0
           point    T
           bloc     T
     )
     (setq dcl_id (load_dialog tmp))
     (if (not (new_dialog "InsTopo" dcl_id))
       (exit)
     )
     (start_list "ptlay")
     (mapcar 'add_list layers)
     (end_list)
     (start_list "blklay")
     (mapcar 'add_list layers)
     (end_list)
     (set_tile "ptlay" (itoa (vl-position clay layers)))
     (set_tile "blklay" (itoa (vl-position clay layers)))
     (foreach k (list "data-sep" "dec-sep" "mat-p" "mat" "alt")
       (action_tile k "(set (read $key) $value)")
     )
     (action_tile
       "point"
       "(if (= \"1\" $value)
         (progn
           (setq point T)
           (mode_tile \"ptlay\" 0)
         )
         (progn
           (setq point nil)
           (mode_tile \"ptlay\" 1)
         )
       )"
     )
     (action_tile
       "bloc"
       "(if (= \"1\" $value)
         (progn
           (setq bloc T)
           (mode_tile \"blklay\" 0)
           (mode_tile \"mat\" 0)
           (mode_tile \"alt\" 0)
           (mode_tile \"scl\" 0)
         )
         (progn
           (setq bloc nil)
           (mode_tile \"blklay\" 1)
           (mode_tile \"mat\" 1)
           (mode_tile \"alt\" 1)
           (mode_tile \"scl\" 1)
         )
       )"
     )
     (action_tile "ptlay" "(setq ptlay (nth (atoi $value) layers))")
     (action_tile "blklay" "(setq blklay (nth (atoi $value) layers))")
     (action_tile
       "scl"
       "(setq scl (distof $value))
(while (or (not scl) (<= scl 0))
(alert \"Nécessite un nombre réel strictement positif\")
(setq scl 1.0)
(set_tile \"scl\" \"1.0\")
(mode_tile \"scl\" 2))"
     )
     (action_tile "cancel" "(setq data-sep nil) (done_dialog 0)")
     (action_tile "accept" "(done_dialog 1)")
     (start_dialog)
     (unload_dialog dcl_id)
     (vl-file-delete tmp)
     (if data-sep
       (progn
         (vla-StartUndoMark *acdoc*)
         (and (vl-catch-all-error-p
                (vl-catch-all-apply
                  'vla-item
                  (list *blocks* "TCPOINT")
                )
              )
              (makeblock)
         )
         (setq space (vla-get-ModelSpace *acdoc*)
               file  (open filename "r")
         )
         (while (setq line (read-line file))
           (setq coords (str2lst line (chr (atoi data-sep))))
           (if (= mat-p "present")
             (setq matric (car coords)
                   coords (cdr coords)
             )
             (setq matric nil)
           )
           (if (= dec-sep "com")
             (setq
               coords (mapcar
                        '(lambda (x)
                           (read (vl-string-translate "," "." x))
                         )
                        coords
                      )
             )
             (setq coords (mapcar 'read coords))
           )
           (setq coords (list (car coords)
                              (cadr coords)
                              (cond ((caddr coords))
                                    (T 0.0)
                              )
                        )
           )
           (if (vl-every 'numberp coords)
             (progn
               (if point
                 (vla-put-Layer (vla-AddPoint space (vlax-3d-point coords))
                                ptlay
                 )
               )
               (if bloc
                 (progn
                   (setq
                     insert
                      (vla-InsertBlock
                        space
                        (vlax-3d-point coords)
                        "TCPOINT"
                        scl
                        scl
                        scl
                        0.0
                      )
                   )
                   (vla-put-Layer insert blklay)
                   (foreach att (vlax-invoke insert 'getAttributes)
                     (if
                       (and
                         (= (vla-get-TagString att) "MAT")
                         matric
                         (= mat "1")
                       )
                        (vla-put-TextString att matric)
                     )
                     (if
                       (and
                         (= (vla-get-TagString att) "ALT")
                         (= alt "1")
                       )
                        (vla-put-TextString att (rtos (caddr coords)))
                     )
                   )
                 )
               )
             )
           )
         )
         (close file)
         (vla-EndUndoMark *acdoc*)
       )
     )
   )
 )
 (princ)
)

;; str2lst
;; Transforme un chaine avec séparateur en liste de chaines
;;
;; Arguments
;; str : la chaine à transformer en liste
;; sep : le séparateur
;;
;; Exemples
;; (str2lst "a b c" " ") -> ("a" "b" "c")
;; (str2lst "1,2,3" ",") -> ("1" "2" "3")
;; (mapcar 'read (str2lst "1,2,3" ",")) -> (1 2 3)

(defun str2lst (str sep / pos)
 (if (setq pos (vl-string-search sep str))
   (cons (substr str 1 pos)
         (str2lst (substr str (+ (strlen sep) pos 1)) sep)
   )
   (list str)
 )
)

[DenisHen]

Salut guess0169

 

Si tu pouvais m'envoyer un extrait de ton fichier... Je regarderais ce que je peu y faire...

 

Denis

[DenisHen]

J'ai une solution rapide,

 

Tu concataine dans excel le matricule et le code puis les x et y comme ça :

"Mat-Cod,x,y"

 

Ce n'est pas joli, mais tu auras quelque chose...

[willy95]

Bonjour,

 

Après avoir décortiqué ce Lisp de Gile plus d'une fois dans tous les sens et qui est pour moi une vraie Merveille, entre autre car il combine plusieurs éléments de réponse (lecture de fichier, ecriture de fichiers temporaire, boite de dialogue, création de bloc sans dwg, choix multiple,etc...) qu'il apporte de l'espoir à mes idées et à mes besoins tellement divers que j'en ai fait mon livre de chevet (en plus de son Mémo bien sur), mais bien que j'ai lu qu'il fallait créer un bloc avec les differents éléments tels que les symboles ou les calques d'une façon différente, j'aimerais bien réussir à appliquer les calques choisis dans la fenêtre de dialogue que j'ai legèrement modifié sans l'autorisation de mon auteur préféré.

 

Je pense que l'idée final de l'insertion du bloc est peu etre dans ce coin la du code :

(vla-put-Layer insert blklay)
                   (foreach att (vlax-invoke insert 'getAttributes)
                     (if
                       (and
		  
		(= (vla-get-TagString att) "MAT")
                         matric
                         (= mat "1")
                       )
                        (vla-put-TextString att matric)
                     )
                     (if
                       (and
                         (= (vla-get-TagString att) "ALT")
                         (= alt "1")		      
                      )

 

L'insertion des calques et le choix de calques sont ok (au passage j'aimerai pouvoir les mettres par defaut) mais je n'arrive pas à les appliqués au différentes étiquettes, je fini par me dire que cela n'est peut-etre pas possible de cette manière la ?

http://i59.servimg.com/u/f59/12/07/72/29/instop10.jpg

 

Merci d'avance

[(gile)]

Salut,

 

Oui tu peux attribuer le calque aux attributs à chaque insertion:

                      (if
                       (and
                         
                       (= (vla-get-TagString att) "MAT")
                         matric
                         (= mat "1")
                       )
                        (progn
                          (vla-put-TextString att matric)
                          (vla-put-Layer att "O1-Point_Matricule")
                        )
                     )

mais il faut être certain que le calque exite bien dans le dessin.

 

Le plus simple est quand même de définir le calque des définitions d'attributs dans la définition de bloc, les références d'attributs, seront ainsi, par défaut, sur le bon calque dans toutes les références de bloc.

 

Regarde dans le fichier InsTopo.lsp (dernière version sur cette page) la routine MakeBlock (au début du code) et remplace:

    (vla-Add *layers* "TopoMat")
   (vla-Add *layers* "TopoAlt")
   ...
   (vla-put-Layer att "TopoMat")
   ...
   (vla-put-Layer att "TopoAlt")

par :

    (or (tblsearch "layer" "01-Point_Matricule") (vla-Add *layers* "01-Point_Matricule"))
   (or (tblsearch "layer" "01-Point_Altitude") (vla-Add *layers* "01-Point_Altitude")
   ...
   (vla-put-Layer att "01-Point_Matricule")
   ...
   (vla-put-Layer att "01-Point_Altitude")

[willy95]

Merci beaucoup

 

j'avoue en avoir encore une fois pris plein les yeux, pour ne pas dire un peu trop car je n'avais pas vu cette dernière version de ce lisp, du coup il va me falloir beaucoup plus de temps pour comprendre correctement toutes les choses que tu a rajouté et le faire fonctionner avec l'insertion au choix des calques que j'avais tout juste reussi à inserer dans les choix de la boite de dialogue de ton ancien lisp.

 

Merci beaucoup pour cette réactivité, ce savoir faire et cette générosité.

[pierrevigneux]

+1 et je te re-merci moi aussi Gile.