威兹曼，你能帮我吗
就在我以为我正在为代码做最后的润色时，我现在有了一个缺陷，这让我发疯了！我想我已经问过李了。也许威兹曼可以帮我，因为他给了我代码
为了排序圆形行（与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’在左边。
目前我没有任何清单。
请帮帮我，我要疯了，努力工作！
非常感谢。
以下是我目前掌握的代码：
(defun c:RowAreas (/ lent ldat ss tcirc subss
total test subss_lst clst rad
flag new_xxlst listrowdia finallist
subss_lstRadareaobj cLstjsx_enamedxf_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 请尝试：
(defun c:RowAreas (/ lent ldat ss tcirc subss
total test subss_lst clst rad
flag new_xxlst listrowdia finallist
subss_lstRadareaobj cLstjsx_enamedxf_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 嘿，谢谢Wizman！
我很高兴！：-）
还有一个问题，我怎么能在“while”之外打两盘呢-
一个在右边，一个在左边？
干杯S.F。
不客气，小鱼，我不确定我是否明白你的下一个问题，也许你只需要另一个变量来存储左右。
*编辑2
*删除了普林斯的错误评论* 是的，这就是我想问的-我如何为左集合和右集合生成一个变量？
如果我拿走普林斯，它会显示任何列表。。。。
抱歉搞糊涂了，你说得对，普林斯需要在场。 为全局变量LEFT和RIGHT添加红线…：-）
..............................................................
);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))
(SET (IF FLAG 'RIGHT 'LEFT) FINALLIST)
(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 谢谢你的时间，威兹曼-这正是我想要的。头痛消失了：-）
干杯小鱼
页:
[1]