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

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

本帖最后由 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)
(foreach num 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: ~:[FAIL~;pass~]

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

;;; 格式化输出函数 format 的简单实现。(非内部函数)
;;;
(defun format (stream ctrl-string variables
/ flag-instruct flag-comma number1 number2 result to-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: ~:[FAIL~;pass~]
(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))
)
)

;;; 格式化输出函数 format 的 简单实现。(非内部函数) 
;;;   
(defun format (stream ctrl-string variables 
         / flag-instruct  flag-comma number1 number2 result  to-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 罗马数字，~<img src="static/image/smiley/default/huffy.gif" smilieid="5" border="0" alt="" />R 旧式罗马数字 
  ;; TODO: ~P 是否复数 
  ;; ~{ ~} 迭代 (内部函数不支持) 
  ;; 条件格式化 ~[ ~] 
  ;; TODO: ~:[FAIL~;pass~] 
 
  (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 写数据流

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

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

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

马上实践：

他们说：有遮挡更性感。

将以下代码复制到 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

本帖最后由 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

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

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

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

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

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

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

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: ~:[FAIL~;pass~]

账号		自动登录	找回密码
密码			注册

[讨论] 多参函数说明以及 cl:format 函数及用法说明

本帖子中包含更多资源

评分

浏览过的版块