958620832 发表于 2013-10-12 23:23:33

交点打断（仅供学习）

本帖最后由 958620832 于 2013-10-13 00:01 编辑

;程序中用的都是autolisp函数，没有加入任何visuallisp函数，实践足可证明autolisp的强大之处。
(defun interss (ss) ;;选择集求交点子程序
(setq len (sslength ss) n1 0 pts nil)
(repeat (- len 1)
    (setq ent (entget (ssname ss n1)) p nil)
    (foreach x ent (if (member (car x) '(10 11)) (setq p (cons (cdr x) p))))
    (setq p1 (car p) p2 (cadr p) n2 (1+ n1)) ;求一条线段的两个端点
    (repeat (- len n2)
      (setq ent (entget (ssname ss n2)) p nil)
      (foreach x ent (if (member (car x) '(10 11)) (setq p (cons (cdr x) p))))
      (setq p3 (car p) p4 (cadr p)) ;求另一线段的两个端点
      (if (setq ipts (inters p1 p2 p3 p4)) (setq pts (cons ipts pts))) ;求两条线段的交点，并集合
      (setq n2 (1+ n2)))
    (setq n1 (1+ n1)))
pts)

(defun c:tt () ;;一次性将所选线段从交点处打断，仅限于直线和多义线
(setq ss (ssget '((0 . "*line"))))
(if (and ss (interss ss)) (progn
    (while t ;结合exit函数
      (setq len (sslength ss) n 0)
      (repeat len
      (foreach x pts
          (if (ssmemb (ssname ss n) (ssget "c" x x)) (progn
            (command "break" (ssname ss n) x x)
            (ssadd (entlast) ss))))
      (setq n (+ n 1)))
    (if (= (sslength ss) len) (exit))))) ;如果ss个数不增加，退出循环。
(princ))

vlisp2012 发表于 2013-10-13 15:57:51

很好的程序，顶一下！

llsheng_73 发表于 2013-10-18 13:36:53

终于坐上板凳了
学习了，思路不错，求交点那再处理下估计应该能打断所有可以打断的

llsheng_73 发表于 2013-10-18 17:10:55

坐在沙发是才发现，当一条多线段与另一条多次相交时，根本断不掉，看来在交点子程序里边还得花大力气

emk 发表于 2013-11-1 14:04:08

建议楼主增加圆弧、椭圆弧等的支持

xujinhua 发表于 2014-1-22 16:33:49

加PL线就好了....

vormittag 发表于 2014-1-22 17:04:15

这种算法太慢，command本身就慢，无效的command操作又越来越多。

500w008 发表于 2015-5-4 20:50:26

用户3766035971 发表于 2015-5-18 10:27:26

很好的程序，

luojunmax 发表于 2015-8-22 23:22:18

页: [1] 2
查看完整版本: 交点打断（仅供学习）