社区 › Auto Lisp › 直线和圆弧的排序列表

doaiena 发表于 2022-7-5 19:23:01

谢谢你的建议，大卫。不过我只是在寻找一种排序算法。我目前正在努力使我的代码适应李·麦克的grouppoints命令，但目前没有多大成功。

David Bethel 发表于 2022-7-5 19:27:25

有时最好让AutoCAD来完成这项工作。通过使用pedit创建多段线并将其分解，它会自动按端点对线段进行排序-大卫

Lee Mac 发表于 2022-7-5 19:32:34

我还没有检查输出，但这应该可以让您大致了解：

(defun c:test ( / cen cnt ent enx ept idx lst rad sel spt )

   (defun assocf ( x l f )
       (vl-some '(lambda ( a ) (if (equal x (car a) f) a)) l)
   )

   (defun grouppoints ( l / a r x x1 x2 )
       (while (setq x (car l))
         (setq x (list x)
               l (cdrl)
         )
         (while
               (cond
                   (   (setq a (assocf (setq x1 (caar x)) l 1e-)
                     (setq x (cons (reverse a) x)
                           l (vl-remove a l)
                     )
                   )
                   (   (setq a (assocf (setq x2 (last (last x))) l 1e-)
                     (setq x (append x (list a))
                           l (vl-remove a l)
                     )
                   )
                   (   (setq a (assocf x1 (setq l (mapcar 'reverse l)) 1e-)
                     (setq x (cons (reverse a) x)
                           l (vl-remove a l)
                     )
                   )
                   (   (setq a (assocf x2 l 1e-)
                     (setq x (append x (list a))
                           l (vl-remove a l)
                     )
                   )
               )
         )
         (setq r (cons x r))
       )
   )

   (defun amid ( c s e / v x )
       (setq v (mapcar '- e s)
             x (trans c 0 v)
       )
       (trans (cons (- (car x) (distance c s)) (cdr x)) v 0)
   )

   (if (setq sel (ssget '((0 . "LINE,ARC"))))
       (progn
         (repeat (setq idx (sslength sel))
               (setq ent (ssname sel (setq idx (1- idx)))
                     enx (entget ent)
               )
               (if (= "LINE" (cdr (assoc 0 enx)))
                   (progn
                     (setq spt (cdr (assoc 10 enx))
                           ept (cdr (assoc 11 enx))
                     )
                     (if (equal (caddr spt) (caddr ept) 1e-
                           (setq lst (cons (list spt ept) lst))
                     )
                   )
                   (setq cen (cdr (assoc 10 enx))
                         rad (cdr (assoc 40 enx))
                         spt (trans (polar cen (cdr (assoc 50 enx)) rad) ent 0)
                         ept (trans (polar cen (cdr (assoc 51 enx)) rad) ent 0)
                         lst (cons(listspt (amid (trans cen ent 0) spt ept) ept) lst)
                   )
               )
         )
         (setq cnt 0)
         (mapcar
               (function
                   (lambda ( grp )
                     (mapcar
                           (function
                               (lambda ( obj )
                                 (cons (setq cnt (1+ cnt))
                                       (apply 'append (apply 'mapcar (cons 'list obj)))
                                 )
                               )
                           )
                           grp
                     )
                   )
               )
               (grouppoints lst)
         )
       )
   )
   (princ)
)

doaiena 发表于 2022-7-5 19:34:06

经过一点修补，我成功地将您的排序解决方案实现到我的代码中。现在它就像一个魅力。它比我的旧代码快，并且它在我测试它的所有部分都做得很好。
 
谢谢你对李的所有帮助，不仅是在这个帖子中，而且还感谢你通过网络与社区分享的所有知识http://www.lee-mac.com/和你的多个论坛帖子。
在过去的几年里，您帮助我学习了很多关于AutoLisp的知识。我真的很感激。

Lee Mac 发表于 2022-7-5 19:40:38

 
很高兴听到doaiena！
 
 
多谢你对我的感激之词，这意义重大。我很高兴这些年来在AutoLISP学习方面直接和间接地帮助了你们——非常欢迎你们。

rlx 发表于 2022-7-5 19:41:18

 
Thanx Lee，你只是看了看你的代码就让我头疼了哈哈

Lee Mac 发表于 2022-7-5 19:47:02

........

查看完整版本: 直线和圆弧的排序列表