Insertion de blocs avec les coordonnées en TXT

[ZCAD]

Bonjour, 

Je souhaite insérer un grand nombre de bloc aux coordonnées qui sont dans un fichier .TXT 

En essayant tous ce que je pouvais, je ne parviens pas à obtenir le résultat que je souhaite. 

J'ai joint le fichier original lisp que j'ai trouvé sur internet et le fichier TXT. 
 

NOM_DU_CALQUE : EVI061--E-(lumiere-appareils)
NOM_DU_BLOC : cn_LUM-ROND-GEN

 

Merci d'avance 

 

Insert.lsp coordonnées.txt

[didier]

Bonjour @ZCAD

Tu souhaites apprendre le langage pour être autonome ou tu veux qu'on te livre un truc qui fonctionne ?

Amicalement

 

[lecrabe]

Hello @ZCAD

Voici une routine "INSTOPO"du Grand Maitre Gilles qui insere au choix : 

-- un Bloc TCPOINT (avec 2 Attributs MAT & ALT) 

-- un Point

-- ou les DEUX

( Si le Bloc TCPOINT n existe pas dans ton DWG, il sera cree "a la volee" )

depuis un fichier TXT, CSV, etc ...

RAPPEL : Comme tu n as rien derriere tes Coords  XY : MAT et ALT seront vides ...

J ai teste sur ton fichier XY TXT, ca marche parfaitement ... Cela te convient il ??

Bye, lecrabe

 

 
;;; 
;;; http://gile.pagesperso-orange.fr/LISP/InsTopo.lsp
;;; 
;;; INSTOPO par GC / Gilles 
;;; 
;;; 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 "Selectionner 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=\"Separateur de donnees\";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=\"Separateur 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=\"Present\";key=\"present\";value=\"1\";}
	:radio_button{label=\"Absent\";key=\"absent\";}}}}
	:boxed_column{label=\"Point\";
	:row{
	:toggle{label=\"Inserer des points\";key=\"point\";value=\"1\";}
	:popup_list{label=\"Calque\";key =\"ptlay\";edit_width = 24;}}
	spacer;}
	:boxed_column{label=\"Bloc\";
	:toggle{label=\"Inserer 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)
  )
)

 

[didier]

Bonjour @ZCAD

Avec la routine fournie par @lecrabe c'est sûr que ça va être plus robuste qu'avec le LSP que tu as fourni qui est un peu "léger".
Venant de @(gile) tu peux t'attendre à du "peaufiné".
Je prends les devants avant que tu charges le LSP, la configuration que tu devras appliquer est celle-ci :

Amicalement

[Luna]

Coucou,

Au vue des coordonnées présentes dans le fichier TXT, il semblerait que celle-ci correspondent à des coordonnées GPS (longitude/latitude). Donc je ne sais pas s'il faut prévoir une conversion des coordonnées sur un système de coordonnées RGF ou autre. Car présentement il me semble que tous les points seront à quelques centième d'unité seulement les uns des autres...
Mais peut-être que je dit des bêtises, auquel cas je suis désolée ^^'

Bisous,
Luna

[ZCAD]

Je vous remercie tous les deux, le Lisp fonctionne impeccable ! 

Pour répondre à ta question @didier , je suis fortement intéressé pour apprendre le Lisp. 

 

[ZCAD]

Bonjour @Luna ,

Je te remercie pour ta remarque, néanmoins les cordonnées seront à revoir c'était un premier test 😉 

Ne soit pas désolé, toutes remarques sont les bienvenues 😄 

[lecrabe]

Hello @ZCAD

SVP quel Lisp ??

MERCI, Bye, lecrabe

[ZCAD]

Le Lisp Instopo du grand maître gilles que tu m'as donné 🙂

[bonuscad]

On peut rester dans le système de coordonnées que l'on veut.

Néanmoins une recommandation émise par le ministère de l'époque et que les intervenants adoptent le système de projection RGF93 pour toute production numérique.

Et si tu veux exploiter par exemple le cadastre, le scan25, la bd_ortho de l'IGN, ceux ci sont fourni en RGF93, donc le choix de cette projection peu faciliter l'échange de fichiers avec d'autres intervenants et homogénéisé l'ensemble de la production. Cela évite aussi des déboires avec des Xref attachés qui ne serait pas dans le même système. 

Pour moi c'est un bon choix mais il n'est pas obligatoire...

NB:Pour ma part j'ai pris l'habitude de mettre en préfixe de mes noms de fichier RGF93_nom du fichier.dwg quand ceux-ci sont référencé avec ce système, comme ça n'importe qui sait à quel système il doit faire référence si il veut exploiter le fichier (plus simple que de chercher à déterminer celui-ci d'après les coordonnées, bien que se soit possible)