Here's another, not quite as advanced as CAB's BreakAll program, but I had fun writing it -
(defun c:breakwith ( / *error* brk brl ent ftr idx sel )
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)
(setq ftr
(list
'(0 . "ARC,CIRCLE,ELLIPSE,LINE,*POLYLINE,SPLINE")
'(-4 . "<NOT")
'(-4 . "<AND")
'(0 . "POLYLINE") '(-4 . "&") '(70 . 80)
'(-4 . "AND>")
'(-4 . "NOT>")
(if (= 1 (getvar 'cvport)) (cons 410 (getvar 'ctab)) '(410 . "Model"))
)
)
(LM:startundo (LM:acdoc))
(cond
( (not (setq sel (LM:ssget "\nSelect objects to break: " (list "_:L" ftr)))))
( (not (setq brk (LM:ssget "\nSelect breaking edges: " (list ftr)))))
( (progn
(repeat (setq idx (sslength brk))
(setq idx (1- idx)
ent (ssname brk idx)
)
(if (not (ssmemb ent sel))
(setq brl (cons (vlax-ename->vla-object ent) brl))
)
)
(null brl)
)
(princ "\nAll selected breaking edges were also selected to be broken.")
)
( (repeat (setq idx (sslength sel))
(setq idx (1- idx))
(breakwithlist (ssname sel idx) brl 1)
)
)
)
(*error* nil)
(princ)
)
(defun breakwithlist ( ent lst mxd / cmd enl obj pnt pt1 pt2 tmp )
(cond
( (< 256 mxd)) ;; Just in case
( (setq obj (vlax-ename->vla-object ent)
pt1 (vlax-curve-getstartpoint ent)
pt2 (vlax-curve-getendpoint ent)
pnt
(vl-some
'(lambda ( x )
(vl-some
'(lambda ( p )
(if (and (not (equal p pt1 1e-8))
(not (equal p pt2 1e-8))
)
p
)
)
( (lambda ( l / r )
(repeat (/ (length l) 3)
(setq r (cons (mapcar '(lambda ( a b ) a) l '(0 1 2)) r)
l (cdddr l)
)
)
(reverse r)
)
(vlax-invoke obj 'intersectwith x acextendnone)
)
)
)
lst
)
)
(setq enl (entlast)
cmd (getvar 'cmdecho)
pnt (trans pnt 0 1)
)
(while (setq tmp (entnext enl))
(setq enl tmp)
)
(setvar 'cmdecho 0)
(vl-cmdf "_.break" (list ent pnt) "_f" "_non" pnt "_non" pnt)
(setvar 'cmdecho cmd)
(if (entnext enl)
(breakwithlist ent lst (1+ mxd))
)
(while (setq enl (entnext enl))
(breakwithlist enl lst (1+ mxd))
)
)
)
)
;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments
(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)