 ; VBC - centre rejustify a column of text.
 ; Copyright 1995, 2006, 2008 by Rocket Software Ltd.
 ; Why do people who have their lives perfectly planned always live in the suburbs?
 (DEFUN C:VBC (/ ss xa rr entt txang obliq dnang xb num enam txpa txpb pa typ
                                                                           sp)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (prompt "Pick text/attdefs to centre justify: ")
  (if (setq ss (ssget '((-4 . "<or")
                        (0 . "text")
                        (0 . "attdef")
                        (-4 . "or>"))))
      (progn
           (setq xa (getpoint "Pick one side: "))
           (setq rr (getpoint xa "\n...and the other side or <Return>:"))
           (if rr 
              (setq xa (list (/ (+ (car xa) (car rr)) 2)
                             (/ (+ (cadr xa) (cadr rr)) 2)
                             (/ (+ (caddr xa) (caddr rr)) 2))))
 ; Use the text angle of the first text entity as the angle for all of them.
           (setq entt (entget (ssname ss 0)))
           (setq txang (cdr (assoc 50 entt)))
           (if (null (setq obliq (cdr (assoc 51 entt))))
               (setq obliq 0))
           (setq dnang (- txang (/ pi 2) obliq))
           (setq xb (polar xa dnang 100))
 ; For each entity, find its angle and the intersection of its baseline with
 ; a line from xa at dnang, the text down angle.  Then move it there.
           (setq num 0)
           (while (setq enam (ssname ss num))
                  (setq num (1+ num))
                  (setq entt (entget enam))
                  (setq txang (cdr (assoc 50 entt)))
                  (setq txpa (cdr (assoc 10 entt)))
                  (setq txpb (polar txpa txang 100))
                  (setq pa (inters xa xb txpa txpb nil))
 ; Make it centre justified.
                  (setq entt (subst (cons 72 1) (assoc 72 entt) entt))
                  (setq typ (cdr (assoc 0 entt)))
                  (if (= typ "ATTDEF")
                      (setq entt (subst (cons 74 0) (assoc 74 entt) entt))
                      (setq entt (subst (cons 73 0) (assoc 73 entt) entt)))
                  (entmod (subst (cons 11 pa) (assoc 11 entt) entt)))
 ; Sum up and end.
           (setq sp (if (= (setq num (sslength ss)) 1) "" "s"))
           (prompt (strcat "\n" (itoa num) " line" sp " centred.")))
      (prompt "\nNo text selected."))
  (command ".undo" "end")
 (princ))