如何批量修剪？

zilong136

lzspain 发表于 2024-9-8 20:35
修补双线，，，，，，，

OK,可以，谢谢。其实如果可以一次画出这种效果也行。

飞雪神光

hubeiwdlue 发表于 2024-9-8 23:05
这个思路好，交点打断，现在都是用command吗，还有别的方法吗？

嗯  打断的话 就是command了

统一网名

(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))
        )                                                
)

kzd2004

正好我也问过，自己解决了http://bbs.mjtd.com/thread-191000-1-1.html

zilong136

kzd2004 发表于 2024-9-9 09:18
正好我也问过，自己解决了http://bbs.mjtd.com/thread-191000-1-1.html

我找了半天就没看到你是怎么解决的

kzd2004

zilong136 发表于 2024-9-9 16:38
我找了半天就没看到你是怎么解决的

炸开，打断，删除小于或等于30的直线。

统一网名

请教一下大佬，怎么一次性生成这种修剪好的方格，比如1000X1000的矩形，里面生成4X4的方格，每小格间距20

指定长、宽画矩形，然后连续复制即可。

zilong136

统一网名 发表于 2024-9-9 17:12
指定长、宽画矩形，然后连续复制即可。

你没听懂我的意思，我是说如何写一个LISP,可以一键生成这些矩形小方格

zilong136

kzd2004 发表于 2024-9-9 17:07
炸开，打断，删除小于或等于30的直线。

好麻烦，没楼上好用。你那个连接我去下载了，貌似我CAD不能运行，不知道什么原因。

kzd2004

zilong136 发表于 2024-9-10 01:47
好麻烦，没楼上好用。你那个连接我去下载了，貌似我CAD不能运行，不知道什么原因。

已上传附件，你看一下。