对以点为索引的表排行列

eachy · 发表于 2013-12-6 09:21:30

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

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

×

本函数为全部重写，效率大幅提升，初步测试 3.4W 点排序部分用时 2.x s，较原来函数提升约 4 倍，原函数为 (ybl-ent-sort 、XD::List:TableSort)，参见
http://bbs.xdcad.net/forum.php?mod=viewthread&tid=669129
;;======================================
;;;调用: (Ea::List:TableSort lst row bp fuzz)
;;;功能: 对点索引子表按点坐标排行列
;;;输入: lst -- list eq. ((p1 data1) (p2 data2) .... )
;;;    row -- 0 row ; 1 column
;;;    bp  -- Basepoint, 0 BottomLeft; 1 BottomRight; 2 TopRight;  3 TopLeft
;;;    fuzz -- Real or int (容差)
;;;输出: 排行列后的表
;;;注意: 参数的合理性自行检查
;;=======================================

游客，本帖隐藏的内容需要积分高于 30 才可浏览，您当前积分为 0

eachy · 发表于 2013-12-6 09:27:13

几个测试程序
XD::Pickset->TableSort 因为有求 EntityBox，在数量巨大的情况机器不够好的情况下可能会停止响应！

;;================================================================================
;;Sample
(defun ss->ents (ss / sl i el)
(setq i -1)
(while (setq e (ssname ss (setq i (1+ i))))
(setq el (cons e el))
)
el
)
(defun Getpoints (ss /)
(mapcar '(lambda (x)
(list (cdr (assoc 10 (entget x))) x)
)
(ss->ents ss)
)
)
(defun Polyline:Make (pts tf)
(entmakex (append '((0 . "LWPOLYLINE")
(100 . "AcDbEntity")
(100 . "AcDbPolyline")
)
(list (cons 90 (1- (length pts)))
(if tf
'(70 . 1)
'(70 . 0)
)
)
(mapcar '(lambda (x)
(list 10 (car x) (cadr x))
)
pts
)
)
)
)
(defun get-utime ()
(* 86400.0 (getvar "tdusrtimer"))
)
;;==========================================================================
;;test1
(defun c:t1 (/ ss sl i e el lst t0 t1 t00)
(if (setq ss (ssget '((0 . "point"))))
(progn
(setq t00 (get-utime))
(setq lst (getpoints ss))
(princ "\n")
(princ "\nGet Points Used time = ")
(princ (- (get-utime) t00))
(setq t0 (get-utime))
(setq lst (Ea::List:TableSort lst 0 0 150.))
;;(ybl-ent-sort el 0 1 150.)
(princ "\nTableSort Used time = ")
(princ (- (setq t1 (get-utime)) t0))
(princ "\nTotle Used Time = ")
(princ (- t1 t00))
(mapcar '(lambda (x)
(if (> (length x) 1)
(polyline:make x)
)
)
(mapcar '(lambda (a) (mapcar 'car a)) lst)
)
(princ "\nMake Pline used time = ")
(princ (- (get-utime) t1))
)
)
(princ)
)
;;test2
(defun c:t3 (/ ss sl i e el lst t0 t1 t00)
(if (setq ss (ssget '((0 . "point"))))
(progn
(setq t00 (get-utime))
(setq lst (getpoints ss))
(princ "\n")
(princ "\nGet Points Used time = ")
(princ (- (get-utime) t00))
(setq t0 (get-utime))
;;(setq lst (Ea::List:TableSort el 0 0 150.))
(setq lst (XD::List:TableSort lst 0 1 150.))
(princ "\nTableSort Used time = ")
(princ (- (setq t1 (get-utime)) t0))
(princ "\nTotle Used Time = ")
(princ (- t1 t00))
(mapcar '(lambda (x)
(if (> (length x) 1)
(polyline:make x)
)
)
(mapcar '(lambda (a) (mapcar 'car a)) lst)
)
(princ "\nMake Pline used time = ")
(princ (- (get-utime) t1))
)
)
(princ)
)
;;test3
(defun c:t3 (/ ss sl i e el lst t0 t1 t00)
(if (setq ss (ssget '((0 . "point"))))
(progn
(setq t00 (get-utime))
(setq lst (XD::Pickset->TableSort ss 0 1 '< '<))
(princ "\nTableSort Used time = ")
(princ (- (setq t1 (get-utime)) t0))
(princ "\nTotle Used Time = ")
(princ (- t1 t00))
(mapcar '(lambda (x)
(if (> (length x) 1)
(polyline:make x)
)
)
(mapcar '(lambda (a) (xdrx_getpropertyvalue a "Position")) lst)
)
(princ "\nMake Pline used time = ")
(princ (- (get-utime) t1))
)
)
(princ)
)

;;================================================================================ 
;;Sample 
(defun ss->ents        (ss / sl i el) 
  (setq i -1) 
  (while (setq e (ssname ss (setq i (1+ i)))) 
    (setq el (cons e el)) 
  ) 
  el 
) 
(defun Getpoints        (ss /) 
  (mapcar '(lambda (x) 
             (list (cdr (assoc 10 (entget x))) x) 
           ) 
          (ss->ents ss) 
  ) 
) 
(defun Polyline:Make (pts tf) 
  (entmakex (append '((0 . "LWPOLYLINE") 
                      (100 . "AcDbEntity") 
                      (100 . "AcDbPolyline") 
                     ) 
                    (list (cons 90 (1- (length pts))) 
                          (if tf 
                            '(70 . 1) 
                            '(70 . 0) 
                          ) 
                    ) 
                    (mapcar '(lambda (x) 
                               (list 10 (car x) (cadr x)) 
                             ) 
                            pts 
                    ) 
            ) 
  ) 
) 
(defun get-utime () 
  (* 86400.0 (getvar "tdusrtimer")) 
) 
;;========================================================================== 
;;test1 
(defun c:t1 (/ ss sl i e el lst t0 t1 t00) 
  (if (setq ss (ssget '((0 . "point")))) 
    (progn 
      (setq t00 (get-utime)) 
      (setq lst (getpoints ss)) 
      (princ "\n") 
      (princ "\nGet Points Used time = ") 
      (princ (- (get-utime) t00)) 
      (setq t0 (get-utime)) 
      (setq lst (Ea::List:TableSort lst 0 0 150.)) 
      ;;(ybl-ent-sort el 0 1 150.) 
      (princ "\nTableSort Used time = ") 
      (princ (- (setq t1 (get-utime)) t0)) 
      (princ "\nTotle Used Time = ") 
      (princ (- t1 t00)) 
      (mapcar '(lambda (x) 
                 (if (> (length x) 1) 
                   (polyline:make x) 
                 ) 
               ) 
              (mapcar '(lambda (a) (mapcar 'car a)) lst) 
      ) 
      (princ "\nMake Pline used time = ") 
      (princ (- (get-utime) t1)) 
    ) 
  ) 
  (princ) 
) 
;;test2 
(defun c:t3 (/ ss sl i e el lst t0 t1 t00) 
  (if (setq ss (ssget '((0 . "point")))) 
    (progn 
      (setq t00 (get-utime)) 
      (setq lst (getpoints ss)) 
      (princ "\n") 
      (princ "\nGet Points Used time = ") 
      (princ (- (get-utime) t00)) 
      (setq t0 (get-utime)) 
      ;;(setq lst (Ea::List:TableSort el 0 0 150.)) 
      (setq lst (XD::List:TableSort lst 0 1 150.)) 
      (princ "\nTableSort Used time = ") 
      (princ (- (setq t1 (get-utime)) t0)) 
      (princ "\nTotle Used Time = ") 
      (princ (- t1 t00)) 
      (mapcar '(lambda (x) 
                 (if (> (length x) 1) 
                   (polyline:make x) 
                 ) 
               ) 
              (mapcar '(lambda (a) (mapcar 'car a)) lst) 
      ) 
      (princ "\nMake Pline used time = ") 
      (princ (- (get-utime) t1)) 
    ) 
  ) 
  (princ) 
) 
;;test3 
(defun c:t3 (/ ss sl i e el lst t0 t1 t00) 
  (if (setq ss (ssget '((0 . "point")))) 
    (progn 
      (setq t00 (get-utime)) 
      (setq lst (XD::Pickset->TableSort ss 0 1 '< '<)) 
      (princ "\nTableSort Used time = ") 
      (princ (- (setq t1 (get-utime)) t0)) 
      (princ "\nTotle Used Time = ") 
      (princ (- t1 t00)) 
      (mapcar '(lambda (x) 
                 (if (> (length x) 1) 
                   (polyline:make x) 
                 ) 
               ) 
              (mapcar '(lambda (a) (xdrx_getpropertyvalue a "Position")) lst) 
      ) 
      (princ "\nMake Pline used time = ") 
      (princ (- (get-utime) t1)) 
    ) 
  ) 
  (princ) 
)

newer · 发表于 2013-12-6 09:43:50

eachy 发表于 2013-12-6 09:27
几个测试程序
XD:ickset->TableSort 因为有求 EntityBox，在数量巨大的情况机器不够好的情况下可能会停 ...

应用场合各有不同吧，PICKSET_TABLESORT处理实体的。

st788796 · 发表于 2013-12-6 10:15:57

newer 发表于 2013-12-6 09:43
应用场合各有不同吧，PICKSET_TABLESORT处理实体的。

这个函数仅保留了核心的排序部分，构造表要自己另作，而且取点不同可以有不同的应用，更通用，不过构造这个点索引表要有很高的技巧

XDSoft · 发表于 2013-12-6 10:26:13

st788796 发表于 2013-12-6 10:15
这个函数仅保留了核心的排序部分，构造表要自己另作，而且取点不同可以有不同的应用，更通用，不过构造这 ...

各种情况多写些例子给大家吧，另外做个函数发布吧。

eachy · 发表于 2013-12-6 10:35:05

这个和原来的 XD::List:TableSort 基本功能一样，去掉了其他方式，仅保留了点索引模式，其他方式分组使用 XD::List:GroupByIndex ，这两个函数适用不同场合，可以解决分组、排列的大部分应用，有时间把这两个函数应用做个汇总帖子

炫翔 · 发表于 2013-12-6 15:40:38

本帖最后由炫翔于 2013-12-6 15:53 编辑

;根据圆心Y值,分组连线
(defun c:xx1 (/ i pts s1 ss)
(setq ss (ssget '((0 . "circle"))))
(setq i (sslength ss))
(while (setq s1 (ssname ss (setq i (1- i))))
(setq pts (cons (list (cdr (assoc 10 (entget s1))) s1) pts))
)
(setq pts (Ea::List:TableSort pts 0 0 0.01))
(mapcar '(lambda (x)
(if (> (length x) 1)(polyline:make x t)))
(mapcar '(lambda (a)(mapcar 'car a))pts)
)
)

炫翔 · 发表于 2013-12-6 16:12:27

;根据圆心Y值,分组改颜色
(defun c:xx ( / i lst s1 ss)
(setq ss (ssget '((0 . "circle"))))
(setq i (sslength ss))
(while (setq s1 (ssname ss (setq i (1- i))))
(setq lst (cons (list (cdr (assoc 10 (entget s1))) s1) lst))
)
(setq lst (ea::list:tablesort lst 0 0 0.01))
(foreach x (mapcar '(lambda (a)(mapcar 'cadr a))lst)
(setq i 1)
(foreach y x
(vla-put-color (vlax-ename->vla-object y) (setq i(1+ i)))
)
)
)

eachy · 发表于 2013-12-6 16:57:01

更正几处错误, 验证程序

(defun c:t1 (/ ss sl i e el lst t0 t1 t00 i)
(if (setq ss (ssget '((0 . "point"))))
(progn
(setq t00 (get-utime))
(setq lst (getpoints ss))
(princ "\n")
(princ "\nGet Points Used time = ")
(princ (- (get-utime) t00))
(setq t0 (get-utime))
(setq lst (Ea::List:TableSort lst 0 0 0.1))
;;(ybl-ent-sort el 0 1 150.)
(princ "\nTableSort Used time = ")
(princ (- (setq t1 (get-utime)) t0))
(princ "\nTotle Used Time = ")
(princ (- t1 t00))
(setq i 1)
(polyline:make
(apply
'append
(mapcar '(lambda (x)
(if (zerop i)
(progn
(setq i (1+ i))
(reverse x)
)
(progn
(setq i (1- i))
x
)
)
)
(mapcar '(lambda (a) (mapcar 'car a)) lst)
)
)
nil
)
(princ "\nMake Pline used time = ")
(princ (- (get-utime) t1))
)
)
(princ)
)

(defun c:t1 (/ ss sl i e el lst t0 t1 t00 i) 
  (if (setq ss (ssget '((0 . "point")))) 
    (progn 
      (setq t00 (get-utime)) 
      (setq lst (getpoints ss)) 
      (princ "\n") 
      (princ "\nGet Points Used time = ") 
      (princ (- (get-utime) t00)) 
      (setq t0 (get-utime)) 
      (setq lst (Ea::List:TableSort lst 0 0 0.1)) 
      ;;(ybl-ent-sort el 0 1 150.) 
      (princ "\nTableSort Used time = ") 
      (princ (- (setq t1 (get-utime)) t0)) 
      (princ "\nTotle Used Time = ") 
      (princ (- t1 t00)) 
      (setq i 1) 
      (polyline:make 
        (apply 
          'append 
          (mapcar '(lambda (x) 
                     (if (zerop i) 
                       (progn 
                         (setq i (1+ i)) 
                         (reverse x) 
                       ) 
                       (progn 
                         (setq i (1- i)) 
                         x 
                       ) 
                     ) 
                   ) 
                  (mapcar '(lambda (a) (mapcar 'car a)) lst) 
          ) 
        ) 
        nil 
      ) 
      (princ "\nMake Pline used time = ") 
      (princ (- (get-utime) t1)) 
    ) 
  ) 
  (princ) 
)

炫翔 · 发表于 2013-12-6 17:24:43

本帖最后由炫翔于 2013-12-6 17:29 编辑

;根据圆心X值,分组改颜色
(defun c:xx ( / i lst s1 ss)
(setq ss (ssget '((0 . "circle"))))
(setq i (sslength ss))
(while (setq s1 (ssname ss (setq i (1- i))))
(setq lst (cons (list (cdr (assoc 10 (entget s1))) s1) lst))
)
(setq lst (ea::list:tablesort lst 1 0 0.01))
(foreach x (mapcar '(lambda (a)(mapcar 'cadr a))lst)
(setq i 1)
(foreach y x
(vla-put-color (vlax-ename->vla-object y) (setq i(1+ i)))
)
)
)
;根据圆心X值,分组连线
(defun c:xx (/ i pts s1 ss)
(setq ss (ssget '((0 . "circle"))))
(setq i (sslength ss))
(while (setq s1 (ssname ss (setq i (1- i))))
(setq pts (cons (list (cdr (assoc 10 (entget s1))) s1) pts))
)
(setq pts (Ea::List:TableSort pts 1 0 0.01))
(mapcar '(lambda (x)
(if (> (length x) 1)(polyline:make x t)))
(mapcar '(lambda (a)(mapcar 'car a))pts)
)
)

eachy · 发表于 2013-12-6 19:37:12

终版，验证程序

(defun c:t1 (/ ss sl i e el lst t0 t1 t00 i pts ms)
(if (setq ss (ssget '((0 . "point"))))
(progn
(setq t00 (get-utime))
(setq lst (getpoints ss))
(princ "\n")
(princ "\nGet Points Used time = ")
(princ (- (get-utime) t00))
(setq t0 (get-utime))
(setq lst (Ea::List:TableSort lst 1 3 0.1))
;;(ybl-ent-sort el 0 1 150.)
(princ "\nTableSort Used time = ")
(princ (- (setq t1 (get-utime)) t0))
(princ "\nTotle Used Time = ")
(princ (- t1 t00))
(setq i 1)
(polyline:make
(setq pts (apply
'append
(mapcar '(lambda (x)
(if (zerop i)
(progn
(setq i (1+ i))
(reverse x)
)
(progn
(setq i (1- i))
x
)
)
)
(mapcar '(lambda (a) (mapcar 'car a)) lst)
)
)
)
nil
)
(princ "\nMake Pline used time = ")
(setq i 0
ms (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
)
(mapcar '(lambda (x)
(vla-addtext
ms
(itoa i)
(vlax-3d-point x)
(getvar "textsize")
)
(setq i (1+ i))
)
pts
)
(princ (- (get-utime) t1))
)
)
(princ)
)

(defun c:t1 (/ ss sl i e el lst t0 t1 t00 i pts ms) 
  (if (setq ss (ssget '((0 . "point")))) 
    (progn 
      (setq t00 (get-utime)) 
      (setq lst (getpoints ss)) 
      (princ "\n") 
      (princ "\nGet Points Used time = ") 
      (princ (- (get-utime) t00)) 
      (setq t0 (get-utime)) 
      (setq lst (Ea::List:TableSort lst 1 3 0.1)) 
      ;;(ybl-ent-sort el 0 1 150.) 
      (princ "\nTableSort Used time = ") 
      (princ (- (setq t1 (get-utime)) t0)) 
      (princ "\nTotle Used Time = ") 
      (princ (- t1 t00)) 
      (setq i 1) 
      (polyline:make 
        (setq pts (apply 
                    'append 
                    (mapcar '(lambda (x) 
                               (if (zerop i) 
                                 (progn 
                                   (setq i (1+ i)) 
                                   (reverse x) 
                                 ) 
                                 (progn 
                                   (setq i (1- i)) 
                                   x 
                                 ) 
                               ) 
                             ) 
                            (mapcar '(lambda (a) (mapcar 'car a)) lst) 
                    ) 
                  ) 
        ) 
        nil 
      ) 
      (princ "\nMake Pline used time = ") 
      (setq i  0 
            ms (vla-get-modelspace 
                 (vla-get-activedocument (vlax-get-acad-object)) 
               ) 
      ) 
      (mapcar '(lambda (x) 
                 (vla-addtext 
                   ms 
                   (itoa i) 
                   (vlax-3d-point x) 
                   (getvar "textsize") 
                 ) 
                 (setq i (1+ i)) 
               ) 
              pts 
      ) 
      (princ (- (get-utime) t1)) 
    ) 
  ) 
  (princ) 
)

Free-Lancer · 发表于 2013-12-7 01:31:47

本帖最后由 Free-Lancer 于 2013-12-7 01:57 编辑

一楼有个笔误 (lambda (e1 e2) (< (cadar e1) (cadar e1))) 应为 (lambda (e1 e2) (< (cadar e1) (cadar e2)))
八种基本方式之一

(defun c:tt (/ ss ss1 pts i h npts pl)
(if (setq ss (ssget '((0 . "line"))))
(progn
(setq ss1
(xdrx_curve_intersectbreak
(xdrx_entity_transformedcopy ss (xdrx_matrix_identity 3))
);_副本交点断开
)
(setq pts (cdr
(vl-sort (xdrx_geom_searchregions ss1);_查找联通区域
'(lambda (l1 l2)
(> (apply 'xdrx_points_area l1)
(apply 'xdrx_points_area l2)
)
)
);_按面积排序
);_去掉最外围框
pts (mapcar '(lambda (p)
(list (apply 'xdrx_points_centroid p) 0)
)
pts
);_取每个区域中心
)
(xdrx_entity_delete ss1);_删除副本
;;按行排
(setq npts (XD::List:TableSort pts 0 0 1.))
;;(setq npts (XD::List:TableSort pts 0 1 1.))
;;(setq npts (XD::List:TableSort pts 0 2 1.))
;;(setq npts (XD::List:TableSort pts 0 3 1.))
;;按列排
;;(setq npts (XD::List:TableSort pts 1 0 1.))
;;(setq npts (XD::List:TableSort pts 1 1 1.))
;;(setq npts (XD::List:TableSort pts 1 2 1.))
;;(setq npts (XD::List:TableSort pts 1 3 1.))
(setq i 1
h (getvar "textsize")
)
(mapcar '(lambda (x)
(mapcar '(lambda (p / txt)
(setq txt (xdrx_text_make
p
(itoa i)
h
0.
)
)
(xdrx_text_setvermode txt 2)
(xdrx_text_sethozmode txt 1)
(xdrx_text_setalignmentpoint txt p)
(xdrx_entity_setcolor txt 2)
(setq i (1+ i))
)
x
)
)
(mapcar '(lambda (a) (mapcar 'car a)) npts)
)
(setq pl
(apply 'xdrx_polyline_make
(apply 'append (mapcar '(lambda (a) (mapcar 'car a)) npts))
)
)
(xdrx_entity_setcolor pl 1)
)
)
(princ)
)

(defun c:tt (/ ss ss1 pts i h npts pl) 
  (if (setq ss (ssget '((0 . "line")))) 
    (progn 
      (setq ss1 
             (xdrx_curve_intersectbreak 
               (xdrx_entity_transformedcopy ss (xdrx_matrix_identity 3)) 
             );_副本交点断开 
      ) 
      (setq pts        (cdr 
                  (vl-sort (xdrx_geom_searchregions ss1);_查找联通区域 
                           '(lambda (l1 l2) 
                              (> (apply 'xdrx_points_area l1) 
                                 (apply 'xdrx_points_area l2) 
                              ) 
                            ) 
                  );_按面积排序 
                );_去掉最外围框 
            pts        (mapcar        '(lambda (p) 
                           (list (apply 'xdrx_points_centroid p) 0) 
                         ) 
                        pts 
                );_取每个区域中心 
      ) 
      (xdrx_entity_delete ss1);_删除副本 
      ;;按行排 
      (setq npts (XD::List:TableSort pts 0 0 1.)) 
      ;;(setq npts (XD::List:TableSort pts 0 1 1.)) 
      ;;(setq npts (XD::List:TableSort pts 0 2 1.)) 
      ;;(setq npts (XD::List:TableSort pts 0 3 1.)) 
      ;;按列排 
      ;;(setq npts (XD::List:TableSort pts 1 0 1.)) 
      ;;(setq npts (XD::List:TableSort pts 1 1 1.)) 
      ;;(setq npts (XD::List:TableSort pts 1 2 1.)) 
      ;;(setq npts (XD::List:TableSort pts 1 3 1.)) 
      (setq i 1 
            h (getvar "textsize") 
      ) 
      (mapcar '(lambda (x) 
                 (mapcar '(lambda (p / txt) 
                            (setq txt (xdrx_text_make 
                                        p 
                                        (itoa i) 
                                        h 
                                        0. 
                                      ) 
                            ) 
                            (xdrx_text_setvermode txt 2) 
                            (xdrx_text_sethozmode txt 1) 
                            (xdrx_text_setalignmentpoint txt p) 
                            (xdrx_entity_setcolor txt 2) 
                            (setq i (1+ i)) 
                          ) 
                         x 
                 ) 
               ) 
              (mapcar '(lambda (a) (mapcar 'car a)) npts) 
      ) 
      (setq pl 
             (apply 'xdrx_polyline_make 
                    (apply 'append (mapcar '(lambda (a) (mapcar 'car a)) npts)) 
             ) 
      ) 
      (xdrx_entity_setcolor pl 1) 
    ) 
  ) 
  (princ) 
)

st788796 · 发表于 2013-12-7 07:33:37

1 2 及 1 3组合有问题

炫翔 · 发表于 2013-12-7 11:09:21

本帖最后由炫翔于 2013-12-7 11:10 编辑

;圆按行列,4点基点连线
(defun c:xx()
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 0 0)
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 0 1)
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 0 2)
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 0 3)
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 1 0)
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 1 1)
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 1 2)
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 1 3)
)
(defun xx-lst-pline (ss mode1 mode2 / i lst pts s1)
(setq i (sslength ss) pts nil)
(while (setq s1 (ssname ss (setq i (1- i))))
(setq pts (cons (list (cdr (assoc 10 (entget s1))) s1) pts))
)
(setq pts (ea::list:tablesort pts mode1 mode2 0.01))
(foreach y pts
(foreach a y
(setq lst(cons (car a) lst))
)
)
(xx-mk-pline-pts (reverse lst) nil)
(princ)
)
(defun xx-mk-pline-pts (lst Close-tnil)
(entmake
(append
(list
'(0 . "lwpolyline")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst))
(cons 70 (if Close-tnil 1 0))
)
(mapcar (function (lambda (pt)(cons 10 pt))) lst )
)
)
)

;圆按行列,4点基点连线 
(defun c:xx() 
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 0 0) 
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 0 1) 
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 0 2) 
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 0 3) 
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 1 0) 
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 1 1) 
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 1 2) 
(xx-lst-pline (ssget ":s" '((0 . "circle"))) 1 3) 
) 
 
(defun xx-lst-pline (ss mode1 mode2 / i lst pts s1) 
  (setq i (sslength ss) pts nil) 
  (while (setq s1 (ssname ss (setq i (1- i)))) 
    (setq pts (cons (list (cdr (assoc 10 (entget s1))) s1) pts)) 
  ) 
  (setq pts (ea::list:tablesort pts mode1 mode2 0.01)) 
   (foreach y pts 
     (foreach a y 
       (setq lst(cons (car a) lst)) 
     ) 
   ) 
   (xx-mk-pline-pts (reverse lst) nil) 
  (princ) 
) 
 
(defun xx-mk-pline-pts (lst Close-tnil) 
   (entmake 
      (append    
         (list 
           '(0 . "lwpolyline") 
           '(100 . "AcDbEntity") 
           '(100 . "AcDbPolyline") 
           (cons 90 (length lst)) 
           (cons 70 (if Close-tnil 1 0)) 
         ) 
      (mapcar (function (lambda (pt)(cons 10 pt))) lst ) 
     ) 
   ) 
)

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

[原创] 对以点为索引的表排行列

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

评分

点评

点评

点评