Rectangle lisp.Little help !

[Guest]

Hello . I have found in an old post this lisp

(defun c:BX (/ foo _dist p1 p2 p3 ang)
 ;; Draw rectangle based on 2 or 3 picked points
 ;; Alan J. Thompson, 07.26.10

 (defun foo (l)
   (entmake
     (append '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 129))
             (mapcar (function (lambda (p) (cons 10 (reverse (cdr (reverse (trans p 1 0))))))) l)
     )
   )
 )

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

 (if (and (setq p1 (getpoint "\nSpecify first point: "))
          (setq p2 (getpoint p1 "\nSpecify second point: "))
          (not (grdraw p1 p2 3 1))
     )
   (if (setq p3 (initget 0 "Left Right")
             p3 (getpoint p2 "\nSpecify third point or Square box or [Left/Right]: ")
       )
     (cond ((vl-consp p3) (foo (list p1 p2 p3 (polar p3 (angle p2 p1) (_dist p1 p2)))))
           ((eq (type p3) 'STR)
            (cond
              ((eq p3 "Left") (setq ang (+ (/ pi 2.) (angle p1 p2))))
              ((eq p3 "Right") (setq ang (+ (* pi 1.5) (angle p1 p2))))
            )
            (foo (list p1 p2 (polar p2 ang (_dist p1 p2)) (polar p1 ang (_dist p1 p2))))
           )
     )
   )
 )
 (redraw)
 (princ)
)

 

I need to add one more command

I need to make rectangle with 3 points like the photo

[ReMark]

Why? Does Alan's 3 point rectangle require a three corner pick?

[Guest]

not like the photo

[marko_ribar]

This works on A2012...

 

(defun c:RX (/ p1 p2 p3 l1 l2 l3 l4 pea)
 (setq p1 (getpoint "\nPick first point: ") p1 (trans p1 1 0))
 (setq p2 (getpoint (trans p1 0 1) "\nPick second point: ") p2 (trans p2 1 0))
 (setq p3 (getpoint "\nPick third point: "))
 (setq l1 (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 p2))))
 (command "_.offset" "t" l1 p3 "")
 (setq l2 (entlast))
 (setq l3 (entmakex (list '(0 . "LINE") (cons 10 p1) (cons 11 (cdr (assoc 10 (entget l2)))))))
 (setq l4 (entmakex (list '(0 . "LINE") (cons 10 p2) (cons 11 (cdr (assoc 11 (entget l2)))))))
 (setq pea (getvar 'peditaccept))
 (setvar 'peditaccept 1)
 (command "_.pedit" l1 "j" l1 l2 l3 l4 "" "")
 (setvar 'peditaccept pea)
 (princ)
)

 

M.R.

[Guest]

thank you marko_ribar nice job

[MSasu]

Nice solution Marko! Simple, but effective.

 

I would add a protection for the case the third point lays on the line defined by the first two.

[David Bethel]

just cobbled together

 

(defun c:test (/ p1 p2 p3 p4 p5 p6)
 (initget 1)
 (setq p1 (getpoint "\nPoint 1:   ")))

 (initget 1)
 (setq p2 (getpoint p1 "\n2nd Point:   "))

 (initget 1)
 (setq p3 (getpoint p2 "\Opposing edge Point:   "))

 (if (setq p4 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (* pi 0.5)) 1) nil))
     (setq p5 (polar p1 (+ (angle p1 p2) (* pi 0.5)) (distance p1 p4)) 
           p6 (polar p2 (+ (angle p1 p2) (* pi 0.5)) (distance p1 p4)))
	  
 (and p1 p2 p5 p6
(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p2)))	  
(entmake (list (cons 0 "LINE")(cons 10 p1)(cons 11 p5)))	  
(entmake (list (cons 0 "LINE")(cons 10 p2)(cons 11 p6)))	  
(entmake (list (cons 0 "LINE")(cons 10 p5)(cons 11 p6)))	  
 
 (prin1))	 

 

 

Would need some 3D point error checking.

-David

[GP_]

David, I modified p5 and p6

 

(defun c:test (/ p1 p2 p3 p4 p5 p6)
  (initget 1)
  (setq p1 (getpoint "\nPoint 1:   "))
  (initget 1)
  (setq p2 (getpoint p1 "\n2nd Point:   "))
  (initget 1)
  (setq p3 (getpoint p2 "\Opposing edge Point:   "))
  (if (setq p4 (inters p1 p2 p3 (polar p3 (+ (angle p1 p2) (* pi 0.5)) 1) nil))
      (setq p5 (polar p1 (angle p4 p3) (distance p4 p3)) 
            p6 (polar p2 (angle p4 p3) (distance p4 p3)) 
      )
  )

  (and p1 p2 p5 p6
       (entmake
           (list
               (cons 0 "LWPOLYLINE")
               (cons 100 "AcDbEntity")
               (cons 100 "AcDbPolyline")
               (cons 90 4)
               (cons 70 1) 
               (cons 10 p1) 
               (cons 10 p2)
               (cons 10 p6)
               (cons 10 p5)
           ) 
       )
   )
   (princ)
)

[MSasu]

It works in 2002 also, but only produces lines instead of a rectangle.

This should be due to Marco's use of PEDITACCEPT system variable which wasn't supported in that release; the routine crash on that point, thus the polyline build isn't reached.

[David Bethel]

David, I modified p5 and p6

 

They needed to be !

[Bhull1985]

It works in 2002 also, but only produces lines instead of a rectangle.

 

If the OP had done a bit more searching and had some imagination, this thread does the trick even in 2d

 

Was the personal stab at the OP really necessary? Personally I thought his detailed description of the problem and his illustration of said problem were far and above the lackluster 1-liner posts many people seem to believe fulfill an accurate description of their problem when honestly they have hardly outlined the issue at all....that's not the case with this poster and as such I don't understand the hostility, even if it was fleeting and passive-aggressive...

Besides, does Google tell you that you have no imagination and you should look elsewhere when you query it with a request for information? Obviously you're not google but if they did, you two would be similar in this regard. Sorry for the rant but I notice this from time to time and don't think a less experienced lisper should be hazed over a properly proposed question in a forum meant for them.

[Lee Mac]

Another version:

(defun c:myrec ( / nv oc p1 p2 p3 p4 p5 p6 )
   (if
       (and
           (setq p1 (getpoint "\n1st point: "))
           (setq p2 (getpoint "\n2nd point: " p1))
           (setq p3 (getpoint "\n3rd point: " p1))
       )
       (progn
           (setq nv (trans (mapcar '- p2 p1) 1 0 t)
                 oc (trans '(0.0 0.0 1.0) 1 0 t)
                 p4 (trans p1 1 nv)
                 p5 (trans p2 1 nv)
                 p6 (trans p3 1 nv)
           )
           (entmake
               (list
                  '(000 . "LWPOLYLINE")
                  '(100 . "AcDbEntity")
                  '(100 . "AcDbPolyline")
                  '(090 . 4)
                  '(070 . 1)
                   (cons 010 (trans p1 1 oc))
                   (cons 010 (trans p2 1 oc))
                   (cons 010 (trans (list (car p6) (cadr p6) (caddr p5)) nv oc))
                   (cons 010 (trans (list (car p6) (cadr p6) (caddr p4)) nv oc))
                   (cons 210 oc)
               )
           )
       )
   )
   (princ)
)

With dynamic effect:

(defun c:myrec ( / nv oc p1 p2 p3 p4 p5 pl )
   (if
       (and
           (setq p1 (getpoint "\n1st point: "))
           (setq p2 (getpoint "\n2nd point: " p1))
       )
       (progn
           (setq nv (trans (mapcar '- p2 p1) 1 0 t)
                 oc (trans '(0.0 0.0 1.0) 1 0 t)
                 p3 (trans p1 1 nv)
                 p4 (trans p2 1 nv)
           )
           (princ "\n3rd point: ")
           (while (= 5 (car (setq p5 (grread t 13 0))))
               (redraw)
               (setq p5 (trans (cadr p5) 1 nv))
               (mapcar '(lambda ( a b ) (grdraw a b 1 1))
                   (setq pl
                       (list p1 p2
                           (trans (list (car p5) (cadr p5) (caddr p4)) nv 1)
                           (trans (list (car p5) (cadr p5) (caddr p3)) nv 1)
                       )
                   )
                   (cons (last pl) pl)
               )
           )
           (if
               (and
                   (listp (cadr p5))
                   (setq p5 (trans (cadr p5) 1 nv))
               )
               (entmake
                   (list
                      '(000 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                      '(090 . 4)
                      '(070 . 1)
                       (cons 010 (trans p1 1 oc))
                       (cons 010 (trans p2 1 oc))
                       (cons 010 (trans (list (car p5) (cadr p5) (caddr p4)) nv oc))
                       (cons 010 (trans (list (car p5) (cadr p5) (caddr p3)) nv oc))
                       (cons 210 oc)
                   )
               )
           )
           (redraw)
       )
   )
   (princ)
)

The above should also work in all UCS & Views.

[lrm]

Here's a 3D version of the rectangle program. I thought I would have some fun and use vector methods. A cross product is used to determine a perpendicular vectr to the plane which is then use to determine a vector that is perpendicular to the line p1p2 in the direction of p3. Note that functions for dot and cross products are included.

 

(defun c:rect3d	(/ p1 p2 p3 p4 p5  n u m d h)
 ; get three points
 (setq p1 (getpoint "\nPoint 1:   "))
 (setq p2 (getpoint p1 "\n2nd Point:   "))
 (setq p3 (getpoint p2 "\Opposing edge Point:   "))
 ; compute normal to plane defined by p1 p2 p3
 (setq n (cross (mapcar '- p3 p1) (mapcar '- p2 p1)))
 ; compute vector perpendicular to line p1 p2
 (setq u (cross (mapcar '- p2 p1) n))
 ; compute magnitude of u
 (setq m (distance '(0 0 0) u))
 ;convert u to unit vector
 (setq u (mapcar '/ u (list m m m)))
 ; get perpendicular length from line p1p2 to point p3
 (setq d (dot (mapcar '- p3 p1) u))
 ;convert length to a vector
 (setq h (mapcar '* (list d d d) u))
 ;define other two corners of the rectangle
 (setq p4 (mapcar '+ p1 h))
 (setq p5 (mapcar '+ p2 h))
 (command "3dpoly" p1 p2 p5 p4 p1 "")
 (princ)
)
; Compute the dot product of 2 vectors a and b
(defun dot (a b / dd)
 (setq dd (mapcar '* a b))
 (setq dd (+ (nth 0 dd) (nth 1 dd) (nth 2 dd)))
)					;end of dot
; Compute the cross product of 2 vectors a and b
(defun cross (a b / crs)
 (setq	crs (list
      (- (* (nth 1 a) (nth 2 b))
	 (* (nth 1 b) (nth 2 a))
      )
      (- (* (nth 0 b) (nth 2 a))
	 (* (nth 0 a) (nth 2 b))
      )
      (- (* (nth 0 a) (nth 1 b))
	 (* (nth 0 b) (nth 1 a))
      )
    )				;end list
 )					;end setq c
)					;end cross

Edited November 9, 2013 by lrm

[Guest]

[/code]

With dynamic effect:

(defun c:myrec ( / nv oc p1 p2 p3 p4 p5 pl )
   (if
       (and
           (setq p1 (getpoint "\n1st point: "))
           (setq p2 (getpoint "\n2nd point: " p1))
       )
       (progn
           (setq nv (trans (mapcar '- p2 p1) 1 0 t)
                 oc (trans '(0.0 0.0 1.0) 1 0 t)
                 p3 (trans p1 1 nv)
                 p4 (trans p2 1 nv)
           )
           (princ "\n3rd point: ")
           (while (= 5 (car (setq p5 (grread t 13 0))))
               (redraw)
               (setq p5 (trans (cadr p5) 1 nv))
               (mapcar '(lambda ( a b ) (grdraw a b 1 1))
                   (setq pl
                       (list p1 p2
                           (trans (list (car p5) (cadr p5) (caddr p4)) nv 1)
                           (trans (list (car p5) (cadr p5) (caddr p3)) nv 1)
                       )
                   )
                   (cons (last pl) pl)
               )
           )
           (if
               (and
                   (listp (cadr p5))
                   (setq p5 (trans (cadr p5) 1 nv))
               )
               (entmake
                   (list
                      '(000 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                      '(090 . 4)
                      '(070 . 1)
                       (cons 010 (trans p1 1 oc))
                       (cons 010 (trans p2 1 oc))
                       (cons 010 (trans (list (car p5) (cadr p5) (caddr p4)) nv oc))
                       (cons 010 (trans (list (car p5) (cadr p5) (caddr p3)) nv oc))
                       (cons 210 oc)
                   )
               )
           )
           (redraw)
       )
   )
   (princ)
)

The above should also work in all UCS & Views.

 

Nice job Lee .I like this lisp

[SLW210]

lrm,

 

Please read the Code posting guidelines and place your code in code tags.

[Guest]

[/code]

With dynamic effect:

(defun c:myrec ( / nv oc p1 p2 p3 p4 p5 pl )
   (if
       (and
           (setq p1 (getpoint "\n1st point: "))
           (setq p2 (getpoint "\n2nd point: " p1))
       )
       (progn
           (setq nv (trans (mapcar '- p2 p1) 1 0 t)
                 oc (trans '(0.0 0.0 1.0) 1 0 t)
                 p3 (trans p1 1 nv)
                 p4 (trans p2 1 nv)
           )
           (princ "\n3rd point: ")
           (while (= 5 (car (setq p5 (grread t 13 0))))
               (redraw)
               (setq p5 (trans (cadr p5) 1 nv))
               (mapcar '(lambda ( a b ) (grdraw a b 1 1))
                   (setq pl
                       (list p1 p2
                           (trans (list (car p5) (cadr p5) (caddr p4)) nv 1)
                           (trans (list (car p5) (cadr p5) (caddr p3)) nv 1)
                       )
                   )
                   (cons (last pl) pl)
               )
           )
           (if
               (and
                   (listp (cadr p5))
                   (setq p5 (trans (cadr p5) 1 nv))
               )
               (entmake
                   (list
                      '(000 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                      '(090 . 4)
                      '(070 . 1)
                       (cons 010 (trans p1 1 oc))
                       (cons 010 (trans p2 1 oc))
                       (cons 010 (trans (list (car p5) (cadr p5) (caddr p4)) nv oc))
                       (cons 010 (trans (list (car p5) (cadr p5) (caddr p3)) nv oc))
                       (cons 210 oc)
                   )
               )
           )
           (redraw)
       )
   )
   (princ)
)

The above should also work in all UCS & Views.

 

Mr Lee i have a litle problem with this lisp

when i select point 1 and point 2 the osnap is on. When i am trying to pick the point3 the osnap is off why? can you fix it !! Thanks

[MSasu]

Prodromosm, that behavior is from the use of dinamyc input for third point (GRREAD); unfortunatly this doesn't work with OSNAP modes.

[Guest]

can you add a command to fix it ??

[MSasu]

There seems to be some work-around; you may want to check this thread.

[Lee Mac]

Mr Lee i have a litle problem with this lisp

when i select point 1 and point 2 the osnap is on. When i am trying to pick the point3 the osnap is off why? can you fix it !! Thanks

 

As MSasu as indicated, when monitoring user input using the AutoLISP grread function, all standard drawing aids (Object Snap / Orthomode / Tracking etc.) are unfortunately disabled.

 

The DynDraw.arx utility by Alexander Rivilis presented in the thread suggested by MSasu offers an alternative to the grread function permitting the use of all drawing aids, but the program would need to be rewritten for use with this function.

 

Otherwise, I would suggest that you simply use the non-dynamic version that I have provided above.