给几个别人写的程序,你稍作修改,便可以满足你的要求
运行程序会返回图形或选择集中所有的块树列表
例如:("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)
- )
|