cad lisp脚本 修改

Posted 2023-05-17

以下这段脚本功能是 抓去选择区域内的 单行文字内的阿拉伯数字 进行求和运算，现在我想改成 抓去 选择区域内的 对齐标注 内的阿拉伯数字 进行求和运算，求改好的 lisp

(DEFUN C:J()
(PROGN
(PRINC "\n请您选取要求和的数字：)")
(SETQ S选择集 (SSGET '((0 . "text")) ))
(SETQ T文字个数 (SSLENGTH S选择集))
(SETQ ZS总数和 0)
(SETQ X 0)
(SETQ Y 0)
(SETQ Z 0)
(SETQ 提示有非数字字符的的文本 "")
(REPEAT T文字个数
(SETQ TEMP临时值 (READ (CDR (ASSOC 1 (ENTGET (SSNAME S选择集 X))))));;
(IF (OR (= (QUOTE REAL) (TYPE TEMP临时值)) (= (QUOTE INT) (TYPE TEMP临时值)))
(PROGN (SETQ Y (+ Y 1))(SETQ ZS总数和 (+ ZS总数和 (FLOAT TEMP临时值)) ))
(PROGN (SETQ Z (+ Z 1))
(SETQ 提示有非数字字符的的文本 (STRCAT "有 " (RTOS Z 2 0) " 个文本因是非数字而不能参与相加，\n\n"))
);END OF PROGN
);END OF IF
(setq x (+ x 1))
);END OF REPEAT
(PRINC (STRCAT "共选择了 " (RTOS T文字个数 2 0) " 个文本，\n" 提示有非数字字符的的文本 "共有 " (RTOS Y 2 0) " 个有效数字参与了相加，总和为：" (RTOS ZS总数和 2) "\n"))
(PRINC)
(ALERT (STRCAT "共有 " (RTOS Y 2 0) " 个有效数参与了相加，总和为：" (RTOS ZS总数和 2)"\n\n温馨提示：\n\n请您核对一下所选有效数字的个数：)"))
);ENF OF PROGN 原命令
);END OF DEFUN

(DEFUN C:J()
(PRINC "\n请您选取要求和的标注:)")
(SETQ S选择集 (SSGET '((0 . "DIMENSION")))m 0
T标注个数(sslength S选择集)ZS总数和 0 T对齐标注 0)
(while(< m T标注个数)
(setq a(entget(ssname S选择集 m))m(1+ m))
(if(member(cdr(assoc 70 a))'(1 33 129 161))
(setq ZS总数和(+(cdr(assoc 42 a))ZS总数和)
T对齐标注(1+ T对齐标注)))
)
(PRINC (STRCAT "共选择了 "(itoa T标注个数)" 个标注，\n共有 " (itoa T对齐标注)"个对齐标注参与了相加，总和为：" (RTOS ZS总数和 2) "\n"))
);END OF DEFUN追问

替换哪一部分 还是 单独一个脚本？

追答

整个吧，你原来那个文件我实在看得头痛了

追问

C:J() 这个 是 命令行 入口吧 我把 J改成其他的 就是 键入其他 进入脚本吧

追答

把C:J()中的J改成其它的比如A，就成了C:A(),C:和(之间是什么，在命令行就输入什么

追问

不知道你测试了没有 我这里好像不起作用。 可能少了点什么。

参考技术A 好久没看LISP了，都忘记的差不多了追问

我觉得就改个几行 或者几个 字段的问题。 实在不行我自己研究了。

参考技术B 真怀恋那一大堆括号~~ 参考技术C 你得找个专业的人员弄啊！追问

不难的 会 lisp 的 就是 改个几行就得了。

lisp编程提示参数太多

;(错误: 参数太少)
(defun c:gxcnew()
(vl-load-com)
(setq ss (ssget))
(setq dx (getstring "请输入线径:"))
(setq gs (getint "请输入导线根数:"))
(setq gd (getstring "请输入管径:"))
(setq hs (getint "请输入户数:"))
(setq lg 0) ;立管
(setq pg 0);平管
(setq i 0)
(repeat (sslength ss)
(setq zbj (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss i)) 'Coordinates ))
(setq lg (+ lg (- (* (nth 5 zbj) 2) (nth 2 zbj) (nth 11 zbj))))
(setq pg (+ pg (distance (list (nth 0) (nth 1)) (list (nth 9) (nth 10)))))
(setq i (1+ i))
)
(print (strcat gd (rtos (* hs (+ lg pg)))))
(print (strcat dx (rtos (* gs hs (+ lg pg)))))
(print (strcat "剔槽" (tros (* hs lg))))
(print 以上数据不含预留长度)
(princ)
)

;(list (nth 0) (nth 1)) (list (nth 9) (nth 10))
;nth 后面要2个参数
;(print 以上数据不含预留长度) 要字符串 你没加双引号

;(setq gx (+ gx (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss i) 'Length ))))
;应改为如下.
(setq gx (+ gx (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss i)) 'Length )))
;(setq pmcd (+ pmcd (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss i) 'Length ))))
;应改为如下.
(setq pmcd (+ pmcd (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss i)) 'Length )))追问

我改正以后,出现"错误: 参数太少"
再请大师指点,多谢!

追答

;利用三维电气管线图求管线槽长度(错误: 参数太少)
(defun c:gxcnew()
(vl-load-com)
(setq ss (ssget))
(setq dx (getstring "请输入线径:"))
(setq gs (getint "请输入导线根数:"))
(setq gd (getstring "请输入管径:"))
(setq hs (getint "请输入户数:"))
(setq lg 0) ;立管
(setq pg 0);平管
(setq i 0)
(repeat (sslength ss)
(setq zbj (Vlax-Get (Vlax-Ename->Vla-Object (ssname ss i)) 'Coordinates ))
;如果zbj中元素个数小于6，则(nth 5 zbj)会出错
;如果zbj中元素个数小于11，则(nth 10 zbj)会出错，...
(setq lg (+ lg (- (* (nth 5 zbj) 2) (nth 2 zbj) (nth 11 zbj))))
;(nth 0 参数) (nth 1 参数) (nth 9 参数) (nth 10 参数)
(setq pg (+ pg (distance (list (nth 0) (nth 1)) (list (nth 9) (nth 10)))))
(setq i (1+ i))
)
(print (strcat gd (rtos (* hs (+ lg pg)))))
(print (strcat dx (rtos (* gs hs (+ lg pg)))))
(print (strcat "剔槽" (rtos (* hs lg))))
;(print 以上数据不含预留长度)
;改为如下：
(print "以上数据不含预留长度")
(princ)
)

追问

非常非常地感谢大师的帮助，多谢了！

参考技术A (print (strcat 剔槽 (rtos tc)))
剔槽---"剔槽"追问

大师回答非常好,但,我改正以后,出现"错误: 参数太少"
再请大师指点,多谢!