Topic: Isometric Rectangle Command

[CAB]

Here is an idea for a lisp routine. I'm busy this morning so I have no time but trying to do some plumbing isometric drawings.
I find the need to draw a rectangle in an isometric plane. So if the lisp would get the SNAPSTYL variable to establish the needed
angles the user would pick the first point then while picking the second point the lines would be drawn in the correct angles.
If during the process the F5 key is pressed the SNAPSTYL variable is changes and so is the iso plane.

Food for thought or if someone is looking to write some code.

Back to work.

[paulmcz]

Here is something

Code: [Select]

(defun c:sr (/ pl   osn opm  opa  oas ip   u30  cd   cp1  p1 p2
       p3   u u1   u2   u3 u4   ip1  p21  ip2  p22 oerr
      )
 
  (setq osn (getvar "osmode")
opm (getvar "polarmode")
opa (getvar "polarang")
oas (getvar "autosnap")
  )

  (setq oerr *error*)
  (defun *error* (msg)
    (princ "\n ERROR! <p>")
    (setvar "osmode" osn)
    (setvar "polarmode" opm)
    (setvar "polarang" opa)
    (setvar "autosnap" oas)
    (setq *error* oerr)
    (command)
    (princ)
  )


  (command "_.undo" "begin")
  (initget "Right Left Top")
  (if pll
    ()
    (setq pll "Right")
  )
  (princ "\n Choose plane: Right, Left, Top >> ")
  (princ pll)
  (princ " <<: ")
  (setq pl (getkword))
  (if (= pl nil)
    (setq pl pll)
    (setq pll pl)
  )

 
  (setvar "autosnap" 63)
  (setvar "polarmode" 7)
  (setvar "polarang" (/ (* 30 pi) 180))
  (setq ip (getpoint "\n First corner: ")
p2 (getpoint ip "\n Opposite corner: ")
  )
;;;****************
  (cond ((= pl "Right")
(if (< (car ip) (car p2))
   (setq u30 (/ pi 6.0))
   (setq u30 (+ pi (/ pi 6.0)))
)
(setq cd  (- (car p2) (car ip))
       cp1 (polar ip 0 cd)
       p1  (polar cp1 (* pi 0.5) (* (/ (sin u30) (cos u30)) cd))
       p3  (polar p2 (angle p1 ip) (distance p1 ip))
)
)

;;;****************
((= pl "Left")
(if (< (car ip) (car p2))
   (setq u30 (* -1 (/ pi 6.0)))
   (setq u30 (* -1 (+ pi (/ pi 6.0))))
)
(setq cd  (- (car p2) (car ip))
       cp1 (polar ip 0 cd)
       p1  (polar cp1 (* pi 0.5) (* (/ (sin u30) (cos u30)) cd))
       p3  (polar p2 (angle p1 ip) (distance p1 ip))
)
)

;;;***************
((= pl "Top")
(setq u  (angle ip p2)
       u1 (/ pi 6)
       u2 (* u1 5)
       u3 (* u1 7)
       u4 (* u1 11)
)
(cond ((or (> u u4) (< u u1))
(setq ip1 (polar ip u4 1.)
      p21 (polar p2 u3 1.)
      p22 (polar p2 u2 1.)
      ip2 (polar ip u1 1.)
)
       )
       ((> u4 u u3)
(setq ip1 (polar ip u3 1.)
      p21 (polar p2 u2 1.)
      p22 (polar p2 u1 1.)
      ip2 (polar ip u4 1.)
)
       )
       ((> u3 u u2)
(setq ip1 (polar ip u2 1.)
      p21 (polar p2 u1 1.)
      p22 (polar p2 u4 1.)
      ip2 (polar ip u3 1.)
)
       )
       ((> u2 u u1)
(setq ip1 (polar ip u1 1.)
      p21 (polar p2 u4 1.)
      p22 (polar p2 u3 1.)
      ip2 (polar ip u2 1.)
)
       )
       (t nil)
)
(setq p1  (inters ip ip1 p2 p21 nil)
       p3  (inters p2 p22 ip ip2 nil))
)
(t nil)
  )
  (setvar "osmode" 0)
  (setvar "polarmode" opm)
  (setvar "polarang" opa)
  (setvar "autosnap" oas)
  (command "pline" ip p1 p2 p3 "c")
  (setvar "osmode" osn)
  (command "_.undo" "end")
  (princ)
)

(prompt "\n Type > sr < : ")

[fixo]

Here is an idea for a lisp routine. I'm busy this morning so I have no time but trying to do some plumbing isometric drawings.
I find the need to draw a rectangle in an isometric plane. So if the lisp would get the SNAPSTYL variable to establish the needed
angles the user would pick the first point then while picking the second point the lines would be drawn in the correct angles.
If during the process the F5 key is pressed the SNAPSTYL variable is changes and so is the iso plane.

Food for thought or if someone is looking to write some code.

Back to work.

Hi Alan
See PM

Oleg

[Stefan]

Error traping still needed...
Sorry... no Osmode for second point

Code: [Select]

(defun C:ISOREC (/ click gr p1 p2 p3 pt msg isoplane item dir oldsnstyl oldecho)
  (setq oldecho   (getvar 'CMDECHO)
        oldsnstyl (getvar 'SNAPSTYL)
  )
  (setvar 'CMDECHO 0)
  (setvar 'SNAPSTYL 1)
  (setq msg      "\nSecond point or press F5 to change isoplane <exit>: "
        isoplane '("\n<Isoplane left>" "\n<Isoplane top>" "\n<Isoplane right>")
        dir      (list
                   (list (/ pi -6.) (/ pi 2.))
                   (list (/ pi 6.) (/ pi -6.))
                   (list (/ pi 2.) (/ pi 6.))
                 )
  )
  (if (setq p1 (getpoint "\nStart point: "))
    (progn
      (princ msg)
      (setq item (getvar 'SNAPISOPAIR))
      (while (not click)
        (setq gr (grread T 3)
              pt (cadr gr)
        )
        (cond ((= 3 (car gr)) (setq click T))
              ((= 5 pt)
               (princ (nth (setq item (setvar 'SNAPISOPAIR (rem (1+ (getvar 'SNAPISOPAIR)) 3))) isoplane))
               (princ msg)
              )
              ((or (member (car gr) '(11 12)) (member pt '(13 32)))
               (setq click T pt nil)
              )
              ((listp pt)
               (command "REDRAW")
               (grdraw p1
                       (setq p2 (inters p1 (polar p1 (car (nth item dir)) 1)
                                        pt (polar pt (cadr (nth item dir)) 1)
                                        nil))
                       7 1)
               (grdraw p1
                       (setq p3 (inters p1 (polar p1 (cadr (nth item dir)) 1)
                                        pt (polar pt (car (nth item dir)) 1)
                                        nil))
                       7 1)
               (grdraw pt p2 7 1)
               (grdraw pt p3 7 1)
              )
              (T (princ (strcat (chr pt) msg)))
        )
      )
      (command "REDRAW")
      (if pt
        (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1)
                       (cons 10 p1) (cons 10 p2) (cons 10 pt) (cons 10 p3)
                 )
        )
      )
    )
  )
  (setvar 'CMDECHO oldecho)
  (setvar 'SNAPSTYL oldsnstyl)
  (princ)
)

EDIT:
-forgot to prompt Press F5... stuff. Now is there...

[CAB]

Thanks paulmcz and Oleg, nice effort. But only draws ISO top & only from existing rectangle.

Phanaem got a great start on the routine as specified.

I'm still working today but will have more time to play with the routine later today.

Good effort all.

[Lee Mac]

Great code Phanaem

I have attempted to add the ability for a typed point input from the user, I hope you don't mind:

Code: [Select]

(defun c:isorec ( / *error* _isopoints _str->lst _str->pt click dir g1 g2 gr iso item msg p p1 pts snap str ucsz )
 
  (defun *error* ( msg ) (redraw) (princ))

  (defun _isopoints ( p1 p3 dir )
    (list
      p1 (inters p1 (polar p1 (car  dir) 1.) p3 (polar p3 (cadr dir) 1.) nil)
      p3 (inters p1 (polar p1 (cadr dir) 1.) p3 (polar p3 (car  dir) 1.) nil)
    )
  )

  (defun _str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
      (cons (substr str 1 pos) (_str->lst (substr str (+ pos 1 (strlen del))) del))
      (list str)
    )
  )
 
  (defun _str->pt ( str p1 dir / pt )
    (if (wcmatch str "`@*")
      (setq str (substr str 2))
      (setq p1 '(0. 0. 0.))
    )
    (if
      (and
        (setq pt (mapcar 'read (_str->lst str ",")))
        (vl-every 'numberp pt)
        (= 2 (length pt))
      )
      (last (mapcar '(lambda ( ang disp ) (setq p1 (polar p1 ang disp))) dir pt))
    )
  )
 
  (setq snap (getvar 'SNAPSTYL))
  (setvar 'SNAPSTYL 1)
 
  (setq msg   "\nSpecify Second Point or Press F5 to Change Isoplane <exit>: "
        iso '("\n<Isoplane left>" "\n<Isoplane top>" "\n<Isoplane right>")
        dir  (list
               (list (/ pi -6.) (/ pi  2.))
               (list (/ pi  6.) (/ pi -6.))
               (list (/ pi  2.) (/ pi  6.))
             )
        ucsz (trans '(0. 0. 1.) 1 0 t)
  )
 
  (if (setq p1 (getpoint "\nSpecify First Corner Point: "))
    (progn
      (princ msg)
      (setq item (getvar 'SNAPISOPAIR) str "")
     
      (while (not click)
        (setq gr (grread t 15 0) g1 (car gr) g2 (cadr gr))
   
        (cond
          ( (= 3 g1) (setq click T) )
          ( (= 2 g1)
            (cond
              ( (= 5 g2)
                (princ (nth (setq item (setvar 'SNAPISOPAIR (rem (1+ (getvar 'SNAPISOPAIR)) 3))) iso))
                (princ msg)
              )
              ( (= 8 g2)
                (and
                  (< 0 (strlen str))
                  (princ (vl-list->string '(8 32 8)))
                  (setq str (substr str 1 (1- (strlen str))))
                )
              )
              ( (< 32 g2 127)
                (setq str (strcat str (princ (chr g2))))
              )
              ( (member g2 '(13 32))
                (if (< 0 (strlen str))
                  (if (setq g2 (_str->pt str p1 (nth item dir)))
                    (setq click t pts (_isopoints p1 g2 (nth item dir)))
                    (princ (strcat (setq str "") "\n2D Point Required." msg))
                  )
                  (setq click t)
                )
              )
              ( (setq g2 nil click t) )
            )
          )
          ( (listp g2) (redraw)

            (mapcar 'grdraw
              (setq pts (_isopoints p1 g2 (nth item dir)))
              (append (cdr pts) (list (car pts))) '(7 7 7 7) '(1 1 1 1)
            )
          )
          ( (setq g2 nil click t) )
        )
      )
      (redraw)
     
      (if (and g2 pts)
        (entmakex
          (append
           '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (100 . "AcDbPolyline") (90 . 4) (70 . 1))
            (mapcar '(lambda ( p ) (cons 10 (trans p 1 ucsz))) pts)
            (list (cons 210 ucsz))
          )
        )
      )
    )
  )

  (setvar 'SNAPSTYL snap)
  (princ)
)

(vl-load-com) (princ)

[CAB]

Good idea Lee but I think, for me anyway, the point needs to be relative. Better still would be distance offset x(on the angle),y

[Lee Mac]

Good idea Lee but I think, for me anyway, the point needs to be relative. Better still would be distance offset x(on the angle),y

Hi Alan,

The user should be able to enter a point relative to the base point by using the "@" prefix, as in usual AutoCAD behaviour.

[CAB]

This is the desired result

[paulmcz]

Alan, check my routine, I modified it and your desired iso-rectangle can be drawn with it. Polar tracking of 30 deg was added to it. But, no "grdraw", though.

[CAB]

Yes, an improvement but it produces the middle example above when @10,10 is entered.
The result should be the example on the right.

[Lee Mac]

This is the desired result

Ah - gotcha, should be an easy enough fix 

EDIT: Updated code above

[paulmcz]

Go "R" for the right plane, pick point, osnap "from", go up with your mouse, type 10, go 30 deg to the right-up type 10 againg and you should have it.

[Lee Mac]

Here's another non-dynamic version:

Code: [Select]

(defun c:isorec ( / p1 p2 an n snap )

  (setq snap (getvar 'SNAPSTYL))
  (setvar 'SNAPSTYL 1)

  (if
    (and
      (setq p1 (getpoint "\nSpecify First Point: "))
      (setq p2 (getpoint "\nSpecify Second Point: " p1))
      (setq an
        (nth (getvar 'SNAPISOPAIR)
          (list (list (/ pi -6.) (/ pi 2.)) (list (/ pi 6.) (/ pi -6.)) (list (/ pi 2.) (/ pi 6.)))
        )
      )
    )
    (entmakex
      (list
        (cons 0 "LWPOLYLINE")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbPolyline")
        (cons 90 4)
        (cons 70 1)
        (cons 10 (trans p1 1 (setq n (trans '(0. 0. 1.) 1 0 t))))
        (cons 10 (trans (inters p1 (polar p1 (car  an) 1.) p2 (polar p2 (cadr an) 1) nil) 1 n))
        (cons 10 (trans p2 1 n))
        (cons 10 (trans (inters p1 (polar p1 (cadr an) 1.) p2 (polar p2 (car  an) 1) nil) 1 n))
        (cons 210 n)
      )
    )
  )

  (setvar 'SNAPSTYL snap)
  (princ)
)
Although unfortunately I don't think one can distinguish a relative and absolute point using a getpoint prompt.

[gile]

just hacking phanaem's

Code: [Select]

(defun C:ISOREC
       (/ *error* validInput click gr p1 p2 p3 pt msg isoplane item dir oldsnstyl oldecho ip str)

  (defun *error* (msg)
    (or (= msg "Function cancelled")
(princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )

  (defun validInput (str / pos len wid)
    (if (and
  (wcmatch str "`@*")
  (setq pos (vl-string-search "," str))
  (setq len (distof (substr str 2 (1- pos))))
  (setq wid (distof (substr str (+ 2 pos))))
)
      (list len wid)
    )
  )

  (setq oldecho   (getvar 'CMDECHO)
oldsnstyl (getvar 'SNAPSTYL)
  )
  (setvar 'CMDECHO 0)
  (setvar 'SNAPSTYL 1)
  (setq msg "\nSecond point or press F5 to change isoplane <exit>: "
isoplane '("\n<Isoplane left>" "\n<Isoplane top>" "\n<Isoplane right>")
dir (list
   (list (/ pi -6.) (/ pi 2.))
   (list (/ pi -6.) (/ pi 6.))
   (list (/ pi 6.) (/ pi 2.))
)
  )
  (if (setq p1 (getpoint "\nStart point: "))
    (progn
      (princ msg)
      (setq item (getvar 'SNAPISOPAIR))
      (while (not click)
(setq gr (grread T 3)
      pt (cadr gr)
)
(cond
  ((= 3 (car gr)) (setq click T))
  ((= 5 pt)
   (princ (nth (setq item (setvar 'SNAPISOPAIR (rem (1+ (getvar 'SNAPISOPAIR)) 3))) isoplane)
   )
   (princ msg)
  )
  ((member (car gr) '(11 12 25))
   (setq click T
pt nil
   )
  )
  ((listp pt)
   (redraw)
   (grdraw p1
   (setq p2 (inters p1
    (polar p1 (car (nth item dir)) 1)
    pt
    (polar pt (cadr (nth item dir)) 1)
    nil
    )
   )
   7
   1
   )
   (grdraw p1
   (setq p3 (inters p1
    (polar p1 (cadr (nth item dir)) 1)
    pt
    (polar pt (car (nth item dir)) 1)
    nil
    )
   )
   7
   1
   )
   (grdraw pt p2 7 1)
   (grdraw pt p3 7 1)
  )
  ((member pt '(13 32))
   (if (and str (setq ip (validInput str)))
     (progn
       (setq p2    (polar p1 (car (nth item dir)) (car ip))
     pt    (polar p2 (cadr (nth item dir)) (cadr ip))
     p3    (polar p1 (cadr (nth item dir)) (cadr ip))
     click T
       )
     )
     (progn
       (princ (strcat "\nInvalid input.\n" msg))
       (setq str "")
     )
   )
  )
  (T
   (if (= (cadr gr) 8)
     (or
       (and
str
(/= str "")
(setq str (substr str 1 (1- (strlen str))))
(princ (chr 8))
(princ (chr 32))
       )
       (setq str nil)
     )
     (or
       (and str
    (setq str (strcat str (chr (cadr gr))))
       )
       (setq str (chr (cadr gr)))
     )
   )
   (and str (princ (chr (cadr gr))))
  )
)
      )
      (redraw)
      (if pt
(entmake (list '(0 . "LWPOLYLINE")
       '(100 . "AcDbEntity")
       '(100 . "AcDbPolyline")
       '(90 . 4)
       '(70 . 1)
       (cons 10 p1)
       (cons 10 p2)
       (cons 10 pt)
       (cons 10 p3)
)
)
      )
    )
  )
  (setvar 'CMDECHO oldecho)
  (setvar 'SNAPSTYL oldsnstyl)
  (princ)
)