弄了个CAD插件

# ExtractLike LSP PluginAutoLISP 插件：点击 CAD 对象 → 提取所有"同类"对象（同图层 + 同实体类型）→ 导出 CSV。## 加载1. 命令行输入 `APPLOAD` 回车2. 选中 `ExtractLike.lsp` 点加载3. 命令行出现 `[ExtractLike] Loaded. Commands: XL / XB / XS`自动加载：把 `ExtractLike.lsp` 复制到 CAD 启动目录，或在 `acaddoc.lsp` 里加 `(load "ExtractLike.lsp")`。## 命令| 命令   | 用途                       || ---- | ------------------------ || `XL` | 点击对象 → 提取同图层 + 同类型的所有对象  || `XB` | 输入图层名（`*` 通配）→ 提取该图层所有对象 || `XS` | 框选对象 → 导出所选对象            |## CSV 列| 列        | 内容                         || -------- | -------------------------- || Index    | 序号（从 1 开始）                 || Handle   | AutoCAD 实体句柄               || Layer    | 图层名                        || Color    | 颜色（数字或 ByLayer）            || Geometry | 几何信息（Pos/Radius/Content 等） |## 支持的实体类型Line / Circle / Arc / Text / MText / BlockRef / Attribute / LWPolyline / Polyline / Dimension / Hatch / Solid## 编码CSV 写入 **UTF-8 with BOM**，Excel / WPS 双击直接打开中文不乱码。

;;; ExtractLike.lsp  v17.0;;; AutoCAD plugin: click an object -> extract all similar objects;;; (same Layer + same Entity Type) -> export to Excel.;;;;;; Load: APPLOAD -> select this file;;; Commands: XL / XB / XS;;;;;; v17.0: Fixed malformed XML structure so Excel parses columns;;;         correctly (Index | Handle | Layer | Color | Content).;;;         Dropped ASCII sanitization - bytes are written as-is and;;;         the file declares encoding="GB18030", so Chinese Windows;;;         Excel decodes degree (deg), cubic, phi, Chinese chars, etc.;;; v16.0: SpreadsheetML 2003 XML with .xls extension.;;; v15.x: CSV output (kept as design rationale; superseded).;;; v15.0: auto-reload on every command.;;; ============================================================;;; Source path - used for auto-reload.;;; Each c:XX entry calls (load *el-source-path*) so that editing this;;; file on disk takes effect on the next command run, without manual;;; APPLOAD. If you MOVE this file, update *el-source-path* below.;;; ============================================================(setq *el-source-path* "C:/Users/cijia/WorkBuddy/2026-09-20-14-23-52/ExtractLikeLSP/ExtractLike.lsp");;; ============================================================;;; Safe primitives;;; ============================================================(defun %el-s (v / out)  (cond    ((null v) "")    ((= (type v) (quote STR)) v)    ((= (type v) (quote INT)) (itoa v))    ((= (type v) (quote REAL)) (rtos v 2 4))    ((= (type v) (quote LIST))     (cond       ((= (length v) 0) "")       ((= (length v) 1) (strcat (chr 40) (%el-s (nth 0 v)) (chr 41)))       ((= (length v) 2)        (strcat (chr 40) (%el-s (nth 0 v)) (chr 44) (%el-s (nth 1 v)) (chr 41)))       ((= (length v) 3)        (strcat (chr 40) (%el-s (nth 0 v)) (chr 44) (%el-s (nth 1 v)) (chr 44) (%el-s (nth 2 v)) (chr 41)))       (T (%el-list-str v))))    (T "")))(defun %el-list-str (lst / out n i sep)  (if (null lst) "" (progn    (setq out "" n (length lst) i 0 sep "")    (while (< i n)      (setq out (strcat out sep (%el-s (nth i lst))))      (if (= sep "") (setq sep ","))      (setq i (1+ i)))    out)))(defun %el-or (a b) (if a a b));;; ============================================================;;; ActiveX helpers;;; ============================================================(defun %el-vla (ent)  (if (vl-catch-all-error-p        (vl-catch-all-apply (quote vlax-ename->vla-object) (list ent)))    nil    (vl-catch-all-apply (quote vlax-ename->vla-object) (list ent))))(defun %el-vget (ent prop / vla val)  (if (vl-catch-all-error-p        (setq vla (vl-catch-all-apply (quote vlax-ename->vla-object) (list ent))))    ""    (progn      (setq val (vl-catch-all-apply (quote vlax-get) (list vla prop)))      (if (vl-catch-all-error-p val) (setq val nil))      (if (and val (= (type val) (quote VARIANT)))        (if (vl-catch-all-error-p              (vl-catch-all-apply (quote vlax-variant-value) (list val)))          (setq val nil)          (setq val (vl-catch-all-apply (quote vlax-variant-value) (list val)))))      (%el-s val))))(defun %el-vcoord (ent prop / vla val lst)  (if (vl-catch-all-error-p        (setq vla (vl-catch-all-apply (quote vlax-ename->vla-object) (list ent))))    nil    (if (vl-catch-all-error-p          (setq val (vl-catch-all-apply (quote vlax-get) (list vla prop))))      nil      (if (vl-catch-all-error-p            (setq lst (vl-catch-all-apply (quote vlax-safearray->list) (list val))))        nil        lst))));;; ============================================================;;; XML entity escape: only & < > " ';;; Chars above 0x7F pass through untouched - encoding is declared as;;; GB18030 in the XML prolog, matching Chinese Windows codepage so;;; degree/cubic/phi/CJK characters round-trip into Excel correctly.;;; ============================================================(defun %el-xml (s / out i n c)  (if (not (= (type s) (quote STR))) (setq s (%el-s s)))  (if (= (strlen s) 0)    ""    (progn      (setq n (strlen s) out "" i 0)      (while (< i n)        (setq c (ascii (substr s (1+ i) 1)))        (cond          ((= c 38) (setq out (strcat out "&amp;")))          ((= c 60) (setq out (strcat out "&lt;")))          ((= c 62) (setq out (strcat out "&gt;")))          ((= c 34) (setq out (strcat out "&quot;")))          ((= c 39) (setq out (strcat out "&apos;")))          (T (setq out (strcat out (chr c)))))        (setq i (1+ i)))      out)))(defun %el-dq () (chr 34));;; ============================================================;;; SpreadsheetML 2003 writer;;; ============================================================(defun %el-write-xls (path rows / f i j r n cell hdr dq)  (setq dq (%el-dq) f (open path "w"))  ;; XML prolog with GB18030 encoding. Matches what AutoLISP writes  ;; on Chinese Windows; Excel decodes degree / cubic / Chinese chars.  (write-line (strcat "<?xml version=" dq "1.0" dq " encoding=" dq "GB18030" dq "?>") f)  (write-line (strcat "<?mso-application progid=" dq "Excel.Sheet" dq "?>") f)  (write-line (strcat "<Workbook xmlns=" dq "urn:schemas-microsoft-com:office:spreadsheet" dq                            " xmlns:o=" dq "urn:schemas-microsoft-com:office:office" dq                            " xmlns:x=" dq "urn:schemas-microsoft-com:office:excel" dq                            " xmlns:ss=" dq "urn:schemas-microsoft-com:office:spreadsheet" dq                            " xmlns:html=" dq "http://www.w3.org/TR/REC-html40" dq ">") f)  ;; Styles  (write-line "<Styles>" f)  (write-line (strcat "<Style ss:ID=" dq "Default" dq " ss:Name=" dq "Normal" dq ">"                       "<Font ss:FontName=" dq "Calibri" dq " ss:Size=" dq "11" dq "/><NumberFormat/>"                       "</Style>") f)  (write-line (strcat "<Style ss:ID=" dq "hdr" dq ">"                       "<Font ss:FontName=" dq "Calibri" dq " ss:Size=" dq "11" dq " ss:Bold=" dq "1" dq "/>"                       "<Interior ss:Color=" dq "#D0D0D0" dq " ss:Pattern=" dq "Solid" dq "/>"                       "<Borders>"                       "<Border ss:Position=" dq "Bottom" dq " ss:LineStyle=" dq "Continuous" dq " ss:Weight=" dq "1" dq "/>"                       "<Border ss:Position=" dq "Left" dq " ss:LineStyle=" dq "Continuous" dq " ss:Weight=" dq "1" dq "/>"                       "<Border ss:Position=" dq "Right" dq " ss:LineStyle=" dq "Continuous" dq " ss:Weight=" dq "1" dq "/>"                       "<Border ss:Position=" dq "Top" dq " ss:LineStyle=" dq "Continuous" dq " ss:Weight=" dq "1" dq "/>"                       "</Borders></Style>") f)  (write-line "</Styles>" f)  ;; Worksheet  (write-line (strcat "<Worksheet ss:Name=" dq "Extracted" dq "><Table>") f)  (if (> (length rows) 0)    (progn      ;; Header row      (write-line "<Row>" f)      (setq hdr (car rows) n (length hdr) j 0)      (repeat n        (setq cell (%el-s (nth j hdr)))        (write-line (strcat "<Cell ss:StyleID=" dq "hdr" dq "><Data ss:Type=" dq "String" dq ">"                             (%el-xml cell) "</Data></Cell>")          f)        (setq j (1+ j)))      (write-line "</Row>" f)      ;; Data rows      (setq i 1)      (repeat (- (length rows) 1)        (setq r (nth i rows))        (write-line "<Row>" f)        (setq j 0)        (repeat (length r)          (setq cell (%el-s (nth j r)))          (write-line (strcat "<Cell><Data ss:Type=" dq "String" dq ">"                               (%el-xml cell) "</Data></Cell>")            f)          (setq j (1+ j)))        (write-line "</Row>" f)        (setq i (1+ i)))))  (write-line "</Table></Worksheet></Workbook>" f)  (close f));;; ============================================================;;; Core: dump a selection set to Excel;;; ============================================================(defun %el-dump (ss title / cnt def path rows i ent hd layer color txt row)  (if (not ss) (exit))  (setq cnt (sslength ss))  (if (= cnt 0) (exit))  (setq def (strcat (%el-s (getvar "DWGPREFIX")) "extracted_" (%el-s title) ".xls"))  (setq path (getfiled "Save Excel File" def "xls" 1))  (if (not path) (progn (princ "\nCancelled.") (exit)))  (setq rows (list (list "Index" "Handle" "Layer" "Color" "Content")))  (setq i 0)  (repeat cnt    (setq ent (ssname ss i))    (setq hd (%el-vget ent (quote Handle)))    (setq layer (%el-vget ent (quote Layer)))    (setq color (%el-vget ent (quote Color)))    (if (= color "") (setq color "ByLayer"))    ;; TextString: bytes are written raw (system codepage).    ;; encoding="GB18030" in XML prolog makes Excel decode them    ;; back to the same Unicode chars (deg, cubic, phi, CJK...).    (setq txt (%el-vget ent (quote TextString)))    (if (= txt "") (setq txt "(no text)"))    (setq row (list (itoa (1+ i)) hd layer color txt))    (setq rows (append rows (list row)))    (setq i (1+ i)))  (%el-write-xls path rows)  (princ (strcat "\n[ExtractLike v17.0] Exported " (itoa cnt) " object(s) to: " path))  (princ));;; ============================================================;;; User commands (with auto-reload);;; ============================================================(defun %el-reload ()  (if (and *el-source-path* (findfile *el-source-path*))    (load *el-source-path*)))(defun %el-do-XL (/ ent etype layer ss cnt)  (setq ent (car (entsel "\n[XL] Click an object: ")))  (if (not ent) (progn (princ "\nNo object selected.") (exit)))  (setq etype (%el-s (cdr (assoc 0 (entget ent)))))  (if (= etype "") (setq etype "UNKNOWN"))  (setq layer (%el-vget ent (quote Layer)))  (princ (strcat "\n  Layer='" layer "'  Type='" etype "'"))  (setq ss (ssget "X" (list (cons 8 layer) (cons 0 etype))))  (if (not ss) (progn (princ "\nNo matching objects.") (exit)))  (setq cnt (sslength ss))  (princ (strcat "  Found " (itoa cnt) " object(s)."))  (%el-dump ss (strcat layer "_" etype))  (princ))(defun %el-do-XB (/ layer ss cnt)  (setq layer (getstring t "\n[XB] Enter layer name (* = all): "))  (if (= (strlen layer) 0) (setq layer "*"))  (setq ss (ssget "X" (list (cons 8 layer))))  (if (not ss) (progn (princ "\nNo objects.") (exit)))  (setq cnt (sslength ss))  (princ (strcat "  Found " (itoa cnt) " object(s) on layers matching '" layer "'."))  (%el-dump ss layer)  (princ))(defun %el-do-XS (/ ss cnt)  (setq ss (ssget ":S" "\n[XS] Select objects: "))  (if (not ss) (progn (princ "\nNo objects selected.") (exit)))  (setq cnt (sslength ss))  (princ (strcat "  Selected " (itoa cnt) " object(s)."))  (%el-dump ss "selected")  (princ))(defun c:XL (/ )  (%el-reload)  (%el-do-XL))(defun c:XB (/ )  (%el-reload)  (%el-do-XB))(defun c:XS (/ )  (%el-reload)  (%el-do-XS))(princ "\n[ExtractLike v17.0] Loaded. Commands: XL / XB / XS. Auto-reload. Output is .xls (GB18030).")(princ)

| `XL` | 点击对象 → 提取同图层 + 同类型的所有对象  || `XB` | 输入图层名（`*` 通配）→ 提取该图层所有对象 || `XS` | 框选对象 → 导出所选对象            |