;|
Demande de jms sur Cadxp
https://cadxp.com/topic/61926-macro-vba-dans-access-pour-exportation-de-propri%C3%A9t%C3%A9s-de-bloc-via-chatgpt/#comment-353065
depuis un dwg extraire dans un csv les sommets des polylignes
format : X;Y;NomFichierDessin;Handle;Ordre
Ordre est la position du sommet dans la polyligne
depuis le même dwg extraire dans un autre csv les points d'insertion des blocs
format : Handle;X;Y;Calque
Version 01 le 5 décembre 2024 Didier Aveline
|;
(defun c:jms01( / dec f fic fic2 h l la lst n ordre sep som ss z)
    (setq n -1)
    (setq l nil)
    (setq dec 6 sep ";" f (strcat (getvar "dwgprefix")(getvar"dwgname")))
    (setq ss (ssget "_x" (list (cons 0 "LWPOLYLINE"))))
    (if ss (progn
           (setq fic (open (strcat (getvar "dwgprefix")"Sommets.csv") "w"))
           (write-line "X;Y;FichierDWG;eHandle;Ordre" fic)
           (repeat (sslength ss)
               (setq lst (entget (ssname ss (setq n (1+ n))))
                     h (cdr (assoc 5 lst))
                     z (cdr (assoc 38 lst))
                     ordre 0)
               (setq som (mapcar 'cdr (vl-remove-if-not '(lambda(x)(= (car x) 10))lst)))
               (foreach item som
                   (setq l (cons (list
                                     (strcat (rtos (car item) 2 dec)sep
                                             (rtos (cadr item) 2 dec)sep
                                             f sep h sep
                                             (itoa (setq ordre (1+ ordre))))
                                     );list
                             l);cons
                     );setq
               );foreach
               (setq l (reverse l))
               (foreach item l (write-line (car item) fic))
               (setq l nil)         
           )
           )
        (progn (prompt "\nMauvais jeu de sélection des polylignes\n")(quit)(princ))
        )
    (close fic)
    (setq n1 (1+ n))
;fin polylignes

    (setq n -1 l nil)
    (setq ss (ssget "_x" (list (cons 0 "INSERT")(cons 2 "PORTEMANTEAU"))))
    (if ss (progn
           (repeat (sslength ss)
               (setq lst (entget (ssname ss (setq n (1+ n))))
                     h (cdr (assoc 5 lst))
                     la (cdr (assoc 8 lst))
                     som (cdr (assoc 10 lst)))
               (setq l (cons
                           (list
                                (strcat h sep
                                        (rtos (car som) 2 dec)sep
                                        (rtos (cadr som) 2 dec)sep
                                        la)
                                );list
                           l);cons
                 );setq
           )
           )
        (progn (prompt "\nMauvais jeu de sélection des blocs\n")(quit)(princ))
        );if ss
    (setq fic2 (open (strcat (getvar "dwgprefix")"Points.csv") "w"))
    (write-line "ehandle_pt;X;Y;layer" fic2)
    (foreach item l (write-line (car item) fic2))
    (close fic2)
    (prompt (strcat "Le fichier " (getvar "dwgprefix")" Sommets.csv" "contient " (itoa n1) " Polylignes"
                    " - Le fichier " (getvar "dwgprefix")" Points.csv" "contient " (itoa (1+ n)) " Blocs"))
    (princ)
    )
(prompt "\nLa commande est jms01.")