=>；[挑战]<；＝嵌套矩形
以为我们需要一个有趣的任务来做。考虑矩形内矩形的插图。我们假设每个矩形都是一个动态块，已根据需要拉伸。我们还将假设绘制所有矩形，以便它们不相交或相互接触。我希望用户能够选择所有矩形并获取嵌套括号，指示矩形之间的嵌套关系。顺序将从左到右和从上到下确定。让整数表示矩形的用户名。我想得到一个这样的列表（1（2）（3（4）（5））（6（7（8））））
），其中每对括号代表其中一个矩形，整数是相应矩形的文件名。
**** Hidden Message ***** 这是我的尝试：
(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)
)
)
)
你好，李！
您的版本为嵌套实体提供了重播... 优化了我的版本:
(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)”一节中？
精湛的方法Evgeniy！
递归技术让我想起了这一点。
嗨，李！
您的版本为嵌套实体提供了重播.........
它在我的所有测试中都有效，但我同意该方法不如您的方法健壮。
小心的Evgeniy：
(reverse (cons a (acet-geom-extents a))) =/= (append (acet-geom-extents a) (list a))
此外，由于您的目标是优化，为什么使用：
(vl-remove-if (function listp) (mapcar (function cadr) (ssnamex l)))
ssnamex
已知非常慢...
绘制三个矩形，首先在内部，然后外部（请参阅附件）...
((( )))
谢谢！
这应该可以解决这个问题，但与你的解决方案相比，它很丑陋：
(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)
)
)
)
我还使用了实体句柄而不是实体名称，因为它更容易跟踪。 是的，它工作得很好！ 以下是我对您的功能的建议：
(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))
)
)
)
希望你不介意 另一个 - 嗖嗖嗖的方式：
(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)
)
)
)
也许它更慢但更短...
Evgeniy，
使用时：
(reverse (cons a (acet-geom-extents a)))
这永远不会是真的：
(vl-every (function
因为（car a）[右上角]的坐标将始终大于（cadr a）[左下角]
页:
[1]
2