麻烦高手帮我整理一下以下字句，谢谢！
麻烦高手帮我整理一下以下字句，我不专业弄不来，谢谢！例如：("1" ("2" "3"("4"("5" ("6" ("7"))))))表示：块“7”在块“6”中，块“6”在块“5”中，块“5”在块“4”中，块“4”，块“3”，块“2”，在块“1”中 ;;;作者：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 ) ) ;;;作者：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) )
不保证对，自己再调试下
(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)
)
;;;作者：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)
) AndyWang 发表于 2021-4-22 14:32
不保证对，自己再调试下
我这边运行提示语法错误。 chenry676 发表于 2021-4-22 14:53
我这边运行提示语法错误。
去lisp里去调试下，错一般在封号断错位置。调试时修改下。 本帖最后由 chenry676 于 2021-4-29 21:11 编辑
不专业，不会调整哦，好像是不是有好几个组合在一起的，我要达到的是统计子块功能，原链接在这个地方http://bbs.mjtd.com/forum.php?mo ... hlight=%D7%D3%BF%E9
页:
[1]