社区 › AutoLISP/Visual LISP 编程技术 › 如何获得排序后圆的图元表？

kanxiaokan 发表于 2019-7-24 13:35:40

如何获得排序后圆的图元表？

本帖最后由 kanxiaokan 于 2019-7-24 15:27 编辑

我需要得到如图所示的效果，如何修改下面的代码？
(defun c:tt ()
    (princ "\n请选择要排序的实体...")
    (if(setq ss (ssget))
(progn
      ;; 1、获取点位表
      (setq lst '()
      i   0
      )
      (repeat (sslength ss)
    (setq en(ssname ss i)
          ent (entget en)
          pt(cdr (assoc 10 ent))
          lst (cons pt lst)
          i    (1+ i)
    )
      )
      ;; 2、排序
      (setq
    lst (vl-sort lst '(lambda (e1 e2)
                  (if (equal (car e1) (car e2) 1e1)
                  (if (equal (cadr e1) (cadr e2) 1e1)
                      (< (car e1) (car e2))
                      (< (cadr e1) (cadr e2))
                  )
                  (< (car e1) (car e2))
                  )
                )
)
      )
      ;; 3、写序号文字
      (setq i 1)
      (foreach ptlst
    (command "_.text" "j" "mc""non"pt (getvar "TEXTSIZE") 0 (itoa i))
    (setq i (1+ i))
      )
)
    )
    (princ)
)

satan421 发表于 2019-7-25 08:50:35

本帖最后由 satan421 于 2019-7-25 08:56 编辑

;;   test

yshf 发表于 2019-7-24 16:56:51

;程序修改为如下：
(defun c:tt ()
    (command "_.undo" "be")
    (if (= (setq YxWc (getreal "\nX坐标容许差<10>=")) nil)
      (setq YxWc 10.0)
    )

    (If (= (setq WzGd (getreal (strcat "\n编号文字高度<" (rtos (getvar "TEXTSIZE")) ">="))) nil)
      (setq WzGd (getvar "TEXTSIZE"))
      (setvar "TEXTSIZE" WzGd)
    )

    (princ "\n请选择要排序的实体...")
    (if (setq ss (ssget '((0 . "circle"))))
      (progn
             ;; 1、获取点位表
             (setq lst '()
                   i   0
             )
             (repeat (sslength ss)
               (setq ent (ssname ss i)
                     dxf (entget ent)
                     pt(cdr (assoc 10 dxf))
                     lst (cons pt lst)
                     i   (1+ i)
                  )
             )
             ;; 2、排序
             (setq lst (vl-sort lst '(lambda (e1 e2)
                                        (if (equal (car e1) (car e2) YxWc)
                                          (< (cadr e1) (cadr e2))
                                          (< (care1) (care2))
                                        )
                                    )
                     )
             )
             (setq pts nil)
             (setq i 1)
             (while lst
               (setq pt (car lst))
                 (setq ptb (vl-remove-if '(lambda(ptt)(not (equal (car pt) (car ptt) YxWc))) lst))
                 (mapcar '(lambda(ptt)(setq lst (vl-remove ptt lst))) ptb)
                 (if (= i (* 2 (fix (* 0.5 i))))
                     (setq ptb (reverse ptb))
               )
                 (setq pts (append (reverse ptb) pts))
               (setq i (1+ i))
             )
             (setq pts (reverse pts))
             ;; 3、写序号文字
             (setq i 1)
             (foreach pt pts
                  (command "_.text" "j" "mc""non" pt WzGd 0 (itoa i))
                  (setq i (1+ i))
             )
      )
    )
    (command "_.undo" "e")
    (princ)
)

satan421 发表于 2019-7-24 13:44:29

本帖最后由 satan421 于 2019-7-24 13:46 编辑

1、实际存在像图中这样的线连接所有圆，还是此线只是配合箭头示意？
2、图元表是什么，圆的图元资料吗？
3、你是只要这一种排序的情况，还是可能有很多种情况？

kanxiaokan 发表于 2019-7-24 13:54:10

satan421 发表于 2019-7-24 13:44
1、实际存在像图中这样的线连接所有圆，还是此线只是配合箭头示意？
2、图元表是什么，圆的图元资料吗？
...

粉色的线是配合箭头的示意图。
按示意图排列后获得的圆的图元表

start4444 发表于 2019-7-24 14:34:26

论坛搜一下很多排序代码，你这种规律的就按照xy值排列应该好搞的

kanxiaokan 发表于 2019-7-24 15:11:15

start4444 发表于 2019-7-24 14:34
论坛搜一下很多排序代码，你这种规律的就按照xy值排列应该好搞的

找到类似的，改了一下，还是达不到我想要的。我更新帖子了。大佬您帮看一下，如何改？

satan421 发表于 2019-7-24 15:38:41

1、先根据X坐标分组，需要考虑容差(这个容差不好确定，需要考虑不止一种因素)
2、得到分组后，每组内再根据Y坐标的大小排序
3、组内排序完成后，再根据每组的第一个元素的X坐标排序
4、根据排序的结果，偶数序号的组元素顺序反转
5、按顺序将各组元素合并为一组

kanxiaokan 发表于 2019-7-25 09:03:39

satan421 发表于 2019-7-25 08:50
;;   test

大佬你这个，是类似7楼的方法吗？能否给代码研究一下。

satan421 发表于 2019-7-25 10:37:28

是按我自己的思路写的。
再给你个子函数，你应该能写出来了。

;;点表根据X坐标值分组(考虑容差)
;;by satan421
(defun classify (lst fuzzy / alst tlst x)
(setq alst '())
(while lst
    (setq x (caar lst) tlst '())
    (mapcar (function(lambda (n) (if (equal (car n) x fuzzy) (setq tlst (cons n tlst))))) lst)
    (setq alst (cons (reverse tlst) alst))
    (mapcar (function(lambda(n)(if (member n lst) (setq lst (vl-remove n lst))))) tlst)
)
(reverse alst)
)

查看完整版本: 如何获得排序后圆的图元表？