Topic: In Search of 'Align Objects'

[M-dub]

We'll see if I'm able to do it without scratching my head to the bone. 

Scalp starting to bleed

Hints maybe?

[M-dub]

*nudge*


Tried it again...


*With hands in pockets, kicks stones, shamefully.*

I can't figure out how to align objects Centered Horizontally or Centered Vertically.  I've been trying, too.  I really have!!!

I need a hint.  Probably a pretty good hint, too. 

[Joe Burke]

Aside, I think it's hilarious MacCAD programs dated circa 1998 did all these align tricks with an interface which included some check boxes and a symbolic representation of what those options would do.

IOW, I think it's too much for the command line because a full set of options would be too confusing.

[T.Willey]

To center them vertically, you need to find the lowest 'Y' value, and the highest 'Y' value, then get the average.  Once you have the average, then you move from the average of each items bounding box to that average.  Same way with the 'X' values.

[M-dub]

Thanks Tim,


   I'll have another go at it later this week. 

[T.Willey]

Thanks Tim,


   I'll have another go at it later this week. 

Cool.  Let us know if you need more pushing. 

[CAB]

I see no follow up was done so I did my version of the routine with command line
for alignment options.

I am creating a DCL version, but bogged down in "Honey Do's"

[Joe Burke]

Alan and Tim,

Nice routine.

May I suggest if one object is pre-selected, it should be assumed to be the alignment entitity.

Also if multiple objects are pre-selected, (sssetfirst) to deselect.

[CAB]

Great suggestion Joe.

[CAB]

I suppose using the pick set if more than one entity as the "to be moved" set is too confusing?

Here is the single object version:

Code: [Select]

;;;=======================[ AlignAll.lsp ]==============================
;;; Author: Copyright© 2009 Charles Alan Butler aka CAB
;;; Contact @  www.TheSwamp.org
;;;   
;;; Version:  1.1 beta   Feb. 2, 2009
;;; Purpose: Align objects to a primary object or point using the
;;;  Top, bottom, left, right edges OR align using the Center of the
;;;  primary object OR Center Vertically or Center Horizontally based
;;;  on the primary object.
;;;   
;;;     http://www.theswamp.org/index.php?topic=18116.0
;;;=====================================================================
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED     ;
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR  ;
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.            ;
;;;                                                                    ;
;;;  You are hereby granted permission to use, copy and modify this    ;
;;;  software without charge, provided you do so exclusively for       ;
;;;  your own use or for use by others in your organization in the     ;
;;;  performance of their normal duties, and provided further that     ;
;;;  the above copyright notice appears in all copies and both that    ;
;;;  copyright notice and the limited warranty and restricted rights   ;
;;;  notice below appear in all supporting documentation.              ;
;;;=====================================================================
(defun c:AlignAll (/ e1 target box ss side from to ent pt ss:first)
  (vl-load-com)

  ;;  expects an ename, returns list or nil
  (defun GetBB (obj / ll ur err)
    (setq obj (vlax-ename->vla-object obj))
    (setq err (vl-catch-all-apply
                'vla-getboundingbox (list obj 'll 'ur))
    )
    (if (not (vl-catch-all-error-p err))
      (list (vlax-safearray->list ll) (vlax-safearray->list ur))
    )
  )

  ;;======================================
 
  ;;  get anything already selected, if only one object use it as the alignment item
  (cond
    ((and (setq ss:first (cadr(ssgetfirst)))
          (= (sslength ss:first) 1)
          (setq target (GetBB (ssname ss:first 0))))
     (sssetfirst nil)
    )
    (t ; no single ent so get one from the user
     (sssetfirst nil)   ; de-select
     (setvar "errno" 0) ; must pre set the errno to 0
     (while ; loop until nil is returned from the cond
       (cond
         ((= (getvar "errno") 52) (prompt "\nUser quit.")) ; exit loop
         ((and pt (listp pt)) nil)
         ((or (initget "P")
              (null (setq e1 (entsel "\nSelect alignment entity, or P to pick point."))))
          (princ "\nNothing selected, try again."))
         ((= e1 "P")(initget 1)(setq pt (getpoint "\nPick alignment point")))
         ((setq target (GetBB (car e1))) ; got a good BB
          nil )
         (e1 (princ "\nError - Can not use that object."))
       )
     )
    )
  )
 
  (if
    (and (or target pt)
         (princ "\nvvvvvvvvvvvvvvvvvvvvvvvvv")
         (princ "\nSelect all other entities to align.")
         (setq ss (ssget))
         (not (initget 1 "Top Bottom Left Right Center mVert mHorz"))
         (setq side (getkword "\nSide to align? [Top/Bottom/Left/Right/Center/mVert/mHorz]"))
    )
     (progn
       (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
       (vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
       (cond
         (pt (setq target pt))
         ((member side '("Top" "Right"))(setq target(cadr target)))
         ((member side '("Bottom" "Left"))(setq target (car target)))
         ((member side '("Center" "mVert" "mHorz"))
          (setq target (mapcar '(lambda (a b) (/ (+ a b) 2.0)) (car target)(cadr target))))
       )

       (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
         (if (setq box (GetBB ent))
           (progn
             (cond
               ((= side "Top")
                (setq from (cadr box))
                (setq to (list (car from) (cadr target) (caddr from))))
               ((= side "Bottom")
                (setq from (car box))
                (setq to (list (car from) (cadr target) (caddr from))))
               ((= side "Left")
                 (setq from (car box))
                 (setq to (list (car target) (cadr from) (caddr from))))
               ((= side "Right")
                 (setq from (cadr box))
                 (setq to (list (car target) (cadr from) (caddr from))))
               ((member side '("Center" "mVert" "mHorz"))
                (setq from (mapcar '(lambda (a b) (/ (+ a b) 2.0))
                                     (car box)(cadr box)))
                (cond
                  ((= side "Center")
                   (setq to target))
                  ((= side "mVert")
                   (setq to (list (car target) (cadr from) (caddr from))))
                  ((= side "mHorz")
                   (setq to (list (car from) (cadr target) (caddr from))))
                )
              ) 
             )

             (vl-catch-all-apply
               'vlax-invoke-method
               (list (vlax-ename->vla-object ent) 'move
                     (vlax-3d-point from) (vlax-3d-point to))
             )
           )
         )
       )
       (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
     )
  )
  (princ)
)
(prompt "\nAlign All Lisp loaded, enter AlignAll to run.")
(princ)

[jvillarreal]

Messy coding..just wanted to provide some ideas for the dialog based one..copy option, ucs compatability, and align objects as group(currently wcs only)...the command is AE

Code: [Select]

(defun create_dialog2 ()
(setq fname (vl-filename-mktemp "dcl2.dcl"))
(setq fn (open fname "w"))
(write-line "temp : dialog { label = \"Align Edges\";
spacer_1;
: popup_list { label = \"          Align:\";
key = \"Selection\"; value = \"0\"; edit_width = 9;
       }
:column {
: toggle { key= \"tog1\"; label = \"Make Copy\";
}
: toggle { key= \"tog2\"; label = \"Align Objects as Group\";
}
}
spacer;

:row {
: button { key = \"accept\"; label = \"Proceed\"; is_default = true; edit_width = true; alignment = centered;}
: button { key = \"cancel\"; label = \"Cancel\"; edit_width = true; alignment = centered; is_cancel = true;} 
} 
: errtile { width = true; } }" fn)

(close fn)

);defun
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Original Author T.Willey "TheSwamp.org";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;Added UCS Compatability(by Gile), Horizontal Center, Vertical Center, Copy Option, and Dialog;;;;;

(defun c:AE (/ ActDoc Sel AliObj AliLl AliUr ss AliOpt Ent tempObj tempLl tempUr MC GR TempobjPoints *error* fname)
(vl-load-com)

(defun *error* ( msg )
        (princ (strcat "\n<" msg ">\n"))
(if Sel (redraw (car Sel) 4))
(setvar "OSMODE" (boole 2 (getvar "OSMODE") 16384))
(vl-file-delete fname)
(vla-EndUndoMark ActDoc)
        (princ)
);defun *error*

(setq OPTIONS '("Left" "Right" "Top" "Bottom" "Horiz. Center" "Vert. Center" "Center"))
(create_dialog2)
(setq dcl_id (load_dialog fname))

     (if (not (new_dialog "temp" dcl_id))
(exit )
     );if
(start_list "Selection")
(mapcar 'add_list OPTIONS)
(end_list)
(action_tile "tog1" "(if (= MC nil)(setq MC 1)(setq MC 0))")
(action_tile "tog2" "(if (= GR nil)(setq GR 1)(setq GR 0))")
(action_tile "accept"
(strcat "(progn (setq AliOpt (atof (get_tile \"Selection\")))"
"(done_dialog)(setq userclick T))"
);strcat
);action_tile
(start_dialog)
(unload_dialog dcl_id)
(if userclick
(progn (setq Aliopt (fix Aliopt) Aliopt (nth Aliopt OPTIONS))
(if (= userclick nil)(progn (vl-file-delete fname)(princ "\nCancel")(exit)))
(setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(vla-EndUndoMark ActDoc)
(vla-StartUndoMark ActDoc)
(if
(and
(while (= sel nil)(setq Sel (entsel "\n Select base object: ")))
(setvar "OSMODE" (boole 7 (getvar "OSMODE") 16384))
(setq AliObj (car Sel))
(setq AliLl (nth 0 (bbox AliObj)))
(setq AliUr (nth 2 (bbox AliObj)))
(not (redraw (car Sel) 3))
(setq ss (ssget))
(setq cnt -1)
)
(if (= GR 1)
(progn
(setq TempobjPoints (if ss
  (lst-getboundingbox
    (mapcar (function vlax-ename->vla-object)
            (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))
    ) ;_  mapcar
  ) ;_  lst-getboundingbox
  ) ;_  if
);setq
(vl-cmdf "rectang" (car TempobjPoints) (cadr TempobjPoints))
(setq tempobj (entlast))
(setq tempLl (nth 0 (bbox tempObj)))
(setq tempUr (nth 2 (bbox tempObj)))
(vl-cmdf "erase" tempobj "")
(setq tempobj ss)
(if (= MC 1)  (vl-cmdf "copy" tempobj "" "" ""))
(cond
((= AliOpt "Center")
(vl-cmdf "move" tempobj ""
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr)
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) AliLl AliUr)
)
);condition1
((= AliOpt "Left")
(vl-cmdf "move" tempobj ""
tempLl

(list
(car AliLl)
(cadr tempLl)
(caddr tempLl)
)

)
);condition2
((= AliOpt "Right")
(vl-cmdf "move" tempobj ""
tempUr
(list
(car AliUr)
(cadr tempUr)
(caddr tempUr)
)
)
);condition3
((= AliOpt "Top")
(vl-cmdf "move" tempobj ""
tempUr
(list
(car tempUr)
(cadr AliUr)
(caddr tempUr)
)
)
);condition4
((= AliOpt "Bottom")
(vl-cmdf "move" tempobj ""
tempLl
(list
(car tempLl)
(cadr AliLl)
(caddr tempLl)
)
)
);condition5
((= AliOpt "Vert. Center")
(vl-cmdf "move" tempobj ""
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr)
(list
(car (mapcar '(lambda (a b) (/ (+ a b) 2.0)) AliLl AliUr))
(cadr (mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr))
(caddr (mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr))
)
)
);condition6
((= AliOpt "Horiz. Center")
(vl-cmdf "move" tempobj ""
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr)
(list
(car (mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr))
(cadr (mapcar '(lambda (a b) (/ (+ a b) 2.0)) AliLl AliUr))
(caddr (mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr))
)
)
);condition7
);cond
);progn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(progn
(while
(setq tempObj (ssname ss (setq cnt (1+ cnt))))
(setq tempLl (nth 0 (bbox tempObj)))
(setq tempUr (nth 2 (bbox tempObj)))

(if (= MC 1) (vla-copy (vlax-ename->vla-object tempObj)))
(cond
((= AliOpt "Center")
(vl-cmdf "move" tempobj ""
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr)
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) AliLl AliUr)
)
);condition1
((= AliOpt "Left")
(vl-cmdf "move" tempobj ""
tempLl

(list
(car AliLl)
(cadr tempLl)
(caddr tempLl)
)

)
);condition2
((= AliOpt "Right")
(vl-cmdf "move" tempobj ""
tempUr
(list
(car AliUr)
(cadr tempUr)
(caddr tempUr)
)
)
);condition3
((= AliOpt "Top")
(vl-cmdf "move" tempobj ""
tempUr
(list
(car tempUr)
(cadr AliUr)
(caddr tempUr)
)
)
);condition4
((= AliOpt "Bottom")
(vl-cmdf "move" tempobj ""
tempLl
(list
(car tempLl)
(cadr AliLl)
(caddr tempLl)
)
)
);condition5
((= AliOpt "Vert. Center")
(vl-cmdf "move" tempobj ""
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr)
(list
(car (mapcar '(lambda (a b) (/ (+ a b) 2.0)) AliLl AliUr))
(cadr (mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr))
(caddr (mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr))
)
)
);condition6
((= AliOpt "Horiz. Center")
(vl-cmdf "move" tempobj ""
(mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr)
(list
(car (mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr))
(cadr (mapcar '(lambda (a b) (/ (+ a b) 2.0)) AliLl AliUr))
(caddr (mapcar '(lambda (a b) (/ (+ a b) 2.0)) tempLl tempUr))
)
)
);condition7
);cond
);while
);progn
);if
);if
(if Sel (redraw (car Sel) 4))
(setvar "OSMODE" (boole 2 (getvar "OSMODE") 16384))
(vl-file-delete fname)
(vla-EndUndoMark ActDoc)
);progn
);if
(princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))
    )
  )
)

;;; Creates an entity (lwpolyline or 3D polyline) figuring the "bounding box"
;;; of the selected object about current UCS.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
;; By: Gile @theswamp.org ;;
;;        Modified Result to setq box points ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bbox ( obj / Space obj bb minpoint maxpoint pt1 pt2 lst poly
       box cen norm)
  (vl-load-com)
  (setq
Space (if (= (getvar "CVPORT") 1)
  (vla-get-PaperSpace ActDoc)
  (vla-get-ModelSpace ActDoc)
)
  )
  (setq obj (vlax-ename->vla-object obj))
  (vla-TransformBy obj (UCS2WCSMatrix))
  (setq bb (vl-catch-all-apply
     'vla-getboundingbox
     (list obj
   'minpoint
   'maxpoint
     )
   )
  )
  (if (vl-catch-all-error-p bb)
    (progn
      (princ
(strcat "; error: " (vl-catch-all-error-message bb))
      )
      (vla-TransformBy obj (WCS2UCSMatrix))
      (vla-endUndoMark ActDoc)
    )
    (progn
      (setq pt1 (vlax-safearray->list minpoint)
    pt2 (vlax-safearray->list maxpoint)
      )
      (if (or (equal (car pt1) (car pt2) 1e-007)
      (equal (cadr pt1) (cadr pt2) 1e-007)
      (equal (caddr pt1) (caddr pt2) 1e-007)
  )
(progn
  (cond
    ((equal (car pt1) (car pt2) 1e-007)
     (setq lst (list pt1
     (list (car pt1) (cadr pt1) (caddr pt2))
     pt2
     (list (car pt1) (cadr pt2) (caddr pt1))
       )
     )
    )
    ((equal (cadr pt1) (cadr pt2) 1e-007)
     (setq lst (list pt1
     (list (car pt1) (cadr pt1) (caddr pt2))
     pt2
     (list (car pt2) (cadr pt1) (caddr pt1))
       )
     )
    )
    ((equal (caddr pt1) (caddr pt2) 1e-007)
     (setq lst (list pt1
     (list (car pt1) (cadr pt2) (caddr pt1))
     pt2
     (list (car pt2) (cadr pt1) (caddr pt1))
       )
     )
    )
  )
  (setq box
(vlax-invoke Space 'add3dPoly (apply 'append lst))
  )
  (vla-put-closed box :vlax-true)
)
(progn
  (setq cen (mapcar '(lambda (x y) (/ (+ x y) 2)) pt1 pt2)
pt2 (mapcar '- pt2 pt1)
box (vla-addBox
     Space
      (vlax-3d-point cen)
      (car pt2)
      (cadr pt2)
      (caddr pt2)
    )
  )
)
      )
      (if (= (vla-get-ObjectName obj) "AcDbText")
(progn
  (setq norm (vlax-get obj 'Normal)
  )
  (vla-Move
    box
    (vlax-3d-point (trans '(0 0 0) norm 0))
    (vlax-3d-point
      (trans
(list
  0
  0
  (caddr
    (trans (vlax-get obj 'InsertionPoint)
   0
   norm
    )
  )
)
norm
0
      )
    )
  )
)
      )
      (mapcar '(lambda (x) (vla-TransformBy x (WCS2UCSMatrix)))
      (list obj box)
      )
    )
  )
(entdel (entlast))
lst
)

(defun lst-getboundingbox (lst / maxp minp)
 ;; by ElpanovEvgeniy
 ;; 14.08.2004
 (if (and lst (listp lst))
  (apply
   (function
    (lambda (a1 a2 a3 a4 a5 a6)
     (list
      (list (apply (function min) a1) (apply (function min) a2) (apply (function min) a3))
      (list (apply (function max) a4) (apply (function max) a5) (apply (function max) a6))
     ) ;_  list
    ) ;_ lambda
   ) ;_ function
   (apply
    (function mapcar)
    (cons
     'list
     (mapcar (function (lambda (x)
                        (vla-getboundingbox x 'minp 'maxp)
                        (append (vlax-safearray->list minp) (vlax-safearray->list maxp))
                       ) ;_ lambda
             ) ;_ function
             (vl-remove-if
              (function null)
              (mapcar (function (lambda (x)
                                 (cond ((= (type x) 'ENAME) (vlax-ename->vla-object x))
                                       ((= (type x) 'VLA-object) x)
                                       (t nil)
                                 ) ;_  cond
                                ) ;_ lambda
                      ) ;_ function
                      lst
              ) ;_  mapcar
             ) ;_ vl-remove-if
     ) ;_  mapcar
    ) ;_  cons
   ) ;_  apply
  ) ;_  apply
 ) ;_ if
)


[CAB]

I think my DCL version is working.
No support for non WCS.