Exporter positions bloc x, y et z excel vers autocad

[VGtino]

Bonjour,

J'ai Autocad 2020 et excel 2016.

J'ai réussi à faire une macro qui extrait le nom du bloc, handle, calque, position X, position Y, position Z et les attributs.

Ensuite j'ai essayé de créer une autre macro pour le sens inverse et là je bloque ...

Voici le code que j'ai utilisé, mon soucis c'est qu'il fonctionne que pour les attributs, je n'ai pas réussi pour les positions X, Y et Z :

Sub EnxporterVersAutoCAD()
  Dim AcadApp As AutoCAD.AcadApplication
  Dim BlocRef As AcadBlockReference
  Dim Entity As AcadEntity
  Dim Row, i, Column As Integer
  'Dim Entity As AcadEntity
  ' On lance AutoCAD
  
  On Error Resume Next
  Set AcadApp = New AutoCAD.AcadApplication
  AcadApp.Visible = True
  
  ' On ouvre le fichier dans AutoCAD
  AcadApp.Documents.Open (Application.GetOpenFilename("Dessins AutoCAD (*.dwg), *.dwg"))
  
  Row = 2  ' On commence à la rangée N°4
  Dim Handle As String
  While Not IsEmpty(Cells(Row, 2)) ' On s'arrête quand on tombe sur une cellule handle vide
    
    ' On retrouve l'insertion de bloc à l'aide du handle mémorisé dans la feuille de calcul et de la
    ' méthode HandleToObject de l'objet document AutoCAD
    Handle = Cells(Row, 2)
    Set BlocRef = AcadApp.ActiveDocument.HandleToObject(Handle)
          
    ' Si le bloc a des attributs...
    If BlocRef.HasAttributes Then
        ' ... on les récupère
        Attributes = BlocRef.GetAttributes
        
        ' On parcourt le tableau
        For i = LBound(Attributes) To UBound(Attributes)
          ' Pour chaque attribut, on cherche une colonne dont l'entête correspond à l'étiquette de l'attribut
          Column = 4
          While Not IsEmpty(Cells(1, Column))
            If Cells(1, Column).Text = Attributes(i).TagString Then
              Attributes(i).TextString = Cells(Row, Column).Text
            End If
            Column = Column + 1 ' On passe à la colonne suivante
          Wend        
        Next
End If
 BlocRef.Update
    
 Row = Row + 1 ' On passe à la ligne suivante
      
  Wend
MsgBox "Les données sont transférées vers AutoCAD"
  
End Sub

Pour les attributs, il cherche le bloc avec son handle, compare l'en-tête du tableau avec les étiquettes du bloc sur Autocad et quand il y a égalité, il modifie l'attribut du bloc dans Autocad par celui qu'il y a dans le tableau excel.

Merci de votre aide.

Bonne journée.

[Maxime.063]

J'ai en stock un lisp qui importe des points de Excel vers Autocad, je ne sais plus qui en est l'auteur

; 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")
(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)
)
)
(defun c:readCSV2BLK ( / input f_open l_read key_sep str_sep l_data l_ini count count_coor mess_att key_data x_data y_data z_data l_rmv l_var inc gab_l last_y l_str l_mes blk_scl pt)
(setq
input (getfiled "Selectionner un fichier CSV" "" "csv" 2)
f_open (open input "r")
l_read (read-line f_open)
)
(close f_open)
(initget "Espace Virgule Point-virgule Tabulation")
(setq key_sep (getkword "\nSeparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: "))
(cond
((eq key_sep "Espace") (setq str_sep " "))
((eq key_sep "Virgule") (setq str_sep ","))
((eq key_sep "Tabulation") (setq str_sep "\t"))
(T (setq str_sep ";"))
)
(setq l_data (str2lst (vl-string-right-trim str_sep l_read) str_sep) count 0 count_coor 0 l_ini "Donnée Xlocation Ylocation Zlocation Ignorer")
(foreach el l_data (princ " ")(princ el))
(initget "Oui Non")
(if (eq (getkword "\nCette 1ère ligne est elle une ligne d'entête qui peut constituer les étiquettes d'attribut [Oui/Non]? <Non>: ") "Oui") (setq mess_att T) (setq mess_att nil))
(foreach el l_data
(initget 1 l_ini)
(setq key_data (getkword (strcat "\nL'élément " el " est [" (vl-list->string (subst 47 32 (vl-string->list l_ini))) "]?: ")))
(cond
((eq key_data "Xlocation") (setq x_data count_coor l_ini (vl-string-subst "" (strcat " " key_data) l_ini) l_rmv (cons (if l_rmv (+ count (length l_rmv)) count) l_rmv) count (1- count)))
((eq key_data "Ylocation") (setq y_data count_coor l_ini (vl-string-subst "" (strcat " " key_data) l_ini) l_rmv (cons (if l_rmv (+ count (length l_rmv)) count) l_rmv) count (1- count)))
((eq key_data "Zlocation") (setq z_data count_coor l_ini (vl-string-subst "" (strcat " " key_data) l_ini) l_rmv (cons (if l_rmv (+ count (length l_rmv)) count) l_rmv) count (1- count)))
((eq key_data "Ignorer") (setq l_rmv (cons (if l_rmv (+ count (length l_rmv)) count) l_rmv) count (1- count)))
(T
(if mess_att
(progn
(set (read el) count)
(setq l_var (cons (read el) l_var) l_str (cons el l_str))
)
(progn
(set (read (strcat "DATA" (itoa count))) count)
(setq l_var (cons (read (strcat "DATA" (itoa count))) l_var))
)
)
)
)
(setq count (1+ count) count_coor (1+ count_coor))
)
(cond
((and (numberp x_data) (numberp y_data))
(setq count 0 inc (/ 5.0 3.0) gab_l (length l_var))
(mapcar
'(lambda (x y / )
(if (not (tblsearch "LAYER" x))
(entmake
(list
'(0 . "LAYER")
'(100 . "AcDbSymbolTableRecord")
'(100 . "AcDbLayerTableRecord")
(cons 2 x)
'(70 . 0)
(cons 62 y)
'(6 . "Continuous")
'(290 . 1)
'(370 . -3)
)
)
)
)
'("CSV2BLK" "CSV2BLK_x-y" "CSV2BLK_z" "CSV2BLK_ATT")
'(1 3 3 4)
)
(if (not (tblsearch "STYLE" "$CSV2BLK"))
(entmake
'(
(0 . "STYLE")
(5 . "40")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "$CSV2BLK")
(70 . 0)
(40 . 0.0)
(41 . 1.0)
(50 . 0.0)
(71 . 0)
(42 . 2.5)
(3 . "arial.ttf")
(4 . "")
)
)
)
(if (not (tblsearch "BLOCK" "CSV2BLK"))
(progn
(entmake
'((0 . "BLOCK") (2 . "CSV2BLK") (70 . 2) (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0))
)
(setq last_y 0.0 count -1 l_str (if mess_att l_str nil) l_mes nil)
(mapcar
'(lambda (tag mes / )
(entmake
(list
'(0 . "ATTDEF")
'(67 . 0)
'(8 . "0")
'(62 . 0)
'(6 . "ByBlock")
'(370 . -2)
(cons 10 (list 1.0 last_y 0.0))
'(40 . 1.0)
'(1 . "")
'(50 . 0.0)
'(41 . 1.0)
'(51 . 0.0)
'(7 . "$CSV2BLK")
'(210 0.0 0.0 1.0)
(cons 3 mes)
(cons 2 tag)
'(70 . 0)
)
)
(setq last_y (+ last_y (- (* inc 2))))
)
(append (list "ID-X" "ID-Y" "ID-Z") (reverse (if mess_att l_str (repeat (length l_var) (setq l_str (cons (strcat "DATA" (itoa (setq count (1+ count)))) l_str))))))
(append (list "Coordinate X: " "Coordinate Y: " "Coordinate Z: ") (repeat (length l_var) (setq l_mes (cons "Data: " l_mes))))
)
(entmake
'(
(0 . "POINT")
(67 . 0)
(8 . "0")
(62 . 0)
(6 . "ByBlock")
(370 . -2)
(10 0.0 0.0 0.0)
(210 0.0 0.0 1.0)
)
)
(entmake '((0 . "ENDBLK") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2)))
)
)
(initget 2)
(if (not (setq blk_scl (getreal "\nEchelle du bloc? <1>: "))) (setq blk_scl 1.0))
(setq f_open (open input "r"))
(if mess_att (read-line f_open))
(while (setq l_read (read-line f_open))
(setq
l_data (str2lst (vl-string-right-trim str_sep l_read) str_sep)
pt (list (atof (nth x_data l_data)) (atof (nth y_data l_data)) (if z_data (atof (nth z_data l_data)) 0.0))
)
(if l_rmv
(foreach el l_rmv
(setq l_data
((lambda (n lst / i rtn)
(reverse
(progn
(setq i -1)
(foreach x lst
(if (/= n (setq i (1+ i)))
(setq rtn (cons x rtn))
)
)
rtn
)
)
)
el
l_data
)
)
)
)
(setq
count 0
l_var nil
)
(repeat gab_l
(set (read (strcat "DATA" (itoa count))) count)
(setq
l_var (cons (read (strcat "DATA" (itoa count))) l_var)
count (1+ count)
)
)
(foreach n l_var
(set n (nth (eval n) l_data))
)
(entmake
(append
'(
(0 . "INSERT")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "CSV2BLK")
(100 . "AcDbBlockReference")
(66 . 1)
(2 . "CSV2BLK")
)
(list
(cons 41 (* 1.0 blk_scl))
(cons 42 (* 1.0 blk_scl))
(cons 43 (* 1.0 blk_scl))
)
'(
(50 . 0.0)
(70 . 0)
(71 . 0)
(44 . 0.0)
(45 . 0.0)
)
(list (cons 10 pt) '(210 0.0 0.0 1.0))
)
)
(setq last_y (+ (cadr pt) (* blk_scl (+ inc))) count 0 l_str (if mess_att l_str nil) l_mes nil)
(mapcar
'(lambda (val tag lay / )
(entmake
(append
(list
'(0 . "ATTRIB")
'(100 . "AcDbEntity")
'(67 . 0)
'(410 . "Model")
'(8 . "CSV2BLK_x-y")
'(100 . "AcDbText")
)
(list
(cons 8 lay)
(cons 10 (list (+ (car pt) (* blk_scl 1.0)) (setq last_y (+ last_y (* blk_scl (- inc)))) (caddr pt)))
(cons 1 val)
(cons 40 (* 1.0 blk_scl))
)
(list
'(50 . 0.0)
'(41 . 1.0)
'(51 . 0.0)
'(7 . "$CSV2BLK")
'(71 . 0)
'(72 . 0)
'(11 0.0 0.0 0.0)
'(210 0.0 0.0 1.0)
'(100 . "AcDbAttribute")
)
(list (cons 2 tag))
(list
'(70 . 0)
'(73 . 0)
'(74 . 0)
)
)
)
)
(append (list (rtos (car pt) 2) (rtos (cadr pt) 2) (rtos (caddr pt) 2)) (mapcar 'eval (reverse l_var)))
(append (list "ID-X" "ID-Y" "ID-Z") (reverse (if mess_att l_str (repeat (length l_var) (setq l_str (cons (strcat "DATA" (itoa (setq count (1+ count)))) l_str))))))
(append (list "CSV2BLK_x-y" "CSV2BLK_x-y" "CSV2BLK_z") (repeat (length l_var) (setq l_mes (cons "CSV2BLK_ATT" l_mes))))
)
(entmake '((0 . "SEQEND") (8 . "CSV2BLK") (62 . 0) (6 . "ByBlock") (370 . -2)))
)
(close f_open)
)
(T (princ "\nPas de coordonnées intoduites, implantation impossible!"))
)
(mapcar '(lambda (x) (eval (set x nil))) l_var)
(prin1)
)

[braudpat]

Hello @VGtino 

Si tu veux extraire le contenu des attributs vers Excel, puis modifier dans Excel les attributs, puis re-injecter les modifs d'attributs dans le DWG, alors les 2 commandes ATTIN / ATTOUT inclus dans les routines Express / Bonus, sont LA Solution !

Seule contrainte, ATTIN / ATTOUT ne sait pas traiter les Blocs dynamiques, il faut une version amelioree / corrigee ... Voir le Lisp joint ...

Dans l attente des tes Infos ...

LA SANTE, Joyeux Noel, Bye, Patrice

[VGtino]

Bonjour,

Merci à tous les deux pour votre retour.

Mon soucis c'est que je dois le faire en vba...

Les blocs ne sont pas dynamiques donc pour le moment pas de soucis avec ça.

Attin et attout ne gèrent pas les points x, y et z des blocs.

Ce que j'essaie de faire c'est comme pour mon code ci-dessus, avec le handle modifier les coordonnées en x, y et z des blocs, en une seule foi.

Oups il est plus de midi. Bonne Appetit.

[braudpat]

Hello

1) Donc si j ai bien compris, tu as des Blocs avec attributs ...

2) Tu veux envoyer dans Excel le Handle, X, Y, Z, Calque, Code Couleur (0-256), etc, et le Contenu des attributs ...

L Extraction de donnees ACAD te fera cela facilement ...

3) Ensuite tu modifies dans Excel eventuellement XYZ, Calque, Code Couleur (0-256), etc, et Contenu des attributs ...

( ATTENTION: ne surtout pas toucher au Handle )

4) Re-Injection dans ACAD avec MAJ des attributs et Proprietes (Calque, Couleur, etc) et eventuellement deplacement des Blocs si XYZ a bouge !?

Sommes nous OK ?

THE HEALTH, Regards, Patrice

[VGtino]

Bonjour, bonjour,

1) et 2) C'est tout à fait ça. Et même plus simple car dans les faits c'est surtout Handle, les x, y et z + les attributs.

Pas besoin du calque, code couleur etc... (Effectivement, l'extraction de donnée fonctionne très bien, mais je me suis fait une macro).

3) Oui, surtout x, y et z et attributs comme mentionné en 1) et 2). Je suis d'accord, on touche pas au handle sinon ca va pas suivre et injecter dans les mauvais blocs.

4) Oui, donc la maj des attributs et surtout le déplacement des blocs.

Dans l'idéal un filtre sur les attributs pour pas devoir tous les injecter a chaque fois.

A  savoir que la maj des attributs fonctionne déjà avec le code que j'ai posté dans mon premier message. Et qu'elle a déjà un genre de filtre car elle va chercher l'étiquette de l'attribut dans l'excel et si elle le trouve dans le bloc, elle le met à jour.

Merci pour ton aide.

Bonne journée.

[braudpat]

Hello

Et si on crée de nouveaux blocs (donc nouveau handle) avec toutes les proprietes (Nom, XYZ, calque, attributs, etc) éventuellement modifiées dans Excel, est ce OK pour toi ?

Cela implique la suppression de tous les anciens blocs !

La Santé, Bye, Patrice

[VGtino]

Re bonjour,

Je ne comprends pas trop ton idée.

Pourquoi devoir tout supprimer pour en insérer d'autre ?

La modification des propriétés x, y, z de bloc n'est pas possible sans tout refaire ?

Bon après-midi.

[braudpat]

Hello

Si tu es OK pour creer des nouveaux Blocs (Donc nouveaux Handles) alors c tres simple

car la fabuleuse routine IXL du regrette Patrick_35 est "parfaite" pour cela !

J'adore la routine IXL que j'utilise souvent quand j'ai un fichier CSV/XLS avec des Coordonnees XY ou XYZ + eventuellement des donnees attributaires ...

SVP voir l image jointe qui montre le XLS necessaire a la routine IXL ...

Ce XLS proviendrait pour toi de l extraction de donnees de tes Blocs !

C pourquoi je parlais du fait qu il faudra supprimer tes Blocs AVANT de les re-injecter dans ton DWG avec la routine IXL !

IXL genere N Blocs (SVP deja present dans le DWG) sur N Calques aux Coords XYZ voulues + angle + echelle + attributs ! ... SVP que des Noms SIMPLES pour les Blocs et Attributs ATTDEF (pas de caracteres speciaux, ni accentues, ni blanc/espace)

ATTENTION: il y a 2 fichiers LSP+DCL donc il faut mettre les 2 fichiers dans le coeur de ton ACAD 20XX

ou bien les mettre dans un dossier specifique et ajouter CE dossier aux chemins de support (Voir dans OPTIONS / 1er Onglet Fichier / 1er Parametre) ...

LA SANTE, Joyeux Noel, Regards, Patrice

[VGtino]

Bonsoir,

Merci pour ce lsp. Je vais regarder ça.

Est-ce que les attributs doivent être dans le même ordre dans le fichier excel et dans les blocs ?

Et du coup, si j'ai bien compris ca insert avec le nom du bloc et non pas avec le handle. Donc, il faut "supprimer" tous les blocs du dessin mais ne pas les purger pour qu'ils restent dans la bibliothèque du dessin. Et quand on lance le lsp il re-insert les blocs listés dans le fichier excel dans le dessin.

Ca peut être intéressant. Merci 🙂

[braudpat]

Hello 

YES tu as tout compris !

SVP les attributs dans l ordre !

Ce LSP est Tip-top !!

La Santé, Bye, Patrice 

[VGtino]

Hello,

Fantastique !

J'essaie ça demain.

Si ça marche, j'essaierai de le faire appliquer.

Car à la base ça devait être en VBA vu qu'on a déjà tout le système d'extraction automatique en VBA.

Si c'est accepté je pourrai clore le post.

Bonne fin de weekend.

[braudpat · Accepted solution]

Hello @VGtino 

Donc pour moi la/le Methodologie / Workflow serait "a peu pres" :

1) Commande: SELECT et selectionner les Blocs concernes ...

2) Commande: Extraction de donnees ...

et Selection :  P  (comme Precedent)

3) Effacer :  P  (comme Precedent)

4) Faire les Modifs necessaires dans Excel ...

5) Lancer IXL ...

6) Et HOP les "nouveaux" Blocs sont crees ...

J'ai deja utilise IXL sur des gros fichiers XLS (SVP pas plus de 5000-15000 lignes a la fois suivant la vitesse de ton PC) pour generer des milliers de Tampons-Regards, Chambres, etc, avec de nombreux attributs techniques (Blocs avec leurs attributs visibles sur de multiples calques "ATT__xxxxx" pour voir ou pas certains attributs) a la bonne position XY ou XYZ en Lambert (Cartographie, Topographie, VRD, Cadastre, etc)

LA SANTE, Joyeux Noel, Regards, Patrice

[patrick.emin]

Bonjour @VGtino 

Si une des réponses résout votre problème ou vous a permis de mieux le comprendre, voulez vous avoir l'amabilité de cliquer sur le bouton  APPROUVER LA SOLUTION  en bas de la réponse qui apporte une solution?
Merci de ne pas accepter comme solution le message que vous êtes en train de lire.

[VGtino]

Bonjour et bonne année 🙂

J'ai validé la solution car ca fonctionne.

Désolé j'ai mis du temps pour essayer.

De mon coté, c'est une "moitié" de solution car je suis sensé le faire en VBA.

Mais ca servira certainement à d'autres.

Bonne journée 🙂