给新手练手--调整行距 支持CAD文字、天正单行和多行文字、图块、天正标高等

print1985

调整行距hj，支持CAD文字、天正单行和多行文字、图块、属性字、天正标高、cad表格、cad尺寸
其中调整天正标高行距非常适合水、暖专业画系统图时，直接复制建筑立面标高来调整行距

部分代码来自论坛，感谢各位大神
技术含量不高，但是水平有限错误难免，如有问题请留言

现在明经不能上传附件 如果下面代码复制不能使用 请到晓东下载
http://bbs.xdcad.net/thread-727738-1-1.html

1. 
   
2. ;;调整行距hj 支持CAD文字、天正单行和多行文字、图块、属性字、天正标高、cad表格、cad尺寸
   
3. (setq BGhangju nil)
   
4. (defun c:hj ( / *error* a all b c e hangju1 hangju2 l m n p snap x x0 xyz xyz_new y y0 z)
   
5.   (defun *error* (msg)  ;错误处理函数
   
6.     (if snap (setvar "osmode" snap)) ;恢复捕捉
   
7.     (if (< 18 (atoi (substr (getvar "acadver") 1 2)))  ;判断CAD版本，高版本用command-s
   
8.       (command-s "undo" "e") ;CAD高版本用
   
9.       (command "undo" "e") ;低版本用
   
10.     )
    
11.     (setvar "cmdecho" 1) ;打开命令行提示
    
12.     (princ msg)
    
13.   )
    
14. 
    
15.   (if (setq a (ssget (list (cons 0 "*TEXT,DIMENSION,INSERT,ATTDEF,ACAD_TABLE,TCH_ELEVATION"))))
    
16.     (progn
    
17.       (setq n (sslength a))
    
18.       (setq m 0)
    
19.       (while (< m n)
    
20.         (setq all (append all (list (entget (ssname a m)))))
    
21.         (setq m (1+ m))
    
22.       )
    
23.       (setq l 0) ;按y坐标降序排列
    
24.       (setq m 1)
    
25.       (while (< l n)
    
26.         (setq b (nth l all))
    
27.         (while (< m n)
    
28.           (setq c (nth m all))
    
29.           (if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b)))
    
30.             (progn
    
31.               (setq all (subst 'aa (nth l all) all))
    
32.               (setq all (subst 'bb (nth m all) all))
    
33.               (setq all (subst c 'aa all))
    
34.               (setq all (subst b 'bb all))
    
35.               (setq b c)
    
36.             )
    
37.           )
    
38.           (setq m (1+ m))
    
39.         )
    
40.         (setq l (1+ l))
    
41.         (setq m (1+ l))
    
42.       )
    
43.       (setq p (cdr (assoc '10 (car all))))
    
44.       (setq hangju2 2000) ;默认行距为2000，自行修改
    
45.       (if (or (= BGhangju 0) (= BGhangju nil))
    
46.         (if (setq BGhangju (getint (strcat "\n行距<" (rtos hangju2) ">：")))
    
47.           (setq hangju2 BGhangju)
    
48.         )
    
49.         (if (setq hangju1 (getint (strcat "\n行距<" (rtos BGhangju) ">：")))
    
50.          (progn
    
51.            (setq hangju2 hangju1)
    
52.            (setq BGhangju hangju1)
    
53.          )
    
54.           (setq hangju2 BGhangju)
    
55.         )
    
56.       )
    
57.       (setq x0 (car p))
    
58.       (setq y0 (cadr p))
    
59.       (setq m 0)
    
60.       (setvar "cmdecho" 0) ;关闭命令行提示
    
61.       (vl-cmdf "undo" "be") ;命令开始标记
    
62.       (setq snap (getvar "osmode")) ;取得捕捉参数
    
63.       (setvar "osmode" 0) ;关闭捕捉
    
64.       (while (< m n)
    
65.         (setq b (nth m all))
    
66.         (setq e (cdr (assoc -1 b))) ;图原名
    
67.         (setq z (nth 3 (assoc 10 b)))
    
68.         (setq x (nth 1 (assoc 10 b)))
    
69.         (setq y (nth 2 (assoc 10 b)))
    
70.         (setq xyz (list x y z)) ;老坐标
    
71.         (setq xyz_new (list x0 y0 z)) ;新坐标
    
72.         (vl-cmdf "move" e "" xyz xyz_new) ;移动
    
73.         (setq y0 (- y0 hangju2))
    
74.         (setq m (1+ m))
    
75.       )
    
76.       (setvar "osmode" snap) ;打开捕捉
    
77.       (vl-cmdf "undo" "e") ;命令结束标记
    
78.       (setvar "cmdecho" 1) ;打开命令行提示
    
79.     )
    
80.   )
    
81.   (princ)
    
82. )

</font><font color="#000000"><br /> ;;调整行距hj 支持CAD文字、天正单行和多行文字、图块、属性字、天正标高、cad表格、cad尺寸<br /> (setq BGhangju nil)<br /> (defun c:hj ( / *error* a all b c e hangju1 hangju2 l m n p snap x x0 xyz xyz_new y y0 z) <br />   (defun *error* (msg)  ;错误处理函数<br />     (if snap (setvar "osmode" snap)) ;恢复捕捉<br />     (if (< 18 (atoi (substr (getvar "acadver") 1 2)))  ;判断CAD版本，高版本用command-s<br />       (command-s "undo" "e") ;CAD高版本用<br />       (command "undo" "e") ;低版本用<br />     )<br />     (setvar "cmdecho" 1) ;打开命令行提示<br />     (princ msg)<br />   )<br /> <br />   (if (setq a (ssget (list (cons 0 "*TEXT,DIMENSION,INSERT,ATTDEF,ACAD_TABLE,TCH_ELEVATION")))) <br />     (progn <br />       (setq n (sslength a))<br />       (setq m 0)<br />       (while (< m n) <br />         (setq all (append all (list (entget (ssname a m)))))<br />         (setq m (1+ m))<br />       )<br />       (setq l 0) ;按y坐标降序排列<br />       (setq m 1)<br />       (while (< l n) <br />         (setq b (nth l all))<br />         (while (< m n) <br />           (setq c (nth m all))<br />           (if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b))) <br />             (progn <br />               (setq all (subst 'aa (nth l all) all))<br />               (setq all (subst 'bb (nth m all) all))<br />               (setq all (subst c 'aa all))<br />               (setq all (subst b 'bb all))<br />               (setq b c)<br />             )<br />           )<br />           (setq m (1+ m))<br />         )<br />         (setq l (1+ l))<br />         (setq m (1+ l))<br />       )<br />       (setq p (cdr (assoc '10 (car all))))<br />       (setq hangju2 2000) ;默认行距为2000，自行修改<br />       (if (or (= BGhangju 0) (= BGhangju nil)) <br />         (if (setq BGhangju (getint (strcat "\n行距<" (rtos hangju2) ">："))) <br />           (setq hangju2 BGhangju)<br />         )<br />         (if (setq hangju1 (getint (strcat "\n行距<" (rtos BGhangju) ">："))) <br />          (progn<br />            (setq hangju2 hangju1)<br />            (setq BGhangju hangju1)<br />          )<br />           (setq hangju2 BGhangju)<br />         )<br />       )<br />       (setq x0 (car p))<br />       (setq y0 (cadr p))<br />       (setq m 0)<br />       (setvar "cmdecho" 0) ;关闭命令行提示<br />       (vl-cmdf "undo" "be") ;命令开始标记<br />       (setq snap (getvar "osmode")) ;取得捕捉参数<br />       (setvar "osmode" 0) ;关闭捕捉<br />       (while (< m n) <br />         (setq b (nth m all))<br />         (setq e (cdr (assoc -1 b))) ;图原名<br />         (setq z (nth 3 (assoc 10 b)))<br />         (setq x (nth 1 (assoc 10 b)))<br />         (setq y (nth 2 (assoc 10 b)))<br />         (setq xyz (list x y z)) ;老坐标<br />         (setq xyz_new (list x0 y0 z)) ;新坐标<br />         (vl-cmdf "move" e "" xyz xyz_new) ;移动<br />         (setq y0 (- y0 hangju2))<br />         (setq m (1+ m))<br />       )<br />       (setvar "osmode" snap) ;打开捕捉<br />       (vl-cmdf "undo" "e") ;命令结束标记<br />       (setvar "cmdecho" 1) ;打开命令行提示<br />     )<br />   )<br />   (princ)<br /> )

sammy

lingduwx 发表于 2021-9-17 09:43
我的字高是统一的，文字在布局之上，行距默认只能整数，行距为4稍微有点大，行距为3又稍小了点，希望能支 ...

将代码中46~49行替换为下列代码即可
        (if (setq BGhangju (getdist (strcat "\n行距<" (rtos hangju2) ">：")))
          (setq hangju2 BGhangju)
        )
        (if (setq hangju1 (getdist (strcat "\n行距<" (rtos BGhangju) ">：")))

aihuyujian

我搜天正竟然看到你 12年的提问 《请问怎样读取天正软件图纸比例》 本来想说一下 发现是12年的帖子  又看见这个帖子 你竟然还在活跃着 我也与天正斗智斗勇好几年了 写了一堆基于天正的命令玩 那个获取天正比例的命令是 (TGetPScale)  不知道现在给你说还晚不晚  我也是翻天正目录下的lisp文件自己无意间发现的 已经在好多个命令中使用了 哈哈

lingduwx

sammy 发表于 2022-7-14 15:02
将代码中46~49行替换为下列代码即可
        (if (setq BGhangju (getdist (strcat "\n行距：")))
    ...

谢谢，这下非常适合我使用了

vitalgg

这个不错，已收录
http://atlisp.cn/package-info?name=align-all&edition=stable

tigcat

阿甘大侠作品井喷啊

print1985

vitalgg 发表于 2021-3-2 22:06
这个不错，已收录
http://atlisp.cn/package-info?name=align-all&edition=stable

是插件集合管理工具？好高级的感觉 给大家介绍介绍呗

vitalgg

print1985 发表于 2021-3-3 17:08
是插件集合管理工具？好高级的感觉 给大家介绍介绍呗

这是这个网站首页的 下载 安装就可以了  http://atlisp.cn

print1985

vitalgg 发表于 2021-3-3 17:31
这是这个网站首页的 下载 安装就可以了  http://atlisp.cn

非常棒

vitalgg

print1985 发表于 2021-3-3 17:48
非常棒

你开发的程序 可以整理合并一下，发布到 @lisp .
别人就可以下载使用了。你的程序也很棒。

angel066499

有没有水平对齐的呢

海盗曹

mark一下，以备学习

f4800

支持  不错的源码