本帖最后由 f4800 于 2025-11-7 18:06 编辑

用ai生成了一个批量修剪的lsp
有别于ET工具 Extrim ，但是用途类似，可以选择需要修剪的对象

目标：
1、选择一条直线或 PL 线作为裁剪边界
2、在需要裁剪的一侧点击任意点
3、选择裁剪对象（直线或PL线）
4、然后裁剪选择的对象


欢迎测试体验、继续完善

  2. ; 快捷命令
  3. (defun c:ttt () (c:sidecut))
  4. (defun c:trr () (c:sidecut))

  6. (princ "\n命令已加载，输入 SIDECUT 或 trr 启动")
  7. (princ)

  9. (defun c:sidecut (/ *error* boundary pt1 pt2 side-pt is-left
  10.                    target-ents i ent int-points)
  11.   (vl-load-com)
  12.   
  13.   ; 错误处理
  14.   (defun *error* (msg)
  15.     (if (not (member msg '("Function cancelled" "quit / exit abort" "")))
  16.       (princ (strcat "\n错误: " msg))
  17.     )
  18.     (princ)
  19.   )
  20.   
  21.   ; 1. 选择裁剪边界线
  22.   (setq boundary nil)
  23.   (while (not boundary)
  24.     (princ "\n选择裁剪边界线（直线/LWPOLYLINE/PLINE）: ")
  25.     (setq temp-sel (entsel))
  26.     (if temp-sel
  27.       (progn
  28.         (setq ent (car temp-sel)
  29.               ent-type (cdr (assoc 0 (entget ent))))
  30.         (if (member ent-type '("LINE" "LWPOLYLINE" "POLYLINE"))
  31.           (setq boundary ent)
  32.           (princ "\n无效对象！请选择直线或多段线。")
  33.         )
  34.       )
  35.       (princ "\n未选择，请重新选择。")
  36.     )
  37.   )

  39.   ; 获取端点
  40.   (setq pt1 (vlax-curve-getStartPoint boundary)
  41.         pt2 (vlax-curve-getEndPoint boundary))
  42.   
  43.   ; 2. 指定裁剪侧
  44.   (princ "\n在需要裁剪的一侧点击任意点: ")
  45.   (setq side-pt (getpoint))
  46.   (if (not side-pt) (progn (princ "\n已取消") (exit)))
  47.   
  48.   ; 3. 判断点在直线的左侧还是右侧 - 使用叉积计算（避免 let 语法问题）
  49.   (setq dx1 (- (car pt2) (car pt1)))
  50.   (setq dy1 (- (cadr pt2) (cadr pt1)))
  51.   (setq dx2 (- (car side-pt) (car pt1)))
  52.   (setq dy2 (- (cadr side-pt) (cadr pt1)))
  53.   (setq is-left (> (* dx1 dy2) (* dy1 dx2)))
  54.   (princ (strcat "\n裁剪侧: " (if is-left "左侧" "右侧")))
  55.   
  56.   ; 4. 选择待裁剪对象
  57.   (princ "\n选择需要裁剪的对象（直线/PL线等）: ")
  58.   (setq target-ents (ssget))
  59.   (if (not target-ents) (progn (princ "\n未选择对象") (exit)))
  60.   
  61.   ; 5. 裁剪指定侧部分
  62.   (setq i 0)
  63.   (repeat (sslength target-ents)
  64.     (setq ent (ssname target-ents i))
  65.     (setq int-points (get-intersections ent boundary))
  66.    
  67.     (if (and int-points (> (length int-points) 0))
  68.       (progn
  69.         (princ (strcat "\n对象" (itoa (1+ i)) "找到" (itoa (length int-points)) "个交点"))
  70.         ; 调用基于TRIM的裁剪函数
  71.         (trim-with-trim ent boundary pt1 pt2 is-left)
  72.       )
  73.       (princ (strcat "\n对象" (itoa (1+ i)) "与边界线无交点，跳过"))
  74.     )
  75.     (setq i (1+ i))
  76.   )
  77.   
  78.   (princ "\n裁剪完成!")
  79.   (princ)
  80. )

  82. ; 辅助函数1：获取交点
  83. (defun get-intersections (obj boundary / obj-vla bnd-vla ints points i)
  84.   (vl-catch-all-apply
  85.     (function (lambda ()
  86.       (setq obj-vla (vlax-ename->vla-object obj)
  87.             bnd-vla (vlax-ename->vla-object boundary)
  88.             ints (vlax-invoke obj-vla 'IntersectWith bnd-vla acExtendNone)
  89.             points nil
  90.             i 0
  91.       )
  92.       (while (< i (length ints))
  93.         (setq points (cons (list (nth i ints) (nth (1+ i) ints)) points))
  94.         (setq i (+ i 3))
  95.       )
  96.       (reverse points)
  97.     ))
  98.     nil
  99.   )
  100. )

  102. ; 核心改进：使用TRIM命令裁剪
  103. (defun trim-with-trim (obj boundary pt1 pt2 is-left /
  104.                        obj-type obj-data pts int-points segs new-ents)
  105.   (setq obj-type (cdr (assoc 0 (entget obj))))
  106.   
  107.   ; 仅处理直线和LWPOLYLINE（简化）
  108.   (cond
  109.     ; ===== 处理直线 =====
  110.     ((= obj-type "LINE")
  111.       (setq pts (list (cdr (assoc 10 (entget obj))) (cdr (assoc 11 (entget obj)))))
  112.       (setq int-points (get-intersections obj boundary))
  113.       (if (and int-points (= (length int-points) 1))
  114.         (progn
  115.           (setq segs (split-line-at-point pts (car int-points)))
  116.           (process-segments segs pt1 pt2 is-left obj)
  117.         )
  118.         (princ "\n直线交点数量异常，跳过")
  119.       )
  120.     )
  121.    
  122.     ; ===== 处理 LWPOLYLINE（简化：只处理无弧段的）=====
  123.     ((= obj-type "LWPOLYLINE")
  124.       (princ "\n警告：LWPOLYLINE 裁剪暂未实现（可扩展）")
  125.       ; 这里可以后续扩展，先跳过
  126.     )
  127.    
  128.     (t
  129.       (princ "\n不支持的对象类型，跳过")
  130.     )
  131.   )
  132. )

  134. ; 将直线按交点拆分为两段
  135. (defun split-line-at-point (pts ip)
  136.   (list (list (car pts) ip) (list ip (cadr pts)))
  137. )

  139. ; 判断并保留/删除线段，同时复制原对象属性
  140. (defun process-segments (segs pt1 pt2 is-left orig-ent /
  141.                          ent-data new-ents layer lt ltype color lw weight)
  142.   ; 获取原对象的所有DXF组码数据
  143.   (setq ent-data (entget orig-ent))
  144.   
  145.   ; 提取常用属性（如果存在）
  146.   (setq layer  (cdr (assoc 8  ent-data)))   ; 图层
  147.   (setq lt     (cdr (assoc 6  ent-data)))   ; 线型（LTYPE）
  148.   (setq color  (cdr (assoc 62 ent-data)))   ; 颜色（0=ByLayer, 正数=索引色, 负数=真彩色）
  149.   (setq lw     (cdr (assoc 370 ent-data)))  ; 线宽（可选）
  150.   (setq weight (cdr (assoc 39 ent-data)))   ; 厚度（可选）
  151.   
  152.   (foreach seg segs
  153.     (setq mid-pt (midpoint (car seg) (cadr seg)))
  154.     (setq pt-is-left (is-point-left-of-line mid-pt pt1 pt2))
  155.     ; 如果中点所在侧 ≠ 要裁剪的侧，则保留该段
  156.     (if (/= pt-is-left is-left)
  157.       (progn
  158.         ; 构建新直线的DXF数据列表
  159.         (setq new-line-data
  160.           (list
  161.             '(0 . "LINE")
  162.             (cons 10 (car seg))    ; 起点
  163.             (cons 11 (cadr seg))   ; 终点
  164.           )
  165.         )
  166.         
  167.         ; 有条件地添加属性（避免 nil 值）
  168.         (if layer  (setq new-line-data (append new-line-data (list (cons 8 layer)))))
  169.         (if lt     (setq new-line-data (append new-line-data (list (cons 6 lt)))))
  170.         (if color  (setq new-line-data (append new-line-data (list (cons 62 color)))))
  171.         (if lw     (setq new-line-data (append new-line-data (list (cons 370 lw)))))
  172.         (if weight (setq new-line-data (append new-line-data (list (cons 39 weight)))))
  173.         
  174.         ; 创建新实体
  175.         (entmake new-line-data)
  176.         (setq new-ents (cons (entlast) new-ents))
  177.       )
  178.     )
  179.   )
  180.   
  181.   ; 删除原始对象
  182.   (entdel orig-ent)
  183.   new-ents
  184. )

  186. ; 计算两点中点
  187. (defun midpoint (p1 p2)
  188.   (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
  189. )

  191. ; 辅助函数3：判断点是否在直线左侧
  192. (defun is-point-left-of-line (pt line-pt1 line-pt2)
  193.   (> (- (* (- (car line-pt2) (car line-pt1)) (- (cadr pt) (cadr line-pt1)))
  194.         (* (- (cadr line-pt2) (cadr line-pt1)) (- (car pt) (car line-pt1))))
  195.     0
  196.   )
  197. )






网友答: 本帖最后由 guosheyang 于 2025-11-2 10:47 编辑

extrim命令（et）就可以满足你了

网友答: 搞定了。。。。




  4. ; 快捷命令
  5. (defun c:ttt () (c:sidecut))
  6. (defun c:trr () (c:sidecut))

  8. (princ "\n命令已加载，输入 SIDECUT 或 trr 启动")
  9. (princ)




  14. (defun c:sidecut (/ *error* boundary pt1 pt2 side-pt is-left
  15.                    target-ents i ent int-points)
  16.   (vl-load-com)
  17.   
  18.   ; 错误处理保持不变
  19.   (defun *error* (msg)
  20.     (if (not (member msg '("Function cancelled" "quit / exit abort" "")))
  21.       (princ (strcat "\n错误: " msg))
  22.     )
  23.     (princ)
  24.   )
  25.   
  26. ; 1. 选择裁剪边界线（必须选中有效对象）
  27. (setq boundary nil)
  28. (while (not boundary)
  29.   (princ "\n选择裁剪边界线（直线/LWPOLYLINE/PLINE）: ")
  30.   (setq temp-sel (entsel))
  31.   (if temp-sel
  32.     (progn
  33.       (setq ent (car temp-sel)
  34.             ent-type (cdr (assoc 0 (entget ent))))
  35.       (if (member ent-type '("LINE" "LWPOLYLINE" "POLYLINE"))
  36.         (setq boundary ent)
  37.         (princ "\n无效对象！请选择直线或多段线。")
  38.       )
  39.     )
  40.     (princ "\n未选择，请重新选择。")
  41.   )
  42. )

  44. ; 获取端点
  45. (setq pt1 (vlax-curve-getStartPoint boundary)
  46.       pt2 (vlax-curve-getEndPoint boundary))
  47.   
  48.   ; 2. 指定裁剪侧（保持不变）
  49.   (princ "\n在需要裁剪的一侧点击任意点: ")
  50.   (setq side-pt (getpoint))
  51.   (if (not side-pt) (progn (princ "\n已取消") (exit)))
  52.   
  53.   (setq is-left
  54.     (> (- (* (- (car pt2) (car pt1)) (- (cadr side-pt) (cadr pt1)))
  55.          (* (- (cadr pt2) (cadr pt1)) (- (car side-pt) (car pt1))))
  56.       0)
  57.   )
  58.   (princ (strcat "\n裁剪侧: " (if is-left "左侧" "右侧")))
  59.   
  60.   ; 3. 选择待裁剪对象（保持不变）
  61.   (princ "\n选择需要裁剪的对象（直线/PL线等）: ")
  62.   (setq target-ents (ssget))
  63.   (if (not target-ents) (progn (princ "\n未选择对象") (exit)))
  64.   
  65.   ; 4. 裁剪指定侧部分（核心修改：使用TRIM命令）
  66.   (setq i 0)
  67.   (repeat (sslength target-ents)
  68.     (setq ent (ssname target-ents i))
  69.     (setq int-points (get-intersections ent boundary))
  70.    
  71.     (if (and int-points (> (length int-points) 0))
  72.       (progn
  73.         (princ (strcat "\n对象" (itoa (1+ i)) "找到" (itoa (length int-points)) "个交点"))
  74.         ; 调用基于TRIM的裁剪函数
  75.         (trim-with-trim ent boundary pt1 pt2 is-left)
  76.       )
  77.       (princ (strcat "\n对象" (itoa (1+ i)) "与边界线无交点，跳过"))
  78.     )
  79.     (setq i (1+ i))
  80.   )
  81.   
  82.   (princ "\n裁剪完成!")
  83.   (princ)
  84. )

  86. ; 辅助函数1：获取交点（保持不变）
  87. (defun get-intersections (obj boundary / obj-vla bnd-vla ints points i)
  88.   (vl-catch-all-apply
  89.     (function (lambda ()
  90.                 (setq obj-vla (vlax-ename->vla-object obj)
  91.                   bnd-vla (vlax-ename->vla-object boundary)
  92.                   ints (vlax-invoke obj-vla 'IntersectWith bnd-vla acExtendNone)
  93.                   points nil
  94.                   i 0
  95.                 )
  96.                 (while (< i (length ints))
  97.                   (setq points (cons (list (nth i ints) (nth (1+ i) ints)) points))
  98.                   (setq i (+ i 3))
  99.                 )
  100.                 (reverse points)
  101.               ))
  102.     nil
  103.   )
  104. )

  106. ; 核心改进：使用TRIM命令裁剪
  107. ; 替换原来的 trim-with-trim 函数
  108. (defun trim-with-trim (obj boundary pt1 pt2 is-left /
  109.                         obj-type obj-data pts int-points segs new-ents)
  110.   (setq obj-type (cdr (assoc 0 (entget obj))))
  111.   
  112.   ; 仅处理直线和LWPOLYLINE（简化）
  113.   (cond
  114.     ; ===== 处理直线 =====
  115.     ((= obj-type "LINE")
  116.       (setq pts (list (cdr (assoc 10 (entget obj))) (cdr (assoc 11 (entget obj)))))
  117.       (setq int-points (get-intersections obj boundary))
  118.       (if (and int-points (= (length int-points) 1))
  119.         (progn
  120.           (setq segs (split-line-at-point pts (car int-points)))
  121.           (process-segments segs pt1 pt2 is-left obj)
  122.         )
  123.         (princ "\n直线交点数量异常，跳过")
  124.       )
  125.     )
  126.    
  127.     ; ===== 处理 LWPOLYLINE（简化：只处理无弧段的）=====
  128.     ((= obj-type "LWPOLYLINE")
  129.       (princ "\n警告：LWPOLYLINE 裁剪暂未实现（可扩展）")
  130.       ; 这里可以后续扩展，先跳过
  131.     )
  132.    
  133.     (t
  134.       (princ "\n不支持的对象类型，跳过")
  135.     )
  136.   )
  137. )

  139. ; 将直线按交点拆分为两段
  140. (defun split-line-at-point (pts ip)
  141.   (list (list (car pts) ip) (list ip (cadr pts)))
  142. )

  144. ; 判断并保留/删除线段
  145. ; 判断并保留/删除线段，同时复制原对象属性
  146. (defun process-segments (segs pt1 pt2 is-left orig-ent /
  147.                           ent-data new-ents layer lt ltype color lw weight)
  148.   ; 获取原对象的所有DXF组码数据
  149.   (setq ent-data (entget orig-ent))
  150.   
  151.   ; 提取常用属性（如果存在）
  152.   (setq layer  (cdr (assoc 8  ent-data)))   ; 图层
  153.   (setq lt     (cdr (assoc 6  ent-data)))   ; 线型（LTYPE）
  154.   (setq color  (cdr (assoc 62 ent-data)))   ; 颜色（0=ByLayer, 正数=索引色, 负数=真彩色）
  155.   (setq lw     (cdr (assoc 370 ent-data)))  ; 线宽（可选）
  156.   (setq weight (cdr (assoc 39 ent-data)))   ; 厚度（可选）
  157.   
  158.   (foreach seg segs
  159.     (setq mid-pt (midpoint (car seg) (cadr seg)))
  160.     (setq pt-is-left (is-point-left-of-line mid-pt pt1 pt2))
  161.     ; 如果中点所在侧 ≠ 要裁剪的侧，则保留该段
  162.     (if (/= pt-is-left is-left)
  163.       (progn
  164.         ; 构建新直线的DXF数据列表
  165.         (setq new-line-data
  166.           (list
  167.             '(0 . "LINE")
  168.             (cons 10 (car seg))    ; 起点
  169.             (cons 11 (cadr seg))   ; 终点
  170.           )
  171.         )
  172.         
  173.         ; 有条件地添加属性（避免 nil 值）
  174.         (if layer  (setq new-line-data (append new-line-data (list (cons 8 layer)))))
  175.         (if lt     (setq new-line-data (append new-line-data (list (cons 6 lt)))))
  176.         (if color  (setq new-line-data (append new-line-data (list (cons 62 color)))))
  177.         (if lw     (setq new-line-data (append new-line-data (list (cons 370 lw)))))
  178.         (if weight (setq new-line-data (append new-line-data (list (cons 39 weight)))))
  179.         
  180.         ; 创建新实体
  181.         (entmake new-line-data)
  182.         (setq new-ents (cons (entlast) new-ents))
  183.       )
  184.     )
  185.   )
  186.   
  187.   ; 删除原始对象
  188.   (entdel orig-ent)
  189.   new-ents
  190. )



  194. ; 计算两点中点
  195. (defun midpoint (p1 p2)
  196.   (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2)
  197. )

  199. ; 辅助函数3：判断点是否在直线左侧（保持不变）
  200. (defun is-point-left-of-line (pt line-pt1 line-pt2)
  201.   (> (- (* (- (car line-pt2) (car line-pt1)) (- (cadr pt) (cadr line-pt1)))
  202.        (* (- (cadr line-pt2) (cadr line-pt1)) (- (car pt) (car line-pt1))))
  203.     0)
  204. )
















网友答: 这个和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
好像只能用于裁剪直线

也是新手 还在摸索阶段
  • 上一篇：多重插入块炸不开
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025