;| BBalign.lsp  - Bounding box align
Visually aligns selected entities with either
  Left Center Right
or
  Top
  Middle
  Bottom
alignment in plan (XY plane).

The alignment is based upon each entity's bounding box in the current
UCS, and not, for example, upon block or text insertion points. Actual
justification properties of TEXT and MTEXT entities are not changed.

Note that the bounding box of an MTEXT object is usually somewhat
larger, and sometimes very much larger, than the text visible on the
screen. No attempt is made here to reconcile the difference.

by Bill Gilliss
bill <at> realerthanreal <dot> com
Comments and suggestions always welcome.

Thanks to Doug Broad and gile for the transformation routines.

No warranty, either expressed or implied, is made as to the fitness of
this information for any particular purpose.   All materials are to be
considered 'as-is' and use thereof should be considered as at your own
risk.

ver 1.0 Mar 27 2010 - initial public release

Keywords: AutoCAD AutoLISP justify justification align alignment
======================================================================
|;

(defun c:BBalign ( / ss pt side n pts LL UR MP
                     WCS2UCSMatrix UCS2WCSMatrix UCS-BBOX)

;;====subroutines===========

;; Doug C. Broad, Jr.
;; can be used with vla-transformby to
;; transform objects from the UCS to the WCS
(defun UCS2WCSMatrix ()
(vlax-tmatrix
  (append
    (mapcar '(lambda 
                (vector origin) 
                (append (trans vector 1 0 t) (list origin)) )
              (list '(1 0 0) '(0 1 0) '(0 0 1))
              (trans '(0 0 0) 0 1) )
    (list '(0 0 0 1))
    )
  )
)

;; transform objects from the WCS to the UCS
(defun WCS2UCSMatrix ()
  (vlax-tmatrix
    (append
      (mapcar '(lambda 
                  (vector origin)
                  (append (trans vector 0 1 t) (list origin)))
               (list '(1 0 0) '(0 1 0) '(0 0 1))
               (trans '(0 0 0) 1 0)
               )
      (list '(0 0 0 1))
      )
    )
)

;; UCS-BBOX (gile)
;; Returns the UCS coordinates of the object bounding box about UCS
;; Argument
;;   obj : a graphical object (ename or vla-object)
;; Return
;;   a list of left lower point and right upper point UCS coordinates
(defun ucs-bbox (obj / minpoint maxpoint)
  (vl-load-com)
  (and (= (type obj) 'ENAME)
       (setq obj (vlax-ename->vla-object obj))
       )
  (vla-TransformBy obj (UCS2WCSMatrix))
  (vla-getboundingbox obj 'minpoint 'maxpoint)
  (vla-TransformBy obj (WCS2UCSMatrix))
  (list (vlax-safearray->list minpoint)
        (vlax-safearray->list maxpoint)
        )
)

;;====main program=========
  (vl-load-com)
   
  (command "._undo" "_begin")
  (prompt "\nSelect objects to align: ")
  (setq ss (ssget ":L"))  ;;ignore objects on locked layers
  (setq pt (getpoint "\nPoint for alignment: "))
  (initget 1 "Left Center Right Top Middle Bottom")
  (setq side 
    (getkword 
      "\nSelect alignment [Left Center Right; Top Middle Bottom]: "))
  (if (member side (list "Left" "Center" "Right"))
      (grdraw (list (car pt) 100000)  (list (car pt) -100000)  1 -1)
      (grdraw (list 100000 (cadr pt)) (list -100000 (cadr pt)) 1 -1)
      )

  (setq n 0)
  (repeat (sslength ss)
    (setq en (ssname ss n))
    (setq pts (ucs-bbox en))
    (setq LL (nth 0 pts)
          UR (nth 1 pts)
          MP (list (/ (+ (car LL) (car UR)) 2.0) 
                   (/ (+ (cadr LL) (cadr UR)) 2.0))
          )
    (cond
      ( (= side "Left")
          (command "move" en "" LL ".x" pt "@")
          )
      ( (= side "Center")
          (command "move" en "" MP ".x" pt "@")
          )
      ( (= side "Right")
          (command "move" en "" UR ".x" pt "@")
          )
      ( (= side "Top")
          (command "move" en "" UR ".y" pt "@")
          )
      ( (= side "Middle")
          (command "move" en "" MP ".y" pt "@")
          )
      ( (= side "Bottom")
          (command "move" en "" LL ".y" pt "@")
          )
      ( T nil)
      );cond
    (setq n (1+ n))
  )
  (command "._undo" "_end")

(princ)
);defun

(princ "\nBBalign loaded.")
(princ)