Polyline modification LISP

[swanny89]

Hi all,

 

Long story short, I waste tens of hours per year creating "quirks" in polylines, and I'm hoping that this could be automated using a LISP....problem is I have no idea where to start when it comes to manipulating geometry with LISP (or even if what I'm trying to achieve is possible).

I'm wondering if anyone has a lisp, or could create a lisp (I will be eternally grateful) that can modify a polyline in a specific manner.

 

The image below shows what I'm trying to achieve. I'd love to have 2 lisps. One to do corners (type 1 - calld "quirkc" ) and another to do lines (type 2 - called "quirkl"). The functionality I'd like to achieve in these LISPS is as follows;

1. Activate the lisp

2. Pick a point on the line or the corner (these geometries are polylines or closed polylines)

3. Have a prompt appear asking for width (x) and height (y)

4. modify the polyline as shown (create additional points in the polyline offset the required x and y distances)

 

Thank you in advance for any help you can provide (or simply telling me this is not possible).

 

 

[devitg]

On 10/18/2025 at 5:28 AM, swanny89 said:

Hi all,

 

Long story short, I waste tens of hours per year creating "quirks" in polylines, and I'm hoping that this could be automated using a LISP....problem is I have no idea where to start when it comes to manipulating geometry with LISP (or even if what I'm trying to achieve is possible).

I'm wondering if anyone has a lisp, or could create a lisp (I will be eternally grateful) that can modify a polyline in a specific manner.

 

The image below shows what I'm trying to achieve. I'd love to have 2 lisps. One to do corners (type 1 - calld "quirkc" ) and another to do lines (type 2 - called "quirkl"). The functionality I'd like to achieve in these LISPS is as follows;

1. Activate the lisp

2. Pick a point on the line or the corner (these geometries are polylines or closed polylines)

3. Have a prompt appear asking for width (x) and height (y)

4. modify the polyline as shown (create additional points in the polyline offset the required x and y distances)

 

Thank you in advance for any help you can provide (or simply telling me this is not possible).

 

 

@swanny89 Please upload your.dwg sample.  Would be all polylines  rectangles orthogonal to X and Y axis?

[swanny89]

@devitg

 

Thank you for taking the time to look into this for me!

Attached is a copy of the dwg with the basic geometry (before and after). I'd say in 90% of cases the rectangles would be orthogonal like you say, but sometimes they can be at any angle.

 

If we could capture the 90% use case that would be hugely beneficial on it's own.

Quirk.dwg

[devitg]

@swanny89 I guess both values W H could be different ?

[BIGAL]

 

For even a pline or a line you can click near an end so setting direction, then you would enter offset, length and height. A little more accurate than pick a point on the object. Added to my "To do list" if @devitg does not do something 1st. Can use a dcl for input.

 

Edited 13 hours ago by BIGAL

[Tsuky]

You can try this. I think is good for you.

 

notch.lsp

[Ajmal]

You need to select a polyline near a corner. After providing the width (X) and depth (Y) dimensions, it automatically modifies the polyline by replacing the selected corner vertex with three new vertices to form the specified quirk.

 

;;; QUIRKC.LSP - Creates a "Quirk" at the corner of a LWPOLYLINE
;;;------------------------------------------------------------------;
(defun c:QUIRKC (/ *error* doc obj sel pt coords len i min-dist dist idx
                   pt-c pt-p pt-n ang1 ang2 x y new-p1 new-p2 new-p3
                   new-coords-flat)

  (defun *error* (msg)
    (if (and doc (not (vlax-object-released-p doc)))
        (vla-endundomark doc)
    )
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
        (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)

  (princ "\nSelect a polyline near the corner to modify: ")
  (setq sel (entsel))

  (if (and sel (eq (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE"))
    (progn
      (setq obj (vlax-ename->vla-object (car sel)))
      (setq pt (trans (cadr sel) 1 0)) ; Clicked point in WCS
      (setq coords (vlax-get obj 'Coordinates))
      (setq len (length coords))

      ;; Find the closest vertex to the clicked point
      (setq i 0 min-dist -1 idx -1)
      (while (< i len)
        (setq current-pt (list (nth i coords) (nth (1+ i) coords)))
        (setq dist (distance pt current-pt))
        (if (or (< min-dist 0) (< dist min-dist))
          (setq min-dist dist idx (/ i 2))
        )
        (setq i (+ i 2))
      )

      ;; Get corner, previous, and next vertices
      (setq pt-c (list (nth (* idx 2) coords) (nth (1+ (* idx 2)) coords)))
      (if (eq idx 0)
          (if (vlax-curve-isclosed obj)
              (setq pt-p (list (nth (- len 2) coords) (nth (1- len) coords)))
              (setq pt-p nil)
          )
          (setq pt-p (list (nth (* (1- idx) 2) coords) (nth (1+ (* (1- idx) 2)) coords)))
      )
      (if (eq idx (/ (- len 2) 2))
          (if (vlax-curve-isclosed obj)
              (setq pt-n (list (nth 0 coords) (nth 1 coords)))
              (setq pt-n nil)
          )
          (setq pt-n (list (nth (* (1+ idx) 2) coords) (nth (1+ (* (1+ idx) 2)) coords)))
      )
      
      (if (and pt-p pt-n)
        (progn
          ;; Get user input for X and Y dimensions
          (setq x (getdist "\nEnter Width (X) of quirk: "))
          (setq y (getdist pt-c "\nEnter Depth (Y) of quirk: "))

          (if (and x y (> x 0) (> y 0))
            (progn
              ;; Calculate the new points for the quirk
              (setq ang1 (angle pt-c pt-p))
              (setq ang2 (angle pt-c pt-n))
              (setq new-p1 (polar pt-c ang1 y))
              (setq new-p2 (polar new-p1 ang2 x))
              (setq new-p3 (polar pt-c ang2 x))

              ;; Rebuild the coordinate list
              (setq i 0 new-coords-flat '())
              (while (< i len)
                (if (eq (/ i 2) idx)
                  (setq new-coords-flat (append new-coords-flat (list (car new-p1) (cadr new-p1)
                                                                      (car new-p2) (cadr new-p2)
                                                                      (car new-p3) (cadr new-p3))))
                  (setq new-coords-flat (append new-coords-flat (list (nth i coords) (nth (1+ i) coords))))
                )
                (setq i (+ i 2))
              )

              ;; Update the polyline with the new coordinates
              (vla-put-coordinates obj (vlax-make-variant
                                         (vlax-safearray-fill
                                           (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length new-coords-flat))))
                                           new-coords-flat
                                         )
                                       )
              )
            )
            (princ "\nInvalid input. X and Y must be greater than zero.")
          )
        )
        (princ "\nCorner must not be an endpoint of an open polyline.")
      )
    )
    (princ "\nNo valid LWPOLYLINE was selected.")
  )
  (vla-endundomark doc)
  (princ)
)

You first select a point on a polyline segment and click to choose which side the quirk should be on. After providing the width (X) and length (Y), the script automatically adds the four new vertices to create the specified quirk, perfectly centered on your initial selection point.


 

;;; QUIRKL.LSP (Final Version with Direction Control)
;;; Creates a "Quirk" on a user-specified side of a LWPOLYLINE segment.
;;;---------------------------------------------------------------------;
(defun c:QUIRKL (/ *error* doc sel obj pt click-pt side-pt param idx pt1 pt2
                   ang-along ang-perp ang-perp1 ang-perp2 test-p1 test-p2
                   x y p1 p2 p3 p4 coords new-coords-flat i)

  (defun *error* (msg)
    (if (and doc (not (vlax-object-released-p doc)))
      (vla-endundomark doc)
    )
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*"))
      (princ (strcat "\nError: " msg))
    )
    (princ)
  )

  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)

  (princ "\nSelect a point on the polyline segment to modify: ")
  (setq sel (entsel))

  (if (and sel (eq (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE"))
    (progn
      (setq obj (vlax-ename->vla-object (car sel)))
      (setq click-pt (trans (cadr sel) 1 0))
      (setq pt (vlax-curve-getclosestpointto obj click-pt))

      ;; -- FEATURE: ASK USER FOR THE SIDE --
      (setq side-pt (getpoint pt "\nClick on the side for the quirk: "))
      
      (if side-pt
        (progn
          (setq x (getdist pt "\nEnter Width (X) of quirk: "))
          (setq y (getdist pt "\nEnter Length (Y) of quirk: "))

          (if (and x y (> x 0) (> y 0))
            (progn
              (setq param (vlax-curve-getparamatpoint obj pt))
              (setq idx (fix param))
              (setq pt1 (vlax-curve-getpointatparam obj idx))
              (setq pt2 (vlax-curve-getpointatparam obj (1+ idx)))
              (setq ang-along (angle pt1 pt2))

              ;; -- Determine the correct perpendicular angle based on user's click --
              (setq ang-perp1 (+ ang-along (/ pi 2.0))) ; Option 1 (CCW)
              (setq ang-perp2 (- ang-along (/ pi 2.0))) ; Option 2 (CW)
              (setq test-p1 (polar pt ang-perp1 1.0))
              (setq test-p2 (polar pt ang-perp2 1.0))
              (if (< (distance side-pt test-p1) (distance side-pt test-p2))
                (setq ang-perp ang-perp1)
                (setq ang-perp ang-perp2)
              )

              ;; Calculate new points using the chosen angle
              (setq p1 (polar pt ang-along (- (/ y 2.0))))
              (setq p2 (polar p1 ang-perp x))
              (setq p3 (polar p2 ang-along y))
              (setq p4 (polar p3 (+ ang-perp pi) x))

              ;; Rebuild the coordinate list
              (setq coords (vlax-get obj 'Coordinates))
              (setq i 0 new-coords-flat '())
              (while (< i (length coords))
                (setq new-coords-flat (append new-coords-flat (list (nth i coords) (nth (1+ i) coords))))
                (if (eq (/ i 2) idx)
                  (setq new-coords-flat (append new-coords-flat (list (car p1) (cadr p1)
                                                                      (car p2) (cadr p2)
                                                                      (car p3) (cadr p3)
                                                                      (car p4) (cadr p4))))
                )
                (setq i (+ i 2))
              )

              ;; Update the polyline
              (vla-put-coordinates obj (vlax-make-variant
                                         (vlax-safearray-fill
                                           (vlax-make-safearray vlax-vbdouble (cons 0 (1- (length new-coords-flat))))
                                           new-coords-flat
                                         )
                                       )
              )
            )
            (princ "\nInvalid input. X and Y must be greater than zero.")
          )
        )
      )
    )
    (princ "\nNo valid LWPOLYLINE was selected.")
  )
  (vla-endundomark doc)
  (princ)
)

 

Edited 40 minutes ago by Ajmal

[swanny89]

@Tsuky

Thank you so much this is absolutley amazing!

It doesn't allow the width and height to be specified independantly, but considering that the vast mojority of the time these are the same it's really no issue at all to just adjust them when required.

 

Again, thank you

[swanny89]

@Ajmal

Thank you this is equally amazing!

I now have two versions that cover all scenarios. I can use @Tsuky's version when the quirk dimensions are equal as this version doesnt require as much user input. Then, for the more unusual quirks I can switch to your version and specify the parameters.

Thanks guys problem solved! I'm sure I'll come up with a new problem soon