=&gt；[挑战]&lt；＝嵌套矩形

Jeremy · 发表于 2013-5-12 19:40:59

以为我们需要一个有趣的任务来做。考虑矩形内矩形的插图。我们假设每个矩形都是一个动态块，已根据需要拉伸。我们还将假设绘制所有矩形，以便它们不相交或相互接触。我希望用户能够选择所有矩形并获取嵌套括号，指示矩形之间的嵌套关系。顺序将从左到右和从上到下确定。让整数表示矩形的用户名。我想得到一个这样的列表
（1（2）（3（4）（5））（6（7（8））））
），其中每对括号代表其中一个矩形，整数是相应矩形的文件名。

4fs4gdv0nhh.JPG

本帖以下内容被隐藏保护；需要你回复后，才能看到！

游客，如果您要查看本帖隐藏内容请回复

Jeremy · 发表于 2013-5-12 19:46:40

这是我的尝试：

copy

(defun c:rord ( / _inside-p _massoc _process ent inc itm lst ref sel sub tmp vtl )
 
    (defun _inside-p ( ll1 ur1 ll2 ur2 )
        (apply 'and (mapcar '
    )
 
    (defun _massoc ( key lst )
        (if (setq itm (assoc key lst))
            (cons (cdr itm) (_massoc key (cdr (member itm lst))))
        )
    )
 
    (defun _process ( lst ref / itm nst out )
        (while (setq itm (car lst))
            (setq lst (cdr lst))
            (if (setq nst (cdr (assoc itm ref)))
                (setq out (cons (cons itm (_process nst ref)) out)
                      lst (vl-remove-if '(lambda ( x ) (member x nst)) lst)
                )
                (setq out (cons itm out))
            )
        )
        (reverse out)
    )
    
    (if (setq sel (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
        (progn
            (repeat (setq inc (sslength sel))
                (setq ent (ssname sel (setq inc (1- inc)))
                      vtl (_massoc 10 (entget ent))
                      tmp (cons (cons ent (mapcar '(lambda ( x ) (apply 'mapcar (cons x vtl))) '(min max))) tmp)
                      lst (cons ent lst)
                )
            )
            (foreach x1 tmp
                (foreach x2 (vl-remove x1 tmp)
                    (if (apply '_inside-p (append (cdr x2) (cdr x1)))
                        (setq sub (cons (car x2) sub))
                    )
                )
                (setq ref (cons (cons (car x1) sub) ref)
                      sub nil
                )
            )
            (_process (vl-sort lst '(lambda ( a b ) (> (length (assoc a ref)) (length (assoc b ref))))) ref)
        )
    )
)

ElpanovEvgeniy · 发表于 2013-5-13 07:29:55

你好，李！
您的版本为嵌套实体提供了重播...

ElpanovEvgeniy · 发表于 2013-5-13 12:30:31

优化了我的版本:

copy

(defun eea-test-1 (/ f l)
  (defun f (l a b c)
    (cond ((not l)
           (cons (if b
                   (cons (last a) (f (cdr (reverse b)) (last b) nil nil))
                   (cddr a)
                 )
                 (if c
                   (f (cdr (reverse c)) (last c) nil nil)
                 )
           )
          )
          ((vl-every (function 
          ((f (cdr l) a b (cons (car l) c)))
    )
  )
  (if (setq l (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
    (progn (setq l (vl-sort (mapcar (function (lambda (a) (reverse (cons a (acet-geom-extents a)))))
                                    (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex l)))
                            )
                            (function (lambda (a b) (
                   )
           )
           (f (cdr l) (car l) nil nil)
    )
  )
)

ps。为什么这个主题在“CAD常规”一节中，而不是在“AutoLISP (Vanilla / Visual)”一节中？

ElpanovEvgeniy · 发表于 2013-5-13 12:34:31

精湛的方法Evgeniy！
递归技术让我想起了这一点。
嗨，李！
您的版本为嵌套实体提供了重播.........
它在我的所有测试中都有效，但我同意该方法不如您的方法健壮。
小心的Evgeniy：

copy

(reverse (cons a (acet-geom-extents a))) =/= (append (acet-geom-extents a) (list a))

此外，由于您的目标是优化，为什么使用：

copy

(vl-remove-if (function listp) (mapcar (function cadr) (ssnamex l)))

ssnamex
已知非常慢...

ElpanovEvgeniy · 发表于 2013-5-14 07:56:40

绘制三个矩形，首先在内部，然后外部（请参阅附件）...

copy

((  ( )))

谢谢！
这应该可以解决这个问题，但与你的解决方案相比，它很丑陋：

copy

(defun c:rord ( / _inside-p _massoc _process _sort enx han inc itm lst ref sel sub tmp vtl )
 
    (defun _inside-p ( ll1 ur1 ll2 ur2 )
        (apply 'and (mapcar '
    )
  
    (defun _massoc ( key lst )
        (if (setq itm (assoc key lst))
            (cons (cdr itm) (_massoc key (cdr (member itm lst))))
        )
    )
  
    (defun _process ( lst ref / itm nst out )
        (while (setq itm (car lst))
            (setq lst (cdr lst))
            (if (setq nst (cdr (assoc itm ref)))
                (setq out (cons (cons itm (_process (_sort nst ref) ref)) out)
                      lst (vl-remove-if '(lambda ( x ) (member x nst)) lst)
                )
                (setq out (cons itm out))
            )
        )
        (reverse out)
    )
 
    (defun _sort ( lst ref )
        (vl-sort lst '(lambda ( a b ) (> (length (assoc a ref)) (length (assoc b ref)))))
    )       
  
    (if (setq sel (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
        (progn
            (repeat (setq inc (sslength sel))
                (setq enx (entget (ssname sel (setq inc (1- inc))))
                      vtl (_massoc 10 enx)
                      han (cdr (assoc 5 enx))
                      tmp (cons (cons han (mapcar '(lambda ( x ) (apply 'mapcar (cons x vtl))) '(min max))) tmp)
                      lst (cons han lst)
                )
            )
            (foreach x1 tmp
                (foreach x2 (vl-remove x1 tmp)
                    (if (apply '_inside-p (append (cdr x2) (cdr x1)))
                        (setq sub (cons (car x2) sub))
                    )
                )
                (setq ref (cons (cons (car x1) sub) ref)
                      sub nil
                )
            )
            (_process (_sort lst ref) ref)
        )
    )
)

我还使用了实体句柄而不是实体名称，因为它更容易跟踪。

ElpanovEvgeniy · 发表于 2013-5-14 08:47:21

是的，它工作得很好！

ElpanovEvgeniy · 发表于 2013-5-14 09:14:04

以下是我对您的功能的建议：

copy

(defun eea-test-1-lm ( / f e i l s )
 
    (defun f ( l a / b c )
        (foreach x l
            (if (vl-every '
                (setq b (cons x b))
                (setq c (cons x c))
            )
        )
        (cons
            (if b
                (cons (last a) (f (cdr (reverse b)) (last b)))
                (cddr a)
            )
            (if c
                (f (cdr (reverse c)) (last c))
            )
        )
    )
 
    (if (setq s (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
        (progn
            (repeat (setq i (sslength s))
                (setq e (ssname s (setq i (1- i)))
                      l (cons (reverse (cons (cdr (assoc 5 (entget e))) (reverse (acet-geom-extents e)))) l)
                )
            )
            (setq l (vl-sort l (function (lambda ( a b ) (
            (f (cdr l) (car l))
        )
    )
)

希望你不介意

ElpanovEvgeniy · 发表于 2013-5-14 09:25:33

另一个 - 嗖嗖嗖的方式：

copy

(defun eea-test-1 (/ f l)
  (defun f (l a b c)
    (cond ((not l)
           (cons (if b
                   (cons (last a) (f (cdr (reverse b)) (last b) nil nil))
                   (cddr a)
                 )
                 (if c
                   (f (cdr (reverse c)) (last c) nil nil)
                 )
           )
          )
          ((vl-every (function 
          ((f (cdr l) a b (cons (car l) c)))
    )
  )
  (if (setq l (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1))))
    (progn (setq l (vl-sort (mapcar (function (lambda (a) (reverse (cons a (acet-geom-extents a))))) (acet-ss-to-list l))
                            (function (lambda (a b) (
                   )
           )
           (f (cdr l) (car l) nil nil)
    )
  )
)

也许它更慢但更短...

ElpanovEvgeniy · 发表于 2013-5-14 09:30:26

Evgeniy，
使用时：

copy

(reverse (cons a (acet-geom-extents a)))

这永远不会是真的：

copy

(vl-every (function

因为（car a）[右上角]的坐标将始终大于（cadr a）[左下角]

=&gt；[挑战]&lt；＝嵌套矩形

发表回复

精选推荐