如何批量修剪？
本帖最后由 zilong136 于 2024-9-8 17:00 编辑如下图所示，想让1批量修剪成2，三领的综合修剪可以，但不知道是不是我CAD的问题还是怎么的，这个命令现在不能用，求能实现该功能的Lisp?谢谢。
本帖最后由 统一网名 于 2024-9-9 10:58 编辑
(defun c:tt (/ a b ename i len lst pts ss dx1)
(setq ss (ssget '((0 . "LINE"))))
(setq i 0)
(setq len (sslength ss))
(repeat len
(setq pts nil)
(setq ename (ssname ss i))
(setq a (cdr (assoc 10 (entget ename))))
(setq b (cdr (assoc 11 (entget ename))))
(setq pts (cons a pts))
(setq pts (cons b pts))
(get-zxssjd ss ename);找出交点
(if(< i (/ len 2))
(setq lst (vl-sort pts (function (lambda (e1 e2)(< (car e1) (car e2))))))
(setq lst (vl-sort pts (function (lambda (e1 e2)(< (cadr e1) (cadr e2))))))
);排序
(chzx lst);重画直线
(setq i (+ i 1))
)
(command "erase" ss "");删除原有直线
(princ)
)
;ss 选择集 , dx1 指定直线
;输出 pts 交点点表
(defun get-zxssjd (ss dx1 /dx2 jd i L)
(setq a (cdr (assoc 10 (entget dx1))))
(setq b (cdr (assoc 11 (entget dx1))))
(setq i (sslength ss))
(setq L 0)
(repeat i
(setq dx2 (ssname ss L));设置 dx2
(setq jd(vlax-invoke (vlax-ename->vla-object dx2) 'IntersectWith (vlax-ename->vla-object dx1) acExtendNone))
(if (and(not (null jd))(not (member jd pts)))
(setq pts (cons jd pts))
);有点对象没有交点，当有交点时把交点加入到点表
(if (not (member a pts))(setq pts (cons a pts)))
(if (not (member b pts))(setq pts (cons b pts)))
(setq L (+ L 1))
)
)
;重画直线
(defun chzx (lst / a b i l)
(setq i 0 )
(repeat (/(length lst)2)
(setq l (+ i 1))
(setq a (nth i lst))
(setq b (nth l lst))
(entmake (list '(0 . "LINE") (cons 10 a) (cons 11 b)(cons 62 1)))
(setq i ( + i 2))
)
)
zilong136 发表于 2024-9-10 01:45
你没听懂我的意思，我是说如何写一个LISP,可以一键生成这些矩形小方格
[*](defun c:tt (/ dzl dzl2 hcs hdzl jj jx1c jx1k jx2c jx2k lsqd p0 qd scs sdzl)
[*](setq
[*] jx1c 240 jx1k 240 ;矩形区域的长、宽
[*] jx2c 4jx2k 4 ;画小矩形的长、宽
[*] jj 20 ;间距
[*]);该部分可以更改为对话框
[*](setq dzl2 0)
[*](setq hdzl (+ jx2c jj))
[*](setq sdzl (+ jx2k jj))
[*](setq hcs (fix (/ jx1c hdzl)))
[*](setq scs (fix (/ jx1k sdzl)))
[*](setq p0 (getpoint "\n点选起点:"))
[*](repeat scs
[*] (setq lsqd (list(car p0)(-(cadr p0)dzl2)))
[*] (setq dzl 0)
[*] (repeat hcs
[*] (setq qd (list(+(car lsqd)dzl)(cadr lsqd)))
[*] (huajuxing qd jx2c jx2k)
[*] (setq dzl (+ dzl hdzl))
[*] )
[*] (setq dzl2 (+ dzl2 sdzl))
[*])
[*])
[*]
[*](defun huajuxing(qd cd kd / djd )
[*](setq djd (list(+(car qd)cd)(-(cadr qd)kd)));左上 右下画矩形
[*](command "rectang" "non" qd "non" djd);画矩形
[*])
看一下大佬lee50310的程序http://bbs.mjtd.com/thread-191020-1-1.html lzspain 发表于 2024-9-8 16:42
看一下大佬lee50310的程序http://bbs.mjtd.com/thread-191020-1-1.html
我去下载了，但还是不能用，就最外框合并了一下。 zilong136 发表于 2024-9-8 17:01
我去下载了，但还是不能用，就最外框合并了一下。
谜你工具箱有这个功能，你可以了解一下。 还有一个思路是 交点打断 或交点重生成 删除长度小于设定值得线 lzspain 发表于 2024-9-8 17:23
谜你工具箱有这个功能，你可以了解一下。
哪个命令，还请明示:handshake zilong136 发表于 2024-9-8 19:53
哪个命令，还请明示
修补双线，，，，，，， 同意5楼意见，这样更简单 飞雪神光 发表于 2024-9-8 19:52
还有一个思路是 交点打断 或交点重生成 删除长度小于设定值得线
我有时候就是用RBD这样做的，就是没有谜你快 飞雪神光 发表于 2024-9-8 19:52
还有一个思路是 交点打断 或交点重生成 删除长度小于设定值得线
这个思路好，交点打断，现在都是用command吗，还有别的方法吗？