[编程交流] 用相等的空间划分对象

;; Code found:
;; https://www.theswamp.org/index.php?topic=51616.msg566915#msg566915
;; https://www.theswamp.org/index.php?topic=51564.msg566732#msg566732
;;
;; Modified by 3dwannab on 11.04.17
;; Made it work by adding prompt to enter/pick width of arrayed objects and result will divide with equal spacings between object boundaries.
;;
;; Known Bugs: Doesn't use the start and end object of the arrayed objects.
;;
(defun _bboxandmid (obj / a b l)
(vla-getboundingbox obj 'a 'b)
(list (car (setq l (mapcar 'vlax-safearray->list (list a b))))
        ; (apply '(lambda (a b) (mapcar '(lambda (a b) (/ (+ a b) 2.)) a b)) l)
        (apply '(lambda (a b) (mapcar '(lambda (a b) (/ (+ a b) 2.)) a b)) l)
        (cadr l)
        )
)
(defun ss->lst (ss / i l)
(if (eq (type ss) 'pickset)
        (repeat (setq i (sslength ss))
                (setq l (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) l))
                )
        )
)
(defun c:spb (/ di doc fac g lst p1 p2 vec)
;; Added by 3dwannab.
(setq di (getdist "\nEnter or Pick width of Array Object: "))
(if di
;;
(progn
        (setq di (/ di 2.))
        (if
                (and
                        (setq lst (ss->lst (ssget "_:L")))
                        (or
                                (< 1 (length lst))
                                (prompt "\nSelection set must contain at least 2 entities ")
                                )
                        (or
                                (setq fixDist (getdist "\nFixed distance or Enter: "))
                                T
                                )
                        (setq p1 (getpoint "\nSpecify first point: "))
                        )
                (progn
                        (setq doc (vla-get-activedocument (vlax-get-acad-object)))
                        (vla-endundomark doc)
                        (vla-startundomark doc)
                        (princ "\nSpecify second point: ")
                        (while (eq 5 (car (setq g (grread t 15 0))))
                                (redraw)
                                (setq p2 (cadr g))
                                (setq p2
                                        (cond
                                        ((osnap p2 "_END,_MID")) ; Change to suit your needs.
                                        (p2)
                                        )
                                        )
                                (if (not (equal p1 p2 1e-4))
                                        (progn
                                                (grdraw p1 p2 1 -1)
                                                (setq fac
                                                        (cond
                                                        ; (fixDist (/ (distance p1 p2) fixDist))
                                                        ;; Added by 3dwannab.
                                                        (fixDist (/ (distance (list (- (car p1) di) (cadr p1) (caddr p1)) (list (+ (car p2) di) (cadr p2) (caddr p2))) fixDist))
                                                        ;;
                                                        ((1- (length lst)))
                                                        )
                                                        )
                                        ; (setq vec (trans (mapcar '(lambda (crd1 crd2) (/ (- crd2 crd1) fac)) p1 p2) 1 0 T))
                                        ;; Added by 3dwannab.
                                        (setq vec (trans (mapcar '(lambda (crd1 crd2) (/ (- crd2 crd1) fac)) (list (- (car p1) di) (cadr p1) (caddr p1)) (list (+ (car p2) di) (cadr p2) (caddr p2))) 1 0 T))
                                        ;;
                                        ;; Added by 3dwannab.
                                        (vlax-invoke (car lst) 'move (cadr (_bboxandmid (car lst))) (trans (list (- (car p1) di) (cadr p1) (caddr p1)) 1 0))
                                        ;;
                                        ; (vlax-invoke (car lst) 'move (cadr (_bboxandmid (car lst))) (trans p1 1 0))
                                        (mapcar
                                                '(lambda (o1 o2 / l)
                                                        (vlax-invoke o2 'move (cadr (_bboxandmid o2)) (mapcar '+ (cadr (_bboxandmid o1)) vec))
                                                        )
                                                lst
                                                (cdr lst)
                                                )
                                        )
                                        )
                                )
                        (vla-endundomark doc)
                        )
                )
        )
)
(redraw)
(princ)
)