[G版的图元对齐]请教怎么改成直线跟文字中间对齐，现在是直线和文字底对齐。
转了一下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)
)
页:
[1]