Drawing Rectangle using Perpendicular Reference Point of 2 Polyline

[avarte]

Hi Everyone,

 

I'm very new in writing lisp, but I was trying to write a lisp that could help me draw a rectangle using the perpendicular reference point of 2 polyline. Attached is a picture of how I want to draw it. It's hard to draw the rectangle using just the onsnap. I was wondering if I could just click on the 2 end points of the polyline and the other direction's polyline to draw the rectangle.

[Tharwat]

Try this and let me know:

(defun c:Test (/ s ss a b c d ins lst)
 ;; 		Tharwat - Date: 21.June.2016		;;
 ;; Draw closed LWpolyline from the two selected	;;
 ;; LWpolylines and they must be straight.		;;
 (defun _straight-p (e / l q a)
   (setq l (mapcar 'cdr
                   (vl-remove-if-not
                     '(lambda (p) (= (car p) 10))
                     (entget (ssname e 0))
                     )
                   )
         q (car l)
         a (angle q (cadr l))
         )
   (apply
     'and
     (mapcar
       '(lambda (pt) (and (equal (angle q pt) a 1e-4) (setq q pt)))
       (cdr l)
       )
     )
   )
 (princ "\nSelect 1st LWpolyline :")
 (if (and (setq s (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
          (_straight-p s)
          (princ "\nSelect 2nd LWpolyline :")
          (setq ss (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
          (_straight-p ss)
          (setq a (vlax-curve-getstartpoint (ssname s 0))
                b (vlax-curve-getendpoint (ssname s 0))
                c (vlax-curve-getstartpoint (ssname ss 0))
                d (vlax-curve-getendpoint (ssname ss 0))
                )
          (setq ins (inters a b c d))
          )
   (progn
     (mapcar '(lambda (j k)
                (setq lst (cons (list (polar a j k)
                                      (polar b j k)
                                      )
                                lst
                                )
                      )
                )
             (list (angle d c) (angle c d))
             (list (distance ins c) (distance ins d))
             )
     (setq lst (apply 'append lst))
     (entmake (list '(0 . "LWPOLYLINE")
                    '(100 . "AcDbEntity")
                    '(100 . "AcDbPolyline")
                    '(90 . 4)
                    '(70 . 1)
                    (cons 10 (car lst))
                    (cons 10 (caddr lst))
                    (cons 10 (last lst))
                    (cons 10 (cadr lst))
                    )
              )
     )
   (princ "\nLWpolylines must be straight and crossed !")
   )
 (princ)
 )(vl-load-com)

[Lee Mac]

Here's another way to write it:

(defun c:myrect ( / int pl1 pl2 pt1 pt2 pt3 pt4 )
   (if (and (setq pl1 (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 2))))
            (setq pl2 (ssget "_+.:E:S" '((0 . "LWPOLYLINE") (90 . 2))))
       )
       (if (setq pl1 (entget (ssname pl1 0))
                 pl2 (entget (ssname pl2 0))
                 pt1 (cdr (assoc 10 pl1))
                 pt2 (cdr (assoc 10 (reverse pl1)))
                 pt3 (cdr (assoc 10 pl2))
                 pt4 (cdr (assoc 10 (reverse pl2)))
                 int (inters pt1 pt2 pt3 pt4)
           )
           (entmake
               (list
                  '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(090 . 4)
                  '(070 . 1)
                   (cons 10 (mapcar '+ pt1 (mapcar '- pt3 int)))
                   (cons 10 (mapcar '+ pt1 (mapcar '- pt4 int)))
                   (cons 10 (mapcar '+ pt2 (mapcar '- pt4 int)))
                   (cons 10 (mapcar '+ pt2 (mapcar '- pt3 int)))
               )
           )
           (princ "\nLines do not intersect.")
       )
   )
   (princ)
)

[Tharwat]

Mine is working on multi-vertices of a LWpolyline when all coordinates are on the same line.

[pkenewell]

To Expand on Lee's excellent work, I had the idea of making a more general version of this that would allow selection of a SEGMENT of any type of line and create the rectangle as well. So using lee's "SelectIf" and another piece of code I got from theSwamp from Stig Madsen:

 

 

(defun c:myrect2 ( / int e1 e2 o1 o2 np1 np2 s1 s2 pt1 pt2 pt3 pt4 )
   (if (and (setq e1 (LM:SelectIf "\nSelect 1st Line Segment: " (lambda (x) (wcmatch (cdr (assoc 0 (entget (car x)))) "LINE,*POLYLINE" )) entsel nil))
            (setq e2 (LM:SelectIf "\nSelect 2nd Line Segment: " (lambda (x) (wcmatch (cdr (assoc 0 (entget (car x)))) "LINE,*POLYLINE" )) entsel nil))
       )
       (if (setq o1 (vlax-ename->vla-object (car e1))
                 o2 (vlax-ename->vla-object (car e2))
                 np1 (vlax-curve-getclosestpointto o1 (cadr e1))
                 np2 (vlax-curve-getclosestpointto o2 (cadr e2))
                 s1 (pjk-GetCurveSegment o1 np1)
                 s2 (pjk-GetCurveSegment o2 np2)
                 pt1 (car s1)
                 pt2 (cadr s1)
                 pt3 (car s2)
                 pt4 (cadr s2)
                 int (inters pt1 pt2 pt3 pt4)
           )
           (entmake
               (list
                  '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(090 . 4)
                  '(070 . 1)
                   (cons 10 (mapcar '+ pt1 (mapcar '- pt3 int)))
                   (cons 10 (mapcar '+ pt1 (mapcar '- pt4 int)))
                   (cons 10 (mapcar '+ pt2 (mapcar '- pt4 int)))
                   (cons 10 (mapcar '+ pt2 (mapcar '- pt3 int)))
               )
           )
           (princ "\nLines do not intersect.")
       )
   )
   (princ)
)
;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Provides continuous selection prompts until either a      ;;
;;  predicate function is validated or a keyword is supplied. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - [url="http://www.lee-mac.com"]www.lee-mac.com[/url]       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  msg  - prompt string                                      ;;
;;  pred - optional predicate function [selection list arg]   ;;
;;  func - selection function to invoke                       ;;
;;  keyw - optional initget argument list                     ;;
;;------------------------------------------------------------;;
;;  Returns:  Entity selection list, keyword, or nil          ;;
;;------------------------------------------------------------;;
(defun LM:SelectIf ( msg pred func keyw / sel ) (setq pred (eval pred))
 (while
   (progn (setvar 'ERRNO 0) (if keyw (apply 'initget keyw)) (setq sel (func msg))
     (cond
       ( (= 7 (getvar 'ERRNO))
         (princ "\nMissed, Try again.")
       )
       ( (eq 'STR (type sel))
         nil
       )
       ( (vl-consp sel)
         (if (and pred (not (pred sel)))
           (princ "\nInvalid Object Selected.")
         )
       )
     )
   )
 )
 sel
)
;; Modified version by PJK originally written by: Stig Madsen
;; refer to thread titled "relaxed-curves" under the "Teach Me"
;; section of TheSwamp at [url="http://www.theswamp.org/phpBB2/"]www.theswamp.org/phpBB2/[/url]
(defun pjk-GetCurveSegment (obj pt / cpt eParam stParam)
(cond
 ((wcmatch (vlax-get-Property obj 'objectName) "AcDbLine,AcDbArc")
      (setq eParam  (vlax-curve-getEndParam   obj)
          stParam (vlax-curve-getStartParam obj)
        )
        (list
   (vlax-curve-getPointAtParam obj stParam)
   (vlax-curve-getPointAtParam obj  eParam)
  )
   )
   ((setq cpt (vlax-curve-getClosestPointTo obj pt))
     (setq eParam (fix (vlax-curve-getEndParam obj)))
        (if (= eParam (setq stParam (fix (vlax-curve-getParamAtPoint obj cpt))))
         (setq stParam (1- stParam))
          (setq eParam  (1+ stParam))
        )
        (list
   (vlax-curve-getPointAtParam obj stParam)
           (vlax-curve-getPointAtParam obj  eParam)
  )
   )
)
)

Please feel free to tear this up and make it more efficient, but I thought this might be more versatile for the application.

Edited June 22, 2016 by pkenewell
Changed Selection Filter to just LINEs and POLYLINEs, since SPLINEs or XLINEs might cause a problem.

[Grrr]

Nice one, pkenewell!

I usually use some subfunction named "get_ends" from Stefan_BMR, to pick line/pline's segment - but now I'll analyse the code you posted.

[pkenewell]

Edited my above program to filter for just LINES and POLYLINEs, because SPLINES, MLINES and XLINEs would cause a problem.

[avarte]

Thank you so much guys. Didn't think I would get a responds that quick. Thank you so much. I get why my previous codes didn't work. Learned a lot from you guys. Thank you again.