给新手练手--调整行距 支持CAD文字、天正单行和多行文字、图块、天正标高等
本帖最后由 print1985 于 2021-3-2 19:59 编辑http://bbs.xdcad.net/data/attachment/forum/202103/02/194835nf3p0f23d119f0dp.gif
调整行距hj，支持CAD文字、天正单行和多行文字、图块、属性字、天正标高、cad表格、cad尺寸
其中调整天正标高行距非常适合水、暖专业画系统图时，直接复制建筑立面标高来调整行距
部分代码来自论坛，感谢各位大神
技术含量不高，但是水平有限错误难免，如有问题请留言
现在明经不能上传附件 如果下面代码复制不能使用 请到晓东下载
http://bbs.xdcad.net/thread-727738-1-1.html
;;调整行距hj 支持CAD文字、天正单行和多行文字、图块、属性字、天正标高、cad表格、cad尺寸
(setq BGhangju nil)
(defun c:hj ( / *error* a all b c e hangju1 hangju2 l m n p snap x x0 xyz xyz_new y y0 z)
(defun *error* (msg);错误处理函数
(if snap (setvar "osmode" snap)) ;恢复捕捉
(if (< 18 (atoi (substr (getvar "acadver") 1 2)));判断CAD版本，高版本用command-s
(command-s "undo" "e") ;CAD高版本用
(command "undo" "e") ;低版本用
)
(setvar "cmdecho" 1) ;打开命令行提示
(princ msg)
)
(if (setq a (ssget (list (cons 0 "*TEXT,DIMENSION,INSERT,ATTDEF,ACAD_TABLE,TCH_ELEVATION"))))
(progn
(setq n (sslength a))
(setq m 0)
(while (< m n)
(setq all (append all (list (entget (ssname a m)))))
(setq m (1+ m))
)
(setq l 0) ;按y坐标降序排列
(setq m 1)
(while (< l n)
(setq b (nth l all))
(while (< m n)
(setq c (nth m all))
(if (> (nth 2 (assoc '10 c)) (nth 2 (assoc '10 b)))
(progn
(setq all (subst 'aa (nth l all) all))
(setq all (subst 'bb (nth m all) all))
(setq all (subst c 'aa all))
(setq all (subst b 'bb all))
(setq b c)
)
)
(setq m (1+ m))
)
(setq l (1+ l))
(setq m (1+ l))
)
(setq p (cdr (assoc '10 (car all))))
(setq hangju2 2000) ;默认行距为2000，自行修改
(if (or (= BGhangju 0) (= BGhangju nil))
(if (setq BGhangju (getint (strcat "\n行距<" (rtos hangju2) ">：")))
(setq hangju2 BGhangju)
)
(if (setq hangju1 (getint (strcat "\n行距<" (rtos BGhangju) ">：")))
(progn
(setq hangju2 hangju1)
(setq BGhangju hangju1)
)
(setq hangju2 BGhangju)
)
)
(setq x0 (car p))
(setq y0 (cadr p))
(setq m 0)
(setvar "cmdecho" 0) ;关闭命令行提示
(vl-cmdf "undo" "be") ;命令开始标记
(setq snap (getvar "osmode")) ;取得捕捉参数
(setvar "osmode" 0) ;关闭捕捉
(while (< m n)
(setq b (nth m all))
(setq e (cdr (assoc -1 b))) ;图原名
(setq z (nth 3 (assoc 10 b)))
(setq x (nth 1 (assoc 10 b)))
(setq y (nth 2 (assoc 10 b)))
(setq xyz (list x y z)) ;老坐标
(setq xyz_new (list x0 y0 z)) ;新坐标
(vl-cmdf "move" e "" xyz xyz_new) ;移动
(setq y0 (- y0 hangju2))
(setq m (1+ m))
)
(setvar "osmode" snap) ;打开捕捉
(vl-cmdf "undo" "e") ;命令结束标记
(setvar "cmdecho" 1) ;打开命令行提示
)
)
(princ)
)
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) ">："))) 我搜天正竟然看到你 12年的提问 《请问怎样读取天正软件图纸比例》 本来想说一下 发现是12年的帖子又看见这个帖子 你竟然还在活跃着 我也与天正斗智斗勇好几年了 写了一堆基于天正的命令玩 那个获取天正比例的命令是 (TGetPScale)不知道现在给你说还晚不晚我也是翻天正目录下的lisp文件自己无意间发现的 已经在好多个命令中使用了 哈哈 sammy 发表于 2022-7-14 15:02
将代码中46~49行替换为下列代码即可
(if (setq BGhangju (getdist (strcat "\n行距：")))
...
谢谢，这下非常适合我使用了 本帖最后由 vitalgg 于 2021-3-2 22:25 编辑
这个不错，已收录
http://atlisp.cn/package-info?name=align-all&edition=stable
http://atlisp.cn/static/align-all.gif 阿甘大侠作品井喷啊 vitalgg 发表于 2021-3-2 22:06
这个不错，已收录
http://atlisp.cn/package-info?name=align-all&edition=stable
是插件集合管理工具？好高级的感觉 给大家介绍介绍呗 print1985 发表于 2021-3-3 17:08
是插件集合管理工具？好高级的感觉 给大家介绍介绍呗
这是这个网站首页的 下载 安装就可以了http://atlisp.cn vitalgg 发表于 2021-3-3 17:31
这是这个网站首页的 下载 安装就可以了http://atlisp.cn
非常棒 print1985 发表于 2021-3-3 17:48
非常棒
你开发的程序 可以整理合并一下，发布到 @lisp .
别人就可以下载使用了。你的程序也很棒。
有没有水平对齐的呢 mark一下，以备学习 支持不错的源码