查找圆的区域

Small Fish · 发表于 2022-7-6 15:14:13

我有这个，但有时似乎会重复，我不知道为什么？

(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))

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

请尝试：

copy


[b][color=RED]([/color][/b][b][color=BLUE]defun[/color][/b] c:RowAreas [b][color=RED]([/color][/b][b][color=BLUE]/[/color][/b] lEnt lDat ss tCirc subSs total test subSs_lst cLst Rad flag[b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lEnt [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entsel[/color][/b] [b][color=#ff00ff]"\nSelect Vertical Line: "[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
          [b][color=RED]([/color][/b][b][color=BLUE]eq[/color][/b] [b][color=#ff00ff]"LINE"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdadr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] lEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] lDat [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] lEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                      [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]11[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] lEnt[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n\nLEFT:\n"[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]repeat[/color][/b] [b][color=#009900]2[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] test [b][color=#009900]1[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] ss [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=RED]([/color][/b][b][color=#009900]0[/color][/b] . [b][color=#ff00ff]"CIRCLE"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
         [b][color=RED]([/color][/b][b][color=BLUE]while[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]zerop[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]sslength[/color][/b] ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] tCirc [b][color=RED]([/color][/b][b][color=BLUE]ssname[/color][/b] ss [b][color=#009900]0[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
           [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] subSs [b][color=RED]([/color][/b][b][color=BLUE]ssget[/color][/b] [b][color=#ff00ff]"_X"[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]0[/color][/b] [b][color=#ff00ff]"CIRCLE"[/color][/b][b][color=RED])[/color][/b]
                                             [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]-4[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] flag [b][color=#ff00ff]">=,=,*"[/color][/b] [b][color=#ff00ff]"<=,=,*"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                                             [b][color=RED]([/color][/b][b][color=BLUE]cons[/color][/b] [b][color=#009900]10[/color][/b]
                                               [b][color=RED]([/color][/b][b][color=BLUE]append[/color][/b]
                                                 [b][color=RED]([/color][/b][b][color=BLUE]list[/color][/b]
                                                   [b][color=RED]([/color][/b][b][color=BLUE]apply[/color][/b]
                                                     [b][color=RED]([/color][/b][b][color=BLUE]if[/color][/b] flag [b][color=DARKRED]'[/color][/b][b][color=BLUE]max[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]min[/color][/b][b][color=RED])[/color][/b]
                                                     [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]car[/color][/b] lDat[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                                                 [b][color=RED]([/color][/b][b][color=BLUE]cddr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] tCirc[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
             [b][color=RED]([/color][/b][b][color=BLUE]progn[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] total [b][color=#009999]0.0[/color][/b][b][color=RED])[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]foreach[/color][/b] ent [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] subSs_lst
                              [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=BLUE]cadr[/color][/b]
                                [b][color=RED]([/color][/b][b][color=BLUE]ssnamex[/color][/b] subSs[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                 [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] total [b][color=RED]([/color][/b][b][color=BLUE]+[/color][/b] total [b][color=RED]([/color][/b][b][color=BLUE]vla-get-Area[/color][/b]
                                        [b][color=RED]([/color][/b][b][color=BLUE]vlax-ename->vla-object[/color][/b] ent[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] cLst
                      [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b]
                        [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]10[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] subSs_lst[b][color=RED])[/color][/b]
                         [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x1 x2[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]<[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x1[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] x2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                     Rad
                      [b][color=RED]([/color][/b][b][color=BLUE]vl-sort[/color][/b]
                        [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]cdr[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]assoc[/color][/b] [b][color=#009900]40[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]entget[/color][/b] x[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b] subSs_lst[b][color=RED])[/color][/b]
                         [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]r1 r2[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]>[/color][/b] r1 r2[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]mapcar[/color][/b] [b][color=DARKRED]'[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]lambda[/color][/b] [b][color=RED]([/color][/b]x[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] x ss[b][color=RED])[/color][/b][b][color=RED])[/color][/b] subSs_lst[b][color=RED])[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]strcat[/color][/b] [b][color=#ff00ff]"\nRow "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]itoa[/color][/b] test[b][color=RED])[/color][/b]
                              [b][color=#ff00ff]"; MinXCtr: "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-princ-to-string[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] cLst[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                              [b][color=#ff00ff]" MaxRad = "[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]vl-princ-to-string[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]car[/color][/b] Rad[b][color=RED])[/color][/b][b][color=RED])[/color][/b]
                              [b][color=#ff00ff]" => "[/color][/b] [b][color=#ff00ff]" Total = "[/color][/b][b][color=RED]([/color][/b][b][color=BLUE]rtos[/color][/b] total[b][color=RED])[/color][/b]
                              [b][color=#ff00ff]"\n-----------------------------------------"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]ssdel[/color][/b] tCirc ss[b][color=RED])[/color][/b]
               [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] test [b][color=RED]([/color][/b][b][color=BLUE]1+[/color][/b] test[b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]and[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]not[/color][/b] flag[b][color=RED])[/color][/b] [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n\nRIGHT:\n"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
       [b][color=RED]([/color][/b][b][color=BLUE]setq[/color][/b] flag [b][color=BLUE]T[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
     [b][color=RED]([/color][/b][b][color=BLUE]textscr[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
   [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=#ff00ff]"\n<!> No Line Selected <!>"[/color][/b][b][color=RED])[/color][/b][b][color=RED])[/color][/b]
 [b][color=RED]([/color][/b][b][color=BLUE]princ[/color][/b] [b][color=RED])[/color][/b][b][color=RED])[/color][/b]

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

不错，威兹曼，

我试着一次做太多的事情，所以我并没有过滤到原始设置。

感谢您的修改

wizman · 发表于 2022-7-6 15:21:06

..也谢谢李。

Lee Mac · 发表于 2022-7-6 15:26:33

您好，是的，谢谢，效果很好，但是我想先选择线，然后在所有圆上创建一个交叉窗口。
我试着用（setq ss（ssget（list）（0，“CIRCLE”）修改它
然而，对于交叉窗口，它要求制作另一个交叉窗口（右侧）
所以我做了2个“whiles”，而不是重复。我还试图创建两个独立的答案-一个是左一个是右，而不是一个最终答案。
这不太管用-有人能调整一下吗？
谢谢
干杯

wizman · 发表于 2022-7-6 15:29:52

这里有一种方法仍然使用repeat，但不是ssget“x”，而是使用ssget“c”

*为子系统的ssget更新的编辑代码

copy

(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 ))

Lee Mac · 发表于 2022-7-6 15:30:03

wizman · 发表于 2022-7-6 15:35:45

..thank you also lee.

Small Fish · 发表于 2022-7-6 15:37:38

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

wizman · 发表于 2022-7-6 15:42:02

here's a way to still use repeat but instead of ssget "x" use ssget "c"

*edit code updated for ssget of subss

copy

(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 ))

[编程交流] 查找圆的区域

发表回复

精选推荐