Topic: Rotated rectangles

[M-dub]

That IS pretty sweet!

[jonesy]

Thanks!  it is great!

Can't wait to start using it in everyday work

Tracey

[CAB]

That is very cool Stig.
--=< Good Job >=--

[SMadsen]

Thanks guys.

Tracey, it was only meant to be a sketch to show what can be done with GRREAD and, especially, what cannot .. but glad you like it

Here's a more foolproof version. I think there was a flaw when hitting backspace. I also included +,- and exponential notation.

Code: [Select]

;; Main command (rename to whatever)
(defun C:RECTROT ()(rectang))

;; Command driven pline creator
(defun drawRect (p1 p2 a dist / p3 p4)
  (setq p3 (polar p2 (+ a (/ pi 2.0)) dist)
        p4 (polar p1 (+ a (/ pi 2.0)) dist)
  )
  (if (vl-cmdf "_PLINE" "_none" p1 "_none" p2 "_none" p3 "_none" p4 "Close")
    (mapcar 'princ (list "\n" (distance p1 p2) "x" (distance p2 p3)
                  " at " (* (/ (angle p1 p2) pi) 180.0) " degrees"))
  )
)

;; Ghost graphic creator
(defun draw (p1 p2 p3 a / p4 p5 pd)
  (redraw)
  (setq pd (* (distance p1 p3) (sin (- (angle p1 p3) a))))
  (grvecs (list 7 p1 p2                      ; base leg
                7 p1 (setq p4 (polar p1 (+ a (/ pi 2.0)) pd)) ; "bottom" leg
                7 p2 (setq p5 (polar p2 (+ a (/ pi 2.0)) pd)) ; "top" leg
                7 p4 p5)                      ; opposite leg
  )
)

;; Prompt output (all this only to allow for backspace)
(defun goPrinc (prmpt str / llen)
  (princ "\r")
  (setq llen (1+ (strlen (strcat prmpt str))))
  (repeat llen (princ "\010"))
  (repeat llen (princ " "))
  (repeat llen (princ "\010"))
  (princ (strcat prmpt str))
)

;; Main sub with GRREAD
(defun rectang (/ ang char code data final flag p prmpt pt1 pt2 rstr str)
  (cond ((and (setq pt1 (getpoint "\nStart point: "))
              (setq pt2 (getpoint pt1 "\nEnd point for base leg: "))
         )
         (setq ang   (angle pt1 pt2)
               prmpt "Opposite leg or length: "
               str   ""
               flag  T)
         (terpri)
         (princ prmpt)
         (while flag
           (setq p    (grread T 11)
                 code (car p)
                 data (cadr p)
           )
           (cond ((= code 5)
                  (draw pt1 pt2 data ang)
                 )
                 ((= code 3)
                  ;; clicked point .. accept it and get on with it
                  (setq final data
                        flag nil
                  )
                 )
                 ((= code 2)
                  (setq char data)
                  (cond ((member char '(43 45))
                         ;; if +/- check where in string to put it
                         (cond ((= str "")(setq str (chr char)))
                               ((member (substr str (strlen str) 1)
                                '("e" "E"))
                                (setq str (strcat str (chr char)))))
                         (goPrinc prmpt str)
                        )
                        ((member char '(69 101))
                         ;; "e" or "E" was entered for exp. notation
                         ;; previous char must be a number and
                         ;; no other e´s must be found
                         (if (and (<= 48 (ascii (substr str (max 1 (strlen str)) 1)) 57)
                                  (not (wcmatch str "*e*,*E*")))
                                (setq str (strcat str (chr char))))
                         (goPrinc prmpt str)
                        )
                        ((= 46 char)
                         ;; a period was entered
                         ;; check to see if a period already exists or
                         ;; if a period is attempted in exponent
                         (if (and (not (vl-string-search "." str))
                                  (not (wcmatch str "*e*,*E*")))
                           (setq str (strcat str (chr char)))
                         )
                         (goPrinc prmpt str)
                        )
                        ((<= 48 char 57)
                         ;; if input is a number then append it
                         (princ (chr char))
                         (setq str  (strcat str (chr char)))
                         (goPrinc prmpt str)
                        )
                        ((= char 8)
                         ;; backspace was hit .. go chop off a character
                         (setq str (substr str 1 (max 0 (1- (strlen str)))))
                         (goPrinc prmpt str)
                        )
                        ((member char '(13 32))
                         ;; If enter or space then see if str
                         ;;  holds a number
                         ;; This *should* check str for all allowed syntaxes!
                         ;; E.g. if str ends with exp. notation without an exponent:
                         (if (member (substr str (max 1 (strlen str)) 1) '("e" "E"))
                           (setq str (strcat str "0"))
                         )
                         (cond
                           ((and (/= str "")
                                 (numberp (setq rstr (vl-catch-all-apply 'read (list str))))
                            )
                            (setq final  (float rstr)
                                  flag nil))
                           ((= str "") (setq flag nil))
                           ((princ "\nRequires numeric distance or a point")
                            (terpri)
                            (setq str "")
                            (goPrinc prmpt str)
                           )
                         )
                        )
                  )
                 )
           )
         ) ;_ while
         (redraw)
         (cond ((vl-consp final)
                (drawRect pt1 pt2 ang (* (distance pt1 final) (sin (- (angle pt1 final) ang))))
               )
               ((numberp final)
                (drawRect pt1 pt2 ang final)
               )
         )
        ) ;_ cond pt1 and pt2
  )
  (princ)
)

[jonesy]

Thanks very much Stig. This routine will save me hours in a job.

When I was doing my psuedo code I had thought that I would need to rotate the ucs, do the rectangle, rotate ucs back to original. Trouble is that I can sort of think what I want to do, but, have no idea where to start. I guess it will come with experience!

Kind regards
Tracey

[SMadsen]

This routine will save me hours in a job.

You're welcome. Personally I would go with routines like Rons or especially Pauls as it a free rotation from the start but I guess it depends on the job.

[jonesy]

This routine will save me hours in a job.

You're welcome. Personally I would go with routines like Rons or especially Pauls as it a free rotation from the start but I guess it depends on the job.

The reason this will work for me is that I can pick the start point and the angle to be drawn is picked at the same time as the size. I use this for the rainwater drains at the side of the english roads. British roads are verrry twisty, and these drains fit to the kerbline. I can now click on a kerb for my start, use nearest osnap and set a distance for 1 side and then just 1 more distance will finish the job!

Kind regards
Tracey