; copyright 1987 by looking glass microproducts
;
;----------------------------------------------------------------------------
; DEFAULT ISOMETRIC AXES
(setq
   iso-x  (/ pi         6.0)   ; 30 degrees
   iso-y  (/ (* 5.0 pi) 6.0)   ; 150 degrees
   iso-z  (/ (* 3.0 pi) 2.0)   ; 270 degrees
)
;----------------------------------------------------------------------------
; PRINT ENTITY

(defun pent (ent / l)
   (terpri)
   (princ (car ent))
   (foreach l (cdr ent)
      (princ "\n   ")
      (princ l)
   )
)


;---------------------------------------------------------------------------
; COMPUTE ISOPOINT
(defun isopoint ( p1 )
       (list (+  (* (car  p1) cos_ax)
                 (* (cadr p1) cos_ay)
                 xbase
             )
             (+  (* (car  p1) sin_ax)
                 (* (cadr p1) sin_ay)
                 ybase
             )
       )

)
(princ ".")
;---------------------------------------------------------------------------
; set the current layer, linetype, and color to that of a specified
; entity
; globals -- olayer, ocolor, oltype -- old layer, color, and linetype
;
(defun lset (ent / layer ltype color)

               (setq
                  ltype (cdr (assoc  6 ent))
                  layer (cdr (assoc  8 ent))
                  color (cdr (assoc 62 ent))
                )
                (if (null ltype) (setq ltype "BYLAYER"))
                (cond ((null color) (setq color "BYLAYER"))
                      ((= 0 color)  (setq color "BYBLOCK"))
                )

                (if (/= layer olayer)
                    (command "layer" "set" (setq olayer layer) "")
                )

                (if (/= ltype oltype)
                    (command "linetype" "set" (setq oltype ltype) "")
                )

                (if (/= color ocolor)
                    (command "color" (setq ocolor color))
                )
)

(princ ".")
;---------------------------------------------------------------------------
; save the current layer, color, linetype, elevation, and thickness
; globals -- savlayer, savltype, savcolor, savelev, savthik
;
(defun savelayr ()
                (setq savlayer (getvar "clayer")
                      savltype (getvar "celtype")
                      savcolor (getvar "cecolor")
                      savelev  (getvar "elevation")
                      savthik  (getvar "thickness")
                )

  (if (and (/= savcolor "BYLAYER")
           (/= savcolor "BYBLOCK")
      )
      (setq savcolor (atoi savcolor))
  )
  (setvar "elevation" 0.0)
  (setvar "thickness" 0.0)
)
(princ ".")
;---------------------------------------------------------------------------
; restore the current layer, color, linetype, elevation, and thickness
; globals -- savlayer, savltype, savcolor, savelev, savthik
;
(defun rlayer()
                (setvar "elevation" savelev)
                (setvar "thickness" savthik)
                (command "linetype" "set" savltype ""
                         "layer"    "set" savlayer ""
                         "color"    savcolor
                )
)
(princ ".")
(defun modent ( ent )
   (entmod
      (subst
         '(39 . 0.0)
         (assoc 39 (setq ent
                      (subst
                         '(38 . 0.0)
                          (assoc 38 ent)
                          ent
                      )
                   )
          )
          ent
      )
   )
)
(princ ".")
;---------------------------------------------------------------------------
; convert a text entity to isometric
;
(defun isotext ( ent       / inspnt-i inspnt-l inspnt-il
                             alipnt-i alipnt-l alipnt-il
                             xpnt-i xfactor  xfact-l  xfact-il
                             rotate rotate-i rotate-il
                             height-l height-il
                             oblique-i oblique-il
               )


  (setq inspnt-il ; insertion point
     (cons 10
        (setq inspnt-i
           (isopoint
              (setq inspnt (cdr (setq inspnt-l (assoc 10 ent)
                                )
                           )
              )
           )
        )
     )
  )

  (setq alipnt-il ; alignment point
     (cons 11
        (IF (setq alipnt
               (cdr
                  (setq alipnt-l (assoc 11 ent)
                  )
               )
            )
            (isopoint  alipnt)
        )
     )
  )
  (setq rotate
       (cdr
          (setq rotate-l (assoc 50 ent)
          )
       )
  )

(setq raw-h
     (distance inspnt-i
        (setq hpnt-i
           (isopoint
               (polar inspnt (+ rotate half-pi)
                  (cdr
                     (setq height-l (assoc 40 ent)
                     )
                  )
               )
           )
        )
    )
  )



  (setq raw-x
            (distance inspnt-i
              (setq xpnt-i
                  (isopoint
                     (polar inspnt
                        rotate
                        (setq xfactor
                           (cdr
                              (setq xfact-l (assoc 41 ent)
                              )
                           )
                        )
                     )
                  )
              )
           )
 )

  (setq height-il  ; height
     (cons 40
        (setq real-h
           (* raw-h
              (cos
                (-
                  (angle inspnt-i hpnt-i)
                  (angle inspnt-i xpnt-i)
                  half-pi
                )
              )
           )
        )
    )
  )
  (setq xfact-il ; width factor
     (cons 41
        (* (/ (cdr height-l) (cdr height-il))
           raw-x
        )
     )

  )
  (setq rotate-il ; rotation angle
     (cons 50
        (setq rotate-i
           (angle inspnt-i xpnt-i
           )
        )
     )
  )

  (setq oblique-il ; obliquing angle
     (cons 51
        (- (+ half-pi rotate-i)
           (angle inspnt-i
              (isopoint
                 (polar inspnt
                    (- (+ rotate half-pi)
                       (cdr
                           (setq oblique-l
                              (assoc 51 ent)
                           )
                       )
                    )
                    1.0
                 )
              )
           )
        )
     )
  )
    (modent                  ; make the substitutions
     (subst                inspnt-il inspnt-l
        (subst             alipnt-il alipnt-l
           (subst          height-il height-l
              (subst       xfact-il xfact-l
                 (subst    rotate-il rotate-l
                    (subst oblique-il oblique-l ent)
                 )
              )
           )
        )
     )
    )
)
(princ ".")
;---------------------------------------------------------------------------
; convert a specified subentity to isometric
;
(defun update (ent num / p)

   (subst
      (cons num
         (isopoint
            (cdr
              (setq p (assoc num  ent)
              )
            )
         )
      )
      p
      ent
   )
)

(princ ".")
;---------------------------------------------------------------------------
; convert a line entity to isometric
;
(defun isoline ( ent )
    (modent
       (update
          (update ent 10)
          11
       )
    )
)

(princ ".")
;---------------------------------------------------------------------------
; convert a solid entity to isometric
;
(defun isosolid ( ent )
   (modent
     (update
        (update
           (update
              (update ent 10)
              11
            )
            12
         )
         13
      )
   )
)

(princ ".")
;---------------------------------------------------------------------------
; convert a point entity to isometric
;

(defun ipoint (ent )
    (modent
          (update ent 10)
    )
)


(princ ".")

;---------------------------------------------------------------------------
; return the (sign of test) X value
;

(defun sgn (test value)
  (cond ((minusp test) (- value))
        ((zerop  test) 0        )
        ( T            value    )
  )
)

(princ ".")

;---------------------------------------------------------------------------
; compute the sub-arcs of an isoarc
;
; c     -- center point
; r     -- radius
; ac0   -- angle from c to p0
; ac1   -- angle from c to p1
; angle -- included angle in arc
;
(defun do-isoarc (c r ac0 ac1 p0 p1 ang / da nseg s0 a0 da2)
   (if (< 0.000001 (abs ang))
     (progn
   (setq
        da   (sgn ang delta)
        nseg (min nsegs
                (max 1
                   (fix (/ ang da))
                )
             )
        da   (/ ang (* 2.0 nseg))
        s0   (* 2.0  r (abs (sin (* 0.5 da))))
        a0   (+ ac0 (* 0.5 (+ pi da)))
        da2  (+ da da)

   )
   (repeat nseg
         (command "S"
                  (isopoint (setq p0 (polar p0 a0 s0)))
                  (isopoint (setq p0 (polar p0 (+ a0 da) s0)))
         )
         (setq a0 (+ a0 da2))
   )
)
)
)

(princ ".")
;---------------------------------------------------------------------------
; convert an arc entity to isometric
;
(defun isoarc ( ent ename / c r ac0 ac1 p0 p1 ang )
   (lset ent)
   (redraw ename 2)
   (setq p0  (polar
                (setq c
                   (cdr (assoc 10 ent))
                )
                (setq ac0
                   (cdr (assoc 50 ent))
                )
                (setq r
                   (cdr (assoc 40 ent))
                )
             )
         p1  (polar
                 c
                 (setq ac1
                    (cdr (assoc 51 ent))
                 )
                 r
              )
         ang (- ac1 ac0)

  )
   (if (minusp ang)
         (setq ang (+ ang (* pi 2.0)))
   )
   (command "Pline" (isopoint p0) "w" "0.0" "0.0" "ARC")

   (do-isoarc c r ac0 ac1 p0 p1 ang)
   (command "")
   (entdel ename)
 )

(princ ".")
;---------------------------------------------------------------------------
; convert an circle entity to isometric
;
(defun isocirc ( ent ename / c r ac0 p0 )
   (lset ent)
   (redraw ename 2)

   (setq c   (cdr (assoc 10 ent))
         r   (cdr (assoc 40 ent))
         ac0 0.0
         p0  (polar c ac0 r)
   )
   (command "Pline" (isopoint p0) "w" "0.0" "0.0" "ARC")
   (do-isoarc c r ac0 ac0 p0 p0 (* 2.0 pi))
   (command "CLOSE")
   (entdel ename)
)

(princ ".")
;---------------------------------------------------------------------------
; convert an polyline entity to isometric
;

(defun isopoly ( ent ename / whole closed bulge p0 p1 d01 ang
                             a01 a1c r c ac0 ac1 firstp)
     (lset ent)
    (redraw ename 2)
    (command "Pline" )
     (setq
          whole ename
          closed   (/= 0 (logand 1 (cdr (assoc 70 ent))))
          bulge 0.0
     )
     (while
          (= "VERTEX"
            (cdr (assoc 0
                     (setq ent (entget
                                  (setq ename (entnext ename))
                                )
                     )
                 )
            )
          )

          (if (/= 16 (cdr (assoc 70 ent)))       ; not a spline control point
              (progn
                  (setq p1 (cdr (assoc 10 ent)))

                  (if (zerop bulge)
                      (progn
                         (command (isopoint (setq p0 p1) ) ); not the end of an arc
                         (if (null firstp)
                            (progn
                               (setq firstp p1)
                               (command "w" "0.0" "0.0")
                             )
                         )
                         (if (/= 0.0 (setq bulge (cdr (assoc 42 ent))))
                             (command "ARC")
                         )
                      )
                      (progn                            ; the  end of an arc
                         ; find the center of the arc
                         (setq d01 (distance p0 p1)
                               ang (* 4.0 (atan bulge))
                               a01 (angle  p0 p1)
                               a1c (* 0.5 (- pi ang))
                               r   (/ (* 0.5  d01) (cos a1c))
                               c   (polar p0 (+ a1c a01) r)
                               ac0 (angle c p0)
                               ac1 (angle c p1)
                         )
                         (do-isoarc c r ac0 ac1 p0 p1 ang)
                         (setq p0 p1)
                         (if (zerop (setq bulge (cdr (assoc 42 ent))))
                             (command "LINE")
                         )
                      )
                  ) ; end of if bulge
              )
          )
     ) ; end of while


     (if closed
        (progn

          (if (/= 0.0 bulge)
              (progn                            ; the  end of an arc
                 ; find the center of the arc
                 (setq p1 firstp)
                 (setq d01 (distance p0 p1)
                       ang (* 4.0 (atan bulge))
                       a01 (angle  p0 p1)
                       a1c (* 0.5 (- pi ang))
                       r   (/ (* 0.5  d01) (cos a1c))
                       c   (polar p0 (+ a1c a01) r)
                       ac0 (angle c p0)
                       ac1 (angle c p1)
                 )
                 (do-isoarc c r ac0 ac1 p0 p1 ang)
                 (setq p0 p1)
              )
          ) ; end of if bulge
          (command "CLOSE")
        )
        (command "")
     )
  (entdel whole)
)

(princ ".")

;---------------------------------------------------------------------------
; extended get angle
(defun xgetangle (base prmpt default / temp)
    (ray ibase default 0)
    (ray ibase default 1)
    (setq 
       temp
       (cond
          ((getangle
               base
               (strcat
                   prmpt
                   " <"
                   (angtos
                       default
                       (getvar "aunits")
                   )
                   ">: "
               )
          ))
          (default) 
       )
   )
   (ray ibase default 1)
   (ray ibase temp    0)
   temp
)

;
(princ ".")

;---------------------------------------------------------------------------
; draw a ray to the edge of the screen
; 
(defun ray (base ang highlite)
    (grdraw base (polar base ang raysize) -1 highlite)
)
(princ ".")

;---------------------------------------------------------------------------
; return the current isoplane
;

(defun setplane ( / isoplane prmpt newplane)
   (setq isoplane (getvar "snapisopair"))
   (ray ibase iso-x 0)
   (ray ibase iso-y 0)
   (ray ibase iso-z 0) 
   (while (null newplane)

    ;update prompt & isoplane to account for toggles
      (setq prmpt
        (strcat
          "\nSelect isoplane "
          (cond ( (= 0 isoplane)               ; left
                  "<Left>/Top/Right/Axes: "
                )
                ( (= 1 isoplane)               ; top
                  "Left/<Top>/Right/Axes: "
                )
                ( (= 2 isoplane)               ; right
                  "Left/Top/<Right>/Axes: "
                )
           )
        )
      )


      (setq
         reply
         (strcase
            (substr (getstring prmpt) 1 1)
         )
      )

      (setq
         isoplane
         (getvar "snapisopair") ; check for toggles

         newplane
         (cond
             ( (= "L" reply) 
               0
             )
             ( (= "T" reply) 
               1
             )
             ( (= "R" reply) 
               2
             )
             ( (= "A" reply)
               (setq iso-x (xgetangle ibase "\nIsometric X-axis" iso-x))
               (setq iso-y (xgetangle ibase "Isometric Y-axis" iso-y))
               (setq iso-z (xgetangle ibase "Isometric Z-Axis" iso-z))
               nil                ; and ask again
             )
             ( (= ""  reply) 
               isoplane
             )
         )
      )
   )

   (setvar "snapisopair"
      newplane
   )
)
(princ ".")
;---------------------------------------------------------------------------
; this is the body of the ISO function
;
(defun c:iso (  / ax ay ce bm closed ent ename e isoplane
                  olayer oltype ocolor savlayer savltype savcolor
                  ibase xbase ybase half-pi nsegs delta l
                  sin_ax sin_ay cos_ax cos_ay olayer oltype ocolor
                  not_done savthik savelev raysize
             )

    (defun *ERROR* (st)
       (rlayer)
       (setvar "cmdecho"  ce)
       (setvar "blipmode" bm)
       (princ "\n[")
       (princ st)
       (setq *error* nil)
       ']
     )

  (setq
      ce    (getvar "cmdecho")
      bm    (getvar "blipmode")
      raysize (distance (getvar "limmin") (getvar "limmax"))  ; max diagonal
  )
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (setvar "osmode"   0)
  (setq p (ssget))
  (savelayr)
  (if p (progn
               (while (null (setq ibase (getpoint "Base point: ")))
               )
               (setq isoplane (setplane))

                (terpri)

                  (cond ( (= 0 isoplane)               ; left
                          (setq ax (+ iso-y pi)
                                ay (+ iso-z pi)
                          )
                        )
                        ( (= 1 isoplane)               ; top
                          (setq ax (+ iso-y pi)
                                ay iso-x
                          )
                        )
                        ( (= 2 isoplane)               ; right
                          (setq ax iso-x
                                ay (+ iso-z pi)
                          )
                        )
                  )
                (setq
                     sin_ax  (sin ax)
                     cos_ax  (cos ax)
                     sin_ay  (sin ay)
                     cos_ay  (cos ay)
                     xbase   (- (car  ibase)
                                (* cos_ax (car  ibase))
                                (* cos_ay (cadr ibase))
                             )
                     ybase   (- (cadr ibase)
                                (* sin_ax (car  ibase))
                                (* sin_ay (cadr ibase))
                             )
                     half-pi (* 0.5 pi)
                     nsegs    18
                     delta    (/ (* 2.0 pi) nsegs)
                     l 0
                     n (sslength p)
                     not_done 0
                  )

; main loop
       (while (< l n)
          (setq enttype (cdr (assoc 0
                               (setq ent (entget (setq ename (ssname p l))))
                              )
                        )
                l (1+ l)
          )
          (cond ((= "POLYLINE" enttype) (isopoly  ent ename))
                ((= "LINE"     enttype) (isoline  ent ))
                ((= "POINT"    enttype) (ipoint   ent ))
                ((= "ARC"      enttype) (isoarc   ent ename))
                ((= "CIRCLE"   enttype) (isocirc  ent ename))
                ((= "SOLID"    enttype) (isosolid ent ))
                ((= "TEXT"     enttype) (isotext  ent ))
                ((= "SHAPE"    enttype) (isotext  ent ))
                ((= "ATTDEF"   enttype) (isotext  ent ))
                (T                      (setq not_done (1+ not_done)))
          )

          ) ; end of the while
          (command "REDRAW")

          (cond   ((= not_done 1)
                      (princ "\n[WARNING -- One Entity was NOT Converted")
                  )
                  ((> not_done 1)
                      (princ (strcat
                                 "\n[WARNING -- "
                                 (itoa not_done)
                                 " Entities were NOT Converted"
                             )
                      )
                  )

                 (T (princ "\n[Done"))
          )
        )
        (princ "\n[None selected")
  ) ; end of if p
  (rlayer)
  (setvar "cmdecho"  ce)
  (setvar "blipmode" bm)
  (setq *error* nil)
  ']
)
(princ
"\n[IsoCAD Version 2.01 -- Copyright 1987,1988 by Looking Glass Microproducts]")

(c:iso)