按y值对ss排序

Small Fish · 发表于 2022-7-6 14:31:48

我有几行圆，每行都有相同的y值中心点。
如何从下至上处理行？

例如，在我的选择集中，我在最下面一行有3行圆圈
有2个7.5半径的圆
然后是2个16半径的圆
然后是2个20半径的圆

然而，我的回报中的列表“ListRowDia”：
((2 20.0 20.0) (1 7.5 7.5 7.5) (3 16.0 16.0))

但我想：
((1 7.5 7.5 7.5) (2 16.0 16.0)(3 20.0 20.0))

这是需要调整的代码：
谢谢你的帮助

Lee Mac · 发表于 2022-7-6 14:40:14

试试这个

copy


(defun c:RowA3  (/ jsx test dxf_ent jsx_ename new_xx total areaobj cLst big_Area rad ListRowDia)
 (vl-load-com)
 (if (setq jsx (ssget "_X" '((0 . "CIRCLE"))))
   (progn
     (setq test 1)
     (while (not (zerop (sslength jsx)))
       (setq dxf_ent  (entget (setq jsx_ename (ssname jsx 0)))
             new_xx   (ssget "_X"
                             (list '(0 . "CIRCLE")
                                   '(-4 . "*,=,*")
                                   (assoc 10 dxf_ent)))
             total    0.0
             big_Area nil)
       (foreach ent  (setq new_xxlst (vl-sort (mapcar 'cadr (ssnamex new_xx))
                                              '(lambda (y1 y2) (< (caddr (assoc 10 (entget y1)))
                                                                  (caddr (assoc 10 (entget y2)))))))
         (setq areaobj (vla-get-area
                         (vlax-ename->vla-object ent))
               total   (+ total areaobj)))
       (setq cLst (vl-sort
                    (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst)
                    '(lambda (x1 x2) (< (car x1) (car x2)))))
       (setq Rad (vl-sort
                   (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst)
                   '(lambda (x1 x2) (> x1 x2))))
       (setq ListRowDia (append (list (cons test Rad)) ListRowDia))
       (mapcar '(lambda (x) (ssdel x jsx)) new_xxlst)
       (princ (strcat "\nRow "
                      (itoa test)
                      "; MinXCtr: "
                      (vl-princ-to-string (car cLst))
                      " MaxRad = "
                      (vl-princ-to-string (car rad))
                      " => "
                      " Total = "
                      (rtos total)
                      "\n-----------------------------------------"))
       (ssdel jsx_ename jsx)
       (setq test (1+ test)))
     (textscr)))
 (princ "\n")
 (princ ListRowDia)
 (princ))

Lee Mac · 发表于 2022-7-6 14:41:14

只是一条小鱼，在发布代码时，将其封装在

copy

 [/ code] tags (without the space) - then the indents in the code are retained.

Small Fish · 发表于 2022-7-6 14:48:52

嗨，李。麦克。是的，很好用。谢谢然而，我不知道如何将您编写的新代码合并到您或Wizman以前编写的代码中。我试着把它们塑造在一起，但它只是挂在这些线上。如何添加：（vl remove if'listp（mapcar'cadr（ssnamex subSs））？
谢谢

进入
这显示了我想要修改的更多代码

]

Lee Mac · 发表于 2022-7-6 14:51:09

也许像这样。。。。

copy


(if (setq subSs (ssget "_c" pt1 pt2 (list (cons 0 "CIRCLE")
                                             (cons -4 (if flag ">=,=,*" "<=,=,*"))
                                             (cons 10
                                               (append
                                                 (list
                                                   (apply
                                                     (if flag 'max 'min)
                                                     (mapcar 'car lDat)))
                                                 (cddr (assoc 10 (entget tCirc))))))))
             (progn
               (setq total 0.0)
               (foreach ent (setq  subSs_lst (vl-sort
                                               (vl-remove-if 'listp
                                                 (mapcar 'cadr
                                                   (ssnamex subSs)))
                                               '(lambda (y1 y2) (< (caddr (assoc 10 (entget y1)))
                                                                   (caddr (assoc 10 (entget y2)))))))
                 (setq total (+ total (vla-get-Area
                                        (vlax-ename->vla-object ent)))))
               (setq  cLst(car
                      (vl-sort
                        (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) subSs_lst)
                         '(lambda (x1 x2) (< (car x1) (car x2)))))
                     Rad
                      (car(vl-sort
                        (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) subSs_lst)
                         '(lambda (r1 r2) (> r1 r2)))))
                 etc  etc etc

Small Fish · 发表于 2022-7-6 14:55:10

这有点复杂，但也许这就是你想要实现的？

copy

Lee Mac · 发表于 2022-7-6 15:02:17

很抱歉没有尽快回复-大约5天前我们的办公室一夜之间着火了。我们现在在一个临时办公室。现在我有机会去看看。
是的，这正是我想要实现的——我对它的理解越来越深刻。我正在努力使您的更改适应我的代码。我想我已经找到了你所有的更改，但我不确定是否需要更改过滤器？
我试图将你的过滤器复制到我的代码中，但它不喜欢。是否应更换过滤器？
它卡在线路上：

这个问题解决后，我就快到了。
谢谢李的耐心
附件是我的代码
小鱼
行区域X。LSP