Exporter les blocs et leurs attributs vers un fichier CSV

Du texte brut, rien de caché. Copiez-le dans un fichier nommé cxblk2csv.lsp ou téléchargez-le.

;;; ============================================================================
;;; CXBLK2CSV - Export blocks and their attributes to a CSV file
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxblk2csv
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; CSV lines (header first) for the block references in NAMES: block, layer, x, y, rotation in degrees, X scale,
;; then one column per attribute tag found in any of the blocks (in order of appearance).
(defun cx:blk2csv-lines (names / tags rows ed)
  (setq tags (cx:tags names))
  (foreach e names
    (setq ed (entget e))
    (setq rows (cons (cx:csv-line
                       (append
                         (list (cx:dxf 2 ed) (cx:dxf 8 ed)
                               (cx:n4 (car (cx:dxf 10 ed))) (cx:n4 (cadr (cx:dxf 10 ed)))
                               (cx:n4 (* 180.0 (/ (if (cx:dxf 50 ed) (cx:dxf 50 ed) 0.0) pi)))
                               (cx:n4 (if (cx:dxf 41 ed) (cx:dxf 41 ed) 1.0)))
                         (mapcar (function (lambda (tg) (if (cx:att-get e tg) (cx:att-get e tg) ""))) tags)))
                     rows)))
  (cons (cx:csv-line (append '("Block" "Layer" "X" "Y" "Rotation" "Scale") tags))
        (reverse rows)))

(defun c:CXBLK2CSV ( / *error* cx:sv ss file)
  (setq *error* cx:err)
  (setq ss (if (= (cx:ask-kw "Export blocks in" "All Selection" "All") "All")
             (ssget "X" (list '(0 . "INSERT") (cons 410 (getvar "CTAB"))))
             (cx:pick "\nSelect blocks: " '((0 . "INSERT")))))
  (if ss
    (if (setq file (cx:file-save "Save the block list as CSV" "blocks"))
      (cx:csv-save file (cx:blk2csv-lines (cx:ss->list ss))))
    (princ "\nNo blocks found."))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

(defun cx:dxf (code ed)
  (cdr (assoc code ed)))

;; The ATTRIB entities of a block reference, in order.
(defun cx:attribs (ins / e out)
  (setq e (entnext ins))
  (while (and e (= (cx:dxf 0 (entget e)) "ATTRIB"))
    (setq out (cons e out) e (entnext e)))
  (reverse out))

;; The attribute tags found in a list of block references, each once, in order of appearance.
(defun cx:tags (names / out)
  (foreach e names
    (foreach a (cx:attribs e)
      (if (not (member (strcase (cx:dxf 2 (entget a))) (mapcar 'strcase out)))
        (setq out (append out (list (cx:dxf 2 (entget a))))))))
  out)

;; 1-based position of SUB in STR at or after START, or nil.
(defun cx:find (str sub start / n i r)
  (setq n (strlen sub) i start r nil)
  (if (> n 0)
    (while (and (not r) (<= i (1+ (- (strlen str) n))))
      (if (= (substr str i n) sub) (setq r i))
      (setq i (1+ i))))
  r)

;; Replace every OLD in STR by NEW (case sensitive).
(defun cx:replace (str old new / n out pos)
  (setq n (strlen old) out "" pos 1)
  (if (= n 0)
    str
    (progn
      (while (<= pos (1+ (- (strlen str) n)))
        (if (= (substr str pos n) old)
          (setq out (strcat out new) pos (+ pos n))
          (setq out (strcat out (substr str pos 1)) pos (1+ pos))))
      (strcat out (substr str pos)))))

;; One CSV field: quoted when it holds a comma, a quote or a line break.
(defun cx:csv-field (s)
  (if (or (cx:find s "," 1) (cx:find s "\"" 1) (cx:find s "\n" 1) (cx:find s "\r" 1))
    (strcat "\"" (cx:replace s "\"" "\"\"") "\"")
    s))

(defun cx:join (lst delim / out)
  (setq out "")
  (foreach s lst
    (setq out (if (= out "") s (strcat out delim s))))
  (if lst out ""))

(defun cx:csv-line (fields)
  (cx:join (mapcar 'cx:csv-field fields) ","))

;; Real X as text with at most PREC decimals and no trailing zeros ("2.50" -> "2.5", "3.00" -> "3").
(defun cx:num (x prec / s)
  (setq s (rtos x 2 prec))
  (if (wcmatch s "*.*")
    (progn
      (while (= (substr s (strlen s)) "0") (setq s (substr s 1 (1- (strlen s)))))
      (if (= (substr s (strlen s)) ".") (setq s (substr s 1 (1- (strlen s)))))))
  (if (or (= s "-0") (= s "")) "0" s))

;; A real as text with at most 4 decimals.
(defun cx:n4 (x) (cx:num x 4))

;;; Geometry helpers: polylines with arcs, length, area, centroid, a point inside a shape.
;;; See helpers.lsp for the format.

;; The ATTRIB of a block reference with the tag TAG (any case), or nil.
(defun cx:att-find (ins tag / r)
  (foreach a (cx:attribs ins)
    (if (and (not r) (= (strcase (cx:dxf 2 (entget a))) (strcase tag))) (setq r a)))
  r)

(defun cx:att-get (ins tag / a)
  (if (setq a (cx:att-find ins tag)) (cx:dxf 1 (entget a))))

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Ask for one of the keywords in BITS ("Yes No"), default DEF; returns the keyword.
(defun cx:ask-kw (msg bits def / v)
  (initget 0 bits)
  (setq v (getkword (strcat "\n" msg " [" (cx:replace bits " " "/") "] <" def ">: ")))
  (if v v def))

;; Use the objects already selected, or ask the user to select; FILTER is an ssget filter list or nil.
(defun cx:pick (msg filter / ss)
  (setq ss (if filter (ssget "_I" filter) (ssget "_I")))
  (if (null ss)
    (progn
      (princ msg)
      (setq ss (if filter (ssget filter) (ssget)))))
  ss)

;; Ask where to save a CSV file; BASE is the proposed file name without folder and extension. Returns a path or nil.
;; With FILEDIA 0 the name is typed at the command line instead of picked in a dialog.
(defun cx:file-save (title base / def f)
  (setq def (strcat (getvar "DWGPREFIX") base ".csv"))
  (if (= (getvar "FILEDIA") 0)
    (progn
      (setq f (getstring T (strcat "\n" title " <" def ">: ")))
      (if (= f "") def f))
    (getfiled title def "csv" 1)))

;; Write LINES to FILE; returns T, or nil when the file cannot be written.
(defun cx:write-lines (file lines / f)
  (if (setq f (open file "w"))
    (progn
      (foreach l lines (write-line l f))
      (close f)
      T)))

;; Write CSV LINES to FILE and report it; returns T when the file was written.
(defun cx:csv-save (file lines)
  (if (cx:write-lines file lines)
    (progn (princ (strcat "\n" (itoa (1- (length lines))) " row(s) written to " file)) T)
    (progn (princ (strcat "\nThe file could not be written: " file)) nil)))

;; Selection set to a list of entity names.
(defun cx:ss->list (ss / i out)
  (setq i 0)
  (if ss
    (repeat (sslength ss)
      (setq out (cons (ssname ss i) out)
            i   (1+ i))))
  (reverse out))

(princ "\nCXBLK2CSV loaded. Type CXBLK2CSV to start.")
(princ)

Autres commandes : Export et import (CSV)

• CXTXT2CSVExporter les textes vers un fichier CSV
• CXCOORD2CSVExporter les coordonnées vers un fichier CSV
• CXLAYER2CSVExporter la liste des calques vers un fichier CSV
• CXAREA2CSVExporter surfaces et périmètres vers un fichier CSV
• CXOBJ2CSVExporter une liste d'objets vers un fichier CSV
• CXDIM2CSVExporter les valeurs des cotes vers un fichier CSV
• CXCSV2TXTPlacer des textes depuis un fichier CSV
• CXPTSTracer des points nommés depuis un fichier CSV
• CXCSV2ATTRenseigner les attributs de blocs depuis un fichier CSV