Untitled
unknown
lisp
a year ago
12 kB
14
Indexable
;; HEXCLIP.lsp - 批量正六边形剪裁脚本
;; 功能：根据CSV文件中的坐标数据，批量剪裁REGION对象并移动到目标位置
;; 作者：AutoLISP Script Generator
;; 日期：2025-08-23
;; 辅助函数：创建或确保图层存在
(defun ensure-layer-exists (layer-name layer-color / layer-table layer-entry)
(setq layer-table (tblsearch "LAYER" layer-name))
(if (not layer-table)
(progn
;; 创建新图层
(command "_.LAYER" "_N" layer-name "_C" (itoa layer-color) layer-name "")
(princ (strcat "已创建图层：" layer-name "\n"))
)
)
layer-name
)
;; 辅助函数：在指定图层创建正六边形面域
(defun create-hexagon-on-layer (center-x center-y center-z edge-length layer-name / old-layer radius angle1 angle2 angle3 angle4 angle5 angle6 pt1 pt2 pt3 pt4 pt5 pt6 hexPline hexRegion)
;; 保存当前图层并切换到指定图层
(setq old-layer (getvar "CLAYER"))
(setvar "CLAYER" layer-name)
(setq radius edge-length) ; 对于正六边形，外接圆半径等于边长
;; 正六边形顶点通过中心点和角度计算（上下边平行，从右侧开始，逆时针）
(setq angle1 0.0) ; 0°
(setq angle2 (/ pi 3.0)) ; 60°
(setq angle3 (* 2.0 (/ pi 3.0))) ; 120°
(setq angle4 pi) ; 180°
(setq angle5 (* 4.0 (/ pi 3.0))) ; 240°
(setq angle6 (* 5.0 (/ pi 3.0))) ; 300°
;; 根据中心点和角度计算各顶点坐标
(setq pt1 (list (+ center-x (* radius (cos angle1)))
(+ center-y (* radius (sin angle1)))
center-z))
(setq pt2 (list (+ center-x (* radius (cos angle2)))
(+ center-y (* radius (sin angle2)))
center-z))
(setq pt3 (list (+ center-x (* radius (cos angle3)))
(+ center-y (* radius (sin angle3)))
center-z))
(setq pt4 (list (+ center-x (* radius (cos angle4)))
(+ center-y (* radius (sin angle4)))
center-z))
(setq pt5 (list (+ center-x (* radius (cos angle5)))
(+ center-y (* radius (sin angle5)))
center-z))
(setq pt6 (list (+ center-x (* radius (cos angle6)))
(+ center-y (* radius (sin angle6)))
center-z))
;; 创建正六边形多段线
(command "_.PLINE" pt1 pt2 pt3 pt4 pt5 pt6 "_C")
(setq hexPline (entlast))
;; 将六边形多段线转换为面域
(command "_.REGION" hexPline "")
(setq hexRegion (entlast))
;; 恢复原图层
(setvar "CLAYER" old-layer)
hexRegion
)
;; 辅助函数：单次剪裁操作
(defun clip-regions-with-hexagon (clip-x clip-y target-x target-y layer-name / edge-length ssRegions ssTemp i ent entCopy result-ent result-regions temp-layer-name displacement-x displacement-y unionRegion hexcutter)
(setq edge-length (/ 125.0 (sqrt 3.0)))
(setq temp-layer-name "TEMP_HEXCLIP")
(setq displacement-x (- target-x clip-x))
(setq displacement-y (- target-y clip-y))
;; 获取指定图层上的所有 REGION 对象
(setq ssRegions (ssget "X" (list '(0 . "REGION") (cons 8 layer-name))))
(if ssRegions
(progn
(setq result-regions '())
;; 先将所有原始REGION复制到临时图层
(princ " 复制原始REGION到临时图层...\n")
(repeat (setq i (sslength ssRegions))
(setq ent (ssname ssRegions (setq i (1- i))))
(if ent
(progn
;; 复制原始REGION对象到临时图层
(command "_.COPY" ent "" '(0 0 0) '(0 0 0))
(setq entCopy (entlast))
(command "_.CHPROP" entCopy "" "_LA" temp-layer-name "")
)
)
)
;; 获取临时图层上的所有REGION对象（复制的原始对象）
(setq ssTemp (ssget "X" (list '(0 . "REGION") (cons 8 temp-layer-name))))
(if ssTemp
(progn
(princ " 合并所有REGION对象...\n")
;; 使用UNION将所有REGION合并为一个
(if (> (sslength ssTemp) 1)
(progn
(command "_.UNION" ssTemp "")
(setq unionRegion (entlast))
(princ " REGION合并完成。\n")
)
(progn
;; 只有一个REGION，直接使用
(setq unionRegion (ssname ssTemp 0))
(princ " 只有一个REGION，无需合并。\n")
)
)
(princ " 创建六边形并执行交集运算...\n")
;; 创建六边形用于交集运算
(setq hexcutter (create-hexagon-on-layer clip-x clip-y 0.0 edge-length temp-layer-name))
;; 执行交集操作（剪裁）
(command "_.INTERSECT" unionRegion hexcutter "")
;; 检查交集结果是否存在
(setq result-ent (entlast))
(if (and result-ent
(= (cdr (assoc 0 (entget result-ent))) "REGION"))
(progn
;; 移动剪裁结果到目标位置
(command "_.MOVE" result-ent ""
'(0 0 0)
(list displacement-x displacement-y 0.0))
;; 将结果移动到result图层
(command "_.CHPROP" result-ent "" "_LA" "result" "")
;; 为REGION添加HATCH填充到剖面线层
(princ " 为REGION添加填充...\n")
(setvar "CLAYER" "剖面线层")
(command "_.HATCH" "ANSI31" "1.0" "0.0" result-ent "")
(setq result-regions (cons result-ent result-regions))
(princ " 交集运算和填充成功完成。\n")
)
(princ " 交集运算未产生有效结果。\n")
)
)
)
;; 清理临时图层上的所有对象
(setq ssTemp (ssget "X" (list (cons 8 temp-layer-name))))
(if ssTemp
(command "_.ERASE" ssTemp "")
)
(length result-regions)
)
)
)
;; 辅助函数：读取CSV文件
(defun read-csv-file (filename / file line-data coord-list line parts)
(setq coord-list '())
(setq file (open filename "r"))
(if file
(progn
;; 跳过表头
(read-line file)
;; 读取数据行
(while (setq line (read-line file))
(if (> (strlen line) 0)
(progn
;; 分割CSV行（简单的逗号分割）
(setq parts (str-split line ","))
(if (>= (length parts) 4)
(progn
(setq line-data (list
(atof (nth 0 parts)) ; 裁剪坐标x
(atof (nth 1 parts)) ; 裁剪坐标y
(atof (nth 2 parts)) ; 放置坐标x
(atof (nth 3 parts)) ; 放置坐标y
))
(setq coord-list (cons line-data coord-list))
)
)
)
)
)
(close file)
(reverse coord-list)
)
nil
)
)
;; 辅助函数：字符串分割
(defun str-split (str delimiter / pos result part)
(setq result '())
(while (setq pos (vl-string-search delimiter str))
(setq part (substr str 1 pos))
(setq result (cons part result))
(setq str (substr str (+ pos 2)))
)
(setq result (cons str result))
(reverse result)
)
;; 主函数：批量剪裁
(defun c:hexclip (/ opn2 opn3 old-osmode csv-file coord-list total-count success-count current-count
clip-x clip-y target-x target-y coord-data layer-name user-csv temp-objects j temp-ent)
;; 保存系统变量
(setq opn2 (getvar "cmdecho"))
(setq opn3 (getvar "blipmode"))
(setq old-osmode (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setvar "osmode" 0)
;; 让用户通过文件对话框选择CSV文件
(princ "\n请选择CSV文件...")
(setq user-csv (getfiled "选择CSV坐标文件" "c:/Users/hehao/Downloads/CAD_CUT/" "csv" 0))
(if (not user-csv)
(progn
(princ "\n用户取消了CSV文件选择，使用默认文件。")
(setq csv-file "c:/Users/hehao/Downloads/CAD_CUT/coordinates_lite.csv")
)
(setq csv-file user-csv)
)
;; 检查CSV文件是否存在
(if (not (findfile csv-file))
(progn
(princ (strcat "\n错误：找不到CSV文件：" csv-file))
(princ "\n请检查文件路径是否正确。")
(setvar "osmode" old-osmode)
(setvar "cmdecho" opn2)
(setvar "blipmode" opn3)
(princ)
(exit)
)
)
(setq layer-name "粗实线层")
;; 创建必要的图层
(ensure-layer-exists "result" 7) ; 白色结果图层
(ensure-layer-exists "剖面线层" 3) ; 绿色剖面线图层
(ensure-layer-exists "TEMP_HEXCLIP" 8) ; 灰色临时图层
(princ "开始批量正六边形剪裁操作...\n")
(princ (strcat "使用CSV文件：" csv-file "\n"))
(princ "结果将保存到图层：result\n")
;; 读取CSV文件
(setq coord-list (read-csv-file csv-file))
(if coord-list
(progn
(setq total-count (length coord-list))
(setq success-count 0)
(setq current-count 0)
(princ (strcat "找到 " (itoa total-count) " 个坐标对。\n"))
;; 处理每个坐标对
(foreach coord-data coord-list
(setq current-count (1+ current-count))
(setq clip-x (nth 0 coord-data))
(setq clip-y (nth 1 coord-data))
(setq target-x (nth 2 coord-data))
(setq target-y (nth 3 coord-data))
(princ (strcat "处理第 " (itoa current-count) "/" (itoa total-count)
" 个：剪裁(" (rtos clip-x 2 3) "," (rtos clip-y 2 3)
") 移动到(" (rtos target-x 2 3) "," (rtos target-y 2 3) ")\n"))
;; 执行单次剪裁操作
(setq result-count (clip-regions-with-hexagon clip-x clip-y target-x target-y layer-name))
(if (and result-count (> result-count 0))
(progn
(setq success-count (1+ success-count))
(princ (strcat " 成功剪裁 " (itoa result-count) " 个REGION对象。\n"))
)
(princ " 此位置没有找到可剪裁的REGION对象。\n")
)
)
;; 清理所有临时图层上的对象（最终清理）
(princ "执行最终清理...\n")
(setq temp-objects (ssget "X" (list (cons 8 "TEMP_HEXCLIP"))))
(if temp-objects
(progn
(repeat (setq j (sslength temp-objects))
(setq temp-ent (ssname temp-objects (setq j (1- j))))
(if temp-ent (entdel temp-ent))
)
(princ (strcat "已清理 " (itoa (sslength temp-objects)) " 个临时对象。\n"))
)
)
;; 设置当前图层为result图层以便查看结果
(command "_.LAYER" "_S" "result" "")
;; 显示最终结果
(princ (strcat "\n批量剪裁操作完成！\n"))
(princ (strcat "总共处理：" (itoa total-count) " 个坐标对\n"))
(princ (strcat "成功剪裁：" (itoa success-count) " 个位置\n"))
(princ "所有结果已保存到图层：result\n")
(princ "当前图层已切换到：result\n")
)
(princ (strcat "无法读取CSV文件：" csv-file "\n"))
)
;; 恢复系统变量
(setvar "osmode" old-osmode)
(setvar "cmdecho" opn2)
(setvar "blipmode" opn3)
;; 刷新显示
(command "_.ZOOM" "_E")
(command "_.REGEN")
(princ)
)
;; 加载完成提示
(princ "\n正六边形批量剪裁脚本已加载。")
(princ "\n使用命令: HEXCLIP")
(princ "\n功能: 根据CSV文件批量剪裁并移动REGION对象到新图层")
(princ "\n使用方法:")
(princ "\n 1. 运行 HEXCLIP 命令")
(princ "\n 2. 在弹出的文件对话框中选择CSV文件（或取消使用默认）")
(princ "\n 3. 脚本将自动完成批量处理并创建result图层")
(princ "\n 4. 原始对象保持不变，剪裁结果保存到result图层")
(princ "\n默认CSV文件: coordinates_lite.csv")
(princ "\n结果图层: result (白色)")
(princ)
Editor is loading...
Leave a Comment