AutoLISP: Break At Distance

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.

Here’s how:

  • 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)
)

About AutoCAD Tips

This blog serves as a knowledge base for myself (and anyone else) so that I can reference tips & tricks that I have learned and also refer others to it as well. I hope that this blog helps you learn at least one tip to make your drafting/design experience better.
This entry was posted in AutoLISP, Modifying, Polylines. Bookmark the permalink.

6 Responses to AutoLISP: Break At Distance

  1. Eric says:

    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?

  2. Pingback: AutoLISP: Updated Code for “Break Along Curve” or “Break At Distance” | AutoCAD Tips

  3. mateej says:

    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!!

  4. Mohammed Salama says:

    Thanks, Good routine.
    Hope to upgrade another routine to apply the BREAK at equal or unequal distances at once like:
    eg.:
    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.

    Regards

Leave a comment