麻烦高手帮我整理一下以下字句，谢谢！

chenry676

麻烦高手帮我整理一下以下字句，我不专业弄不来，谢谢！例如：("1" ("2" "3"  ("4"  ("5" ("6" ("7"))))))
表示：块“7”在块“6”中，块“6”在块“5”中，块“5”在块“4”中，块“4”，块“3”，块“2”，在块“1”中[code="lisp] ;;;作者：highflybird ;;;Main Function (defun c:BT (/ AllLst bkTree)   (setq *APP (vlax-get-acad-object))   (setq *DOC (vla-get-ActiveDocument *APP))   (setq *BLK (vla-get-blocks *DOC))   (vlax-for blk *BLK     (setq AllLst (cons (GetNestedName blk) AllLst))   )   (foreach n AllLst     (setq bkTree (cons (Tree (car n)) bkTree))   )   (princ bkTree)   ; Now BkTree is the return value, it's a blockDef tree.   (princ) ) ;;;Get all names of Nested Blocks in A blockDef (defun GetNestedName (blk / lst iName)   (vlax-for n blk     (if (or           (= (vla-get-objectname n) "AcDbBlockReference")           (= (vla-get-objectname n) "AcDbMInsertBlock")         )       (progn         (setq iName (vla-get-name n))         (if (not (member iName lst))           (setq lst (cons iName lst))         )       )     )   )   (cons (vla-get-name blk) lst) ) ;;;to Construct The BlockDef Tree (defun Tree (name / lst)   (foreach n (cdr (assoc name AllLst))     (setq lst (cons (Tree n) lst))   )   (if lst     (cons name (list lst))     name   ) )[/code][code="lisp] ;;;作者：Leeben (defun AllBlkNInBlkdef (blkn / blkdef e typ bn bnl e-l nl)   (setq ;bnl    '() blkdef (tblobjname "block" blkn)   )   (while (setq e (entnext blkdef))     (setq typ (cdr (assoc 0 (entget e))))     (if (= typ "INSERT")       (setq bn (vla-get-name (vlax-ename->vla-object e))      bnl (if bn     (cons (if (setq nl (AllBlkNInBlkdef bn))        (list bn nl)        bn      )      bnl     )   )       )     )     (setq blkdef e)   )   bnl ) (defun c:ABnInBl (/ i en ss blknlst ABblknlst)   (setq ss   (ssget '((0 . "INSERT"))) ;ABblknlst '()   )   (if ss     (repeat (setq i (sslength ss))       (setq en       (ssname ss (setq i (1- i)))      blkn      (vla-get-name (vlax-ename->vla-object en))      blknlst   (AllBlkNInBlkdef blkn)      ABblknlst (cons (if blknlst     (list blkn blknlst)     blkn          )          ABblknlst         )       )     )     (princ "*** 你没有选择任何图块 ***")   )   (princ ABblknlst) (princ) )[/code]

AndyWang

不保证对，自己再调试下

1. (defun c:BT (/ AllLst bkTree)
   
2.   (setq *APP (vlax-get-acad-object))
   
3.   (setq *DOC (vla-get-ActiveDocument *APP))
   
4.   (setq *BLK (vla-get-blocks *DOC))
   
5.   (vlax-for blk *BLK (setq AllLst (cons (GetNestedName blk) AllLst)))
   
6.   (foreach n AllLst (setq bkTree (cons (Tree (car n)) bkTree)))
   
7.   (princ bkTree) ; Now BkTree is the return value, it's a blockDef tree.
   
8.   (princ)
   
9. ) ;;;Get all names of Nested Blocks in A blockDef
   
10. (defun GetNestedName (blk / lst iName)
    
11.   (vlax-for n
    
12.             blk
    
13.             (if
    
14.               (or (= (vla-get-objectname n) "AcDbBlockReference")
    
15.                   (= (vla-get-objectname n) "AcDbMInsertBlock")
    
16.               )
    
17.               (progn (setq iName (vla-get-name n))
    
18.                      (if (not (member iName lst)) (setq lst (cons iName lst)))
    
19.               )
    
20.             )
    
21.   )
    
22.   (cons (vla-get-name blk) lst)
    
23. ) ;;;to Construct The BlockDef Tree
    
24. (defun Tree (name / lst)
    
25.   (foreach n (cdr (assoc name AllLst)) (setq lst (cons (Tree n) lst)))
    
26.   (if lst (cons name (list lst)) name)
    
27. )
    
28. ;;;作者：Leeben
    
29. (defun AllBlkNInBlkdef (blkn / blkdef e typ bn bnl e-l nl)
    
30.   (setq  ;
    
31.         bnl    '()
    
32.         blkdef (tblobjname "block" blkn)
    
33.   )
    
34.   (while (setq e (entnext blkdef))
    
35.     (setq typ (cdr (assoc 0 (entget e))))
    
36.     (if (= typ "INSERT")
    
37.       (setq bn  (vla-get-name (vlax-ename->vla-object e))
    
38.             bnl (if bn
    
39.                   (cons (if (setq nl (AllBlkNInBlkdef bn)) (list bn nl) bn) bnl)
    
40.                 )
    
41.       )
    
42.     )
    
43.     (setq blkdef e)
    
44.   )
    
45.   bnl
    
46. )
    
47. (defun c:ABnInBl (/ i en ss blknlst ABblknlst)
    
48.   (setq ss  (ssget '((0 . "INSERT"))) ;ABblknlst
    
49.         '()
    
50.   )
    
51.   (if ss
    
52.     (repeat (setq i (sslength ss))
    
53.       (setq en        (ssname ss (setq i (1- i)))
    
54.             blkn      (vla-get-name (vlax-ename->vla-object en))
    
55.             blknlst   (AllBlkNInBlkdef blkn)
    
56.             ABblknlst (cons (if blknlst (list blkn blknlst) blkn) ABblknlst)
    
57.       )
    
58.     )
    
59.     (princ "*** 你没有选择任何图块 ***")
    
60.   )
    
61.   (princ ABblknlst)
    
62.   (princ)
    
63. )

(defun c:BT (/ AllLst bkTree) <br />   (setq *APP (vlax-get-acad-object))<br />   (setq *DOC (vla-get-ActiveDocument *APP))<br />   (setq *BLK (vla-get-blocks *DOC))<br />   (vlax-for blk *BLK (setq AllLst (cons (GetNestedName blk) AllLst)))<br />   (foreach n AllLst (setq bkTree (cons (Tree (car n)) bkTree)))<br />   (princ bkTree) ; Now BkTree is the return value, it's a blockDef tree.<br />   (princ)<br /> ) ;;;Get all names of Nested Blocks in A blockDef <br /> (defun GetNestedName (blk / lst iName) <br />   (vlax-for n <br />             blk<br />             (if <br />               (or (= (vla-get-objectname n) "AcDbBlockReference") <br />                   (= (vla-get-objectname n) "AcDbMInsertBlock")<br />               )<br />               (progn (setq iName (vla-get-name n)) <br />                      (if (not (member iName lst)) (setq lst (cons iName lst)))<br />               )<br />             )<br />   )<br />   (cons (vla-get-name blk) lst)<br /> ) ;;;to Construct The BlockDef Tree <br /> (defun Tree (name / lst) <br />   (foreach n (cdr (assoc name AllLst)) (setq lst (cons (Tree n) lst)))<br />   (if lst (cons name (list lst)) name)<br /> )<br /> ;;;作者：Leeben <br /> (defun AllBlkNInBlkdef (blkn / blkdef e typ bn bnl e-l nl) <br />   (setq  ;<br />         bnl    '()<br />         blkdef (tblobjname "block" blkn)<br />   )<br />   (while (setq e (entnext blkdef)) <br />     (setq typ (cdr (assoc 0 (entget e))))<br />     (if (= typ "INSERT") <br />       (setq bn  (vla-get-name (vlax-ename->vla-object e))<br />             bnl (if bn <br />                   (cons (if (setq nl (AllBlkNInBlkdef bn)) (list bn nl) bn) bnl)<br />                 )<br />       )<br />     )<br />     (setq blkdef e)<br />   )<br />   bnl<br /> )<br /> (defun c:ABnInBl (/ i en ss blknlst ABblknlst) <br />   (setq ss  (ssget '((0 . "INSERT"))) ;ABblknlst<br />         '()<br />   )<br />   (if ss <br />     (repeat (setq i (sslength ss)) <br />       (setq en        (ssname ss (setq i (1- i)))<br />             blkn      (vla-get-name (vlax-ename->vla-object en))<br />             blknlst   (AllBlkNInBlkdef blkn)<br />             ABblknlst (cons (if blknlst (list blkn blknlst) blkn) ABblknlst)<br />       )<br />     )<br />     (princ "*** 你没有选择任何图块 ***")<br />   )<br />   (princ ABblknlst)<br />   (princ)<br /> )

chenry676

AndyWang 发表于 2021-4-22 14:32
不保证对，自己再调试下

我这边运行提示语法错误。

AndyWang

chenry676 发表于 2021-4-22 14:53
我这边运行提示语法错误。

去lisp里去调试下，错一般在封号断错位置。调试时修改下。

chenry676

不专业，不会调整哦，好像是不是有好几个组合在一起的，我要达到的是统计子块功能，原链接在这个地方http://bbs.mjtd.com/forum.php?mo ... hlight=%D7%D3%BF%E9