★★请高手完善批量交点自动裁剪功能★★

wanhongron · 发表于 2015-7-27 13:10:52

网上找到一个能单选交点裁剪相交线段的程序，请高手修整一下，能框选批量处理这种所有相交线段。
;;;单个交点裁线
(defun c:mtrim(/ ss ww ll mb p1 p2 p3 en1 en2 list-sn list-en list2 mod)
(setq mod (getvar "osmode"))
(setvar "osmode" 0)
(prompt "\n请选择需裁剪的线:")
(setq ss (ssget))
(setvar "cmdecho" 0)
(setq list-sn (list 0.0))
(setq list-en (list 0.0))
(setq mb (sslength ss) ll 1)
(repeat mb
   (setq list-sn (append list-sn (list (ssname ss (- ll 1)))))
   (setq list-en (append list-en (list (entget (ssname ss (- ll 1))))))
   (setq ll (+ ll 1))
);repeat
(setq ll 1)
(setq list2 (list 0.0))
(repeat mb
   (setq en1 (nth ll list-en) ww 1)
   (repeat mb
      (setq p1 nil)
      (setq en2 (nth ww list-en))
      (setq p1 (inters (cdr (assoc 10 en1)) (cdr (assoc 11 en1))
                        (cdr (assoc 10 en2)) (cdr (assoc 11 en2))))
      (if p1 (setq list2 (append list2 (list p1))))
      (setq ww (+ ww 1))
   );repeat
   (if (< (- (length list2) 1) (* ll 2))
      (progn (setq p1 (nth (- (length list2) 1) list2))
               (setq p2 (cdr (assoc 10 en1)))
               (setq p3 (cdr (assoc 11 en1)))
               (if (< (distance p1 p2) (distance p1 p3))
                  (setq list2 (append list2 (list p2)))
                  (setq list2 (append list2 (list p3)))
               );if
      );progn
   );if
   (setq ll (+ ll 1))
);repeat
(setq ww 1)
(repeat mb
   (command "break" (nth ww list-sn) (nth (- (* ww 2) 1) list2) (nth (* ww 2) list2))
   (setq ww (+ ww 1))
);repeat
(setvar "cmdecho" 1)
(setvar "osmode" mod)
);defun

wanhongron · 发表于 2015-7-27 19:04:15

哪个高手帮帮忙，工作中用到比较多。

newbuser · 发表于 2015-7-28 09:02:39

wanhongron 发表于 2015-7-27 19:04
哪个高手帮帮忙，工作中用到比较多。

你要求的太智能化了，不容易办到

wanhongron · 发表于 2015-7-29 17:41:26

哪位大侠帮帮小妹，拜托了！！

wanhongron · 发表于 2015-7-30 00:01:10

无尘235 · 发表于 2020-2-11 23:03:09

(defun c:trr(/ ss ww ll mb p1 p2 p3 en1 en2 list-sn list-en list2 mod)
(setq mod (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(prompt "\n请选择需裁剪的线:")
(setq ss (ssget ":S"))
(while ss

      (setq list-sn (list 0.0))
      (setq list-en (list 0.0))
      (setq mb (sslength ss) ll 1)
      (repeat mb
      (setq list-sn (append list-sn (list (ssname ss (- ll 1)))))
      (setq list-en (append list-en (list (entget (ssname ss (- ll 1))))))
      (setq ll (+ ll 1))
      );repeat
      (setq ll 1)
      (setq list2 (list 0.0))
      (repeat mb
      (setq en1 (nth ll list-en) ww 1)
      (repeat mb
         (setq p1 nil)
         (setq en2 (nth ww list-en))
         (setq p1 (inters (cdr (assoc 10 en1)) (cdr (assoc 11 en1))
                           (cdr (assoc 10 en2)) (cdr (assoc 11 en2))))
         (if p1 (setq list2 (append list2 (list p1))))
         (setq ww (+ ww 1))
      );repeat
      (if (< (- (length list2) 1) (* ll 2))
            (progn (setq p1 (nth (- (length list2) 1) list2))
                  (setq p2 (cdr (assoc 10 en1)))
                  (setq p3 (cdr (assoc 11 en1)))
                  (if (< (distance p1 p2) (distance p1 p3))
                     (setq list2 (append list2 (list p2)))
                     (setq list2 (append list2 (list p3)))
                  );if
            );progn
      );if
      (setq ll (+ ll 1))
      );repeat
      (setq ww 1)
      (repeat mb
         (command "break" (nth ww list-sn) (nth (- (* ww 2) 1) list2) (nth (* ww 2) list2))
         (setq ww (+ ww 1))
      );repeat
         (princ)
       (prompt "\n请选择需裁剪的线:")
         (setq ss (ssget ":S"))

   )
(setvar "cmdecho" 1)
(setvar "osmode" mod)

);defun

借花献佛，稍微优化了一下

账号		自动登录	找回密码
密码			注册

[讨论] ★★请高手完善批量交点自动裁剪功能★★

本帖子中包含更多资源

相关帖子