如何求不限重数内层块A相对于最外层块B的插入点

960322

有一个不限重数的多重嵌套块，块名为B ，比如B包含块C、C包含D，D包含块A。  如何求得块A相对于最外层块B定义点的相对插入点？要用什么矩阵转换之类的，实在是不会，恳请高手帮忙，谢谢了！最好是在block中直接算出来，不要在实体中获取，这样速度快。

liuhe

https://www.lee-mac.com/extractnestedblock.html


leemac  提取嵌套块，层层嵌套实例

vitalgg

如果无法播放，请点击此处在新窗口打开

1. (defun blk-in-loop (blkref / res)
   
2.   "块嵌套表"
   
3.   (setq res nil)
   
4.   (if (eq "INSERT" (entity:getdxf blkref 0))
   
5.       (progn
   
6.   (setq res (cons blkref res))
   
7.   (if (setq subblks (vl-remove-if-not
   
8.          '(lambda(x)(eq "INSERT" (entity:getdxf x 0)))
   
9.          (block:ent-list (entity:getdxf blkref 2))))
   
10.       (setq res (cons (mapcar 'blk-in-loop subblks) res)))))
    
11.   (reverse res))
    
12. 
    
13. (defun blkbase-in-loop (lst-blkloop para1 / res subblks tmp-para)
    
14.   "基点坐标嵌套表,para1为基点，旋转角，缩放比例，默认为((0 0)  0 1)"
    
15.   (if (null para1)
    
16.       (setq para1 '((0 0 0) 0 1.0)))
    
17.   (setq res nil)
    
18.   (if (eq "INSERT" (entity:getdxf (car lst-blkloop) 0))
    
19.       (progn
    
20.   (setq res (cons
    
21.        (list
    
22.         (block:bcs2wcs
    
23.          (entity:getdxf (car lst-blkloop) 10)
    
24.          (entity:getdxf
    
25.           (tblobjname "block" (entity:getdxf (car lst-blkloop) 2))
    
26.           10)
    
27.          (car para1)
    
28.          (cadr para1)
    
29.          (caddr para1)
    
30.          )
    
31.         (+  (cadr para1)
    
32.       (entity:getdxf (car lst-blkloop) 50))
    
33.         
    
34.         (* (entity:getdxf (car lst-blkloop) 41)
    
35.            (caddr para1))
    
36.         )
    
37.        res))
    
38.   (entity:putdxf
    
39.    (entity:make-circle (caar res) 2)
    
40.    62 1)
    
41.   (if (setq subblks (cadr lst-blkloop))
    
42.       (progn
    
43.         (setq tmp-para (car res))
    
44.         (setq res (cons (mapcar '(lambda(x)
    
45.           (blkbase-in-loop
    
46.            x
    
47.            tmp-para))
    
48.               subblks)
    
49.             res))))))
    
50.   (reverse res))
    
51. 
    
52. (setq blkref(car(entsel)))
    
53. (blkbase-in-loop(blk-in-loop blkref)nil)
    

(defun blk-in-loop (blkref / res)<br />   "块嵌套表"<br />   (setq res nil)<br />   (if (eq "INSERT" (entity:getdxf blkref 0))<br />       (progn<br />   (setq res (cons blkref res))<br />   (if (setq subblks (vl-remove-if-not<br />          '(lambda(x)(eq "INSERT" (entity:getdxf x 0)))<br />          (block:ent-list (entity:getdxf blkref 2))))<br />       (setq res (cons (mapcar 'blk-in-loop subblks) res)))))<br />   (reverse res))<br /> <br /> (defun blkbase-in-loop (lst-blkloop para1 / res subblks tmp-para)<br />   "基点坐标嵌套表,para1为基点，旋转角，缩放比例，默认为((0 0)  0 1)"<br />   (if (null para1)<br />       (setq para1 '((0 0 0) 0 1.0)))<br />   (setq res nil)<br />   (if (eq "INSERT" (entity:getdxf (car lst-blkloop) 0))<br />       (progn<br />   (setq res (cons<br />        (list<br />         (block:bcs2wcs<br />          (entity:getdxf (car lst-blkloop) 10)<br />          (entity:getdxf<br />           (tblobjname "block" (entity:getdxf (car lst-blkloop) 2))<br />           10)<br />          (car para1)<br />          (cadr para1)<br />          (caddr para1)<br />          )<br />         (+  (cadr para1)<br />       (entity:getdxf (car lst-blkloop) 50))<br />         <br />         (* (entity:getdxf (car lst-blkloop) 41)<br />            (caddr para1))<br />         )<br />        res))<br />   (entity:putdxf<br />    (entity:make-circle (caar res) 2)<br />    62 1)<br />   (if (setq subblks (cadr lst-blkloop))<br />       (progn<br />         (setq tmp-para (car res))<br />         (setq res (cons (mapcar '(lambda(x)<br />           (blkbase-in-loop<br />            x<br />            tmp-para))<br />               subblks)<br />             res))))))<br />   (reverse res))<br /> <br /> (setq blkref(car(entsel)))<br /> (blkbase-in-loop(blk-in-loop blkref)nil)<br />

以上代码由 @lisp函数库 提供支持！  https://atlisp.cn/functionlib.html
请先运行以下代码，再执行上面的代码。

1. (progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))
   

(progn(vl-load-com)(setq s strcat h"http"o(vlax-create-object (s"win"h".win"h"request.5.1"))v vlax-invoke e eval r read)(v o'open "get" (s h"://""atlisp.""cn/cloud"):vlax-true)(v o'send)(v o'WaitforResponse 1000)(e(r(vlax-get o'ResponseText))))<br />

960322

谢谢楼上的大师，帮我解决了问题。