;;; ---------------------------------------------------------------------------
;;; IsoProject.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; PROJECT ORTHOGRAPHIC GEOMETRY INTO AN ISOMETRIC PLANE
;;;
;;; PURPOSE
;;;   Takes a flat orthographic view you have already drawn - a front elevation,
;;;   a plan, a side - and projects it into the left, right or top isoplane of an
;;;   isometric drawing.
;;;
;;;   AutoCAD has isometric snap, which helps you DRAW in isometric. It has
;;;   nothing that CONVERTS an existing view into one. That is the gap this
;;;   fills: draw the view square, where it is easy to get right and easy to
;;;   check, then project it.
;;;
;;; HOW THE PROJECTION WORKS
;;;   Isometric drafting is a shear plus a horizontal squash, measured from one
;;;   reference point. Take any point's offset from that reference as u across
;;;   and v up. Then, writing 0.866 for cos(30):
;;;
;;;     Left plane    x = 0.866u          y = v - 0.5u
;;;     Right plane   x = 0.866u          y = v + 0.5u
;;;     Top plane     x = 0.866(u - v)    y = 0.5(u + v)
;;;
;;;   In the left and right planes, vertical stays vertical and unscaled, while
;;;   horizontal tips to 30 degrees below or above. In the top plane both axes
;;;   tip, one to 30 degrees and the other to 150.
;;;
;;;   Note this is ISOMETRIC DRAWING, not true isometric projection: lengths
;;;   along the isometric axes stay true rather than being scaled by 0.8165.
;;;   That is what drafting practice uses, because it lets you measure a length
;;;   straight off the drawing.
;;;
;;; WHAT GETS CONVERTED
;;;   Lines, points, solids and zero-bulge polylines are transformed in place -
;;;   each vertex moved, the object otherwise untouched.
;;;
;;;   Circles become isometric ellipses, which is the only correct answer: a
;;;   circle seen in an isoplane is an ellipse, and sheared circles are not.
;;;
;;;   Arcs are replaced by a fitted polyline through points sampled every five
;;;   degrees, because a sheared arc is an elliptical arc and AutoCAD has no
;;;   direct way to build one from a shear.
;;;
;;;   Text is moved and re-set in an obliqued style so it lies in the plane.
;;;
;;; POLYLINES ARE HANDLED
;;;   The routine this replaces required every polyline to be exploded first.
;;;   Straight-segment polylines are transformed directly here, vertex by vertex.
;;;   Polylines carrying bulges are still refused - a bulge is a circular arc,
;;;   and shearing one gives an ellipse a bulge cannot describe - but they are
;;;   reported rather than silently mangled.
;;;
;;;   ISOPROJECT  - project selected objects into an isometric plane
;;; ---------------------------------------------------------------------------

(setq IsoProject:COS30 0.8660254)

;;; ---------------------------------------------------------------------------
;;; THE TRANSFORM
;;;
;;; One function does all three planes. Everything else in this file feeds points
;;; through here, so the projection is defined in exactly one place.
;;; ---------------------------------------------------------------------------

(defun IsoProject:Map ( p ref plane / u v x y )
    (setq u (- (car  p) (car  ref))
          v (- (cadr p) (cadr ref)))
    (cond
        ((= plane "Left")
         (setq x (* IsoProject:COS30 u)
               y (- v (* 0.5 u))))
        ((= plane "Right")
         (setq x (* IsoProject:COS30 u)
               y (+ v (* 0.5 u))))
        (t   ; Top
         (setq x (* IsoProject:COS30 (- u v))
               y (* 0.5 (+ u v))))
    )
    (list (+ (car ref) x)
          (+ (cadr ref) y)
          (if (caddr p) (caddr p) 0.0))
)

;;; ---------------------------------------------------------------------------
;;; TEXT STYLES
;;;
;;; Isometric text needs an obliquing angle as well as a rotation, so it lies in
;;; the plane rather than standing up out of it. Two styles cover all three
;;; planes: one obliqued +30 and one obliqued -30.
;;;
;;; Created from ROMANS at variable height. A variable-height style is essential -
;;; a fixed-height style would override the height of every piece of text being
;;; converted and silently resize the drawing.
;;; ---------------------------------------------------------------------------

(defun IsoProject:EnsureStyle ( name oblique )
    (if (not (tblsearch "style" name))
        (vl-catch-all-apply
            '(lambda ( )
                 (command "_.-STYLE" name "romans.shx" 0 1 oblique "_N" "_N" "_N"))))
    (tblsearch "style" name)
)

;;; Which style and rotation the text in a given plane needs. Returns
;;; ( style-name . rotation-in-degrees ).
;;;
;;; Text already at 90 or 270 degrees is standing vertically in the original
;;; view, so it stays vertical and takes the OPPOSITE oblique to lie in the
;;; plane - which is why the two cases below are not simply the same answer.
(defun IsoProject:TextSetup ( plane rot / )
    (cond
        ((or (equal rot  90.0 1e-6) (equal rot 270.0 1e-6))
         (cond ((= plane "Left")  (cons "ISO-R"  rot))
               ((= plane "Right") (cons "ISO-L"  rot))
               (t                 (cons "ISO-R"  rot))))
        ((= plane "Left")  (cons "ISO-L" -30.0))
        ((= plane "Right") (cons "ISO-R"  30.0))
        (t                 (cons "ISO-L"  30.0))
    )
)

;;; ---------------------------------------------------------------------------
;;; PER-ENTITY CONVERSION
;;;
;;; Each returns T when it handled the object, nil when it could not.
;;; ---------------------------------------------------------------------------

;;; Swap one DXF value in an entity list.
(defun IsoProject:Sub ( code new dat )
    (subst (cons code new) (assoc code dat) dat)
)

;;; Lines, points and solids: every point moved, nothing else touched.
(defun IsoProject:Simple ( ent codes ref plane / dat old )
    (setq dat (entget ent))
    (foreach c codes
        (if (setq old (cdr (assoc c dat)))
            (setq dat (IsoProject:Sub c (IsoProject:Map old ref plane) dat))))
    (entmod dat)
    t
)

;;; Straight-segment polylines. Refused when any vertex carries a bulge.
(defun IsoProject:LwPoly ( ent ref plane / dat out bulged )
    (setq dat (entget ent) bulged nil)
    (foreach pair dat
        (if (and (= 42 (car pair)) (not (zerop (cdr pair))))
            (setq bulged t)))
    (if bulged
        nil
        (progn
            ;; Rebuilt rather than SUBST-ed because a polyline has many group 10
            ;; entries and SUBST would only ever replace the first.
            (foreach pair dat
                (setq out
                    (cons (if (= 10 (car pair))
                              (cons 10 (IsoProject:Map (cdr pair) ref plane))
                              pair)
                          out)))
            (entmod (reverse out))
            t))
)

;;; A circle becomes an isometric ellipse in the chosen plane.
(defun IsoProject:Circle ( ent ref plane / dat cen rad )
    (setq dat (entget ent)
          cen (IsoProject:Map (cdr (assoc 10 dat)) ref plane)
          rad (cdr (assoc 40 dat)))
    (entdel ent)
    ;; ELLIPSE only offers its Isocircle option while isometric snap is on, and
    ;; it builds the ellipse for whichever isoplane is current.
    (setvar "SNAPSTYL" 1)
    (command "_.ISOPLANE" (cond ((= plane "Left") "_Left")
                                ((= plane "Right") "_Right")
                                (t "_Top")))
    (command "_.ELLIPSE" "_I" cen rad)
    (setvar "SNAPSTYL" 0)
    t
)

;;; An arc is sampled every five degrees and refitted as a smooth polyline.
;;; Five degrees is the original's sampling and is fine at drawing scale; the
;;; PEDIT fit smooths the result so the facets do not read.
(defun IsoProject:Arc ( ent ref plane / dat cen rad a1 a2 pts a )
    (setq dat (entget ent)
          cen (cdr (assoc 10 dat))
          rad (cdr (assoc 40 dat))
          a1  (/ (* 180.0 (cdr (assoc 50 dat))) pi)
          a2  (/ (* 180.0 (cdr (assoc 51 dat))) pi))
    ;; An arc crossing zero degrees has an end angle below its start.
    (if (> a1 a2) (setq a2 (+ a2 360.0)))

    ;; Built fresh for every arc. The routine this replaces accumulated into one
    ;; global list that was never cleared, so the second arc in a selection came
    ;; out with the first arc's points still attached to it.
    (setq pts nil a a1)
    (while (< a a2)
        (setq pts (cons (IsoProject:Map (polar cen (/ (* a pi) 180.0) rad) ref plane) pts)
              a   (+ a 5.0)))
    (setq pts (reverse (cons (IsoProject:Map (polar cen (/ (* a2 pi) 180.0) rad) ref plane)
                             pts)))

    (entdel ent)
    (command "_.PLINE")
    (foreach p pts (command p))
    (command "")
    (command "_.PEDIT" "_L" "_F" "")
    t
)

;;; Text is moved and rewritten in an obliqued style.
;;; Aligned and Fit text is refused - both are defined by two points and would
;;; need both transformed and the height rederived, which is not a conversion
;;; so much as a redraw.
(defun IsoProject:Text ( ent ref plane / dat s hgt jus rot pt setup style )
    (setq dat (entget ent)
          s   (cdr (assoc 1 dat))
          hgt (cdr (assoc 40 dat))
          jus (cdr (assoc 72 dat))
          rot (/ (* 180.0 (cdr (assoc 50 dat))) pi))

    (if (member jus '(3 5))
        nil                      ; Aligned or Fit
        (progn
            ;; Left-justified text is positioned by group 10; every other
            ;; justification uses the alignment point in group 11.
            (setq pt (if (= jus 0) (cdr (assoc 10 dat)) (cdr (assoc 11 dat))))
            (setq pt (IsoProject:Map pt ref plane))

            (setq setup (IsoProject:TextSetup plane rot)
                  style (car setup))

            (IsoProject:EnsureStyle "ISO-L" -30)
            (IsoProject:EnsureStyle "ISO-R"  30)

            (if (tblsearch "style" style)
                ;; Set the TEXT style directly. The original set the DIMENSION
                ;; text style instead, so the obliquing never reached the text
                ;; it was creating.
                (setvar "TEXTSTYLE" style))

            (entdel ent)
            (if (= jus 0)
                (command "_.TEXT" pt hgt (cdr setup) s)
                (command "_.TEXT" "_J"
                         (cond ((= jus 1) "_C") ((= jus 2) "_R") (t "_M"))
                         pt hgt (cdr setup) s))
            t))
)

;;; ---------------------------------------------------------------------------
;;; MAIN COMMAND
;;; ---------------------------------------------------------------------------

(defun c:ISOPROJECT ( / *error* vars vals ss plane ref i ent typ
                        done skipped ents )

    (setq vars '("CMDECHO" "OSMODE" "BLIPMODE" "SNAPSTYL" "SNAPMODE"
                 "TEXTSTYLE" "ANGDIR" "GRIDMODE" "PLINEWID")
          vals (mapcar 'getvar vars))

    (defun IsoProject:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (princ)
    )

    (defun *error* ( msg )
        (IsoProject:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** ISOPROJECT error: " msg " **")))
        (princ)
    )

    (setvar "CMDECHO" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler
    ;; unless the routine says up front that it will use one. Restore does,
    ;; to close this undo group. The declaring call is absent on older
    ;; releases, so it is wrapped rather than tested for.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (princ "\nSelect the orthographic geometry to project.")
    (setq ss (ssget '((0 . "LINE,POINT,CIRCLE,ARC,TEXT,SOLID,LWPOLYLINE"))))

    (cond
        ((null ss) (princ "\nNothing selected."))

        (t
            (initget 1 "Left Right Top")
            (setq plane (getkword "\nProject into which isoplane [Left/Right/Top]: "))

            (setq ref (getpoint "\nReference point - the corner everything is measured from: "))

            (if (null ref)
                (princ "\nCancelled - no reference point.")
                (progn
                    (setvar "OSMODE" 0)
                    (setvar "BLIPMODE" 0)
                    (setvar "ANGDIR" 0)

                    ;; Snapshot the entity names before touching anything. Some
                    ;; conversions delete and recreate, which would disturb a
                    ;; selection set being walked at the same time.
                    (setq i 0 ents nil)
                    (repeat (sslength ss)
                        (setq ents (cons (ssname ss i) ents) i (1+ i)))
                    (setq ents (reverse ents) done 0 skipped 0)

                    (foreach ent ents
                        (setq typ (cdr (assoc 0 (entget ent))))
                        (if (cond
                                ((= typ "LINE")       (IsoProject:Simple ent '(10 11) ref plane))
                                ((= typ "POINT")      (IsoProject:Simple ent '(10) ref plane))
                                ((= typ "SOLID")      (IsoProject:Simple ent '(10 11 12 13) ref plane))
                                ((= typ "LWPOLYLINE") (IsoProject:LwPoly ent ref plane))
                                ((= typ "CIRCLE")     (IsoProject:Circle ent ref plane))
                                ((= typ "ARC")        (IsoProject:Arc    ent ref plane))
                                ((= typ "TEXT")       (IsoProject:Text   ent ref plane))
                                (t nil))
                            (setq done (1+ done))
                            (setq skipped (1+ skipped))))

                    (princ (strcat "\n" (itoa done) " object(s) projected into the "
                                   (strcase plane t) " isoplane."))
                    (if (> skipped 0)
                        (princ (strcat "\n" (itoa skipped)
                                       " skipped - polylines with curved segments,"
                                       " and aligned or fit text, cannot be sheared.")))
                )
            )
        )
    )

    (IsoProject:Restore)
    (princ)
)

(princ)