TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: highflyingbird on March 26, 2009, 09:25:18 PM
-
In a dwg file,there are a lot of blocks. Some blocks is nested. How to list all the blocks in a directory form?
for example ,These are blocks: "1" "2" "3" "4" "5" "6" "7"; "7" in "6","6" "5" in "4", "4" "3" "2" in "1";
this function return value likes below:
("1" ("2" "3" ("4" ("5" ("6" ("7"))))))
How to get it?
Actually, I found a way to list all the nested blocks in a Insert.But for this ,I have no idea...
-
If you want to flatten the list this will help:
http://www.theswamp.org/index.php?topic=4064.0
Otherwise I'm lost. 8-)
-
I believe he wants the opposite of flattening Alan (a block def tree), but I could be wrong. :)
Simply walk thru each block definition collection (starting with the master blocks collection), recursively drilling into, and then out of each nested definition, indenting, and then de-indenting accordingly | appropriately before printing the block collection names. Should be 50 lines of code or less.
-
I believe he wants the opposite of flattening Alan (a block def tree), but I could be wrong. :)
Simply walk thru each block definition collection (starting with the master blocks collection), recursively drilling into, and then out of each nested definition, indenting, and then de-indenting accordingly | appropriately before printing the block collection names. Should be 50 lines of code or less.
Yes,extractly,I want a block def tree.
-
REALLY QUICK, REALLY DIRTY.
But should work <starting point anyway>:
(defun c:BlockDefTree ( / foo blocks )
(defun foo ( blocks block indent )
(repeat indent (princ " "))
(princ (vla-get-name block))
(princ "\n")
(vlax-for object block
(if (eq "AcDbBlockReference" (vla-get-objectname object))
(foo blocks (vla-item blocks (vla-get-name object)) (1+ indent))
)
)
)
(vlax-for block
(setq blocks
(vla-get-blocks
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(foo blocks block 0)
)
(princ)
)
Tried to stretched it out but it only spans 29 lines. :|
-
REALLY QUICK, REALLY DIRTY.
But should work <starting point anyway>:
(defun c:BlockDefTree ( / foo blocks )
(defun foo ( blocks block indent )
(repeat indent (princ " "))
(princ (vla-get-name block))
(princ "\n")
(vlax-for object block
(if (eq "AcDbBlockReference" (vla-get-objectname object))
(foo blocks (vla-item blocks (vla-get-name object)) (1+ indent))
)
)
)
(vlax-for block
(setq blocks
(vla-get-blocks
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(foo blocks block 0)
)
(princ)
)
Tried to stretched it out but it only spans 29 lines. :|
Nice job! MP
Could you make this function return value likes below:
("1" ("2" "3" ("4" ("5" ("6" ("7"))))))
???
-
Sure could but it's late. By the time I look at this thread tomorrow there will likely be 10 versions posted, so just wait a bit. :D
-
Sure could but it's late. By the time I look at this thread tomorrow there will likely be 10 versions posted, so just wait a bit. :D
MP,thanks a lot.
But I want the return value is a list,(I think it is a multiway tree structure), and if a blockdef has many same name nested blockdef in it, I just want a single ,remove those Duplicates.
Ha,What a different between our time! When we are working ,you are sleeping.Have a good dream!
-
Sure could but it's late. By the time I look at this thread tomorrow there will likely be 10 versions posted, so just wait a bit. :D
:-D
Time difference!!!
-
How my codes?
(defun AllBlkNInBlkdef (blkn / blkdef e typ bn bnl e-l)
(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
;;(append (list (list bn (AllBlkNInBlkdef bn))) bnl)
(cons (list bn (AllBlkNInBlkdef bn)) bnl)
)
)
;(setq el (cons e el))
)
(setq blkdef e)
)
bnl
)
(defun c:ABnInBl1 (/ 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 (append (list (list blkn blknlst)) ABblknlst)
)
)
(princ "*** 你没有选择任何图块 ***")
)
;(princ)
)
-
OK! Now I got it!
;;;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
)
)
-
But I want the return value is a list
I misunderstood what you wanted but it appears you have what you need now so all is good.
PS: I don't know if you've been formerly welcomed to the swamp, so 'Welcome to the swamp highflybird'.
:)
-
I modded my original little contribution. It doesn't list redundant entries, makes it look like a tree of sorts, flags xrefs.
(defun c:BTree ( / walk main )
(defun walk ( blocks block indent / names )
(repeat (1- indent) (princ " "))
(if (< 0 indent) (princ "+-- "))
(princ (vla-get-name block))
(princ (if (eq :vlax-true (vla-get-isxref block)) " <XREF>\n" "\n"))
(vlax-for object block
(if (eq "AcDbBlockReference" (vla-get-objectname object))
(if (null (member (setq name (vla-get-name object)) names))
(progn
(setq names (cons name names))
(walk
blocks
(vla-item blocks (vla-get-name object))
(1+ indent)
)
)
)
)
)
)
(defun main ( / blocks index )
(princ "\n")
(foreach block
(mapcar 'car
(vl-sort
(vlax-for block
(setq blocks
(vla-get-blocks
(vla-get-activedocument (vlax-get-acad-object))
)
)
(setq index
(cons
(cons block (vla-get-name block))
index
)
)
)
'(lambda (a b) (< (cdr a) (cdr b)))
)
)
(walk blocks block 0)
)
(princ)
)
(main)
)
For what it's worth.
Edit: Modded so primary block collection is sorted.
-
Now , It is works.
(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
(append (list(if (setq nl (AllBlkNInBlkdef bn))
(list bn nl)
(list 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 (append (list(if blknlst
(list blkn blknlst)
(list blkn)
))
ABblknlst
)
)
)
(princ "*** 你没有选择任何图块 ***")
)
(princ ABblknlst)
(princ)
)
The new modified codes ,it works very exactly:
(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)
)
-
I modded my original little contribution. It doesn't list redundant entries, makes it look like a tree of sorts, flags xrefs.
......
Edit: Modded so primary block collection is sorted.
Oh, It looks awesome ! beautiful!