One point break at intersect point

[Dayananda]

I have lots of LINES. And those lines crossing by a SPLINE.

I want to  each lines break at intersection points. 

The spline should keep remain without breaking.

[ronjonp]

Give this a try ( use breakwith )... quick test here and it worked perfectly.

[Lee Mac]

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)

 

Edited December 30, 2024 by Lee Mac