两个打断程序

millermin

奉献两个打断程序。一直线打断一组线。这个好办，一个循环就完成了。另一个是一组线打断一根直线。这个有点麻烦，因为断第一点以后，原来的目标变成了两个，那么原来的变量名就不能再用，程序无法继续。经过观察，找到解决办法，请各位行家大力斧正。为提高操作速度，我特意分成两个程序，只要记住两个程序名就可以节省了操作过程中的选项。
1. 一断多：

(defun c:bpm (/ pt )
  (vl-load-com)
  
  (setvar "cmdecho" 0)
  (setvar "orthomode" 0)
  
  (setq bl (car (entsel "\nCHOOSE A LINE TO BE CUT:")))
  (setq bl-v (vlax-ename->vla-object bl))
  
  (prompt "\nCHOOSE CUTTING LINES:")
  (setq cutln-s(ssget '((0 . "LINE,ARC,CIRCLE,ELLIPSE,LWPOLYLINE,SPLINE"))))
   
  (setq m 0)
  (setq n 0)
( while (< m (sslength cutln-s))
    (setq cutln  (ssname cutln-s m))
    (setq cutln-v (vlax-ename->vla-object cutln))
       (if (and (setq point-v (vla-intersectwith bl-v cutln-v acExtendNone))
        (setq point (vlax-variant-value point-v))
        (> (vlax-safearray-get-u-bound point 1) 0)
       )
        (progn
         (setq point (vlax-safearray->list (vlax-variant-value point-v)))  
         (COMMAND "_break" cutln point "@")         

          ;(setq pt(append pt (list point)))
         (setq m (+ m 1))
        )   ; end progn
         (setq m (+ m 1))
        )   ; end if
)          ; end while   
  
(princ)
)   


2. 多断一。
(defun c:bps (/ pt )
  (vl-load-com)
  
  (setvar "cmdecho" 0)
  (setvar "orthomode" 0)
  
  (setq bl (car (entsel "\nCHOOSE A LINE TO BE CUT:")))
  (setq bl-v (vlax-ename->vla-object bl))
  
  (prompt "\nCHOOSE CUTTING LINES:")
  (setq cutln-s(ssget '((0 . "LINE,ARC,CIRCLE,ELLIPSE,LWPOLYLINE,SPLINE,INSERT"))))

  (setq m 0)
  (setq n 0)
( while (< m (sslength cutln-s))
    (setq cutln  (ssname cutln-s m))
    (setq cutln-v (vlax-ename->vla-object cutln))
       (if (and (setq point-v (vla-intersectwith bl-v cutln-v acExtendNone))
        (setq point (vlax-variant-value point-v))
        (> (vlax-safearray-get-u-bound point 1) 0)
       )
        (progn
         (setq point (vlax-safearray->list (vlax-variant-value point-v)))  
              (if (> (length point) 3)
                (progn
                (setq i 0)         
                  (repeat (/ (length point) 3)
                    (setq point-i(list (nth i point) (nth (+ i 1) point) (nth (+ i 2) point)))
                    (setq pt(append pt (list point-i)))
                    (setq i (+ i 3))
                  )   ; end repeat
                 )    ; end progn
              )       ; end if >
         (setq pt(append pt (list point)))
         (setq m (+ m 1))
        )   ; end progn
         (setq m (+ m 1))
        )   ; end if
)          ; end while   
  (setq blst(vlax-curve-getstartpoint bl-v)
        blend(vlax-curve-getendpoint bl-v))
  (if (= (cadr blst) (cadr blend))
     (progn   
       (if (> (car blst) (car blend))
         (setq pt  
            (vl-sort pt
              (function (lambda (e1 e2) (> (car e1) (car e2))))
             )
          )  
          (setq pt  
             (vl-sort pt
               (function (lambda (e1 e2) (< (car e1) (car e2))))
             )
          )
        ) ; end if (>
      )   ; end progn
   
     (progn
  (if (> (cadr blst) (cadr blend))
     (setq pt  
          (vl-sort pt
            (function (lambda (e1 e2) (> (cadr e1) (cadr e2))))
          )
      )  
  
      (setq pt  
           (vl-sort pt
             (function (lambda (e1 e2) (< (cadr e1) (cadr e2))))
           )
      )
   )
   )  ; end progn   
)    ; end (=   
  (command "_break" bl (nth 0 pt) "@")
  (vl-remove (nth 0 pt) pt)
  (foreach x pt
     (command "_break" (entlast) "non" x "@")
   )
(princ)
)   

byghbcx

1、可以用SSGET ”F“的方式选择与直线相交的线，再分别在每根线与直线交点处打断；
2、可以求出直线与一组线的所有交点，再把直线起点、终点加上去，再排序，重新生成每段小直线。

millermin

byghbcx 发表于 2012-4-12 09:33
1、可以用SSGET ”F“的方式选择与直线相交的线，再分别在每根线与直线交点处打断；
2、可以求出直线与一组 ...

谢谢。
我仅仅根据我自己的情况设计的。因为我的图比较密集，极少需要断所有交线，所以我设计成自选目标。原来的初稿还复杂一些，但只要选一根直线，所有和他碰过的都能断开。

byghbcx

自选也可以，也可以增加过滤值

清风明月名字

一断多有一个问题，就是不能打断封闭的圆、多边形、矩形、椭圆等，望修改
谢谢楼主的代码

669423907

留个脚印先。谢谢楼主分享！

梦醒才知原是梦

留个脚印先。谢谢楼主分享！

wqq8889

可以求出直线与一组线的所有交点，再把直线起点、终点加上去，再排序，重新生成每段小直线。现在也用到了这个思路