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

Advertisements

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.

4 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

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s