写一个小函数_CAD中文技术交流网

写一个小函数

前几天，在院长群里看到院长说的一个问题，挺感兴趣，今天尝试写了一下，分享出来。
院长说的是
(aaa '("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" ("1" "2")) ("6" ("4" "5")))))))
→
'(("9" "7" "3" "1")
("9" "7" "3" "2")
("9" "7" "6" "4")
("9" "7" "6" "5")
("9" "8" "3" "1")
("9" "8" "3" "2")
("9" "8" "6" "4")
("9" "8" "6" "5")
)

代码如下

(defun LY:SplitBran(Var / first ret second second_1)
(cond
((= (type Var) 'LIST)
(setq first (car Var));第一个元素
(if (= (type first) 'STR)
(progn
(setq second (cadr Var))
(cond
((= (type second) 'list);第二个元素是表
(progn
(setq second_1
(vl-remove nil (mapcar '(lambda (x)
(cond
( (= (type x) 'STR)
x
)
((= (type x) 'list)
(LY:SplitBran x)
)
(t
nil
)
)
)
second
)
)
);去除nil
(setq second_1 (append second_1))
(setq Ret '())
(foreach X second_1
(if (= (type X) 'list)
(foreach Y X
(setq Ret (cons Y Ret))
)
(setq Ret (cons (list X) Ret))
)
)
(reverse (mapcar '(lambda (x)(cons first X)) Ret))
)
)
((= (type second) 'STR);第二个元素是字符
;直接原样返回
(cdr Var)
)
(t;其他情况
nil
)
)
)
(;第一个元素不是字符，就返回nil
nil
)
)
)
(t ;如果不是表，就返回nil
nil
)
)
)
(defun c:tt ()
(setq var '("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" ("1" "2")) ("6" ("4" "5")))))))
(LY:SplitBran var)
)

(defun LY:SplitBran(Var / first ret second second_1) 
(cond 
((= (type Var) 'LIST) 
(setq first (car Var));第一个元素 
(if (= (type first) 'STR) 
(progn 
(setq second (cadr Var)) 
(cond 
((= (type second) 'list);第二个元素是表 
(progn 
(setq second_1 
(vl-remove nil (mapcar '(lambda (x) 
(cond 
( (= (type x) 'STR) 
x 
) 
((= (type x) 'list) 
(LY:SplitBran x) 
) 
(t 
nil 
) 
) 
) 
second 
) 
) 
);去除nil 
(setq second_1 (append second_1)) 
(setq Ret '()) 
(foreach X second_1 
(if (= (type X) 'list) 
(foreach Y X 
(setq Ret (cons Y Ret)) 
) 
(setq Ret (cons (list X) Ret)) 
) 
) 
(reverse (mapcar '(lambda (x)(cons first X)) Ret)) 
) 
) 
((= (type second) 'STR);第二个元素是字符 
;直接原样返回 
(cdr Var) 
) 
(t;其他情况 
nil 
) 
) 
) 
(;第一个元素不是字符，就返回nil 
nil 
) 
) 
) 
(t ;如果不是表，就返回nil 
nil 
) 
) 
) 
 
(defun c:tt () 
(setq var '("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" ("1" "2")) ("6" ("4" "5"))))))) 
 
(LY:SplitBran var) 
)

网友答: 晚上在群里有大佬搞出来一个递归，几行代码就搞定了。太厉害了。

(defun tt (a)
(cond ((atom (cadr a)) (mapcar 'list a))
((atom (car a))
(mapcar '(lambda (x) (cons (car a) x)) (tt (cadr a))))
(t (apply 'append (mapcar '(lambda (x) (tt x)) a)))))

复制代码

网友答: 本帖最后由 llsheng_73 于 2024-5-20 18:25 编辑

看着简单,搞起来比较烧脑

(defun SplitBran(lst / LLS_SplitBran)
(princ"By:llsheng_73")
(defun LLS_SplitBran(l / a)
(while(not(listp(car l)))
(setq a(cons(car l)a)l(cdr l)))
(setq a(reverse a))
(mapcar(function(lambda(x)(append a x)))(car l)))
(while(and(listp(last lst))(listp(last(last lst)))(listp(last(last(last lst)))))
(or(listp(car lst))(setq lst(LLS_SplitBran lst)))
(foreach x lst
(setq lst(subst(if(and(listp x)(listp(last x))(listp(last(last x))))
(LLS_SplitBran x)(list x))x lst)))
(setq lst(apply(function append)lst)))
(apply(function append)
(mapcar(function(lambda(x / a)
(if(listp(last x))
(progn(setq a(vl-remove(last x)x))
(mapcar(function(lambda(x)(append a(list x))))(last x)))(list x))))lst)))

(SplitBran'("10"(("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" ("1" "2")) ("6" ("4" "5" "A")))))))))
=>'(("10" "9" "7" "3" "1") ("10" "9" "7" "3" "2") ("10" "9" "7" "6" "4") ("10" "9" "7" "6" "5") ("10" "9" "8" "3" "1") ("10" "9" "8" "3" "2") ("10" "9" "8" "6" "4") ("10" "9" "8" "6" "5") ("10" "9" "8" "6" "A"))
(SPLITBRAN '("10"(("9" (("7" (("3" ("1" "2")) ("6" ("4" "5")))) ("8" (("3" (("1" "2"))) ("6" (("4" "B")("5" "A"))))))))))
=>'(("10" "9" "7" "3" "1") ("10" "9" "7" "3" "2") ("10" "9" "7" "6" "4") ("10" "9" "7" "6" "5") ("10" "9" "8" "3" "1" "2") ("10" "9" "8" "6" "4" "B") ("10" "9" "8" "6" "5" "A"))

还存在BUG,后边三项都错了，正确的应该是
'(("10" "9" "7" "3" "1") ("10" "9" "7" "3" "2") ("10" "9" "7" "6" "4") ("10" "9" "7" "6" "5") ("10" "9" "8" "3" "1") ("10" "9" "8" "3" "1") ("10" "9" "8" "6" "4") ("10" "9" "8" "6" "B") ("10" "9" "8" "6" "5") ("10" "9" "8" "6" "A"))

改天再收拾

网友答: 看到都头疼

网友答: 居然在玩数组扁平化,只是lisp太麻烦了

网友答: 为啥会搞出这样的数据来？

网友答:

bskidtf 发表于 2024-5-21 00:32
晚上在群里有大佬搞出来一个递归，几行代码就搞定了。太厉害了。

我研究了半天，就是写不出来如此精妙的代码啊，大佬牛逼

网友答: 向大佬致敬，我是看不懂

网友答: 日拱一卒，学习了。

网友答:

bskidtf 发表于 2024-5-21 00:32
晚上在群里有大佬搞出来一个递归，几行代码就搞定了。太厉害了。

deepseek问了三次也有这个结果

(defun aaa (tree)
(cond
((atom tree) (list (list tree))) ; 如果是原子（叶子节点），返回包含它自身的列表
(t
(apply 'append ; 将子节点生成的所有路径列表合并
(mapcar
(function (lambda (child)
(mapcar
(function (lambda (path) (cons (car tree) path)))
(aaa child)
)
)
)
(cadr tree) ; 子节点列表
)
)
)
)
)

上一篇：bpoly 函数的应用问题

下一篇：没有了