;;; ---------------------------------------------------------------------------
;;; SectionProps.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; CROSS-SECTION PROPERTIES FOR A CLOSED SHAPE WITH HOLES
;;;
;;; PURPOSE
;;;   Reports the full set of section properties an engineer needs for a built-up
;;;   or cut-out cross section:
;;;
;;;     Area and centroid
;;;     Ix, Iy, Ixy about the WCS origin
;;;     Ix, Iy, Ixy about the centroid          (second moments of area)
;;;     Principal moments I1 and I2, and the angle of the principal axes
;;;     Radii of gyration about the principal axes
;;;     Section moduli to the extreme fibres
;;;
;;;   Holes are handled: select the outer boundary and every hole together and
;;;   the holes are subtracted automatically.
;;;
;;; HOW IT WORKS
;;;   1. Every selected closed curve is turned into a REGION. Regions are exact
;;;      area primitives - AutoCAD computes their properties analytically, so a
;;;      curved boundary is exact rather than approximated by short chords.
;;;
;;;   2. The region with the largest area is taken as the outer boundary and
;;;      every other region is subtracted from it. That single rule handles the
;;;      normal case - one outline, any number of holes inside it - without
;;;      asking the user to nominate which is which.
;;;
;;;   3. Area, centroid, moment of inertia and product of inertia are read
;;;      straight off the resulting region.
;;;
;;;   4. The centroidal values are then derived with the parallel axis theorem:
;;;
;;;        Ix about centroid  =  Ix about origin  -  A * ybar^2
;;;        Iy about centroid  =  Iy about origin  -  A * xbar^2
;;;        Ixy about centroid =  Ixy about origin -  A * xbar * ybar
;;;
;;;      and the principal values from the standard Mohr's circle relations:
;;;
;;;        I1,I2 = (Ix+Iy)/2 +/- sqrt( ((Ix-Iy)/2)^2 + Ixy^2 )
;;;        angle = 0.5 * atan2( -2*Ixy, Ix-Iy )
;;;
;;;      ATAN2 rather than ATAN so the angle lands in the correct quadrant when
;;;      Ix equals Iy - a case a plain division would divide by zero on.
;;;
;;;   5. The temporary regions are erased. Your geometry is never modified and
;;;      nothing is left behind, whether the routine finishes or errors out.
;;;
;;; WHAT TO SELECT
;;;   Closed curves only: closed polylines, circles, ellipses, closed splines.
;;;   Open curves and anything that is not a curve are ignored, and the routine
;;;   says how many it skipped rather than failing silently.
;;;
;;;   SECTPROPS  - report section properties for a closed shape with holes
;;; ---------------------------------------------------------------------------

(vl-load-com)

;;; Cached handle on the active document. The function redefines itself the
;;; first time it runs, so the COM lookup happens once per drawing session
;;; instead of once per call.
(defun SectionProps:Doc nil
    (eval (list 'defun 'SectionProps:Doc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (SectionProps:Doc)
)

;;; Model space or the current layout, whichever the user is actually working in,
;;; so a section drawn in paper space still works.
(defun SectionProps:Space ( )
    (if (= 1 (getvar "CVPORT"))
        (vla-get-paperspace (SectionProps:Doc))
        (vla-get-modelspace (SectionProps:Doc))
    )
)

;;; ---------------------------------------------------------------------------
;;; COM PLUMBING
;;; ---------------------------------------------------------------------------

;;; Wrap a LISP list of VLA objects into the variant array AddRegion expects.
(defun SectionProps:ObjArray ( objs / arr )
    (setq arr (vlax-make-safearray vlax-vbObject (cons 0 (1- (length objs)))))
    (vlax-safearray-fill arr objs)
    (vlax-make-variant arr)
)

;;; Read a property that comes back as an array of doubles, as a plain list.
;;; Returns nil rather than raising when the property is not supported, which
;;; keeps one missing property from killing the whole report.
(defun SectionProps:Doubles ( obj prop / res )
    (setq res (vl-catch-all-apply
                  '(lambda ( ) (vlax-get obj prop))))
    (cond
        ((vl-catch-all-error-p res) nil)
        ((listp res) res)
        ((= (type res) 'variant) (vlax-safearray->list (vlax-variant-value res)))
        (t nil)
    )
)

;;; ---------------------------------------------------------------------------
;;; MATHS
;;; ---------------------------------------------------------------------------

;;; Four-quadrant arctangent. AutoLISP's ATAN already accepts two arguments and
;;; behaves as atan2, but it raises on (0 0), so that case is caught here.
(defun SectionProps:Atan2 ( y x )
    (if (and (zerop y) (zerop x)) 0.0 (atan y x))
)

;;; ---------------------------------------------------------------------------
;;; REPORT FORMATTING
;;;
;;; Values are printed at four decimals in the drawing's own units. Section
;;; properties span a very wide numeric range - an area might be tens while a
;;; fourth moment is millions - so each line is labelled and right-aligned rather
;;; than tabulated, which stays readable at any magnitude.
;;; ---------------------------------------------------------------------------

(defun SectionProps:Line ( label value )
    (princ (strcat "\n  " label
                   (substr "                    " 1 (max 1 (- 20 (strlen label))))
                   (rtos value 2 4)))
)

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

(defun c:SECTPROPS ( / *error* vars vals ss i ent obj curves skipped
                       regionsVar regions areas outer rest made
                       area cen xbar ybar mi pi2 ix iy ixy
                       ixc iyc ixyc avg dif root i1 i2 ang
                       r1 r2 box lo hi )

    (setq vars '("CMDECHO")
          vals (mapcar 'getvar vars))

    ;; Every region this routine creates is tracked here, so the cleanup can
    ;; remove them whether the command ends normally or blows up halfway.
    (setq made nil)

    (defun SectionProps:Cleanup ( )
        (foreach r made
            (if (and r (not (vlax-erased-p r)))
                (vl-catch-all-apply '(lambda ( ) (vla-delete r)))))
        (setq made nil)
        (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 )
        (SectionProps:Cleanup)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** SECTPROPS 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 outer boundary and any holes, all together.")
    ;; Regions are deliberately NOT accepted here: AddRegion builds regions FROM
    ;; curves and rejects an array that already contains one.
    (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE,SPLINE"))))

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

        (t
            ;; Sort the selection into usable closed curves and things to skip.
            ;; A closed test up front is better than letting AddRegion fail,
            ;; because AddRegion refuses the whole array if any member is open.
            (setq i 0 curves nil skipped 0)
            (repeat (sslength ss)
                (setq ent (ssname ss i)
                      obj (vlax-ename->vla-object ent)
                      i   (1+ i))
                (cond
                    ;; A circle is closed by definition and carries no Closed
                    ;; property to test, so it is accepted outright.
                    ((= "AcDbCircle" (vla-get-objectname obj))
                     (setq curves (cons obj curves)))

                    ((and (vlax-property-available-p obj 'Closed)
                          (= :vlax-true (vla-get-closed obj)))
                     (setq curves (cons obj curves)))

                    (t (setq skipped (1+ skipped)))
                )
            )

            (if (> skipped 0)
                (princ (strcat "\n" (itoa skipped)
                               " open or unusable object(s) ignored.")))

            (cond
                ((null curves)
                 (princ "\nNo closed curves in the selection - nothing to measure."))

                (t
                    ;; Turn the curves into regions. AddRegion returns an array
                    ;; of however many regions it managed to build.
                    (setq regionsVar
                          (vl-catch-all-apply
                              '(lambda ( )
                                   (vla-AddRegion (SectionProps:Space)
                                                  (SectionProps:ObjArray curves)))))

                    (if (vl-catch-all-error-p regionsVar)
                        (princ "\n** Could not build regions from that selection. **")
                        (progn
                            (setq regions (vlax-safearray->list
                                              (vlax-variant-value regionsVar))
                                  made    regions)

                            ;; Largest area is the outer boundary; everything
                            ;; else is a hole to be cut out of it.
                            (setq areas (mapcar '(lambda (r) (cons (vla-get-area r) r))
                                                regions))
                            (setq areas (vl-sort areas
                                                 '(lambda (a b) (> (car a) (car b)))))
                            (setq outer (cdar areas)
                                  rest  (mapcar 'cdr (cdr areas)))

                            ;; acSubtraction is boolean type 2. Each hole is
                            ;; consumed by the operation, so it must not be
                            ;; deleted again during cleanup.
                            (foreach hole rest
                                (vl-catch-all-apply
                                    '(lambda ( ) (vla-Boolean outer 2 hole)))
                                (setq made (vl-remove hole made)))

                            ;; --- read the raw properties ---------------------
                            (setq area (vla-get-area outer)
                                  cen  (SectionProps:Doubles outer 'Centroid)
                                  mi   (SectionProps:Doubles outer 'MomentOfInertia)
                                  pi2  (SectionProps:Doubles outer 'ProductOfInertia))

                            (setq xbar (if cen (car  cen) 0.0)
                                  ybar (if cen (cadr cen) 0.0)
                                  ix   (if mi  (car  mi)  0.0)
                                  iy   (if mi  (cadr mi)  0.0)
                                  ixy  (if pi2 (car  pi2) 0.0))

                            ;; --- parallel axis theorem to the centroid -------
                            (setq ixc  (- ix  (* area ybar ybar))
                                  iyc  (- iy  (* area xbar xbar))
                                  ixyc (- ixy (* area xbar ybar)))

                            ;; --- principal values, Mohr's circle -------------
                            (setq avg  (/ (+ ixc iyc) 2.0)
                                  dif  (/ (- ixc iyc) 2.0)
                                  root (sqrt (+ (* dif dif) (* ixyc ixyc)))
                                  i1   (+ avg root)
                                  i2   (- avg root)
                                  ang  (* 0.5 (SectionProps:Atan2 (* -2.0 ixyc)
                                                                  (- ixc iyc))))

                            ;; --- radii of gyration ---------------------------
                            (setq r1 (if (> area 0.0) (sqrt (abs (/ i1 area))) 0.0)
                                  r2 (if (> area 0.0) (sqrt (abs (/ i2 area))) 0.0))

                            ;; --- extreme fibre distances for section moduli --
                            ;; Taken from the region's bounding box, which is the
                            ;; extent of the real shape including its curves.
                            (setq box (vl-catch-all-apply
                                          '(lambda ( / a b)
                                               (vla-getboundingbox outer 'a 'b)
                                               (list (vlax-safearray->list a)
                                                     (vlax-safearray->list b)))))
                            (if (not (vl-catch-all-error-p box))
                                (setq lo (car box) hi (cadr box)))

                            ;; --- report --------------------------------------
                            (textscr)
                            (princ "\n")
                            (princ "\n===========================================")
                            (princ "\n  SECTION PROPERTIES")
                            (princ "\n===========================================")
                            (SectionProps:Line "Area"  area)
                            (SectionProps:Line "Centroid X" xbar)
                            (SectionProps:Line "Centroid Y" ybar)

                            (princ "\n\n  About the WCS origin")
                            (SectionProps:Line "Ix"  ix)
                            (SectionProps:Line "Iy"  iy)
                            (SectionProps:Line "Ixy" ixy)

                            (princ "\n\n  About the centroid")
                            (SectionProps:Line "Ix"  ixc)
                            (SectionProps:Line "Iy"  iyc)
                            (SectionProps:Line "Ixy" ixyc)

                            (princ "\n\n  Principal, about the centroid")
                            (SectionProps:Line "I1 (major)" i1)
                            (SectionProps:Line "I2 (minor)" i2)
                            (princ (strcat "\n  Axis angle         "
                                           (angtos ang 0 4)))
                            (SectionProps:Line "r1 (major)" r1)
                            (SectionProps:Line "r2 (minor)" r2)

                            (if (and lo hi (> area 0.0))
                                (progn
                                    (princ "\n\n  Elastic section moduli about the centroid")
                                    (SectionProps:Line "Sx top"
                                        (if (> (abs (- (cadr hi) ybar)) 1e-12)
                                            (/ ixc (abs (- (cadr hi) ybar))) 0.0))
                                    (SectionProps:Line "Sx bottom"
                                        (if (> (abs (- ybar (cadr lo))) 1e-12)
                                            (/ ixc (abs (- ybar (cadr lo)))) 0.0))
                                    (SectionProps:Line "Sy right"
                                        (if (> (abs (- (car hi) xbar)) 1e-12)
                                            (/ iyc (abs (- (car hi) xbar))) 0.0))
                                    (SectionProps:Line "Sy left"
                                        (if (> (abs (- xbar (car lo))) 1e-12)
                                            (/ iyc (abs (- xbar (car lo)))) 0.0))
                                )
                            )
                            (princ "\n\n  Values are in drawing units.")
                            (princ "\n===========================================\n")
                        )
                    )
                )
            )
        )
    )

    ;; Removes the temporary regions and restores everything saved above.
    (SectionProps:Cleanup)
    (princ)
)

(princ)