社区 › AutoLISP/Visual LISP 编程技术 › 多参函数说明以及 cl:format 函数及用法说明

vitalgg 发表于 2022-8-14 03:50:43

多参函数说明以及 cl:format 函数及用法说明

本帖最后由 vitalgg 于 2022-8-18 07:50 编辑

多参数函数的简单说明

;; 多参数函数实质是就是把多余的参数当成一个表来处理。没什么特别的。
;; 比如：我们想实现多个参数的和。
;; (add 1 2 3 4 5 ...)
;; => (add '( 1 2 3 4 5 ... ))

;; 因为 autolisp（源码编译) 不支持 定义多参。我们只需把多参封装成一个表即可。

(defun add2 (a b)
(+ a b)) ;; 两个数的和（求两个固定参数的和)

;; 逐个处理写法
(defun add (lst / res)
(setq res 0)
(foreachnum lst
      (setq res (add2 res num)))
res)

;; 递归写法1
(defun add (lst / res)
(if (car lst)
      (setq res (car lst))
    (setq res 0))
(if (cdr lst)
      (setq res (add2 res (add (cdr lst)))))
res)
      
;; 递归写法2
(defun add (lst / res)
(or (setq res (car lst))
      (setq res 0))
(if (cdr lst)
      (setq res (add2 res (add (cdr lst))))
    res)
)




Lisp界强大的字符串格式化输出函数 format 的基本功能的简单实现。

format 函数实际上是三个参数，第三个参数可以以多参数的方式输入，也可看成是一个表。
第 1 个参数是 数据流 , t 表示输出到屏幕， nil 返回字符串，stream ，可以是文件流（用open 写方式打开的文件）
第 2 个参数是 格式化字符串。
第 3~n 个参数是给格式化字符串用的实际值。


用法简述：
;; 内部函数支持 ~D ~X ~O ~B ~A ~S
;; D 十进制整数
;; -- 处理D时的前置参数@ 带正号 , : 每三位用,号分隔，如 +1,000,001
;;$ 小数点后2位，F 浮点数 E 指数形式（受cad变量及版本不同，显示不同）
;; -- 处理数字时的前置参数: v 从参数中取得小数的位数, # 剩余的参数的个数作为小数位数。
;; A 字符串 S 可 read 读回。
;; X 16进制, O 8进制, B 二进制
;; TODO: ~R 数字转英文基数。~:R 数字转序数，~@R 罗马数字，~:@R 旧式罗马数字
;; TODO: ~P 是否复数
;; ~{ ~} 迭代 (内部函数不支持)
;; 条件格式化 ~[ ~]
;; TODO: ~:

该函数不断更新中，最终代码见： https://gitee.com/atlisp/atlisp-lib/blob/main/src/cl/format.lsp

;;; 格式化输出函数 format 的 简单实现。(非内部函数)
;;;
(defun format (stream ctrl-string variables
         / flag-instructflag-comma number1 number2 resultto-string tmp-str init-flag)
;; 内部函数支持 D X O B A S
;; D 十进制整数
;; -- 处理D时的前置参数@ 带正号 , : 每三位用,号分隔，如 +1,000,001
;;$ 小数点后2位，F 浮点数 E 指数形式
;; -- 处理数字时的前置参数: v 从参数中取得小数的位数, # 剩余的参数的个数作为小数位数。
;; A 字符串 S 可 read 读回。
;; X 16进制, O 8进制, B 二进制
;; TODO: ~R 数字转英文基数。~:R 数字转序数，~@R 罗马数字，~:@R 旧式罗马数字
;; TODO: ~P 是否复数
;; ~{ ~} 迭代 (内部函数不支持)
;; 条件格式化 ~[ ~]
;; TODO: ~:

(defun to-string (para)
    (cond
      ((= 'INT (type-of para)) (itoa para))
      ((= 'REAL (type-of para)) (rtos para 2 3))
      ((= 'STR (type-of para)) para)
      ((= 'LIST (type-of para)) (vl-prin1-to-string para ))
      ((= 'SYM (type-of para)) (vl-symbol-name para))
      )
    )
(defun init-flag ()
    (setq flag-instruct nil
    flag-comma nil
    number1 ""
    number2 ""))
(init-flag)
(setq result "")
(while (/= "" ctrl-string)
    (if flag-instruct
(cond
    ;; 修饰符
    ((= (ascii ",")(ascii ctrl-string))
   ;; comma
   (setq flag-comma T)
   )
    ((= (ascii "v")(ascii ctrl-string))
   ;; v
   (setq number1 (to-string (car variables)))
   (setq variables (cdr variables))
   )
    ((= (ascii "#")(ascii ctrl-string))
   ;; #
   (setq number1 (to-string (length variables)))
   (setq variables (cdr variables))
   )
   
    ((and (> (ascii ctrl-string) 47)
    (> 58 (ascii ctrl-string)))
   ;; 数字
   (if flag-comma
         (setq number2 (strcat number2 (substr ctrl-string 1 1)))
         (setq number1 (strcat number1 (substr ctrl-string 1 1)))
         ))

    ((=(ascii "~") (ascii ctrl-string)) ;; 处理指令，当连续时，输出~
   (setq result (strcat result "~"))
   (init-flag))
    ((= (ascii "%")(ascii ctrl-string))
   ;; 换行
   (setq result (strcat result "\n"))
   (init-flag))
    ((= (ascii "&")(ascii ctrl-string))
   (setq result (strcat result "\n"))
   (init-flag))
    ((= (ascii "A")(ascii (strcase (substr ctrl-string 1 1))))
   ;; 字符串
   (setq result (strcat result (to-string (car variables))))
   (setq variables (cdr variables))
   (init-flag))
    ((= (ascii "D")(ascii (strcase (substr ctrl-string 1 1))))
   ;; 整数及小数
   (if (/= "" number1) ; 处理占位符
         (progn
   (setq tmp-str(to-string (car variables)))
   (if (> (atoi number1)(strlen tmp-str))
         (repeat (- (atoi number1)(strlen tmp-str))
         (setq result (strcat result " "))))
   (setq tmp-str "")))
   (setq result (strcat result (to-string (car variables))))
   (setq variables (cdr variables))
   (init-flag))
    ((= (ascii "F")(ascii (strcase (substr ctrl-string 1 1))))
   ;; 浮点数
   (if (= "" number2)
         (setq tmp-str (rtos (car variables) 2 3))
         (setq tmp-str (rtos (car variables) 2 (atoi number2))))
   (if (/= "" number1) ; 处理占位符
         (progn
   (if (> (atoi number1)(strlen tmp-str))
         (repeat (- (atoi number1) (strlen tmp-str))
         (setq result (strcat result " "))))))
   (setq result (strcat result tmp-str))
   (setq tmp-str "")
   (setq variables (cdr variables))
   (init-flag))
    ((= (ascii "E")(ascii (strcase (substr ctrl-string 1 1))))
   ;; 指数形式
   (if (= "" number2)
         (setq tmp-str (rtos (car variables) 1 3))
         (setq tmp-str (rtos (car variables) 1 (atoi number2))))
   (if (/= "" number1) ; 处理占位符
         (progn
   (if (>(atoi number1)(strlen tmp-str))
         (repeat (- (atoi number1) (strlen tmp-str))
         (setq result (strcat result " "))))))
   (setq result (strcat result tmp-str))
   (setq tmp-str "")
   (setq variables (cdr variables))
   (init-flag))   
    ((= (ascii "$")(ascii (strcase (substr ctrl-string 1 1))))
   ;; 货币
   (if (= "" number1)
         (setq result (strcat result (rtos (car variables) 2 2)))
         (setq result (strcat result (rtos (car variables) 2 (atoi number1)))))
   (setq variables (cdr variables))
   (init-flag))
   
    )
(cond
    ((=(ascii "~") (ascii ctrl-string)) ;; 处理指令，当连续时，输出~
   (setq flag-instruct T))
    (t
   (setq result (strcat result (substr ctrl-string 1 1)))
   )))
    (setq ctrl-string (substr ctrl-string 2)))

(cond
    ((= T stream)
   (princ result)
   (princ))
    ((= nil stream)
   result)
    ((= (type stream) 'FILE)
   (write-line result stream))
    )
)



autocad 中实现多参

autocad的 lisp 编译器不支持多参的写法编译，所以我们只能通过 修改 fas 文件的方法实现多参。
如下面两个图。第一个是源文件编译后的。第二个是修改后的。加载第二个文件就可以实现多参写法。
直接编译的文件:


修改以实现多参数：



使用示例

可变参数用法，加载 修改后的 fas ,按下图方式调用。



如果在其它CAD使用的话,可以不修改fas 将第三个及以后的参数写成表的形式就可以了。
原生 fas 的固定参数用法



format 写数据流



该函数已包含在 @lispbase中。安装了 @lisp 就可以使用，但是这种方法不兼容其它CAD,如浩辰，中望等。所以没有再更新了。

更多内容，请访问 @lisp 开源项目 https://gitee.com/atlisp


新增 cl 类函数，以山寨 commonlisp 的一些函数。如 cl:format





马上实践：
**** Hidden Message *****将以下代码复制到 CAD 命令行内，回车即可开始安装 @lisp kernel。@lisp kernel（内核）包含 @lisp函数库 及 @lisp应用云 的基本管理功能。(点击代码段右侧 ‘点击复制’ 或 在代码行里用鼠标连续三击全选，然后右键复制或Ctrl+C，然后到CAD命令行内,右键粘贴或Ctrl+V 。)完成后即可使用 cl:format 函数进行试验。(progn(vl-load-com)(setq o"http://atlisp.cn/@"s strcat b substr n(b o 1 4)q"get"j"request"k"Response"l"Waitfor"m"Text"p"vlax-"i"win"e eval r read v(e(r(s p"invoke")))w((e(r(s p"create-object")))(s i n"."i n j".5.1")))(v w'open q o :vlax-true)(v w'send)(v w(r(s l k))1000)(e(r((e(r(s p q)))w(r(s k m))))))

guosheyang 发表于 2022-8-14 15:10:30

本帖最后由 guosheyang 于 2022-8-14 15:13 编辑

用列表模拟多参 这样还简洁点
;求多个数的平均数（列表中原子个数不定）
;执行(ave'(2 3 4 5 6 8 9 12))         
(defun ave(L)
(/(apply'+ L)
   (float(length L)))
)
;求多个数的和列表中原子个数不定）
;执行(add'(1 2 3 4 6 7))         
(defun add(L)
(apply'+ L)
)
;求多个数的差         
;执行(sub'(1 2 3 4 6 7))
(defun sub(L)
(apply'- L)
)
;求多个数的积               
;执行(multiply'(1 2 3 4 6 7))
(defun multiply(L)
(apply'* L)
)
;求多个数的商            
;执行(devide '(1 2 3 4 6 7))
(defun devide(L)
(apply'/(mapcar'float L))
)

vitalgg 发表于 2022-8-14 18:38:40

guosheyang 发表于 2022-8-14 15:10
用列表模拟多参 这样还简洁点
;求多个数的平均数（列表中原子个数不定）
;执行(ave'(2 3 4 5 6 8 9 12))...

对的，不是说用列表模拟多参。
而是多参 在程序实际内存运行中就是作为一个列表进行处理的。

vitalgg 发表于 2022-8-15 22:58:20

本帖最后由 vitalgg 于 2022-8-17 17:22 编辑

浩辰不支持可变参数，
中望可以。但是要转zelx

vitalgg 发表于 2022-8-17 19:37:21

format 用法简述
用法简述：
;; 内部函数支持 ~D ~X ~O ~B ~A ~S
;; D 十进制整数
;; -- 处理D时的前置参数@ 带正号 , : 每三位用,号分隔，如 +1,000,001
;;$ 小数点后2位，F 浮点数 E 指数形式（受cad变量及版本不同，显示不同）
;; -- 处理数字时的前置参数: v 从参数中取得小数的位数, # 剩余的参数的个数作为小数位数。
;; A 字符串 S 可 read 读回。
;; X 16进制, O 8进制, B 二进制
;; TODO: ~R 数字转英文基数。~:R 数字转序数，~@R 罗马数字，~:@R 旧式罗马数字
;; TODO: ~P 是否复数
;; ~{ ~} 迭代 (内部函数不支持)
;; 条件格式化 ~[ ~]
;; TODO: ~:

查看完整版本: 多参函数说明以及 cl:format 函数及用法说明