AutoLISP: Advanced Polyline Offset

Not knowing what to call this routine, I think that it is more of a combination of an advanced Offset command that automates the placement of the vertices at the (M2P) Mid-Between-2-Points.

If you need an offset that is between 2 polylines and the 2 polylines are not truly parallel to each other, the result of the polyline might not be the desired result.

OffsetPL2Mid 1

This process is automated by using this routine written by Alan Thompson and found at CADTutor: http://www.cadtutor.net/forum/showthread.php?73308-Multiple-Offsets&p=535978&viewfull=1#post535978

(Please refer questions or requests to the forum where the lisp routine was originally posted)

OffsetPL2Mid 2

Note: that the output offers an option for the created polyline (LWPolyline or Polyline)

OffsetPL2Mid 3

As an added bonus, the routine handles polylines that are at different elevations (z values) and it even handles 3DPolylines pretty well.

OffsetPL2Mid 4

OffsetPL2Mid 5

Thanks Alan!!

Here’s how:

  • LBL <enter> to start
  • Select the 1st polyline
  • Select the 2nd polyline
  • Specify the output polyline (LWPoline or Polyline)
  • RE <enter> or REGEN <enter> to get rid of the temporary dashed red lines



(defun c:LBL (/ foo AT:GetSel _pnts _pline _lwpline _dist e1 e2)
  ;; Draw (LW)Polyline between two selected curves (at midpoint of vertices).
  ;; Alan J. Thompson, 09.29.10
  ;; http://www.cadtutor.net/forum/showthread.php?73308-Multiple-Offsets&p=535978&viewfull=1#post535978
  (vl-load-com)

  (defun foo (e)
    (and (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,*POLYLINE,SPLINE")
         (not (vlax-curve-isClosed (car e)))
    )
  )

  (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
    (while
      (progn (setvar 'ERRNO 0)
             (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 _pnts (e / p l)
    (if e
      (cond ((wcmatch (cdr (assoc 0 (entget e))) "ARC,LINE,SPLINE")
             (list (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
            )
            ((wcmatch (cdr (assoc 0 (entget e))) "*POLYLINE")
             (repeat (setq p (1+ (fix (vlax-curve-getEndParam e))))
               (setq l (cons (vlax-curve-getPointAtParam e (setq p (1- p))) l))
             )
            )
      )
    )
  )

  (defun _pline (lst)
    (if (and (> (length lst) 1)
             (entmakex '((0 . "POLYLINE") (10 0. 0. 0.) (70 . 8)))
             (foreach x lst (entmakex (list '(0 . "VERTEX") (cons 10 x) '(70 . 32))))
        )
      (cdr (assoc 330 (entget (entmakex '((0 . "SEQEND"))))))
    )
  )

  (defun _lwpline (lst)
    (if (> (length lst) 1)
      (entmakex (append
                  (list '(0 . "LWPOLYLINE")
                        '(100 . "AcDbEntity")
                        '(100 . "AcDbPolyline")
                        (cons 90 (length lst))
                        (cons 70 (* (getvar 'plinegen) 128))
                  )
                  (mapcar (function (lambda (p) (list 10 (car p) (cadr p)))) lst)
                )
      )
    )
  )

  (defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

  (if
    (and
      (setq e1 (_pnts (car (AT:GetSel entsel "\nSelect first open curve: " foo))))
      (setq e2 (_pnts (car (AT:GetSel entsel "\nSelect next open curve: " foo))))
      (not (initget 0 "Lwpolyline Polyline"))
      (setq *LBL:Opt* (cond ((getkword (strcat "\nSpecify line to draw: [Lwpolyline/Polyline] <"
                                               (cond (*LBL:Opt*)
                                                     ((setq *LBL:Opt* "Lwpolyline"))
                                               )
                                               ">: "
                                       )
                             )
                            )
                            (*LBL:Opt*)
                      )
      )
    )
     ((if (eq *LBL:Opt* "Lwpolyline")
        _lwpline
        _pline
      )
       (vl-remove nil
                  (mapcar (function (lambda (a b)
                                      (if (and a b (not (grdraw (trans a 0 1) (trans b 0 1) 1 1)))
                                        (mapcar (function (lambda (a b) (/ (+ a b) 2.))) a b)
                                      )
                                    )
                          )
                          e1
                          (if (< (_dist (car e1) (car e2))
                                 (_dist (car e1) (last e2))
                              )
                            e2
                            (reverse e2)
                          )
                  )
       )
     )
  )
  (princ)
)
About these ads

About AutoCAD Tips

This blog serves as a knowledge base for myself 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 experience better. I am currently unemployed and I am located in the Denver Metro Area. If you would like to find out more about my and see samples of my work, please visit www.gregbattin.weebly.com
This entry was posted in AutoLISP, AutoLISP: Creating, AutoLISP: Modify, AutoLISP: Polylines. Bookmark the permalink.

4 Responses to AutoLISP: Advanced Polyline Offset

  1. Doug says:

    This is terrific. Thanks!

  2. Szigeti Pál says:

    Does it work on polylines with different number of points?

  3. laud8 says:

    You always make me learn a useful thing! Thanks Greg! :)

    • AutoCAD Tips says:

      Thanks for the compliment. I find your blog inspiring. Blending art and architecture and especially landscape architecture which I think is some of the hardest architecture to pull off and make it really stand out. You guys do a great job.
      Thanks
      ~Greg

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