寻找线段回路
本帖最后由 kkq0305 于 2022-8-23 07:05 编辑输入线段点表，输出回路表
例：(setq lst '((0 . 1) (1 . 2) (2 . 4) (5 . 6) (6 . 1) (1 . 8) (8 . 9) (10 . 6) (6 . 2) (2 . 8) (8 . 10)))
(tt1 lst)--->>>(((6 . 10) (10 . 8) (8 . 2) (2 . 6)) ((6 . 2) (2 . 1) (1 . 6)) ((1 . 2) (2 . 8) (8 . 1)) ((1 . 8) (8 . 10) (10 . 6) (6 . 1)))
(defun tt1 (lst)
(setqlst4 (tt lst)
lst5 nil
)
(while lst4
(setq e1 (car lst4)
lst6 (list (list e1))
loop t
)
(while loop
(setq a (cdr e1)
b (cons a (car e1))
e2lst (vl-remove-if-not
'(lambda (x) (or (equal b x) (= (car x) a)))
lst4
)
e2 (car e2lst)
)
(cond ((null e2)
(if (cdr lst6)
(setq lst4 (vl-remove e1 lst4)
lst6 (if (cdar lst6)
(cons (cdar lst6) (cdr lst6))
(cdr lst6)
)
e1 (caar lst6)
)
(setq lst4 (vl-remove e1 lst4)
e1 (car lst4)
)
)
)
((assoc (cdr e2) (apply 'append lst6))
(setq lst5(cons (setq lst6 (ff2 (reverse lst6) e2)) lst5)
loopnil
)
(foreach n lst6 (setq lst4 (vl-remove n lst4)))
)
(t
(setq e1e2
lst6(cons e2lst lst6)
)
)
)
)
)
lst5
)
(defun tt (lst / lst1 lst2 lst3 lst4)
(setqlst1 (mapcar 'car lst)
lst2 (mapcar 'cdr lst)
lst3 (vl-remove-if-not '(lambda (x) (member x lst2)) lst1)
lst4 (vl-remove-if-not
'(lambda(x)
(and (member (car x) lst3) (member (cdr x) lst3))
)
lst
)
)
(append lst4
(mapcar '(lambda (x) (cons (cdr x) (car x))) lst4)
)
)
(defun ff2 (lst6 e2 / lst6 y lst1 lst2)
(setq ff (lambda (lst a)
ff函数加载顺序错了 最小围区算法，费脑；
最后FF函数代码没贴全 xuningxu 发表于 2022-8-23 15:22
最小围区算法，费脑；
最后FF函数代码没贴全
感觉不加入坐标或提前计算出“最小角”（不包含其它方向）的话，无法判断是不是最小环，纯数学只能解决到这里 ff2码不全吧
页:
[1]