明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
楼主: xiaxiang

[资源] 文本等间距对齐

    [复制链接]
发表于 2013-8-15 20:24 | 显示全部楼层
李麦克的代码也挺好用。
(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                        ;;
;;------------------------------------------------------------;;
发表于 2013-8-27 19:20 | 显示全部楼层
谢了,兄弟,我整了半天没编完,后来才想起来上网找找,果然有现成的
发表于 2013-8-27 20:08 | 显示全部楼层
谢谢,下载了,可以改右对齐不?
发表于 2013-9-1 22:05 | 显示全部楼层
1#的在世界坐标系下可以正常工作,用户坐标系下就不行了,31#的程序在任何坐标系下通吃!
发表于 2013-9-2 02:02 | 显示全部楼层
应该加上排序就好了
发表于 2015-11-18 13:31 | 显示全部楼层
版主好,如果以首行文字的左对齐点为基点,再文字排序,应该如何修改啊
发表于 2015-12-21 17:03 | 显示全部楼层
请问有按x轴等间距对齐的吗?谢谢
发表于 2016-2-22 18:32 | 显示全部楼层
  能从中学到东西,谢了
发表于 2016-5-21 11:11 | 显示全部楼层
不错,方便实用,学到知识了
发表于 2016-5-30 20:34 | 显示全部楼层
真的非常谢谢!!!太有用了!!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-28 17:21 , Processed in 0.156353 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表