Exporter une liste d'objets vers un fichier CSV

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

;;; ============================================================================
;;; CXOBJ2CSV - Export an object list to a CSV file
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxobj2csv
;;; 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) listing the objects in NAMES: handle, type, layer, color number (0 = by layer), linetype
;; (empty = by layer), x and y of the first point.
(defun cx:obj2csv-lines (names / rows ed p)
  (foreach e names
    (setq ed (entget e)
          p  (car (cx:coord-points ed)))
    (setq rows (cons (cx:csv-line (list (cx:dxf 5 ed) (cx:dxf 0 ed) (cx:dxf 8 ed)
                                        (itoa (if (cx:dxf 62 ed) (cx:dxf 62 ed) 0))
                                        (if (cx:dxf 6 ed) (cx:dxf 6 ed) "")
                                        (if p (cx:n4 (car p)) "") (if p (cx:n4 (cadr p)) "")))
                     rows)))
  (cons "Handle,Type,Layer,Color,Linetype,X,Y" (reverse rows)))

(defun c:CXOBJ2CSV ( / *error* cx:sv ss file)
  (setq *error* cx:err)
  (setq ss (if (= (cx:ask-kw "Export objects in" "All Selection" "All") "All")
             (ssget "X" (list (cons 410 (getvar "CTAB"))))
             (cx:pick "\nSelect objects: " nil)))
  (if ss
    (if (setq file (cx:file-save "Save the object list as CSV" "objects"))
      (cx:csv-save file (cx:obj2csv-lines (cx:ss->list ss))))
    (princ "\nNothing found."))
  (princ))


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

;; The vertices of an LWPOLYLINE entity list as ((x y bulge start-width end-width) ...).
(defun cx:lw-verts (ed / out cur)
  (foreach g ed
    (cond
      ((= (car g) 10)
       (if cur (setq out (cons cur out)))
       (setq cur (list (cadr g) (caddr g) 0.0 0.0 0.0)))
      ((and cur (= (car g) 40)) (setq cur (list (nth 0 cur) (nth 1 cur) (nth 2 cur) (cdr g) (nth 4 cur))))
      ((and cur (= (car g) 41)) (setq cur (list (nth 0 cur) (nth 1 cur) (nth 2 cur) (nth 3 cur) (cdr g))))
      ((and cur (= (car g) 42)) (setq cur (list (nth 0 cur) (nth 1 cur) (cdr g) (nth 3 cur) (nth 4 cur))))))
  (if cur (setq out (cons cur out)))
  (reverse out))

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

;; The points that describe an entity: a line gives its two ends, a polyline its vertices, anything else its
;; insertion or center point. Each point is (x y z).
(defun cx:coord-points (ed / type)
  (setq type (cx:dxf 0 ed))
  (cond
    ((= type "LINE") (list (cx:dxf 10 ed) (cx:dxf 11 ed)))
    ((= type "LWPOLYLINE") (mapcar (function (lambda (v) (list (car v) (cadr v) (cx:dxf 38 ed)))) (cx:lw-verts ed)))
    ((cx:dxf 10 ed) (list (cx:dxf 10 ed)))))

;;; Layer helpers. See helpers.lsp for the format.

;; 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.

;; 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 "\nCXOBJ2CSV loaded. Type CXOBJ2CSV to start.")
(princ)

Autres commandes : Export et import (CSV)

• CXTXT2CSVExporter les textes vers un fichier CSV
• CXBLK2CSVExporter les blocs et leurs attributs 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
• 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