楼梯梯段尺寸标注等式
本帖最后由 wuzhenif 于 2023-8-8 18:33 编辑介绍：这是一个可以将楼梯尺寸标注快速修改为等式的lsp，可以看一下附图演示，可以选择保留0位或1位小数，可以继承上次的设置，可以一次批量修改多个尺寸标注。
以下是源码，这是本菜鸟第一个练习程序，无偿奉献给大家，程序很简陋，欢迎批评指正。:lol
(defun c:ds (/ d1 d2)
;将L1写在/之前就会出错？因为“/”之前应该写自变量，L1不是自变量
;全局变量不用在（）内定义，不定义就默认是全局变量
;“/”后要有一个空格。
(princ
"==本程序将尺寸标注改为等式==作者：<魂之彼岸>"
)
(setvar "cmdecho" 0) ;设置系统变量：关闭命令行回显
(setq n1 (getint "\n请选择：取整;保留一位小数;按上次选择:"))
(cond
((= n1 1) ;这里用到COND条件函数
(progn
(setq d1 (getpoint "\n请指定第一个点："))
(setq d2 (getpoint "\n请指定第二个点："))
(princ "\n请选择尺寸标注：")
(setq dix (abs (- (car d1) (car d2))))
(setq diy (abs (- (cadr d1) (cadr d2))))
(setq L1 (max dix diy))
;计算两点之间的距离，并赋值给L1
(setq ss (ssget)) ;获得选择集
(setq m 0)
(repeat (sslength ss) ;获得选择集内图元数目，将数目设置为重复次数
(setq ssn (ssname ss m)) ;获得第m+1个图元的图元名,m初始为0
(setq ssdata (entget ssn)) ;获得变量ssn的值代表的图元的属性列表
;;; (setq a1 (entsel "\n选择一个对象："))
;选中一个对象，取得一个表（包含对象名称和选点坐标的列表），赋值给a1
;;; (setq a2 (entget (car a1))) ;取出a1里面的第一个子表（对象名称），然后用entget函数获得对象名称的属性列表，赋值给a2
(if (= (cdr (assoc 0 ssdata)) "DIMENSION")
;如果属性列表内包含"DIMENSION"，执行以下代码，不包含则返回nil
(progn
(setq olddi (cdr (assoc 42 ssdata)))
;取得<测量单位>的值；assoc为在属性列表中找到点对左边的关键字42，并返回子表
(setq n (/ olddi L1)) ;计算梯段数
(setq thwz (assoc 1 ssdata))
;获得属性列表内关于<文字替代>的子表
(setq zh (strcat (rtos L1 2 0) "*" (rtos n 2 0) "=<>"))
;经测试，rtos函数可以实现四舍五入
;rtos为实数转为字符串，strcat为将几个字符串合为一个字符串
(setq newdi (cons 1 zh)) ;设置一个新的子列表点对
(setq ssdata (subst newdi thwz ssdata))
;用新的子列表替换旧的子列表
(entmod ssdata) ;更新属性列表a2，并更新cad中的对象。
(setq e n1) ;将n1的值赋值给e，以备后面做选择
)
)
(setq m (1+ m))
)
)
)
((= n1 2)
(progn
(setq d1 (getpoint "\n请指定第一个点："))
(setq d2 (getpoint "\n请指定第二个点："))
(princ "\n请选择尺寸标注：")
(setq dix (abs (- (car d1) (car d2))))
(setq diy (abs (- (cadr d1) (cadr d2))))
(setq L1 (max dix diy))
;计算两点之间的距离，并赋值给L1
(setq ss (ssget)) ;获得选择集
(setq m 0)
(repeat (sslength ss) ;获得选择集内图元数目，将数目设置为重复次数
(setq ssn (ssname ss m)) ;获得第m+1个图元的图元名
(setq ssdata (entget ssn)) ;获得变量ssn的值代表的图元的属性列表
;;; (setq a1 (entsel "\n选择一个对象："))
;选中一个对象，取得一个表（包含对象名称和选点坐标的列表），赋值给a1
;;; (setq a2 (entget (car a1))) ;取出a1里面的第一个子表（对象名称），然后用entget函数获得对象名称的属性列表，赋值给a2
(if (= (cdr (assoc 0 ssdata)) "DIMENSION")
;如果属性列表内包含"DIMENSION"，执行以下代码，不包含则返回nil
(progn
(setq olddi (cdr (assoc 42 ssdata)))
;取得<测量单位>的值；assoc为在属性列表中找到点对左边的关键字42，并返回子表
(setq n (/ olddi L1)) ;计算梯段数
(setq thwz (assoc 1 ssdata))
;获得属性列表内关于<文字替代>的子表
(setq zh (strcat (rtos L1 2 1) "*" (rtos n 2 0) "=<>"))
;精度为1是保留一位小数，精度为0保留零位小数
;经测试，rtos函数可以实现四舍五入
;rtos为实数转为字符串，strcat为将几个字符串合为一个字符串
(setq newdi (cons 1 zh)) ;设置一个新的子列表点对
(setq ssdata (subst newdi thwz ssdata))
;用新的子列表替换旧的子列表
(entmod ssdata) ;更新属性列表a2，并更新cad中的对象。
(setq e n1) ;将n1的值赋值给e，以备后面做选择
)
)
(setq m (1+ m))
)
)
)
((/= n1 (or 1 2))
(progn
(if (or (= e 1) (= e 2))
(setq e1 e)
(progn
(setq e1 (getint "\n请选择：取整;保留一位小数:"))
(setq d1 (getpoint "\n请指定第一个点："))
(setq d2 (getpoint "\n请指定第二个点："))
(setq dix (abs (- (car d1) (car d2))))
(setq diy (abs (- (cadr d1) (cadr d2))))
(setq L1 (max dix diy))
(setq e e1)
;;;(setq e1 (getint "\n请选择：取整;保留一位小数;按上次选择:"))
;;; (princ "\n没有运行记录，请先选择或运行一次!!!")
;;; (exit)
)
)
(princ "\n请选择尺寸标注：")
(setq ss (ssget)) ;获得选择集
(setq m 0)
(repeat (sslength ss) ;获得选择集内图元数目，将数目设置为重复次数
(setq ssn (ssname ss m)) ;获得第m+1个图元的图元名
(setq ssdata (entget ssn)) ;获得变量ssn的值代表的图元的属性列表
;;; (setq a1 (entsel "\n选择一个对象："))
;选中一个对象，取得一个表（包含对象名称和选点坐标的列表），赋值给a1
;;; (setq a2 (entget (car a1))) ;取出a1里面的第一个子表（对象名称），然后用entget函数获得对象名称的属性列表，赋值给a2
(if (= (cdr (assoc 0 ssdata)) "DIMENSION")
;如果属性列表内包含"DIMENSION"，执行以下代码，不包含则返回nil
(progn
(setq olddi (cdr (assoc 42 ssdata)))
;取得<测量单位>的值；assoc为在属性列表中找到点对左边的关键字42，并返回子表
(setq n (/ olddi L1)) ;计算梯段数
(setq thwz (assoc 1 ssdata))
;获得属性列表内关于<文字替代>的子表
(if (= 1 e1) ;判断，这里用到了一个IF条件函数,注意到，COND选择函数里可以嵌套if选择函数
(setq zh (strcat (rtos L1 2 0) "*" (rtos n 2 0) "=<>"))
(setq zh (strcat (rtos L1 2 1) "*" (rtos n 2 0) "=<>"))
)
;经测试，rtos函数可以实现四舍五入
;rtos为实数转为字符串，strcat为将几个字符串合为一个字符串
(setq newdi (cons 1 zh)) ;设置一个新的子列表点对
(setq ssdata (subst newdi thwz ssdata))
;用新的子列表替换旧的子列表
(entmod ssdata) ;更新属性列表a2，并更新cad中的对象。
)
)
(setq m (1+ m))
)
)
)
)
(prin1)
)
====更新日志====
v1.020230617
本程序第一个版本v1.0于2023年6月17号面世，版本功能：可单选尺寸标注，修改尺寸标注为等式；踏步宽可在图中测量；可选择精度为小数点后0位或1位，可选择重复，继承上次设置及测量的踏步宽。
v1.120230618
次日版本v1.1面世，第二个版本对上一个版本进行了重大改进。
更新内容有：
1.改为可以复选，可以一次选择多个标注一次修改到位，大大提高了绘图效率；
2.改进上版本如果之前没有运行过程序，选择选项3就会出错退出程序，需要再次输入程序调用命令。此版本程序自动判断是否运行过程序，如果判断没有运行过，可以重新选择精度，继续操作，程序不会出错退出。
3.此版本除过1或2，输入任意键选择重复程序，不必固定输入3，增强程序的容错率；
4.优化程序提示，更直观易用。
***本程序的作者是<魂之彼岸>，qq：819486554。
(defun c:cc ( / tbk ss n i cljl xssz fds cljl0)
(setvar "cmdecho" 0)
(princ "\n 选择需要等式标注的标注：")
(princ)
(setq ss (ssget '((0 . "DIMENSION")))
n (sslength ss)
i 0 )
(initget "S")
(if (= (setq fds (getstring "\n 输入等分的数量[恢复标注(S)]")) "S")
(cond (
(while (< i n)
(setq cljl0 (rtos(vla-get-Measurement (Vlax-Ename->Vla-Object (ssname ss i))) 2 1))
(vla-put-TextOverride (Vlax-Ename->Vla-Object (ssname ss i)) cljl0)
(setq i (+ i 1))
)
)
)
(while (< i n)
(setq cljl (vla-get-Measurement (Vlax-Ename->Vla-Object (ssname ss i)))
)
(setq tbk (rtos (/ cljl (atof fds)) 2 1)
xssz (strcat tbk "x" fds "=" (rtos cljl 2 1)))
(vla-put-TextOverride (Vlax-Ename->Vla-Object (ssname ss i)) xssz)
(setq i (+ i 1))
)
)
(setvar "cmdecho" 1)
)
(princ "\n 加载成功! 启动命令:W_DSBZ-----BY WW \n")
本帖最后由 zhoupeng220 于 2023-10-8 11:50 编辑
谢谢分享源码，已改为自己想要的显示结果，每家公司的现场表现不同，有的显示一排，有的显示两排，希望不要介意。
如果显示结果可以修改显示格式就好了。比如：（下面是我们对应的公司现场各有各的规范要求）
是否可以优化成不需要选择1、2、3，输入命令后直接量取两点距离，且记住这次的距离值，然后选择尺寸标注。下次再用这个命令，可以再次量取新的两点距离，或者直接右键或空格调用上次量取的距离数值，然后选择尺寸标注。 NEW BEE:victory::victory: 谢谢分享！！！ 我以前弄过一个这个相似的 我也有一个相同功能:lol 你们梯柱都按300的做了啊，会不会挨骂啊 包哥 发表于 2023-8-14 15:08
你们梯柱都按300的做了啊，会不会挨骂啊
最近审图老师提的，说是通规要求的，哈哈哈 包哥 发表于 2023-8-14 15:06
我也有一个相同功能
君子所见略同啊:handshake yyz123121 发表于 2023-9-20 00:38
是否可以优化成不需要选择1、2、3，输入命令后直接量取两点距离，且记住这次的距离值，然后选择尺寸标注。 ...
很好的建议
页:
[1]
2