座標を CSV ファイルに書き出す

隠している部分のないテキストです。cxcoord2csv.lsp という名前のファイルにコピーするか、ダウンロードしてください。

;;; ============================================================================
;;; CXCOORD2CSV - Export coordinates to a CSV file
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxcoord2csv
;;; 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) with the coordinates of the objects in NAMES: object number, type, layer, point number,
;; x, y, z. A point, circle, arc, text or block gives one point (its center or insertion point), a line two, a
;; polyline one per vertex.
(defun cx:coord2csv-lines (names / rows n i ed)
  (setq n 0)
  (foreach e names
    (setq ed (entget e) n (1+ n) i 0)
    (foreach p (cx:coord-points ed)
      (setq i (1+ i))
      (setq rows (cons (cx:csv-line (list (itoa n) (cx:dxf 0 ed) (cx:dxf 8 ed) (itoa i)
                                          (cx:n4 (car p)) (cx:n4 (cadr p))
                                          (cx:n4 (if (and (caddr p) (numberp (caddr p))) (caddr p) 0.0))))
                       rows))))
  (cons "Object,Type,Layer,Point,X,Y,Z" (reverse rows)))

(defun c:CXCOORD2CSV ( / *error* cx:sv ss file)
  (setq *error* cx:err)
  (if (setq ss (cx:pick "\nSelect points, lines, polylines, circles, text or blocks: "
                        '((0 . "POINT,LINE,LWPOLYLINE,CIRCLE,ARC,TEXT,MTEXT,INSERT"))))
    (if (setq file (cx:file-save "Save the coordinates as CSV" "coordinates"))
      (cx:csv-save file (cx:coord2csv-lines (cx:ss->list ss)))))
  (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))

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

ほかのコマンド：書き出しと取り込み（CSV）

• CXTXT2CSV文字を CSV ファイルに書き出す
• CXBLK2CSVブロックと属性を CSV ファイルに書き出す
• CXLAYER2CSV画層の一覧を CSV ファイルに書き出す
• CXAREA2CSV面積と周長を CSV ファイルに書き出す
• CXOBJ2CSV図形の一覧を CSV ファイルに書き出す
• CXDIM2CSV寸法の値を CSV ファイルに書き出す
• CXCSV2TXTCSV ファイルから文字を配置
• CXPTSCSV ファイルから名前付きの点を配置
• CXCSV2ATTCSV ファイルからブロック属性を入力