面積と周長を CSV ファイルに書き出す

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

;;; ============================================================================
;;; CXAREA2CSV - Export areas and perimeters to a CSV file
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxarea2csv
;;; 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 closed polylines, circles and full ellipses in NAMES: handle, type, layer, area,
;; perimeter, centroid x and y. Open objects are skipped.
(defun cx:area2csv-lines (names / rows ed c)
  (foreach e names
    (setq ed (entget e))
    (if (cx:ent-area ed)
      (progn
        (setq c (car (cx:centroid-run (list e))))
        (setq rows (cons (cx:csv-line (list (cx:dxf 5 ed) (cx:dxf 0 ed) (cx:dxf 8 ed)
                                            (cx:n4 (cx:ent-area ed)) (cx:n4 (cx:ent-length ed))
                                            (cx:n4 (car c)) (cx:n4 (cadr c))))
                         rows)))))
  (cons "Handle,Type,Layer,Area,Perimeter,CentroidX,CentroidY" (reverse rows)))

(defun c:CXAREA2CSV ( / *error* cx:sv ss file)
  (setq *error* cx:err)
  (if (setq ss (cx:pick "\nSelect closed polylines, circles or ellipses: " '((0 . "LWPOLYLINE,CIRCLE,ELLIPSE"))))
    (if (setq file (cx:file-save "Save the areas as CSV" "areas"))
      (cx:csv-save file (cx:area2csv-lines (cx:ss->list ss)))))
  (princ))


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

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

;; True for a closed polyline, a circle and a full ellipse.
(defun cx:ent-closed (ed / type)
  (setq type (cx:dxf 0 ed))
  (cond
    ((= type "LWPOLYLINE") (= 1 (logand 1 (cx:dxf 70 ed))))
    ((= type "CIRCLE") T)
    ((= type "ELLIPSE") (< (abs (- (- (cx:dxf 42 ed) (cx:dxf 41 ed)) (* 2.0 pi))) 1e-6))))

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

;; The arc a bulge makes between P1 and P2 as (center-x center-y radius start-angle sweep), or nil for a straight segment.
;; The sweep is signed: positive turns counter-clockwise.
(defun cx:bulge-arc (p1 p2 b / theta dx dy len nx ny d ccx ccy)
  (if (< (abs b) 1e-9)
    nil
    (progn
      (setq theta (* 4.0 (atan b))
            dx    (- (car p2) (car p1))
            dy    (- (cadr p2) (cadr p1))
            len   (sqrt (+ (* dx dx) (* dy dy))))
      (if (< len 1e-12)
        nil
        (progn
          (setq nx  (/ (- dy) len)
                ny  (/ dx len)
                d   (/ (/ len 2.0) (/ (sin (/ theta 2.0)) (cos (/ theta 2.0))))
                ccx (+ (/ (+ (car p1) (car p2)) 2.0) (* nx d))
                ccy (+ (/ (+ (cadr p1) (cadr p2)) 2.0) (* ny d)))
          (list ccx ccy (/ len (* 2.0 (sin (/ (abs theta) 2.0))))
                (atan (- (cadr p1) ccy) (- (car p1) ccx)) theta))))))

;; The area of a closed polyline with its arc segments.
(defun cx:lw-area (verts / sum i n a v1 v2)
  (setq sum 0.0 i 0 n (length verts))
  (repeat n
    (setq v1  (nth i verts)
          v2  (nth (rem (1+ i) n) verts)
          sum (+ sum (/ (- (* (car v1) (cadr v2)) (* (car v2) (cadr v1))) 2.0))
          a   (cx:bulge-arc v1 v2 (nth 2 v1)))
    (if a
      (setq sum (+ sum (* 0.5 (nth 2 a) (nth 2 a) (- (nth 4 a) (sin (nth 4 a)))))))
    (setq i (1+ i)))
  (abs sum))

;; The area of a closed polyline, a circle or a full ellipse; nil for other objects.
(defun cx:ent-area (ed / type a)
  (setq type (cx:dxf 0 ed))
  (cond
    ((not (cx:ent-closed ed)) nil)
    ((= type "LWPOLYLINE") (cx:lw-area (cx:lw-verts ed)))
    ((= type "CIRCLE") (* pi (cx:dxf 40 ed) (cx:dxf 40 ed)))
    ((= type "ELLIPSE")
     (setq a (distance '(0.0 0.0 0.0) (cx:dxf 11 ed)))
     (* pi a a (cx:dxf 40 ed)))))

;; The centroid of a closed polyline with its arc segments, and its area: ((x y) area).
(defun cx:lw-centroid (verts / n i v1 v2 a f ap sx sy seg dd mid)
  (setq n (length verts) i 0 ap 0.0 sx 0.0 sy 0.0)
  ;; the polygon through the vertices
  (repeat n
    (setq v1 (nth i verts)
          v2 (nth (rem (1+ i) n) verts)
          f  (- (* (car v1) (cadr v2)) (* (car v2) (cadr v1)))
          ap (+ ap (/ f 2.0))
          sx (+ sx (/ (* (+ (car v1) (car v2)) f) 6.0))
          sy (+ sy (/ (* (+ (cadr v1) (cadr v2)) f) 6.0)))
    (setq i (1+ i)))
  ;; plus the circular segment of every arc
  (setq i 0)
  (repeat n
    (setq v1 (nth i verts)
          v2 (nth (rem (1+ i) n) verts)
          a  (cx:bulge-arc v1 v2 (nth 2 v1)))
    (if a
      (progn
        (setq seg (* 0.5 (nth 2 a) (nth 2 a) (- (nth 4 a) (sin (nth 4 a))))
              dd  (/ (* 4.0 (nth 2 a) (expt (sin (/ (nth 4 a) 2.0)) 3)) (* 3.0 (- (nth 4 a) (sin (nth 4 a)))))
              mid (+ (nth 3 a) (/ (nth 4 a) 2.0))
              ap  (+ ap seg)
              sx  (+ sx (* seg (+ (car a) (* dd (cos mid)))))
              sy  (+ sy (* seg (+ (cadr a) (* dd (sin mid))))))))
    (setq i (1+ i)))
  (if (< (abs ap) 1e-12)
    (list (list (car (car verts)) (cadr (car verts))) 0.0)
    (list (list (/ sx ap) (/ sy ap)) (abs ap))))

;; The centroid of every closed polyline (arcs included), circle and full ellipse in NAMES: ((x y) ...).
(defun cx:centroid-run (names / out ed)
  (foreach e names
    (setq ed (entget e))
    (cond
      ((not (cx:ent-closed ed)))
      ((= (cx:dxf 0 ed) "LWPOLYLINE") (setq out (cons (car (cx:lw-centroid (cx:lw-verts ed))) out)))
      (T (setq out (cons (list (car (cx:dxf 10 ed)) (cadr (cx:dxf 10 ed))) out)))))
  (reverse 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 number of segments of a polyline with N vertices.
(defun cx:seg-count (n closed)
  (if closed n (1- n)))

;; A polyline as a list of (x y) points; arcs are cut into short straight pieces.
(defun cx:lw-points (verts closed / out i n a v1 v2 k steps ang)
  (setq i 0 n (length verts))
  (repeat (cx:seg-count n closed)
    (setq v1  (nth i verts)
          v2  (nth (rem (1+ i) n) verts)
          a   (cx:bulge-arc v1 v2 (nth 2 v1))
          out (cons (list (car v1) (cadr v1)) out))
    (if a
      (progn
        (setq steps (max 4 (fix (/ (abs (nth 4 a)) 0.15))) k 1)
        (while (< k steps)
          (setq ang (+ (nth 3 a) (* (nth 4 a) (/ (float k) steps)))
                out (cons (list (+ (car a) (* (nth 2 a) (cos ang))) (+ (cadr a) (* (nth 2 a) (sin ang)))) out)
                k   (1+ k)))))
    (setq i (1+ i)))
  (if (not closed)
    (setq out (cons (list (car (last verts)) (cadr (last verts))) out)))
  (reverse out))

;; An object as a list of (x y) points; circles and ellipses are cut into 120 pieces, arcs into short pieces.
;; Returns nil for an object it does not know.
(defun cx:ent-points (ed / type ctr r a1 a2 k pts ratio ang maj steps)
  (setq type (cx:dxf 0 ed))
  (cond
    ((= type "LWPOLYLINE") (cx:lw-points (cx:lw-verts ed) (= 1 (logand 1 (cx:dxf 70 ed)))))
    ((= type "LINE")
     (list (list (car (cx:dxf 10 ed)) (cadr (cx:dxf 10 ed))) (list (car (cx:dxf 11 ed)) (cadr (cx:dxf 11 ed)))))
    ((= type "CIRCLE")
     (setq ctr (cx:dxf 10 ed) r (cx:dxf 40 ed) k 0)
     (repeat 120
       (setq ang (* 2.0 pi (/ k 120.0))
             pts (cons (list (+ (car ctr) (* r (cos ang))) (+ (cadr ctr) (* r (sin ang)))) pts)
             k   (1+ k)))
     (reverse pts))
    ((= type "ARC")
     (setq ctr (cx:dxf 10 ed) r (cx:dxf 40 ed) a1 (cx:dxf 50 ed) a2 (cx:dxf 51 ed))
     (if (<= a2 a1) (setq a2 (+ a2 (* 2.0 pi))))
     (setq steps (max 8 (fix (/ (- a2 a1) 0.05))) k 0)
     (repeat (1+ steps)
       (setq ang (+ a1 (* (- a2 a1) (/ (float k) steps)))
             pts (cons (list (+ (car ctr) (* r (cos ang))) (+ (cadr ctr) (* r (sin ang)))) pts)
             k   (1+ k)))
     (reverse pts))
    ((= type "ELLIPSE")
     (setq ctr (cx:dxf 10 ed) maj (cx:dxf 11 ed) ratio (cx:dxf 40 ed) a1 (cx:dxf 41 ed) a2 (cx:dxf 42 ed))
     (if (<= a2 a1) (setq a2 (+ a2 (* 2.0 pi))))
     (setq k 0)
     (repeat 121
       (setq ang (+ a1 (* (- a2 a1) (/ k 120.0)))
             pts (cons (list (+ (car ctr) (* (car maj) (cos ang)) (* (- (cadr maj)) ratio (sin ang)))
                             (+ (cadr ctr) (* (cadr maj) (cos ang)) (* (car maj) ratio (sin ang))))
                       pts)
             k   (1+ k)))
     (reverse pts))))

(defun cx:lw-length (verts closed / total i n a v1 v2)
  (setq total 0.0 i 0 n (length verts))
  (repeat (cx:seg-count n closed)
    (setq v1    (nth i verts)
          v2    (nth (rem (1+ i) n) verts)
          a     (cx:bulge-arc v1 v2 (nth 2 v1))
          total (+ total (if a
                           (* (nth 2 a) (abs (nth 4 a)))
                           (distance (list (car v1) (cadr v1)) (list (car v2) (cadr v2))))))
    (setq i (1+ i)))
  total)

;; The length of a line, arc, polyline, circle (its circumference) or ellipse; nil for other objects.
(defun cx:ent-length (ed / type pts total i s)
  (setq type (cx:dxf 0 ed))
  (cond
    ((= type "LINE") (distance (cx:dxf 10 ed) (cx:dxf 11 ed)))
    ((= type "CIRCLE") (* 2.0 pi (cx:dxf 40 ed)))
    ((= type "ARC")
     (setq s (- (cx:dxf 51 ed) (cx:dxf 50 ed)))
     (if (<= s 0.0) (setq s (+ s (* 2.0 pi))))
     (* (cx:dxf 40 ed) s))
    ((= type "LWPOLYLINE") (cx:lw-length (cx:lw-verts ed) (cx:ent-closed ed)))
    ((= type "ELLIPSE")
     (setq pts (cx:ent-points ed) total 0.0 i 0)
     (repeat (1- (length pts))
       (setq total (+ total (distance (nth i pts) (nth (1+ i) pts))) i (1+ i)))
     total)))

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

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

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