再回到这里。我在这里找到了惯例&在这里。
我对其进行了修改，以便它要求用户输入或选择对象的宽度，然后进行相应的分割。好吧，它不使用分割中的第一个对象和最后一个对象，正如您在所附的前后图片中看到的那样。
但是，我很高兴我能设法让它发挥作用。也适用于UCS。
如果有人可以帮助修改它，使其可以使用&沿直线分割开始和结束对象，那么这将非常像正确的结果图像。
我的修改版本：
;; 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)
)
页:
1
[2]