Topic: Breaking at Intersections

[cmwade77]

After seeing a breaking routine in another thread, I thought I would take a crack at making one that I have needed for sometime now. Basically I need it to break the specified object at the intersection of selected objects.

This is what I have come up with:

Code: [Select]

;Written by: Chris Wade
;2010-02-03
;Breaks objects at intersections
(defun c:BreakInt (/ Ent1 Ent1E EntSS ct IntLst ct2 pt1 pt1a bptlist BDis ct3)
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq BDis (/ 0.1 (getvar "cannoscalevalue")))
(setq BDis 0.1)
)
(princ "\n")
(while (= Ent1 nil)
(setq Ent1 (entsel "\rSelect the object to break: "))
)
(setq Ent1E (vlax-ename->vla-object (car Ent1)))
(princ "\n")
(while (= EntSS nil)
(princ "\rSelect the objects to break with: ")
(setq EntSS (ssget))
)
(setq ct 0)
(while (< ct (sslength EntSS))
(setq intLst (vlax-invoke Ent1E 'intersectWith (vlax-ename->vla-object (ssname EntSS ct)) acExtendNone))
(cond
((/= intLst nil)
(setq ct2 0)
(while (< ct2 (length intLst))
(setq pt1 (list (nth ct2 intLst) (nth (+ ct2 1) intLst) (nth (+ ct2 2) intLst)))
(setq pt1a (vlax-curve-getdistatparam Ent1E (vlax-curve-getparamatpoint Ent1E pt1)))
(cond
((= bptlist nil)
(setq bptlist (list (vlax-curve-getpointatdist Ent1E (- pt1a BDis))))
)
(T
(setq bptlist (append bptlist (list (vlax-curve-getpointatdist Ent1E (- pt1a BDis)))))
)
)
(setq bptlist (append bptlist (list (vlax-curve-getpointatdist Ent1E (+ pt1a BDis)))))
(setq ct2 (+ ct2 3))
)
)
)
(setq ct (+ ct 1))
)
(cond
((/= bptlist nil)
(setq ct3 0)
(while (< ct3 (length bptlist))
(command "._break" "_non" (trans (nth ct3 bptlist) 0 1)  "_non" (trans (nth (+ ct3 1) bptlist) 0 1))
(setq ct3 (+ ct3 2))
)
)
)
)
(defun C:BI ()
(c:breakint)
)

It definitely works, but I am wondering if anyone has better ways to accomplish this? I want to get better with my LISP routines.

[CAB]

Hey Chris, was this the other thread?
http://www.theswamp.org/index.php?topic=10370.0

[cmwade77]

No, I actually think I had seen that thread a while ago though now that you, I am not sure, I may have even posted to it. No the thread that made me think about it this time around was: http://www.theswamp.org/index.php?topic=31754.0

I will take a look at that thread though.

[t-bear]

I can use this with wiring diagrams...very nice.
Do have a question though....can this have an option to set the break gap distance? At the moment it's set to a total .2 with this part of the code:  (setq BDis 0.1)....right? Would be sweet if it asked for a total dist instead.

I know, I know...I'm begging again! 

[mksretenovic]

You can add a prompt at the beginning and make a small change for the scale.  See changes below in red:

Code: [Select]

;Written by: Chris Wade
;2010-02-03
;Breaks objects at intersections
(defun c:BreakInt (/ Ent1 Ent1E EntSS ct IntLst ct2 pt1 pt1a bptlist BDis ct3)
[color=red] (if (not (setq BDis (getreal "Enter a gap distance <0.1>: ")))
(setq BDis 0.1)
)[/color]
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq BDis (/ [color=red]BDis[/color] (getvar "cannoscalevalue")))
[color=red];;(setq BDis 0.1) <--commented out[/color]
)
(princ "\n")
(while (= Ent1 nil)
(setq Ent1 (entsel "\rSelect the object to break: "))
)
(setq Ent1E (vlax-ename->vla-object (car Ent1)))
(princ "\n")
(while (= EntSS nil)
(princ "\rSelect the objects to break with: ")
(setq EntSS (ssget))
)
(setq ct 0)
(while (< ct (sslength EntSS))
(setq intLst (vlax-invoke Ent1E 'intersectWith (vlax-ename->vla-object (ssname EntSS ct)) acExtendNone))
(cond
((/= intLst nil)
(setq ct2 0)
(while (< ct2 (length intLst))
(setq pt1 (list (nth ct2 intLst) (nth (+ ct2 1) intLst) (nth (+ ct2 2) intLst)))
(setq pt1a (vlax-curve-getdistatparam Ent1E (vlax-curve-getparamatpoint Ent1E pt1)))
(cond
((= bptlist nil)
(setq bptlist (list (vlax-curve-getpointatdist Ent1E (- pt1a BDis))))
)
(T
(setq bptlist (append bptlist (list (vlax-curve-getpointatdist Ent1E (- pt1a BDis)))))
)
)
(setq bptlist (append bptlist (list (vlax-curve-getpointatdist Ent1E (+ pt1a BDis)))))
(setq ct2 (+ ct2 3))
)
)
)
(setq ct (+ ct 1))
)
(cond
((/= bptlist nil)
(setq ct3 0)
(while (< ct3 (length bptlist))
(command "._break" "_non" (trans (nth ct3 bptlist) 0 1)  "_non" (trans (nth (+ ct3 1) bptlist) 0 1))
(setq ct3 (+ ct3 2))
)
)
)
)
(defun C:BI ()
(c:breakint)
)

HTH, 

[t-bear]

Thank you!  That's what I love about this place....good people helping grumpy old men like me.  :ugly:     

[CAB]

Ted,
You can also use this: http://www.theswamp.org/index.php?topic=10370.0
Run MyBreak for an option to enter the Gap.

[t-bear]

Thanks CAB....that is a sweet routine.  Had forgotten it....but then, I forgot what I had for breakfast!  :ugly:
Got it in my "break" fly-out.

[cmwade77]

You can add a prompt at the beginning and make a small change for the scale.  See changes below in red:

Code: [Select]

;Written by: Chris Wade
;2010-02-03
;Breaks objects at intersections
(defun c:BreakInt (/ Ent1 Ent1E EntSS ct IntLst ct2 pt1 pt1a bptlist BDis ct3)
[color=red] (if (not (setq BDis (getreal "Enter a gap distance <0.1>: ")))
(setq BDis 0.1)
)[/color]
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq BDis (/ [color=red]BDis[/color] (getvar "cannoscalevalue")))
[color=red];;(setq BDis 0.1) <--commented out[/color]
)
(princ "\n")
(while (= Ent1 nil)
(setq Ent1 (entsel "\rSelect the object to break: "))
)
(setq Ent1E (vlax-ename->vla-object (car Ent1)))
(princ "\n")
(while (= EntSS nil)
(princ "\rSelect the objects to break with: ")
(setq EntSS (ssget))
)
(setq ct 0)
(while (< ct (sslength EntSS))
(setq intLst (vlax-invoke Ent1E 'intersectWith (vlax-ename->vla-object (ssname EntSS ct)) acExtendNone))
(cond
((/= intLst nil)
(setq ct2 0)
(while (< ct2 (length intLst))
(setq pt1 (list (nth ct2 intLst) (nth (+ ct2 1) intLst) (nth (+ ct2 2) intLst)))
(setq pt1a (vlax-curve-getdistatparam Ent1E (vlax-curve-getparamatpoint Ent1E pt1)))
(cond
((= bptlist nil)
(setq bptlist (list (vlax-curve-getpointatdist Ent1E (- pt1a BDis))))
)
(T
(setq bptlist (append bptlist (list (vlax-curve-getpointatdist Ent1E (- pt1a BDis)))))
)
)
(setq bptlist (append bptlist (list (vlax-curve-getpointatdist Ent1E (+ pt1a BDis)))))
(setq ct2 (+ ct2 3))
)
)
)
(setq ct (+ ct 1))
)
(cond
((/= bptlist nil)
(setq ct3 0)
(while (< ct3 (length bptlist))
(command "._break" "_non" (trans (nth ct3 bptlist) 0 1)  "_non" (trans (nth (+ ct3 1) bptlist) 0 1))
(setq ct3 (+ ct3 2))
)
)
)
)
(defun C:BI ()
(c:breakint)
)

HTH, 

Thanks, I just hadn't gotten that far with it yet, I have been busy trying to fix up the rest of my routines first.

[trogg]

Chris, I just wanted to drop you a big thank you for this routine. I have been using it a lot and it saves me a lot of time.
Thanks again for sharing
~Greg