(defun c:RowAreas(/ jsx test dxf_ent jsx_ename new_xx total areaobj cLst big_Area rad)
(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 (mapcar 'cadr (ssnamex new_xx)))
(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))))
(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)) 请尝试：
(defun c:RowAreas (/ lEnt lDat ss tCirc subSs total test subSs_lst cLst Rad flag)
(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" '((0 . "CIRCLE"))))
(while (not (zerop (sslength ss)))
(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 subSs_lst
(mapcar 'cadr
(ssnamex subSs)))
(setq total (+ total (vla-get-Area
(vlax-ename->vla-object ent)))))
(setq cLst
(vl-sort
(mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) subSs_lst)
'(lambda (x1 x2) (< (car x1) (car x2))))
Rad
(vl-sort
(mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) subSs_lst)
'(lambda (r1 r2) (> r1 r2))))
(mapcar '(lambda (x) (ssdel x ss)) subSs_lst)
(princ (strcat "\nRow " (itoa test)
"; MinXCtr: " (vl-princ-to-string (car cLst))
" MaxRad = " (vl-princ-to-string (car Rad))
" => " " Total = "(rtos total)
"\n-----------------------------------------"))))
(ssdel tCirc ss)
(setq test (1+ test))))
(and (not flag) (princ "\n\nRIGHT:\n"))
(setq flag T))
(textscr))
(princ "\n<!> No Line Selected <!>"))
(princ ))
不错，威兹曼，
我试着一次做太多的事情，所以我并没有过滤到原始设置。
感谢您的修改 ..也谢谢李。 您好，是的，谢谢，效果很好，但是我想先选择线，然后在所有圆上创建一个交叉窗口。
我试着用（setq ss（ssget（list）（0，“CIRCLE”）修改它
然而，对于交叉窗口，它要求制作另一个交叉窗口（右侧）
所以我做了2个“whiles”，而不是重复。我还试图创建两个独立的答案-一个是左一个是右，而不是一个最终答案。
这不太管用-有人能调整一下吗？
谢谢
干杯
这里有一种方法仍然使用repeat，但不是ssget“x”，而是使用ssget“c”
*为子系统的ssget更新的编辑代码
(defun c:RowAreas (/ lEnt lDat ss tCirc subSs total test subSs_lst cLst Rad flag)
(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 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 subSs_lst
(mapcar 'cadr
(ssnamex subSs)))
(setq total (+ total (vla-get-Area
(vlax-ename->vla-object ent)))))
(setq cLst
(vl-sort
(mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) subSs_lst)
'(lambda (x1 x2) (< (car x1) (car x2))))
Rad
(vl-sort
(mapcar '(lambda (x) (cdr (assoc 40 (entget x)))) subSs_lst)
'(lambda (r1 r2) (> r1 r2))))
(mapcar '(lambda (x) (ssdel x ss)) subSs_lst)
(princ (strcat "\nRow " (itoa test)
"; MinXCtr: " (vl-princ-to-string (car cLst))
" MaxRad = " (vl-princ-to-string (car Rad))
" => " " Total = "(rtos total)
"\n-----------------------------------------"))))
(ssdel tCirc ss)
(setq test (1+ test))))
(and (not flag) (princ "\n\nRIGHT:\n"))
(setq flag T))
(textscr))
(princ "\n<!> No Line Selected <!>"))
(princ )) ..thank you also lee. Hi yes thanks that works well however I wanted to first select the line then make a crossing window over all the circles.
I have tried to modify it using (setq ss (ssget(list '(0 . "CIRCLE")
for a crossing window however it then ask to make another crossing window (for the right side)
So I have made 2 'whiles' rather than repeat. I am also trying to create two seperate answers - one for the left and one for the right rather than one final answer.
Its not quite working - can someone please adjust it?
thanks
cheers
here's a way to still use repeat but instead of ssget "x" use ssget "c"
*edit code updated for ssget of subss
(defun c:RowAreas (/ lEnt lDat ss tCirc subSs total test subSs_lst cLst Rad flag pt1 pt2) (vl-load-com) (if (and (setq lEnt (car (entsel "\n>>>...Select Vertical Line...>>>: "))) (eq "LINE" (cdadr (entget lEnt))) (null (redraw lEnt 3)) (setq pt1 (getpoint "\n>>>...Pick First Point of Window...>>>: ")) (null (initget 32)) (setq pt2 (getcorner pt1 "\n>>>...Pick Second Point of Window...>>>>: ")) (null (redraw lEnt 4))) (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 "_c" pt1 pt2 (list '(0 . "CIRCLE")(cons -4 (if flag ">=,*,*" "=,=,*" " " " Total = "(rtos total) "\n-----------------------------------------")))) (ssdel tCirc ss) (setq test (1+ test)))) (and (not flag) (princ "\n\nRIGHT:\n")) (setq flag T)) (textscr)) (princ "\n No Line Selected ")) (princ ))
页:
1
[2]