已有嵌套块中的块层级表，请问如何按各路径展开

960322

现在已经得到了嵌套块中的块层级表，请问如何按各路径展开得到所有的嵌套块组成情况
;;;;得到多重嵌套块的嵌套层级表
;;;;blk，任意图块的图块名
(defun getblklst (blk / e dxf lst blk2)
   (setq e(tblobjname "block" blk)
  lst  nil)
        (while(setq e(entnext e)    )            ;;;;;(setq e(entnext e) nam (zm e 2)   )              
                 (and(setq dxf(entget e))                                
                         (wcmatch(cdr(assoc 0 dxf)) "INSERT")
                         (setq blk2(cdr(assoc 2 dxf)))      
                         (setq lst1 (list(list   (list blk2) (getblks blk2))   ))
           (setq lst (append lst1 lst))                        
                 )
         )lst
)
(getblklst  "9")
;;((("8") ((("6") ((("5") nil) (("4") nil))) (("3") ((("2") nil) (("1") nil))))) (("7") ((("6") ((("5") nil) (("4") nil))) (("3") ((("2") nil) (("1") nil))))))

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

楼上的高手，我确实是想得到每个图块的实际插入点，可惜水平太差做不到。就想先一步一步的来了。请问您的程序是不是需要联网用你的程序库才行？

kozmosovia

要得到插入点，不用矩阵转换的方式就是把主图快copy原点到DBX中分解，然后顺次分解得到需要图块名的快插入点。

960322

vitalgg 发表于 2024-5-17 10:36
以上代码由 @lisp函数库 提供支持！  https://atlisp.cn/functionlib.html
请先运行以下代码 ...

感谢老大，自己摸索着把你的函数补齐了，搞定了，谢谢！

Pegasus

960322 发表于 2024-5-18 00:02
感谢老大，自己摸索着把你的函数补齐了，搞定了，谢谢！

差 "@:log" 和 "TYPE-OF" 这两个函数，能提供代码吗？

xshrimp

不知道你要什么?

(xzj-blk-tree "9")
=>

1. (defun xzj-blk-tree (blkName / i lst)   
   
2.    (setq lst (append lst  (list blkName)))
   
3.    (vlax-for i (vla-item(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))blkName)   
   
4.     (if (= "AcDbBlockReference" (vla-get-ObjectName i))
   
5.       (setq lst (append lst (list (append (xzj-blk-tree (vla-get-Name i)) ))))
   
6.     )      
   
7.    )
   
8.   lst
   
9. )

(defun xzj-blk-tree (blkName / i lst)    <br />    (setq lst (append lst  (list blkName))) <br />    (vlax-for i (vla-item(vla-get-blocks(vla-get-activedocument(vlax-get-acad-object)))blkName)   <br />     (if (= "AcDbBlockReference" (vla-get-ObjectName i))<br />       (setq lst (append lst (list (append (xzj-blk-tree (vla-get-Name i)) ))))<br />     )      <br />    )<br />   lst<br /> )

("9"
  ("7"
    ("3" ("1") ("2"))
    ("6" ("4") ("5"))
  )
  ("8"
    ("3" ("1") ("2"))
    ("6" ("4") ("5"))
  )
)