[编程交流] 打断与相交的所有线

;;; Break All, by Lee McDonnell.  25/07/2009
(defun c:brkAll (/ *error* doc spc ss Objlst Obj iLst Altlst lst)
 (vl-load-com)
 (defun *error* (msg)
   (if doc (vla-EndUndoMark doc))
   (if ov (mapcar 'setvar vl ov))
   (if (not
         (wcmatch
           (strcase msg) "*BREAK,*EXIT*,*CANCEL*"))
     (princ
       (strcat "\n** Error: " msg " **")))
   (princ))
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 
 (setq vl '("CMDECHO" "OSMODE")
       ov (mapcar 'getvar vl))
 
 (vla-StartUndoMark doc)
 (or *brk$dis* (setq *brk$dis* 5.))
 (if (setq ss (ssget '((0 . "*LINE,ARC"))))
   (progn
     (or (not
           (setq tmp
             (getdist
               (strcat "\nSpecify Break Distance <" (rtos *brk$dis* 2 2) "> : "))))
         (setq *brk$dis* tmp))
     (setq Objlst
       (mapcar 'vlax-ename->vla-object
         (vl-remove-if 'listp
           (mapcar 'cadr (ssnamex ss)))))
     (while (setq Obj (car Objlst))
       (foreach iObj (setq Objlst (cdr Objlst))
         (setq iLst
           (cons
             (cons Obj
               (vlax-list->3D-point
                 (vlax-invoke Obj
                   'IntersectWith iObj acExtendNone))) iLst))))
     (mapcar 'setvar vl '(0 0))
     (foreach Int (vl-remove-if-not
                    (function
                      (lambda (x)
                        (vl-consp (cdr x)))) iLst)
       (setq Obj (car Int))
       (foreach Pt (cdr Int)
         (and Altlst (setq lst Altlst))
         (if (not (setq bDis (vlax-curve-getDistatPoint Obj Pt)))
           (while (and (not bDis) lst)
             (setq bDis (vlax-curve-getDistatPoint (setq Obj (car lst)) Pt)
                   lst (cdr lst))))
         (if bDis
           (progn
             (or (setq bPt1 (vlax-curve-getPointatDist Obj
                              (+ bDis (/ *brk$dis* 2.))))
                 (setq bPt1 (vlax-curve-getEndPoint Obj)))
             (or (setq bPt2 (vlax-curve-getPointatDist Obj
                              (- bDis (/ *brk$dis* 2.))))
                 (setq bPt2 (vlax-curve-getStartPoint Obj)))
             (command "_.Break"
               (list (vlax-vla-object->ename Obj) pt) "_F" bPt1 bPt2)
             (setq AltLst (cons (vlax-ename->vla-object (entlast)) AltLst)))))))
   (princ "\n** Nothing Selected **"))
 (vla-EndUndoMark doc)
 (mapcar 'setvar vl ov)
 (princ))
             
(defun vlax-list->3D-point (lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
         (vlax-list->3D-point (cdddr lst)))))