Draw rectangle on polyline's vertex

Hi, I need your help if this is this possible via lisp. I have a pline and I want to draw a rectangle on it's 2 consecutive vertices with a given height which is X on the drawing. Polyline may have 4 to infinite vertices. I doesn't matter if the resultant rectangle is inside or outside the polyline/polygon.

Or probably click on a segment of the polyline and it will create the rectangle with a given height. So I just need to click each segments. Also can the height be stored as a variable so I don't have to enter again except when the height change again. Just like when we do offset, the last offset distance is stored and can be call again by pressing enter. Thank you all and have a great day.

Welcome to the forum .

Here is my code that I have just written it for you . And if Polylines went inside and you want them to be outside drawn , so just call the command reverse and implement it on the

source Polyline .

(defun c:TesT (/ e lst i j d p1 p2 ang p3 p4)
 ;;=====   TharwaT  =====;;
 ;;===== 31.07.2011 =====;;
 (if (not x)
   (setq x 1.0)
 )
 (if
   (and
     (setq e (car (entsel "\n Select a polyline : ")))
     (member (cdr (assoc 0 (entget e)))
             '("LWPOLYLINE" "POLYLINE")
     )
     (setq
       x (cond ((getdist (strcat "\n Specify the Depth distance <"
                                 (rtos x 2)
                                 "> :"
                         )
                )
               )
               (atoi x)
         )
     )
   )
    (progn
      (setq lst (vl-remove-if-not
                  (function (lambda (x)
                              (eq (car x) 10)
                            )
                  )
                  (entget e)
                )
      )
      (setq i 0
            j 1
      )
      (repeat (1- (length lst))

        (setq
          d (distance
              (setq p1 (vlax-curve-getpointatparam e i))
              (setq p2 (vlax-curve-getpointatparam e (setq i (1+ i))))
            )
        )
        (setq ang (angle p1 p2))
        (entmakex
          (list '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 5)
                '(70 . 1)
                (cons 10 p1)
                (cons 10 p2)
                (cons 10 (setq p3 (polar p2 (- ang 1.5708) x)))
                (cons 10 (setq p4 (polar p3 (angle p2 p1) d)))
          )
        )
      )
    )
    (princ
      "\n You missed the Polyline or it's not a Polyline !! ... "
    )
 )
 (princ)
)

Tharwat

This one is a little bit better in dealing with Rectangle Polylines (square shapes)besides to undo option .

(defun c:TesT (/ *error* acdoc e lst i j l d p1 p2 ang p3 p4)
 ;;=====   TharwaT  =====;;
 ;;===== 31.07.2011 =====;;

 (vl-load-com)
 (defun *error* (msg)
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (if (not x)
   (setq x 1.0)
 )
 (if
   (and
     (setq e (car (entsel "\n Select a polyline : ")))
     (member (cdr (assoc 0 (entget e)))
             '("LWPOLYLINE" "POLYLINE")
     )
     (setq
       x (cond ((getdist (strcat "\n Specify the Depth distance <"
                                 (rtos x 2)
                                 "> :"
                         )
                )
               )
               (atoi x)
         )
     )
   )
    (progn
      (vla-StartUndoMark acdoc)
      (setq lst (vl-remove-if-not
                  (function (lambda (x)
                              (eq (car x) 10)
                            )
                  )
                  (entget e)
                )
      )
      (setq i 0
            j 1
      )
      (if (not (eq 4 (setq l (length lst))))
        (setq l (1- l))
      )
      (repeat l

        (setq
          d (distance
              (setq p1 (vlax-curve-getpointatparam e i))
              (setq p2 (vlax-curve-getpointatparam e (setq i (1+ i))))
            )
        )
        (setq ang (angle p1 p2))
        (entmakex
          (list '(0 . "LWPOLYLINE")
                '(100 . "AcDbEntity")
                '(100 . "AcDbPolyline")
                '(90 . 5)
                '(70 . 1)
                (cons 10 p1)
                (cons 10 p2)
                (cons 10 (setq p3 (polar p2 (- ang 1.5708) x)))
                (cons 10 (setq p4 (polar p3 (angle p2 p1) d)))
          )
        )
      )
      (vla-EndUndoMark acdoc)
    )
    (princ
      "\n You missed the Polyline or it's not a Polyline !! ... "
    )
 )
 (princ)
)

Tharwat

This one is a little bit better in dealing with Rectangle Polylines (square shapes)besides to undo option .

 

(defun c:TesT (/ *error* acdoc e lst i j l d p1 p2 ang p3 p4)
;;===== TharwaT =====;;
;;===== 31.07.2011 =====;;

(vl-load-com)
(defun *error* (msg)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)
(setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)))

(if (not x)
(setq x 1.0)
)
(if
(and
(setq e (car (entsel "\n Select a polyline : ")))
(member (cdr (assoc 0 (entget e)))
'("LWPOLYLINE" "POLYLINE")
)
(setq
x (cond ((getdist (strcat "\n Specify the Depth distance <"
(rtos x 2)
"> :"
)
)
)
(atoi x)
)
)
)
(progn
(vla-StartUndoMark acdoc)
(setq lst (vl-remove-if-not
(function (lambda (x)
(eq (car x) 10)
)
)
(entget e)
)
)
(setq i 0
j 1
)
(if (not (eq 4 (setq l (length lst))))
(setq l (1- l))
)
(repeat l

(setq
d (distance
(setq p1 (vlax-curve-getpointatparam e i))
(setq p2 (vlax-curve-getpointatparam e (setq i (1+ i))))
)
)
(setq ang (angle p1 p2))
(entmakex
(list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 5)
'(70 . 1)
(cons 10 p1)
(cons 10 p2)
(cons 10 (setq p3 (polar p2 (- ang 1.5708) x)))
(cons 10 (setq p4 (polar p3 (angle p2 p1) d)))
)
)
)
(vla-EndUndoMark acdoc)
)
(princ
"\n You missed the Polyline or it's not a Polyline !! ... "
)
)
(princ)
)

Tharwat

Funny, it only works on LWpolyline here and not Plines ? What if anything am I doing wrong. If I convert the Pline to LW, then it works.

TIA

Funny, it only works on LWpolyline here and not Plines ? What if anything am I doing wrong. If I convert the Pline to LW, then it works.

TIA

I am sure you mean the 3dpoly not the polyline . So that is not included .

Had some time, so here's another, pure Vanilla AutoLISP version for LWPolylines:

(defun c:doit ( / angle0 angle1 angle2 bulge elist entity point1 point2 selection xsize ) ;; Lee Mac 2011

   (initget 1)
   (setq xsize (getdist "\nHeight: "))

   (if (setq selection (ssget '((0 . "LWPOLYLINE"))))
       (while (setq entity (ssname selection 0))
           (setq elist (entget entity))
           (if (= 1 (logand 1 (cdr (assoc 70 elist))))
               (setq elist (append elist (list (assoc 10 elist))))
           )
           (repeat  (+ (cdr (assoc 90 elist)) (logand 1 (cdr (assoc 70 elist))) -1)
               (setq point1 (assoc 10 elist)
                     elist  (cdr (member point1 elist))
                     point2 (assoc 10 elist)
                     bulge  (* 2.0 (atan (cdr (assoc 42 elist))))
                     angle0 (angle (cdr point1) (cdr point2))
                     angle1 (- angle0 (+ (/ pi 2.) bulge))
                     angle2 (- angle0 (- (/ pi 2.) bulge))
               )
               (entmakex
                   (list
                       (cons 0 "LWPOLYLINE")
                       (cons 100 "AcDbEntity")
                       (cons 100 "AcDbPolyline")
                       (cons 90 4)
                       (cons 70 0)
                       point1
                       (cons 10 (polar (cdr point1) angle1 xsize))
                       (assoc 42 elist)
                       (cons 10 (polar (cdr point2) angle2 xsize))
                       point2
                       (assoc 210 elist)
                   )
               )
           )
           (ssdel entity selection)
       )
   )
   (princ)
)

Should work in all UCS/Views and with LWPolyline Arcs.