单行文字对齐源码

;---------------------------------------------------------------------;
;已完成，勿动(-_-!)
;根据参数返回点列表按某一坐标轴排序，ordor=1为降序，=0为升序
(defun pzj:sort(ptlst axis ordor / tmp)
  (setq tmp
    (cond
      ((= axis "x") (vl-sort ptlst '(lambda(a b) (< (car a) (car b)))))
      ((= axis "y") (vl-sort ptlst '(lambda(a b) (< (cadr a) (cadr b)))))
      ((= axis "z") (vl-sort ptlst '(lambda(a b) (< (caddr a) (caddr b)))))
    )
  )
  (if (= ordor 1)
    (reverse tmp)
    tmp
  )
)
;---------------------------------------------------------------------;
;更改文字为左对齐
(defun pzj:chalignCur(ent)
  (if (not (= (assoc 72 ent) 0))
    (setq ent (entmod (subst (cons 72 0) (assoc 72 ent) ent)))
  )
  (princ)
)
;---------------------------------------------------------------------;
;文字横向对齐
(defun pzj:dqth(ss dqpt space / i boxpt lst sph)
  (setq i 0)
  (repeat (sslength ss)
    (pzj:chalignCur (entget (ssname ss i)));文字改为左对齐
    (setq
      boxpt (textbox (entget (ssname ss i)))
      lst (cons (list
      (ssname ss i)
      (cdr (assoc 10 (entget (ssname ss i))))
      (1+ (fix (- (nth 0 (nth 1 boxpt)) (nth 0 (nth 0 boxpt)))))
    )
      lst
    );构建((图元名1 对齐点1 字长1) (图元名2 对齐点2 字长2)...)列表
      lst (vl-sort lst '(lambda(a b) (< (nth 0 (nth 1 a)) (nth 0 (nth 1 b)))));((图元名1 对齐点1 字长1) (图元名2 对齐点2 字长2)...)列表按x轴排序，升序 
    )
    (setq i (1+ i))
  )
  (setq sph 0)
  (foreach each lst
    (if (= space nil)
      (vla-move (vlax-ename->vla-object (nth 0 each)) (vlax-3d-point (nth 1 each)) (vlax-3d-point (list (car (nth 1 each)) (cadr dqpt) (caddr (nth 1 each)))))
      (progn
        (vla-move (vlax-ename->vla-object (nth 0 each)) (vlax-3d-point (nth 1 each)) (vlax-3d-point (list (+ (car dqpt) sph) (cadr dqpt) (caddr dqpt))))
  (setq sph (+ (+ (nth 2 each) space) sph))
      )
    )
  )
  (princ)
)
;---------------------------------------------------------------------;
;文字纵向对齐
(defun pzj:dqts(ss dqpt space / i boxpt lst spz)
  (setq i 0)
  (repeat (sslength ss)
    (pzj:chalignCur (entget (ssname ss i)));文字改为左对齐
    (setq
      boxpt (textbox (entget (ssname ss i)))
      lst (cons (list
      (ssname ss i)
      (cdr (assoc 10 (entget (ssname ss i))))
      (cdr (assoc 40 (entget (ssname ss i))))
    )
      lst
    );构建((图元名1 对齐点1 字高1) (图元名2 对齐点2 字高2)...)列表
      lst (vl-sort lst '(lambda(a b) (> (nth 1 (nth 1 a)) (nth 1 (nth 1 b)))));((图元名1 对齐点1 字高1) (图元名2 对齐点2 字高2)...)列表按轴排序，升序(x轴m=0、y轴m=1、z轴m=2) 
    )
    (setq i (1+ i))
  )
  
  (setq spz 0)
  (foreach each lst
    (if (= space nil)
      (vla-move (vlax-ename->vla-object (nth 0 each)) (vlax-3d-point (nth 1 each)) (vlax-3d-point (list (car dqpt) (cadr (nth 1 each)) (caddr (nth 1 each)))))
      (progn
        (vla-move (vlax-ename->vla-object (nth 0 each)) (vlax-3d-point (nth 1 each)) (vlax-3d-point (list (car dqpt) (- (cadr dqpt) spz) (caddr dqpt))))
        (setq spz (+ (+ (nth 2 each) space) spz))
      )
    )
  )
)
;---------------------------------------------------------------------;
;执行函数
(vl-load-com)
(defun c:dq (/ m)
  (initget "s")
  (setq m (getkword "(s)竖向对齐/横向对齐："))
  (if (= m "s")
    (pzj:dqts (ssget "" '((0 . "TEXT"))) (getpoint "\n指定对齐点：") (getreal"\n指定间距:"))
    (pzj:dqth (ssget "" '((0 . "TEXT"))) (getpoint "\n指定对齐点：") (getreal"\n指定间距:"))
  )
  (princ)
)
;---------------------------------------------------------------------;