社区 › AutoLISP/Visual LISP 编程技术 › 单行文字对齐

幽兰聆雨 发表于 2024-7-17 13:00:13

单行文字对齐

之前学AutoLisp的时候搞的小插件，转C#，分享一下。


功能：选择单行文字，输入间距/回车，横/竖向对齐文字。
;---------------------------------------------------------------------;
;已完成，勿动(-_-!)
;根据参数返回点列表按某一坐标轴排序，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 ":L" '((0 . "TEXT"))) (getpoint "\n指定对齐点：") (getreal"\n指定间距:"))
    (pzj:dqth (ssget ":L" '((0 . "TEXT"))) (getpoint "\n指定对齐点：") (getreal"\n指定间距:"))
)
(princ)
)
;---------------------------------------------------------------------;

幽兰聆雨 发表于 2024-12-8 13:10:09

开心无惧 发表于 2024-11-22 16:16
请问下 选择对象时 选择不到任何图形是什么原因？

只能单行文字对齐，可能你的是多行文字

开心无惧 发表于 2024-12-10 10:28:53

幽兰聆雨 发表于 2024-12-8 13:10
只能单行文字对齐，可能你的是多行文字

我检查一下非常感谢

开心无惧 发表于 2024-11-22 16:16:00

请问下 选择对象时 选择不到任何图形是什么原因？

lxl217114 发表于 2024-7-17 13:56:28

谢谢分享，666

gble119 发表于 2024-7-17 14:01:37

多谢分享，支持源码

p-3-ianlcc 发表于 2024-7-17 14:23:25

谢谢分享源码～
下载来试试看

MZ_li 发表于 2024-7-17 15:29:52

谢谢分享，学习

paulpipi 发表于 2024-7-17 16:02:30

非常厉害，感谢分享

中国梦 发表于 2024-7-18 20:54:40

好东西，谢谢分享

zhengchuan 发表于 2024-7-19 14:14:59

非常厉害，感谢分享

taiwanfox 发表于 2024-7-24 14:54:34

好東西，謝謝分享，感謝!!!

yk1216 发表于 2024-8-30 23:16:25

好东西，学习了

查看完整版本: 单行文字对齐