将G版的程序，稍微改动了一下,将物体横向和竖向同时批量对齐
(defun c:pldq ();;;将物体横向和竖向同时批量对齐
;;选择集转表
(defun gxl-Sel-SS->List (ss / i s )
(if ss
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s))
)
)
)
;;计算物体中心点
(defun gxl-getboxCenter (e1 / obj minpoint maxpoint)
(if (= 'ENAME (type e1))
(setq obj (vlax-ename->vla-object e1)) ;转换图元名
(setq obj e1)
)
(vla-GetBoundingBox obj 'minpoint 'maxpoint)
;取得包容图元的最大点和最小点
(setq minpoint (vlax-safearray->list minpoint)) ;把变体数据转化为表
;;;(setq maxpoint (vlax-safearray->list maxpoint)) ;把变体数据转化为表
;;;(setq p (mapcar '+ minpoint maxpoint))
;;; (mapcar '(lambda (x) (* 0.5 x)) p)
minpoint
)
;;主程序
(setq cmdecho (getvar 'cmdecho))
(setq osmode (getvar 'osmode))
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(princ "\n选择水平基准物体:")
(setq s1 (ssget))
(princ "\n选择要对齐物体:")
(setq s2 (ssget))
(setq s1-1 (getpoint "选取竖直对齐点位置："))
(setq s1 (GXL-SEL-SS->LIST s1)
s2 (GXL-SEL-SS->LIST s2)
)
(setq s1 (mapcar '(lambda (x) (list x (GXL-GETBOXCENTER x))) s1))
(setq s1 (vl-sort s1 '(lambda (a b) (> (cadadr a) (cadadr b))) )) ;_ 按Y从大到小排序
(setq s2 (mapcar '(lambda (x) (list x (GXL-GETBOXCENTER x))) s2))
(setq s2 (vl-sort s2 '(lambda (a b) (> (cadadr a) (cadadr b))) )) ;_ 按Y从大到小排序
(setq n 0)
(repeat (length s1)
(setq e1 (car (nth n s1))
p1 (cadr (nth n s1))
)
(if (setq e2 (car (nth n s2)))
(progn
(setq p2 (cadr (nth n s2)))
(setq p3 (list (car s1-1) (cadr p1) (caddr p2)))
(command "move" e2 "" p2 p3)
)
)
(setq n (1+ n))
)
(setvar 'osmode osmode)
(setvar 'cmdecho cmdecho)
(princ)
)
本帖最后由 lz123456 于 2012-10-10 22:41 编辑
楼主改的还是只能水平对齐并不是物体中心对齐的，怎样以竖向物体为准对齐。最好是能加个选项，能水平，竖向对齐。2个功能合在一起
有源码吗？
灌水，不要惩罚我。。。
本帖最后由 lz123456 于 2012-10-11 20:19 编辑
G大说只改几行就可以用于横向的，菜鸟一个实在是没懂。。最好是哪个老大帮忙改成横向，竖向的通用j,加个选项横，竖向。最好是UCS用。但是菜鸟一个，没一个老大帮忙。本来院长那能行，但不能为这功能按整个XCAD.
这个对齐程序，牛！
G版程序必看，顶起来！
学习了，集思广益！
执行该段程序后返回：错误: no function definition: VLAX-ENAME->VLA-OBJECT
看上去很好呀