ai生成的一个批量修剪工具 可以选择需要修剪的对象
本帖最后由 f4800 于 2025-11-7 18:06 编辑用ai生成了一个批量修剪的lsp
有别于ET工具 Extrim ，但是用途类似，可以选择需要修剪的对象
目标：
1、选择一条直线或 PL 线作为裁剪边界
2、在需要裁剪的一侧点击任意点
3、选择裁剪对象（直线或PL线）
4、然后裁剪选择的对象
欢迎测试体验、继续完善
; 快捷命令
(defun c:ttt () (c:sidecut))
(defun c:trr () (c:sidecut))
(princ "\n命令已加载，输入 SIDECUT 或 trr 启动")
(princ)
(defun c:sidecut (/ *error* boundary pt1 pt2 side-pt is-left
target-ents i ent int-points)
(vl-load-com)
; 错误处理
(defun *error* (msg)
(if (not (member msg '("Function cancelled" "quit / exit abort" "")))
(princ (strcat "\n错误: " msg))
)
(princ)
)
; 1. 选择裁剪边界线
(setq boundary nil)
(while (not boundary)
(princ "\n选择裁剪边界线（直线/LWPOLYLINE/PLINE）: ")
(setq temp-sel (entsel))
(if temp-sel
(progn
(setq ent (car temp-sel)
ent-type (cdr (assoc 0 (entget ent))))
(if (member ent-type '("LINE" "LWPOLYLINE" "POLYLINE"))
(setq boundary ent)
(princ "\n无效对象！请选择直线或多段线。")
)
)
(princ "\n未选择，请重新选择。")
)
)
; 获取端点
(setq pt1 (vlax-curve-getStartPoint boundary)
pt2 (vlax-curve-getEndPoint boundary))
; 2. 指定裁剪侧
(princ "\n在需要裁剪的一侧点击任意点: ")
(setq side-pt (getpoint))
(if (not side-pt) (progn (princ "\n已取消") (exit)))
; 3. 判断点在直线的左侧还是右侧 - 使用叉积计算（避免 let 语法问题）
(setq dx1 (- (car pt2) (car pt1)))
(setq dy1 (- (cadr pt2) (cadr pt1)))
(setq dx2 (- (car side-pt) (car pt1)))
(setq dy2 (- (cadr side-pt) (cadr pt1)))
(setq is-left (> (* dx1 dy2) (* dy1 dx2)))
(princ (strcat "\n裁剪侧: " (if is-left "左侧" "右侧")))
; 4. 选择待裁剪对象
(princ "\n选择需要裁剪的对象（直线/PL线等）: ")
(setq target-ents (ssget))
(if (not target-ents) (progn (princ "\n未选择对象") (exit)))
; 5. 裁剪指定侧部分
(setq i 0)
(repeat (sslength target-ents)
(setq ent (ssname target-ents i))
(setq int-points (get-intersections ent boundary))
(if (and int-points (> (length int-points) 0))
(progn
(princ (strcat "\n对象" (itoa (1+ i)) "找到" (itoa (length int-points)) "个交点"))
; 调用基于TRIM的裁剪函数
(trim-with-trim ent boundary pt1 pt2 is-left)
)
(princ (strcat "\n对象" (itoa (1+ i)) "与边界线无交点，跳过"))
)
(setq i (1+ i))
)
(princ "\n裁剪完成!")
(princ)
)
; 辅助函数1：获取交点
(defun get-intersections (obj boundary / obj-vla bnd-vla ints points i)
(vl-catch-all-apply
(function (lambda ()
(setq obj-vla (vlax-ename->vla-object obj)
bnd-vla (vlax-ename->vla-object boundary)
ints (vlax-invoke obj-vla 'IntersectWith bnd-vla acExtendNone)
points nil
i 0
)
(while (< i (length ints))
(setq points (cons (list (nth i ints) (nth (1+ i) ints)) points))
(setq i (+ i 3))
)
(reverse points)
))
nil
)
)
; 核心改进：使用TRIM命令裁剪
(defun trim-with-trim (obj boundary pt1 pt2 is-left /
obj-type obj-data pts int-points segs new-ents)
(setq obj-type (cdr (assoc 0 (entget obj))))
; 仅处理直线和LWPOLYLINE（简化）
(cond
; ===== 处理直线 =====
((= obj-type "LINE")
(setq pts (list (cdr (assoc 10 (entget obj))) (cdr (assoc 11 (entget obj)))))
(setq int-points (get-intersections obj boundary))
(if (and int-points (= (length int-points) 1))
(progn
(setq segs (split-line-at-point pts (car int-points)))
(process-segments segs pt1 pt2 is-left obj)
)
(princ "\n直线交点数量异常，跳过")
)
)
; ===== 处理 LWPOLYLINE（简化：只处理无弧段的）=====
((= obj-type "LWPOLYLINE")
(princ "\n警告：LWPOLYLINE 裁剪暂未实现（可扩展）")
; 这里可以后续扩展，先跳过
)
(t
(princ "\n不支持的对象类型，跳过")
)
)
)
; 将直线按交点拆分为两段
(defun split-line-at-point (pts ip)
(list (list (car pts) ip) (list ip (cadr pts)))
)
; 判断并保留/删除线段，同时复制原对象属性
(defun process-segments (segs pt1 pt2 is-left orig-ent /
ent-data new-ents layer lt ltype color lw weight)
; 获取原对象的所有DXF组码数据
(setq ent-data (entget orig-ent))
; 提取常用属性（如果存在）
(setq layer(cdr (assoc 8ent-data))) ; 图层
(setq lt (cdr (assoc 6ent-data))) ; 线型（LTYPE）
(setq color(cdr (assoc 62 ent-data))) ; 颜色（0=ByLayer, 正数=索引色, 负数=真彩色）
(setq lw (cdr (assoc 370 ent-data))); 线宽（可选）
(setq weight (cdr (assoc 39 ent-data))) ; 厚度（可选）
(foreach seg segs
(setq mid-pt (midpoint (car seg) (cadr seg)))
(setq pt-is-left (is-point-left-of-line mid-pt pt1 pt2))
; 如果中点所在侧 ≠ 要裁剪的侧，则保留该段
(if (/= pt-is-left is-left)
(progn
; 构建新直线的DXF数据列表
(setq new-line-data
(list
'(0 . "LINE")
(cons 10 (car seg)) ; 起点
(cons 11 (cadr seg)) ; 终点
)
)
; 有条件地添加属性（避免 nil 值）
(if layer(setq new-line-data (append new-line-data (list (cons 8 layer)))))
(if lt (setq new-line-data (append new-line-data (list (cons 6 lt)))))
(if color(setq new-line-data (append new-line-data (list (cons 62 color)))))
(if lw (setq new-line-data (append new-line-data (list (cons 370 lw)))))
(if weight (setq new-line-data (append new-line-data (list (cons 39 weight)))))
; 创建新实体
(entmake new-line-data)
(setq new-ents (cons (entlast) new-ents))
)
)
)
; 删除原始对象
(entdel orig-ent)
new-ents
)
; 计算两点中点
(defun midpoint (p1 p2)
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
; 辅助函数3：判断点是否在直线左侧
(defun is-point-left-of-line (pt line-pt1 line-pt2)
(> (- (* (- (car line-pt2) (car line-pt1)) (- (cadr pt) (cadr line-pt1)))
(* (- (cadr line-pt2) (cadr line-pt1)) (- (car pt) (car line-pt1))))
0
)
)
本帖最后由 guosheyang 于 2025-11-2 10:47 编辑
extrim命令（et）就可以满足你了 搞定了。。。。
; 快捷命令
(defun c:ttt () (c:sidecut))
(defun c:trr () (c:sidecut))
(princ "\n命令已加载，输入 SIDECUT 或 trr 启动")
(princ)
(defun c:sidecut (/ *error* boundary pt1 pt2 side-pt is-left
target-ents i ent int-points)
(vl-load-com)
; 错误处理保持不变
(defun *error* (msg)
(if (not (member msg '("Function cancelled" "quit / exit abort" "")))
(princ (strcat "\n错误: " msg))
)
(princ)
)
; 1. 选择裁剪边界线（必须选中有效对象）
(setq boundary nil)
(while (not boundary)
(princ "\n选择裁剪边界线（直线/LWPOLYLINE/PLINE）: ")
(setq temp-sel (entsel))
(if temp-sel
(progn
(setq ent (car temp-sel)
ent-type (cdr (assoc 0 (entget ent))))
(if (member ent-type '("LINE" "LWPOLYLINE" "POLYLINE"))
(setq boundary ent)
(princ "\n无效对象！请选择直线或多段线。")
)
)
(princ "\n未选择，请重新选择。")
)
)
; 获取端点
(setq pt1 (vlax-curve-getStartPoint boundary)
pt2 (vlax-curve-getEndPoint boundary))
; 2. 指定裁剪侧（保持不变）
(princ "\n在需要裁剪的一侧点击任意点: ")
(setq side-pt (getpoint))
(if (not side-pt) (progn (princ "\n已取消") (exit)))
(setq is-left
(> (- (* (- (car pt2) (car pt1)) (- (cadr side-pt) (cadr pt1)))
(* (- (cadr pt2) (cadr pt1)) (- (car side-pt) (car pt1))))
0)
)
(princ (strcat "\n裁剪侧: " (if is-left "左侧" "右侧")))
; 3. 选择待裁剪对象（保持不变）
(princ "\n选择需要裁剪的对象（直线/PL线等）: ")
(setq target-ents (ssget))
(if (not target-ents) (progn (princ "\n未选择对象") (exit)))
; 4. 裁剪指定侧部分（核心修改：使用TRIM命令）
(setq i 0)
(repeat (sslength target-ents)
(setq ent (ssname target-ents i))
(setq int-points (get-intersections ent boundary))
(if (and int-points (> (length int-points) 0))
(progn
(princ (strcat "\n对象" (itoa (1+ i)) "找到" (itoa (length int-points)) "个交点"))
; 调用基于TRIM的裁剪函数
(trim-with-trim ent boundary pt1 pt2 is-left)
)
(princ (strcat "\n对象" (itoa (1+ i)) "与边界线无交点，跳过"))
)
(setq i (1+ i))
)
(princ "\n裁剪完成!")
(princ)
)
; 辅助函数1：获取交点（保持不变）
(defun get-intersections (obj boundary / obj-vla bnd-vla ints points i)
(vl-catch-all-apply
(function (lambda ()
(setq obj-vla (vlax-ename->vla-object obj)
bnd-vla (vlax-ename->vla-object boundary)
ints (vlax-invoke obj-vla 'IntersectWith bnd-vla acExtendNone)
points nil
i 0
)
(while (< i (length ints))
(setq points (cons (list (nth i ints) (nth (1+ i) ints)) points))
(setq i (+ i 3))
)
(reverse points)
))
nil
)
)
; 核心改进：使用TRIM命令裁剪
; 替换原来的 trim-with-trim 函数
(defun trim-with-trim (obj boundary pt1 pt2 is-left /
obj-type obj-data pts int-points segs new-ents)
(setq obj-type (cdr (assoc 0 (entget obj))))
; 仅处理直线和LWPOLYLINE（简化）
(cond
; ===== 处理直线 =====
((= obj-type "LINE")
(setq pts (list (cdr (assoc 10 (entget obj))) (cdr (assoc 11 (entget obj)))))
(setq int-points (get-intersections obj boundary))
(if (and int-points (= (length int-points) 1))
(progn
(setq segs (split-line-at-point pts (car int-points)))
(process-segments segs pt1 pt2 is-left obj)
)
(princ "\n直线交点数量异常，跳过")
)
)
; ===== 处理 LWPOLYLINE（简化：只处理无弧段的）=====
((= obj-type "LWPOLYLINE")
(princ "\n警告：LWPOLYLINE 裁剪暂未实现（可扩展）")
; 这里可以后续扩展，先跳过
)
(t
(princ "\n不支持的对象类型，跳过")
)
)
)
; 将直线按交点拆分为两段
(defun split-line-at-point (pts ip)
(list (list (car pts) ip) (list ip (cadr pts)))
)
; 判断并保留/删除线段
; 判断并保留/删除线段，同时复制原对象属性
(defun process-segments (segs pt1 pt2 is-left orig-ent /
ent-data new-ents layer lt ltype color lw weight)
; 获取原对象的所有DXF组码数据
(setq ent-data (entget orig-ent))
; 提取常用属性（如果存在）
(setq layer(cdr (assoc 8ent-data))) ; 图层
(setq lt (cdr (assoc 6ent-data))) ; 线型（LTYPE）
(setq color(cdr (assoc 62 ent-data))) ; 颜色（0=ByLayer, 正数=索引色, 负数=真彩色）
(setq lw (cdr (assoc 370 ent-data))); 线宽（可选）
(setq weight (cdr (assoc 39 ent-data))) ; 厚度（可选）
(foreach seg segs
(setq mid-pt (midpoint (car seg) (cadr seg)))
(setq pt-is-left (is-point-left-of-line mid-pt pt1 pt2))
; 如果中点所在侧 ≠ 要裁剪的侧，则保留该段
(if (/= pt-is-left is-left)
(progn
; 构建新直线的DXF数据列表
(setq new-line-data
(list
'(0 . "LINE")
(cons 10 (car seg)) ; 起点
(cons 11 (cadr seg)) ; 终点
)
)
; 有条件地添加属性（避免 nil 值）
(if layer(setq new-line-data (append new-line-data (list (cons 8 layer)))))
(if lt (setq new-line-data (append new-line-data (list (cons 6 lt)))))
(if color(setq new-line-data (append new-line-data (list (cons 62 color)))))
(if lw (setq new-line-data (append new-line-data (list (cons 370 lw)))))
(if weight (setq new-line-data (append new-line-data (list (cons 39 weight)))))
; 创建新实体
(entmake new-line-data)
(setq new-ents (cons (entlast) new-ents))
)
)
)
; 删除原始对象
(entdel orig-ent)
new-ents
)
; 计算两点中点
(defun midpoint (p1 p2)
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
)
; 辅助函数3：判断点是否在直线左侧（保持不变）
(defun is-point-left-of-line (pt line-pt1 line-pt2)
(> (- (* (- (car line-pt2) (car line-pt1)) (- (cadr pt) (cadr line-pt1)))
(* (- (cadr line-pt2) (cadr line-pt1)) (- (car pt) (car line-pt1))))
0)
)
这个和TRT有什么区别 guosheyang 发表于 2025-11-2 10:39
extrim命令（et）就可以满足你了
可行这个不错 一直没发现 这个和TRT有什么区别
阿猪蛋 发表于 2025-11-3 15:32
这个和TRT有什么区别
TRT ?我这没有这个命令。。。。。。。。。。 guosheyang 发表于 2025-11-2 10:39
extrim命令（et）就可以满足你了
厉害了哥，一直想找这个功能的插件，没想到，这是CAD自带的吗？非常感谢 好像只能用于裁剪直线 nzdog 发表于 2025-11-4 12:35
好像只能用于裁剪直线
也是新手 还在摸索阶段
页:
[1]