Even though this routine prompts you to select a curve, this routine can be used on other objects as well.
You simply select an object near the endpoint where you want to start from then specify a distance along the object. This routine will break the object at that distance and create a temporary X to mark where the break is. As soon as you either do a REGEN (RE) <enter> the Xs will go away.
This routine doesn’t not work on closed objects like Rectangles, Polygons or closed Polylines/Splines.
- BAD <enter> to start Break At Distance
- Select the end point start from.
- Enter the distance away from the start point to create a break.
- Continue by entering another distance away from the previous break point
- When you are finished, hit <enter> to end.
(defun c:BAD (/ *error* AT:GetSel AT:DrawX _getDist ent pnt cmd undo total add dist break) ;; Break curve At Distance ;; Alan J. Thompson, 09.21.11 ;; http://www.theswamp.org/index.php?topic=39550.0;all (vl-load-com) (defun *error* (msg) (and cmd (setvar 'CMDECHO cmd)) (and *AcadDoc* (vla-endundomark *AcadDoc*)) (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,"))) (princ (strcat "\nError: " msg)) ) ) (defun AT:GetSel (meth msg fnc / ent) ;; meth - selection method (entsel, nentsel, nentselp) ;; msg - message to display (nil for default) ;; fnc - optional function to apply to selected object ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC"))) ;; Alan J. Thompson, 05.25.10 (setvar 'ERRNO 0) (while (progn (setq ent (meth (cond (msg) ("\nSelect object: ") ) ) ) (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again.")) ((eq (type (car ent)) 'ENAME) (if (and fnc (not (fnc ent))) (princ "\nInvalid object!") ) ) ) ) ) ent ) (defun AT:DrawX (P C) ;; Draw and "X" vector at specified point ;; P - Placement point for "X" ;; C - Color of "X" (must be integer b/w 1 & 255) ;; Alan J. Thompson, 10.31.09 (if (vl-consp P) ((lambda (d) (grvecs (cons C (mapcar (function (lambda (n) (polar P (* n pi) d))) '(0.25 1.25 0.75 1.75) ) ) ) P ) (* (getvar 'viewsize) 0.02) ) ) ) (defun _getDist (total point / dist) (and undo (initget "Undo")) (cond ((not (setq dist (getdist (AT:DrawX point 4) (strcat "\nDistance at which to break curve (Total= " (rtos total) (if undo ") [Undo]: " "): " ) ) ) ) ) nil ) ((eq dist "Undo") dist) ((not (< 0. dist total)) (princ (strcat "\nValue must be between 0.0 and and " (rtos total) "!")) (_getDist total point) ) (dist) ) ) (vla-startundomark (cond (*AcadDoc*) ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))) ) ) (if (setq ent (AT:GetSel entsel "\nSelect curve to break: " (lambda (x) (and (wcmatch (cdr (assoc 0 (entget (car x)))) "ARC,LINE,*POLYLINE,SPLINE" ) (not (vlax-curve-isClosed (car x))) ) ) ) ) (progn (setq pnt (trans (cadr ent) 1 0) ent (car ent) cmd (getvar 'CMDECHO) ) (setvar 'CMDECHO 0) (while (setq dist (_getDist (setq total (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))) (setq pnt (trans (if (> (vlax-curve-getParamAtPoint ent (vlax-curve-getClosestPointToProjection ent pnt '(0. 0. 1.)) ) (vlax-curve-getParamAtDist ent (/ total 2.)) ) (progn (setq add total) (vlax-curve-getEndPoint ent)) (progn (setq add 0.) (vlax-curve-getStartPoint ent)) ) 0 1 ) ) ) ) (if (eq dist "Undo") (progn (vl-cmdf "_.U") (setq ent (caar undo) pnt (cadar undo) undo (cdr undo) ) ) (progn (setq break (trans (vlax-curve-getPointAtDist ent (abs (- add dist))) 0 1)) (command-s "_.break" ent "_F" "_non" break "_non" break) (setq undo (cons (list ent pnt) undo)) (and (zerop add) (setq ent (entlast))) ) ) (redraw) (foreach p (vl-remove (last undo) undo) (AT:DrawX (cadr p) 1)) ) ) ) (*error* nil) (princ) )
Has anyone had any issues using this in 2015? The routine does not work as it used to in 2013, it only states “invalid point” even if the points should be valid. Any thoughts?
I’ve updated the code and tested it in ACAD 2015 and it worked for me. Give the new code a try.
Thanks for bring that issue to my attention.
Thanks its work perfectly Great job
, if we want circle not break.
Pingback: AutoLISP: Updated Code for “Break Along Curve” or “Break At Distance” | AutoCAD Tips
Hi great LISP, I am using it really often in my work. However, at home I am still using the AutoCAD 2010 version due to the licensing. Would it be possible to post back also the old, non-updated code? Thank you in advance!!
Thanks, Good routine.
Hope to upgrade another routine to apply the BREAK at equal or unequal distances at once like:
1- For equal breaking : command should contain: Distance 1m, Frequency 20.
2- For unequal breaking : command should contain: Distances 1,3,2.5,2,2,6,1,1.25 etc.