(XD::List:toTableValue)对按行排列的表构造Table Value

eachy · 发表于 2014-12-30 08:58:31

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

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

×

(defun XD::List:ToTableValue (lst fuzz / pts xcoord pl)
(setq pts (apply 'append (mapcar '(lambda (x) (mapcar 'caar x)) lst))
xcoord (vl-sort pts '<)
pl (list (car xcoord))
xcoord (cdr xcoord)
)
(while xcoord
(if (equal (car xcoord) (car pl) fuzz)
(setq xcoord (cdr xcoord))
(setq pl (cons (car xcoord) pl)
xcoord (cdr xcoord)
)
)
)
(setq pl (reverse pl))
(mapcar '(lambda (x)
(mapcar '(lambda (a / l)
(if (setq l
(vl-member-if
'(lambda (b)
(equal (caar b) a fuzz)
)
x
)
)
(car l)
nil
)
)
pl
)
)
lst
)
)

(defun XD::List:ToTableValue (lst fuzz / pts xcoord pl) 
  (setq        pts    (apply 'append (mapcar '(lambda (x) (mapcar 'caar x)) lst)) 
        xcoord (vl-sort pts '<) 
        pl     (list (car xcoord)) 
        xcoord (cdr xcoord) 
  ) 
  (while xcoord 
    (if        (equal (car xcoord) (car pl) fuzz) 
      (setq xcoord (cdr xcoord)) 
      (setq pl           (cons (car xcoord) pl) 
            xcoord (cdr xcoord) 
      ) 
    ) 
  ) 
  (setq pl (reverse pl)) 
  (mapcar '(lambda (x) 
             (mapcar '(lambda (a / l) 
                        (if (setq l 
                                   (vl-member-if 
                                     '(lambda (b) 
                                        (equal (caar b) a fuzz) 
                                      ) 
                                     x 
                                   ) 
                            ) 
                          (car l) 
                          nil 
                        ) 
                      ) 
                     pl 
             ) 
           ) 
          lst 
  ) 
)

测试

(defun c:tt (/ ss lst d0 d1)
(if (and (setq ss (ssget '((0 . "text"))))
(setq d0 (getdist "\n行误差: "))
(setq d1 (getdist "\n列误差: "))
)
(progn
(setq lst (mapcar '(lambda (x)
(xdrx_getpropertyvalue x "Position" "textstring")
)
(xdrx_pickset->ents ss)
)
lst (xd::list:tablesort lst 0 3 d0)
lst (XD::List:ToTableValue lst d1)
)
)
)
)

kkt123 · 发表于 2015-2-26 12:14:13

;PXD::List:toTableValue:loveliness:

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

[表] (XD::List:toTableValue)对按行排列的表构造Table Value

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