香田里浪人 发表于 2013-8-15 20:24:22

李麦克的代码也挺好用。
(defun c:wbdq ( / *error* bpt enx inc ins lst sel spf vec )

    (setq spf 1.5) ;; 行距因子

    (defun *error* ( msg )
      (LM:endundo (LM:acdoc))
      (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
      )
      (princ)
    )

    (if (setq sel (ssget "_:L" '((0 . "TEXT"))))
      (progn
            (setq inc (sslength sel)
                  enx (entget (ssname sel (1- inc)))
                  spf (polar '(0.0 0.0) (+ (cdr (assoc 50 enx)) (/ pi 2.0)) (* (cdr (assoc 40 enx)) spf))
                  vec (trans spf (trans '(0.0 0.0 1.0) 1 0 t) 0)
            )
            (repeat inc
                (setq lst (cons (entget (ssname sel (setq inc (1- inc)))) lst)
                      ins (cons (caddr (trans (aligntext:gettextinsertion (car lst)) (cdr (assoc -1 (car lst))) vec)) ins)
                )
            )
            (setq lst (mapcar '(lambda ( n ) (nth n lst)) (vl-sort-i ins '>))
                  bpt (aligntext:gettextinsertion (car lst))
            )
            (LM:startundo (LM:acdoc))
            (foreach itm (cdr lst)
                (aligntext:puttextinsertion (setq bpt (mapcar '- bpt spf)) itm)
            )
            (LM:endundo (LM:acdoc))
      )
    )
    (princ)
)

(defun aligntext:getdxfkey ( enx )
    (if
      (and
            (zerop (cdr (assoc 72 enx)))
            (zerop (cdr (assoc 73 enx)))
      )
      10 11
    )
)

(defun aligntext:gettextinsertion ( enx )
    (cdr (assoc (aligntext:getdxfkey enx) enx))
)

(defun aligntext:puttextinsertion ( ins enx )
    (   (lambda ( key )
            (if (entmod (subst (cons key ins) (assoc key enx) enx))
                (entupd (cdr (assoc -1 enx)))
            )
      )
      (aligntext:getdxfkey enx)
    )
)

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
      (vla-endundomark doc)
    )
)

;; Active Document-Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

(vl-load-com) (princ)

;;------------------------------------------------------------;;
;;                         End of File                        ;;
;;------------------------------------------------------------;;

tgl121 发表于 2013-8-27 19:20:23

谢了，兄弟，我整了半天没编完，后来才想起来上网找找，果然有现成的

zjsmlzp 发表于 2013-8-27 20:08:57

谢谢，下载了，可以改右对齐不？

tgl121 发表于 2013-9-1 22:05:06

1#的在世界坐标系下可以正常工作，用户坐标系下就不行了，31#的程序在任何坐标系下通吃！

hnfsf 发表于 2013-9-2 02:02:01

应该加上排序就好了

wjnnan 发表于 2015-11-18 13:31:44

版主好，如果以首行文字的左对齐点为基点，再文字排序，应该如何修改啊

sjgqhg 发表于 2015-12-21 17:03:06

请问有按x轴等间距对齐的吗？谢谢

恐龙8001 发表于 2016-2-22 18:32:12

能从中学到东西，谢了

cba246 发表于 2016-5-21 11:11:24

不错，方便实用，学到知识了

15902100873 发表于 2016-5-30 20:34:40

真的非常谢谢！！！太有用了！！
页: 1 2 3 [4] 5
查看完整版本: 文本等间距对齐