多个选择集，图元表，图元转为选择集

llsheng_73 · 发表于 2016-8-11 16:12:07

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[code=list](defun x2ss(ssl / s2es etype el ss a)
  (defun s2es(s)(reverse(mapcar'cadr(member(nth(1-(sslength s))(setq s(ssnamex s)))(reverse s)))))
  (foreach x ssl
(setq etype(type x))
(cond((= etype'ename)(setq el(cons x el)))
  ((= etype'pickset)(setq ss(cons x ss)))
  ((= etype'list)(setq el(append(vl-remove-if-not'(lambda(x)(=(type x)'ename))x)el)))))
  (setq a(if ss(last ss)(if el(ssadd))))
  (vl-every'(lambda(x)(ssadd x a))(apply'append(cons el(mapcar's2es(cdr(reverse ss))))))
  a)[/code]
QQ截图20160811160500.jpg

炫翔 · 发表于 2016-8-11 16:19:09

我替楼主格式化了

(defun x2ss (ssl / s2es etype el ss a)
(defun s2es (s)
(reverse (mapcar
'cadr
(member (nth (1- (sslength s)) (setq s (ssnamex s)))
(reverse s)
)
)
)
)
(foreach x ssl
(setq etype (type x))
(cond
((= etype 'ename)
(setq el (cons x el))
)
((= etype 'pickset)
(setq ss (cons x ss))
)
((= etype 'list)
(setq el (append
(vl-remove-if-not '(lambda (x)
(= (type x) 'ename)
) x
)
el
)
)
)
)
)
(setq a (if ss
(last ss)
(if el
(ssadd)
)
)
)
(vl-every '(lambda (x)
(ssadd x a)
) (apply
'append
(cons el (mapcar's2es (cdr (reverse ss))))
)
)
a
)

(defun x2ss (ssl / s2es etype el ss a) 
  (defun s2es (s) 
    (reverse (mapcar 
               'cadr 
               (member (nth (1- (sslength s)) (setq s (ssnamex s))) 
                       (reverse s) 
               ) 
             ) 
    ) 
  ) 
  (foreach x ssl 
    (setq etype (type x)) 
    (cond 
      ((= etype 'ename) 
        (setq el (cons x el)) 
      ) 
      ((= etype 'pickset) 
        (setq ss (cons x ss)) 
      ) 
      ((= etype 'list) 
        (setq el (append 
                   (vl-remove-if-not '(lambda (x) 
                                        (= (type x) 'ename) 
                                      ) x 
                   ) 
                   el 
                 ) 
        ) 
      ) 
    ) 
  ) 
  (setq a (if ss 
            (last ss) 
            (if el 
              (ssadd) 
            ) 
          ) 
  ) 
  (vl-every '(lambda (x) 
               (ssadd x a) 
             ) (apply 
                 'append 
                 (cons el (mapcar's2es (cdr (reverse ss)))) 
               ) 
  ) 
  a 
)

下

WhoCanSay · 发表于 2016-8-12 08:16:21

老乡呀，你是不是把简单问题复杂化了，看看俺们的ss+ Lst=>ss

llsheng_73 · 发表于 2016-8-12 10:21:15

WhoCanSay 发表于 2016-8-12 08:16
老乡呀，你是不是把简单问题复杂化了，看看俺们的ss+ Lst=>ss

看过了,很简练

yoyoho · 发表于 2017-2-3 20:01:58

感谢楼主分享程序！

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

[选择集] 多个选择集，图元表，图元转为选择集

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

浏览过的版块