威兹曼，你能帮我吗

Small Fish · 发表于 2022-7-6 14:28:35

就在我以为我正在为代码做最后的润色时，我现在有了一个缺陷，这让我发疯了！
我想我已经问过李了。也许威兹曼可以帮我，因为他给了我代码
为了排序圆形行（与Lee mac一起），Wizman进行了排序，但Lee mac在
正确的顺序，这就是我发现很难实现的，修改它以适应。
一条垂直线将几行圆分开。正如我所说的，我想要一份最终的清单
例如-FinalList=（（1（5.0 5.0 5.0）（2（3.0 3.0）（3（8.0 8.0 8.0））
其中第1行有3个半径为5.0的圆，第2行有2个半径为3.0的圆等

我想要一个‘FinalList’在右边，一个‘FinalList’在左边。
目前我没有任何清单。

请帮帮我，我要疯了，努力工作！
非常感谢。
以下是我目前掌握的代码：

copy

(defun c:RowAreas (/ lent      ldat    ss      tcirc        subss
           total     test    subss_lst clst        rad
           flag      new_xxlst    listrowdia        finallist
           subss_lst  Rad  areaobj cLst  jsx_ename  dxf_ent)
   (vl-load-com)
 (if (and (setq lEnt (car (entsel "\nSelect Vertical Line: ")))
          (eq "LINE" (cdadr (entget lEnt))))
   (progn
     (setq lDat (list (cdr (assoc 10 (entget lEnt)))
                      (cdr (assoc 11 (entget lEnt)))))
     (princ "\n\nLEFT:\n") 
     (repeat 2
       (setq test 1)
       (if (setq ss (ssget "_X" (list '(0 . "CIRCLE")(cons -4 (if flag ">=,*,*" "<=,*,*"))
                            (cons 10
                                               (append
                                                 (list
                                                   (apply
                                                     (if flag 'max 'min)
                                                     (mapcar 'car lDat)))
                                                 '(0 0))))))
         (while (not (zerop (sslength ss)))
       (setq dxf_ent  (entget (setq jsx_ename (ssname ss 0))))
           (setq tCirc (ssname ss 0))
           (if (setq subSs (ssget "_X" (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 new_xxlst
                 (mapcar 'cadr
                     (ssnamex subSs)))
         (setq areaobj (vla-get-area
                         (vlax-ename->vla-object ent))
               total   (+ total areaobj))
     );foreach
               (setq cLst
                      (vl-sort
                        (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst)
                         '(lambda (x1 x2) (< (car x1) (car x2))));centrepoint
                     Rad
                      (vl-sort
                        (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst)
                         '(lambda (r1 r2) (> r1 r2))));radius
       (setq ListRowDia (cons (append (list (caddr (assoc 10 (entget (car new_xxlst))))) Rad) ListRowDia))
           (mapcar '(lambda (x) (ssdel x ss)) new_xxlst)
       );progn
         );if
           (ssdel jsx_ename ss)
       );while
     
   (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2)))))
     (setq test 1)
       (setq FinalList (cons (list test x) FinalList) test (1+ test))
   );foreach
     );if
      (and (not flag) (princ "\n\nRIGHT:\n"))
       (setq flag T)
   );repeat
         );progn
   (princ "\n<!> No Line Selected <!>")
   );if-->for dividing line
 (princ (vl-princ-to-string FinalList))
   (princ )
 );defun

wizman · 发表于 2022-7-6 14:44:03

请尝试：

copy

(defun c:RowAreas (/ lent      ldat    ss      tcirc        subss
           total     test    subss_lst clst        rad
           flag      new_xxlst    listrowdia        finallist
           subss_lst  Rad  areaobj cLst  jsx_ename  dxf_ent)
   (vl-load-com)
 (if (and (setq lEnt (car (entsel "\nSelect Vertical Line: ")))
          (eq "LINE" (cdadr (entget lEnt))))
   (progn
     (setq lDat (list (cdr (assoc 10 (entget lEnt)))
                      (cdr (assoc 11 (entget lEnt)))))
     (princ "\n\nLEFT:\n") 
     (repeat 2
       ;(SETQ TEST 1);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       (if (setq ss (ssget "_X" (list '(0 . "CIRCLE")(cons -4 (if flag ">=,*,*" "<=,*,*"))
                            (cons 10
                                               (append
                                                 (list
                                                   (apply
                                                     (if flag 'max 'min)
                                                     (mapcar 'car lDat)))
                                                 '(0 0))))))
    (PROGN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
         (while (not (zerop (sslength ss)))
       (setq dxf_ent  (entget (setq jsx_ename (ssname ss 0))))
           (setq tCirc (ssname ss 0))
           (if (setq subSs (ssget "_X" (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 new_xxlst
                 (mapcar 'cadr
                     (ssnamex subSs)))
         (setq areaobj (vla-get-area
                         (vlax-ename->vla-object ent))
               total   (+ total areaobj))
     );foreach
               (setq cLst
                      (vl-sort
                        (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) new_xxlst)
                         '(lambda (x1 x2) (< (car x1) (car x2))));centrepoint
                     Rad
                      (vl-sort
                        (mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) new_xxlst)
                         '(lambda (r1 r2) (> r1 r2))));radius
       (setq ListRowDia (cons (append (list (caddr (assoc 10 (entget (car new_xxlst))))) Rad) ListRowDia))
           (mapcar '(lambda (x) (ssdel x ss)) new_xxlst)
       );progn
         );if
           (ssdel jsx_ename ss)
       );while
     (SETQ TEST 1);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2)))))
     
       (setq FinalList (cons (list test x) FinalList) test (1+ test))
   );foreach
  (PRINC (VL-PRINC-TO-STRING FINALLIST))(SETQ FINALLIST NIL LISTROWDIA NIL);;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  );PROGN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     );if
      (and (not flag) (princ "\n\nRIGHT:\n"))
       (setq flag T)
   );repeat
         );progn
   (princ "\n<!> No Line Selected <!>")
   );if-->for dividing line
     (princ )
 );defun

Small Fish · 发表于 2022-7-6 14:49:57

嘿，谢谢Wizman！
我很高兴！：-）
还有一个问题，我怎么能在“while”之外打两盘呢-
一个在右边，一个在左边？
干杯S.F。

wizman · 发表于 2022-7-6 14:59:57

不客气，小鱼，我不确定我是否明白你的下一个问题，也许你只需要另一个变量来存储左右。

*编辑2

*删除了普林斯的错误评论*

Small Fish · 发表于 2022-7-6 15:08:41

是的，这就是我想问的-我如何为左集合和右集合生成一个变量？
如果我拿走普林斯，它会显示任何列表。。。。

wizman · 发表于 2022-7-6 15:16:25

抱歉搞糊涂了，你说得对，普林斯需要在场。

wizman · 发表于 2022-7-6 15:27:18

为全局变量LEFT和RIGHT添加红线…：-）

copy


..............................................................
);if
           (ssdel jsx_ename ss)
       );while
     (SETQ TEST 1)
   (foreach x (mapcar 'cdr (vl-sort ListRowDia '(lambda (x1 x2) (< (car x1) (car x2)))))
     
       (setq FinalList (cons (list test x) FinalList) test (1+ test))
   );foreach
  (PRINC (VL-PRINC-TO-STRING FINALLIST))
         [color="Red"](SET (IF FLAG 'RIGHT 'LEFT) FINALLIST)[/color]
         (SETQ FINALLIST NIL LISTROWDIA NIL)
  )
     );if
      (and (not flag) (princ "\n\nRIGHT:\n"))
       (setq flag T)
   );repeat
         );progn
   (princ "\n<!> No Line Selected <!>")
   );if-->for dividing line
     (princ )
 );defun

Small Fish · 发表于 2022-7-6 15:29:54

谢谢你的时间，威兹曼-这正是我想要的。头痛消失了：-）
干杯小鱼

[编程交流] 威兹曼，你能帮我吗

发表回复

精选推荐