What is the most efficient way that I could do this lisp?

Anonymous · ‎01-12-2018

'm starting in the Lisp routines, and wanted to know how efficiently I could do it, the intention is to make Lisp draw several rectangles (polylines) based on the three points, p1, p2 p3.

(defun c:CTeste001 (/ p1 p2 p3 p4)
(setq p1 (getpoint "\nPOINT <P1>")
p2 (getpoint "\nPOINT <P2>")
p3 (getpoint "\nPOINT <P3>")
p4 (getreal "\nQuantities? <Quant>"))
)

trevor.bird.au · ‎01-14-2018

Hi All,

I've been following the discussion regarding defining a rectangle from 3 points and I've modified my previously provided program to handle point selection that does not contain right angles or if there is zero distance between the selected points.

If the 3 points selected do not define any right angles then points P1 and P2 are assumed to form one side of the rectangle and P3 is recalculated based on the longer distance of P1 to P2 or P2 to P3.

The longest distance will be used to define the length of the rectangle.

Regards,

Trevor

;;  3PointRectangle.lsp by Trevor Bird
;;
;;  2018-01-13

;;------------------------------------------------------------------------------
(defun c:3pointrectangle
  (
    /

    color_int

    entlast_dxf
    entlast_ename

    Long:uv
    Long_length

    NumberOfRectangles

    P1P2:d
    P1P2:uv
    P1P3:d
    P1P3:uv
    P2P3:d
    P2P3:uv

    P1ucs
    P1wcs
    P2ucs
    P2wcs
    P3ucs
    P3wcs
    P4ucs
    P4wcs
    ptP3:uv
    ptwcs

    R1ucs
    R1wcs
    R2ucs
    R2wcs
    R3ucs
    R3wcs
    R4ucs
    R4wcs

    Short:uv
    Short_length
    ss_entlast
    sv_blipmode
    sv_cmdecho
    sv_osmode

    vxv1
    vxv2
    vxv3
    vxv4
  )
  (setq 3pointrectangleErr *error* *error* 3pointrectangle:Error)


  (setq sv_blipmode (getvar 'BLIPMODE))
  (setvar 'BLIPMODE 1)


  (cond
    ( (not (setq P1ucs  (getpoint "\nFirst point (1 of 3): ")))
      (princ "\nFirst point not specified.")
    );(not P1ucs)


    ( (not (setq P2ucs  (getpoint P1ucs "\nSecond point (2 of 3): ")))
      (princ "\nSecond point not specified.")
    );(not P2ucs)


    ( (not (setq P3ucs  (getpoint P2ucs "\nThird point (3 of 3): ")))
      (princ "\nThird point not specified.")
    );(not P3ucs)


    (T
      (setq P1wcs   (trans P1ucs 1 0)
            P2wcs   (trans P2ucs 1 0)
            P3wcs   (trans P3ucs 1 0)

            P1P2:uv (leemac:unit (mapcar '- P2wcs P1wcs))
            P1P3:uv (leemac:unit (mapcar '- P3wcs P1wcs))
            P2P3:uv (leemac:unit (mapcar '- P3wcs P2wcs))

            vxv1    (leemac:vxv P1P2:uv P1P3:uv)
            vxv2    (leemac:vxv P1P2:uv P2P3:uv)
            vxv3    (leemac:vxv P1P3:uv P2P3:uv)

            P1P2:d  (distance P1wcs P2wcs)
            P1P3:d  (distance P1wcs P3wcs)
            P2P3:d  (distance P2wcs P3wcs)
      );setq


      (cond
        ( (or (equal P1P2:d 0.0 1.0e-4)
              (equal P1P3:d 0.0 1.0e-4)
              (equal P2P3:d 0.0 1.0e-4)
          );or
          ;;  Point selection is invalid.
          (princ "\nInvalid point selection. Distance between points must be greater than 0.")
        )


        ( (not
            ;;  Determine if any right angles have been defined.
            (cond
              ( (equal vxv1 0.0 1.0e-4)
                ;;  P1 is origin of rectangle.
                (setq P4wcs   P3wcs
                      P3wcs   (mapcar '+ P2wcs (leemac:vxs P1P3:uv (distance P1wcs P3wcs)))

                      ;;  Hypotenuse (reset P1P3:uv)
                      P1P3:uv (leemac:unit (mapcar '- P3wcs P1wcs))

                      P3ucs   (trans P3wcs 0 1)
                      P4ucs   (trans P4wcs 0 1)
                );setq
              )


              ( (equal vxv2 0.0 1.0e-4)
                ;;  P2 is origin of rectangle.
                ;;  Reset P1 to P2.
                (setq ptwcs   P1wcs
                      P1wcs   P2wcs
                      P2wcs   ptwcs

                      P1P2:uv (leemac:unit (mapcar '- P2wcs P1wcs))

                      P4wcs   P3wcs
                      P3wcs   (mapcar '+ P2wcs (leemac:vxs P2P3:uv (distance P1wcs P3wcs)))

                      ;;  Hypotenuse (reset P1P3:uv)
                      P1P3:uv (leemac:unit (mapcar '- P3wcs P1wcs))

                      P1ucs   (trans P1wcs 0 1)
                      P2ucs   (trans P2wcs 0 1)
                      P3ucs   (trans P3wcs 0 1)
                      P4ucs   (trans P4wcs 0 1)
                );setq
              )


              ( (equal vxv3 0.0 1.0e-4)
                ;;  P3 is origin of rectangle.
                ;;  Reset P1 to P3.
                (setq ptwcs   P1wcs
                      P1wcs   P3wcs
                      P3wcs   ptwcs

                      P1P2:uv (leemac:unit (mapcar '- P2wcs P1wcs))
                      P1P3:uv (leemac:unit (mapcar '- P3wcs P1wcs))

                      P4wcs   P3wcs
                      P3wcs   (mapcar '+ P2wcs (leemac:vxs P1P3:uv (distance P1wcs P3wcs)))

                      ;;  Hypotenuse (reset P1P3:uv)
                      P1P3:uv (leemac:unit (mapcar '- P3wcs P1wcs))

                      P1ucs   (trans P1wcs 0 1)
                      P3ucs   (trans P3wcs 0 1)
                      P4ucs   (trans P4wcs 0 1)
                );setq
              )


              (T
                ;;  No right angles defined.
                ;;  Assume P1.P2 define one side of the rectangle.
                (princ "\nPoints P1 and P2 will form one side of the rectangle.")

                (setq ptwcs   (mapcar '+ P1wcs (leemac:vxs P1P2:uv (* P1P3:d (cos (leemac:acos vxv1)))))
                      ptP3:uv (leemac:unit (mapcar '- P3wcs ptwcs))
                );setq

                (cond
                  ( (or (equal P1P2:d P1P3:d 1.0e-4)
                        (> P1P2:d P1P3:d)
                    );or
                    (setq P3wcs   (mapcar '+ P2wcs (leemac:vxs ptP3:uv (* P1P3:d (sin (leemac:acos vxv1)))))
                          P4wcs   (mapcar '+ P1wcs (leemac:vxs ptP3:uv (* P1P3:d (sin (leemac:acos vxv1)))))
                          P3ucs   (trans P3wcs 0 1)
                          P4ucs   (trans P4wcs 0 1)
                          P1P3:uv (leemac:unit (mapcar '- P3wcs P1wcs))
                          P2P3:uv (leemac:unit (mapcar '- P3wcs P2wcs))
                    );setq
                  )

                  ( (> P1P3:d P1P2:d)
                    (setq P2wcs   (mapcar '+ P1wcs (leemac:vxs P1P2:uv (* P1P3:d (cos (leemac:acos vxv1)))))
                          P4wcs   (mapcar '+ P1wcs (leemac:vxs ptP3:uv (* P1P3:d (sin (leemac:acos vxv1)))))
                          P2ucs   (trans P2wcs 0 1)
                          P4ucs   (trans P4wcs 0 1)
                          P1P2:uv (leemac:unit (mapcar '- P2wcs P1wcs))
                          P2P3:uv (leemac:unit (mapcar '- P3wcs P2wcs))
                    );setq
                  )
                );cond
              );T
            );cond
          );not
        )


        ( (not
            (progn
              (if (not 3pointrectangle::NumberOfRectangles) (setq 3pointrectangle::NumberOfRectangles 1))
              (princ "\nNumber of rectangles: <") (prin1 3pointrectangle::NumberOfRectangles) (princ "> ")

              (initget (+ 2 4))
              (setq NumberOfRectangles  (getint))

              (if (not NumberOfRectangles)
                (setq NumberOfRectangles  3pointrectangle::NumberOfRectangles)
                (setq 3pointrectangle::NumberOfRectangles NumberOfRectangles)
              );if
            );progn
          );not
          (princ "\nNumber of rectangles not set.")
        )


        (T
          ;;  Determine if rectangle is a square and set Short_length and Long_length.
          (setq vxv4  (leemac:vxv P1P2:uv P1P3:uv))

          (cond
            ( (< (leemac:acos vxv4) (/ pi 4.0))
              ;;  Hypotenuse is less than 45°.
              ;;  P1.P4 is shortest side.
              (setq Short:uv      (leemac:unit (mapcar '- P4wcs P1wcs))
                    Long:uv       P1P2:uv
                    Short_length  (distance P1wcs P4wcs)
                    Long_length   (distance P1wcs P2wcs)
              );setq
            )

            ( (> (leemac:acos vxv4) (/ pi 4.0))
              ;;  Hypotenuse is greater than 45°.
              ;;  P1.P2 is shortest side.
              (setq Short:uv      P1P2:uv
                    Long:uv       (leemac:unit (mapcar '- P4wcs P1wcs))
                    Short_length  (distance P1wcs P2wcs)
                    Long_length   (distance P1wcs P4wcs)
              );setq
            )

            ( (equal (leemac:acos vxv4) (/ pi 4.0) 1.0e-4)
              ;;  Hypotenuse equals 45°.
              ;;  Square.
              (setq Short:uv      P1P2:uv
                    Long:uv       (leemac:unit (mapcar '- P4wcs P1wcs))
                    Short_length  (distance P1wcs P2wcs)
                    Long_length   (distance P1wcs P4wcs)
              );setq
            )
          );cond


          ;;  Draw rectangle(s).
          (setq sv_cmdecho  (getvar 'CMDECHO)
                sv_osmode   (getvar 'OSMODE)
          );setq

          (vlax-invoke-method (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'StartUndoMark)

          (setvar 'CMDECHO 0)
          (setvar 'OSMODE 0)

          (setq R1wcs     P1wcs
                color_int 0
          );setq

          (repeat NumberOfRectangles
            (setq R2wcs (mapcar '+ R1wcs (leemac:vxs Short:uv Short_length))
                  R3wcs (mapcar '+ R2wcs (leemac:vxs Long:uv (/ Long_length NumberOfRectangles)))
                  R4wcs (mapcar '+ R1wcs (leemac:vxs Long:uv (/ Long_length NumberOfRectangles)))

                  R1ucs (trans R1wcs 0 1)
                  R2ucs (trans R2wcs 0 1)
                  R3ucs (trans R3wcs 0 1)
                  R4ucs (trans R4wcs 0 1)
            );setq


            (vl-cmdf "_.PLINE" R1ucs R2ucs R3ucs R4ucs "_C")

            (setq entlast_ename (entlast)
                  entlast_dxf   (entget entlast_ename)
                  color_int     (1+ color_int)
            );setq

            (if (not (assoc 62 entlast_dxf))
              (setq entlast_dxf (append entlast_dxf (list (cons 62 color_int))))
              (setq entlast_dxf (subst (cons 62 color_int) (assoc 62 entlast_dxf) entlast_dxf))
            );if
            (entmod entlast_dxf)
            (entupd entlast_ename)


            ;;  Reset R1wcs
            (setq R1wcs R4wcs)
          );repeat NumberOfRectangles

          (setvar 'CMDECHO sv_cmdecho)
          (setvar 'OSMODE sv_osmode)

          (vlax-invoke-method (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'EndUndoMark)
        );T
      );cond
    );T
  );cond


  (setvar 'BLIPMODE sv_blipmode)


  (redraw)


  (setq *error* 3pointrectangleErr 3pointrectangleErr nil)


  (princ)
);c:3pointrectangle




;;--------------------------------------------------------------------
(defun 3pointrectangle:Error
  ( msg

    /
  )
  (if sv_cmdecho
    (setvar 'CMDECHO sv_cmdecho)
  );if
  (setq sv_cmdecho  nil)


  (if sv_blipmode
    (setvar 'BLIPMODE sv_blipmode)
  );if
  (setq sv_blipmode nil)


  (if sv_osmode
    (setvar 'OSMODE sv_osmode)
  );if
  (setq sv_osmode nil)

  (redraw)

  (vlax-invoke-method (vlax-get-property (vlax-get-acad-object) 'ActiveDocument) 'EndUndoMark)

  (setq *error* 3pointrectangleErr 3pointrectangleErr nil)
  (princ)
);3pointrectangle:Error




;;------------------------------------------------------------------------------
;; Vector Norm - Lee Mac
;; Args: v - vector in R^n

(defun leemac:norm ( v )
  (sqrt (apply '+ (mapcar '* v v)))
)


;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar

(defun leemac:vxs ( v s )
  (mapcar '(lambda ( n ) (* n s)) v)
)


;; Unit Vector - Lee Mac
;; Args: v - vector in R^n

(defun leemac:unit ( v )
  ( (lambda ( n ) (if (equal 0.0 n 1e-14) nil (leemac:vxs v (/ 1.0 n)))) (leemac:norm v))
)


;; Vector Dot Product  -  Lee Mac
;; Args: u,v - vectors in R^n

(defun leemac:vxv ( u v )
    (apply '+ (mapcar '* u v))
)


;; ArcCosine  -  Lee Mac
;; Args: -1 <= x <= 1

(defun leemac:acos ( x )
    (if (<= -1.0 x 1.0)
        (atan (sqrt (- 1.0 (* x x))) x)
    )
)




;;------------------------------------------------------------------------------
(princ "\n3PointRectangle loaded. Start command with 3POINTRECTANGLE.")
(princ)

ActivistInvestor · ‎01-14-2018

@Moshe-A wrote:
Hi,

Yes you are right i admit we little 'carried away' after the OP but on second thought if the distance of the first segment is longer than the first segment then the rectangles are aligned to the second segment and the 3rd point become more significant.

i challage the OP to write a fix. i'll also would be glade to 'hear' if you have some good things to say on the code.

thank you
Moshe

I'm not sure I understand what you mean by ' if the distance of the first segment is longer than the first segment', but as written, the first two points define the location, direction and length of one side of a rectangle. And given that only a third point on the (infinite-length) line passing through the endpoints of the opposite side is needed.

I don't have any issues with your code, as it's easy to follow, which is what I find most-important.

Kent1Cooper · ‎01-14-2018

@Anonymous wrote:

I wish all parallelograms, p3 to be parallel to p1-> p2

I'm confused. One routine [from @john.uhden] marked as an accepted Solution makes [non-rectangular] parallelograms [the word used above] if the angle between the 3 points is not a right angle, but the other [from @Moshe-A] forces them to be rectangles. A point can't be "parallel to" a line, so I'm interpreting, but if the second half quoted above really means that p3 should be along a line perpendicular to the p1->p2 line, then the first half should instead say you want all rectangles, and @john.uhden's routine shouldn't be a Solution; if that's not what it means, then @Moshe-A's routine shouldn't be a Solution.

I also notice something about @Moshe-A's Solution that I wonder about. If the 3rd point [there called p2] does not form a right angle with the first 2 points [p0 & p1], but is within 10 degrees of doing so, the routine uses the diagonal distance from p1 to p2 as the length, but draws with that distance perpendicular to p0->p1. In this image, the yellow is what happens if p2 forms a right angle with p0->p1. The magenta p2 is the same distance from the p0->p1 line as the yellow p2 is, but farther than that from p1, and the result is s t r e t c h e d o u t longer because the distance is taken on the diagonal, and p2 ends up not being on the far end.

I was pushing the limit on the 10-degree variability to see what the result would be, but the same distortion happens to a lesser degree any time the angle formed is off from 90 degrees even slightly. If p2 doesn't form a right angle with p0->p1, should it be using the absolute [diagonal] distance like that, or should it be using the perpendicular distance from p2 to p0->p1? [If you're talking about land subdivisions, the difference could have significant legal consequences.]

Kent Cooper, AIA

john.uhden · ‎01-14-2018

Well I am not confused. I asked @Anonymous if parallelograms were okay and he said yes. So that's what I did and he accepted it. If he wants rectangles then he can draw two perpendicular lines and make his picks (p1, p2, p3) at their endpoints, or he could set up snap vars and turn on orthomode.

Subdivision legal consequences? No matter how a lot is configured, if it meets the ordinance bulk requirements (width, depth, area, frontage) then it's approvable without the need for variances. And if the buyer wants to build a parallelogram house, he can do that too.

John F. Uhden

ActivistInvestor · ‎01-14-2018

@Kent1Cooper wrote:
@Anonymous wrote:
I wish all parallelograms, p3 to be parallel to p1-> p2
I also notice something about @Moshe-A's Solution that I wonder about. If the 3rd point [there called p2] does not form a right angle with the first 2 points [p0 & p1], but is within 10 degrees of doing so, the routine uses the diagonal distance from p1 to p2 as the length, but draws with that distance perpendicular to p0->p1. In this image, the yellow is what happens if p2 forms a right angle with p0->p1. The magenta p2 is the same distance from the p0->p1 line as the yellow p2 is, but farther than that from p1, and the result is s t r e t c h e d o u t longer because the distance is taken on the diagonal, and p2 ends up not being on the far end.

I was pushing the limit on the 10-degree variability to see what the result would be, but the same distortion happens to a lesser degree any time the angle formed is off from 90 degrees even slightly. If p2 doesn't form a right angle with p0->p1, should it be using the absolute [diagonal] distance like that, or should it be using the perpendicular distance from p2 to p0->p1? [If you're talking about land subdivisions, the difference could have significant legal consequences.]

I didn't really read (just 'skimmed') most of the posts in the thread, and was only focusing on @Moshe-A's post and code, and also didn't notice what you point out above, but that makes the third point constraint an oxymoron. if the 'almost/nearly-perpendicular' constraint has any validity, the fact that the opposite side of the rectangle does not necessarily lie on that point, is erroneous. Let's hope the OP is layout out parking stalls rather than land subdivisions.

john.uhden · ‎01-14-2018

You guys should not speak from a perspective in which you know nothing.
It's probably not about land subdivision or parking stalls at all. Or
perhaps you need to respond earlier and tell the OP what he should be
asking for. At least I took the time to ask him.

John F. Uhden

ActivistInvestor · ‎01-15-2018

@john.uhden wrote:
You guys should not speak from a perspective in which you know nothing.
It's probably not about land subdivision or parking stalls at all. Or
perhaps you need to respond earlier and tell the OP what he should be
asking for. At least I took the time to ask him.

Speaking of knowing nothing, I don't see anything particularly clear about what the OP has asked for (and keep in mind that he's translating to/from English/Spanish), and if you gave him what you think he asked for, then you must have ignored the contradictory answers he gives, like for example:

1. Most of the time yes,
2. Yes it would be interesting to have these options.
3. No, they will always be rectangles.
4. No, the distance between P1 and P2
5. I did not understand !!
6. Yes, Polilinnhas closed

Or to be more precise, his request is about as vague as it gets, which is most-likely due to his not speaking English, and I'm not faulting him for that, but when you say you gave him what he was asking for, then please explain the above contradiction to the question of whether parallelograms are desired.

BTW, Polilinnhas is the mis-spelled translation of polylines.

john.uhden · ‎01-15-2018

Let's recall...

In post # 6, @john.uhden wrote, "Now if p1, p2, p3 do not form a right angle, do you want the first polyline to be trapezoidal and the remainder to be rectangular, or do you want them all to be parallelograms? Do you want the line intersecting at p3 to be parallel to p1->p2 or to be perpendicular to p2->p3?"
In post #7, @Anonymous responded, "I wish all parallelograms,"
In post #13, @Anonymous wrote, "@john.uhden It was exactly as I was thinking,"

His English, translated or not, seemed clear to me.

I also mentioned that he could set a snapang and turn on orthomode to make right angle picks.

John F. Uhden

john.uhden · ‎01-16-2018

@ActivistInvestor wrote, "BTW, Polilinnhas is the mis-spelled translation of polylines."

I think rather that Polilinnhas is perfectly spelled but not translated.

John F. Uhden

ActivistInvestor · ‎01-16-2018

It most definitely is translated, and mis-spelled.

The Spanish translation for Polylines is POLILÍNEAS

john.uhden · ‎01-16-2018

You would know better than I. Are Spanish and Portuguese exactly the same?

John F. Uhden

ActivistInvestor · ‎01-16-2018

@john.uhden wrote:
You would know better than I. Are Spanish and Portuguese exactly the same?

The Portuguese translation (according to Google) of polylines is polilinhas, which is closer.

john.uhden · ‎01-17-2018

Is it close enough for a cigar?

John F. Uhden

Community

What is the most efficient way that I could do this lisp?

What is the most efficient way that I could do this lisp?

What is the most efficient way that I could do this lisp?