求坐标排序并成表

峰云于雾

求附件“坐标点.dwg”各点坐标并列表表示的问题。
对于确定的坐标名称如1-1-1，可设定规则为：桥梁编号-桥墩编号-桩基编号，1-1-1即表达该点为1号桥1号墩第1根桩的坐标点。
如果图中已经点选好各点，要求将各坐标点的坐标生成表格并写入cad中。如下图：

按要求生成表格：

图中所用带编号的五角星是已生成的属性块，编号是属性值已有提取代码。
路过的大神们，如果有兴趣可以驻足研究一下，问题的关键是在于如何利用文字进行排序并生成表格。
本人已经完成部分代码，但对于排序这块未能想到合适的方法。

1、生成属性块代码：
;生成属性块"坐标点"，emkattblk ,生成普通块"坐标点1"
(defun c:emkattblk (/ ang0 ang1 h pt0 pt1 pt10 pt11 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 s1 s2)
  (vl-load-com)
  ;(setq pt0 (getpoint "请输入插入点"))
  ;(setq h (getdist pt0 "字高"))
  (setq pt0 '(0 0 0))
  (setq h 2.5)
  (setq ang0 (/ pi 5))
  (setq ang1 (* ang0 2))
  (setq s1 (* h 1))
  (setq s2 (* h 1 (/ (cos ang1) (cos ang0))))
  (setq pt1 (polar pt0 (/ pi 2) s1)
        pt2 (polar pt0 (- (/ pi 2) ang0) s2)
        pt3 (polar pt0 (- (/ pi 2) (* ang0 2)) s1)   
        pt4 (polar pt0 (- (/ pi 2) (* ang0 3)) s2)   
        pt5 (polar pt0 (- (/ pi 2) (* ang0 4)) s1)
        pt6 (polar pt0 (- (/ pi 2) (* ang0 5)) s2)
        pt7 (polar pt0 (- (/ pi 2) (* ang0 6)) s1)
        pt8 (polar pt0 (- (/ pi 2) (* ang0 7)) s2)
        pt9 (polar pt0 (- (/ pi 2) (* ang0 8)) s1)
        pt10 (polar pt0 (- (/ pi 2) (* ang0 9))s2)   
        pt11 (polar pt0 (* (/ pi 6) -1) (* h 1.1))   
  )
  ;五星单独做块
  (entmake (list '(0 . "block") (cons 2 "坐标点1") '(70 . 2) (cons 10 pt0)))  
  (entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)))
  (entmake (list '(0 . "LINE") (cons 10 pt2) (cons 11 pt3)))
  (entmake (list '(0 . "LINE") (cons 10 pt3) (cons 11 pt4)))
  (entmake (list '(0 . "LINE") (cons 10 pt4) (cons 11 pt5)))
  (entmake (list '(0 . "LINE") (cons 10 pt5) (cons 11 pt6)))
  (entmake (list '(0 . "LINE") (cons 10 pt6) (cons 11 pt7)))
  (entmake (list '(0 . "LINE") (cons 10 pt7) (cons 11 pt8)))
  (entmake (list '(0 . "LINE") (cons 10 pt8) (cons 11 pt9)))
  (entmake (list '(0 . "LINE") (cons 10 pt9) (cons 11 pt10)))
  (entmake (list '(0 . "LINE") (cons 10 pt10) (cons 11 pt1)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt1)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt2)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt3)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt4)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt5)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt6)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt7)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt8)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt9)))
  (entmake (list '(0 . "LINE") (cons 10 pt0) (cons 11 pt10)))
  (entmake '((0 . "ENDBLK")))
  ;;块结束  
  (entmake (list '(0 . "block") (cons 2 "坐标点") '(70 . 2) (cons 10 pt0)))
   (entmake (list '(0 . "INSERT") (cons 2 "坐标点1") (cons 10 pt0)))
    (entmake (list '(0 . "ATTDEF") '(8 . "0") (cons 10 pt11) (cons 40 h) '(1 . "0-0-0") '(3 . "坐标点编号")
             '(2 . "编号") '(41 . 0.7) '(70 . 0))   
    )
  (entmake '((0 . "ENDBLK")))
  (princ)
)

2、提取所有坐标并排序：
;定义3向排序，从左到右排序，返回序号
(defun pxi_3  ( xyzlist / one oneof three threeof two twoof)
  (setq one car ;_X
    two cadr ;_Y
    three caddr ;_z
    oneof < ;_X
    twoof < ;_y
    threeof < ;_z
  )
  (vl-sort-i xyzlist   ;返回点集内容可采用vl-sort函数
    (function (lambda (e1 e2)
                (cond
                  ((> (abs (- (one e1) (one e2))) 0) ;_ 结束>
                    (oneof (one e1) (one e2)) ;_ 结束oneof
                  )
                  ((> (abs (- (two e1) (two e2))) 0) ;_ 结束>
                    (twoof (two e1) (two e2)) ;_ 结束twoof
                  )
                  (T
                    (threeof (three e1) (three e2)) ;_ 结束threeof
                  )
                ) ;_ 结束cond
              ) ;_ 结束lambda
    ) ;_ 结束function
  ) ;_ 结束vl-sort
)

;定义3向排序，从左到右排序，返回排序结果
(defun px_3  ( xyzlist / one oneof three threeof two twoof)
  (setq one car ;_X
    two cadr ;_Y
    three caddr ;_z
    oneof < ;_X
    twoof < ;_y
    threeof < ;_z
  )
  (vl-sort xyzlist   ;返回点集内容可采用vl-sort函数
    (function (lambda (e1 e2)
                (cond
                  ((> (abs (- (one e1) (one e2))) 0) ;_ 结束>
                    (oneof (one e1) (one e2)) ;_ 结束oneof
                  )
                  ((> (abs (- (two e1) (two e2))) 0) ;_ 结束>
                    (twoof (two e1) (two e2)) ;_ 结束twoof
                  )
                  (T
                    (threeof (three e1) (three e2)) ;_ 结束threeof
                  )
                ) ;_ 结束cond
              ) ;_ 结束lambda
    ) ;_ 结束function
  ) ;_ 结束vl-sort
)

;去重复项，求表中子项。
(defun by-same-cut (lst1 / lst_new lst2)
  (setq lst_new '() lst2 lst1)
  (foreach m lst1
    (setq lst2 (cdr lst2))
    (if (= (member m lst2) nil)
      (setq lst_new (append lst_new (list m)))
    )
  )
)
;定义求表中的子项及个数  
(defun list_xyz_num (A / a_1 an b lst n num)
  (setq B (by-same-cut A ))
  (setq n 0)
  (setq lst nil)
  (repeat (length B)
    (setq an (nth n B))
    (setq A_1 (vl-remove an A))
    (setq num (- (length A) (length A_1)))
    (setq lst (cons (list an num) lst))
    (setq n(1+ n))
  )
  (setq lst (reverse lst))
)

;;选取属性块,提取属性块中文字及插入点.
(vl-load-com)
(defun c:tt (/ elist elist_01 i lst n1 n2 pt pts s1 txt_00 txt_01 txt_02 txt_03 txt_list)
  ;elist   图元表
  ;elist_01    图元表迭代
  ;i       起始序号
  ;pt      插入点坐标
  ;s1      属性块选择集
  ;txt_00  属性块文字内容
  ;txt_01  A列
  ;txt_02  B列
  ;txt_03  C列  
  ;pts      插入点坐标集合
  ;txt_list  属性块文字内容转化为表集合
  ;txt_A  A列集合
  ;txt_B  B列集合
  ;txt_C  C列集合
  
  (SETVAR "CMDECHO" 0)  
  (setq S1 (ssget '((0 . "INSERT") (66 . 1))));;;框选修改的属性块
  (if s1
    (progn
      (setq i 0)
      (setq pts nil
        txt_list nil
        txt_A  nil
        txt_B  nil
        txt_C  nil
      )
      (repeat (sslength S1)
        (setq elist (entget (ssname S1 i))
          elist_01 elist)
        (setq pt (cdr(assoc 10 elist)))
        (setq pts (cons pt pts) )  
        (while (/= (cdr(assoc 0 (setq elist_01 (entget(entnext(cdr(assoc -1 elist_01)))))))
                 "SEQEND")
          (if (= (cdr(assoc 0 elist_01)) "ATTRIB")
            (progn
              (setq txt_00 (cdr(assoc 1 elist_01)))
              (setq n1 (vl-string-search  "-" Txt_00))
              (setq n2 (vl-string-search  "-" Txt_00 (1+ n1)))
              (setq txt_01 (atoi (substr  txt_00 1 n1) ))
              (setq txt_02 (atoi (substr  txt_00 (+ n1 2) (- n2 n1 1))))
              (setq txt_03 (atoi (substr  txt_00 (+ n2 2) )))
            )
          )
        )
        (setq txt_list (cons (list txt_01 txt_02 txt_03) txt_list ))  
        (setq txt_A (cons  txt_01 txt_A ))  
        ;(setq txt_B (cons  txt_02 txt_B ))  
        ;(setq txt_C (cons  txt_03 txt_C ))  
        (setq i (1+ i))
      )  
      (setq txt_list_i (pxi_3 txt_list))
      (setq txt_list (px_3 txt_list))
      (setq A_1 (list_xyz_num txt_A))
      (princ txt_A)
      (princ txt_list_i)      
      (setq i nil)
    )
  )
  (SETVAR "CMDECHO" 1)
  (princ)
)

3、求各分项的个数及顺序并写入表格
···

峰云于雾

顶一下，这个对于桥梁绘制桩基坐标很有用啊，请各路神仙伸出援手吧

峰云于雾

走过路过千万不要直接飘过啊

zhenz02

感谢楼主 分享