Baber62 Posted October 22, 2012 Posted October 22, 2012 (edited) Hi there, I am looking for lisp routine that will count blocks by layer for example I have a drawing in which the same block has been used but inserted into specific layers. I need to determine how many of this block are within each of the layers. Any ideas would be appreciated. You know that I write slowly. This is chiefly because I am never satisfied until I have said as much as possible in a few words, and writing briefly takes far more time than writing at length. Gauss Edited October 22, 2012 by Baber62 double word was used Quote
Tharwat Posted October 22, 2012 Posted October 22, 2012 You should reply to your thread before you start a new thread as a matter of respect to people and to their time . http://www.cadtutor.net/forum/showthread.php?73704-Offset-command Quote
Baber62 Posted October 22, 2012 Author Posted October 22, 2012 @Tharwat Please check thread ... have posted. You know that I write slowly. This is chiefly because I am never satisfied until I have said as much as possible in a few words, and writing briefly takes far more time than writing at length. Gauss Quote
BIGAL Posted October 23, 2012 Posted October 23, 2012 pretty simple (setq ss1 (ssget "x" (list (cons 0 "INSERT") (cons 2 bname)(cons 8 layername)))) (sslength ss1) Quote
pBe Posted October 23, 2012 Posted October 23, 2012 (edited) A generic code (defun BlkAtLayer (bl ll / _getv _comma lst ss f g h i j) [b][color="blue"](vl-load-com)[/color][/b] (defun _getv (e m / x) (setq x (if m (vla-get-effectivename (vlax-ename->vla-object e)) (cdr (assoc 8 (entget e))))) (strcase x)) (setq _comma (lambda (e)(strcase (strcat e ",")))) (if (and bl ll (setq lst nil ss (ssget "_X" (list '(0 . "INSERT") (cons 8 (apply 'strcat (mapcar '_comma ll))) (cons 2 (apply 'strcat (mapcar '_comma (cons "`*U*," bl)))))))) (progn (repeat (setq i (sslength ss)) (setq en (ssname ss (setq i (1- i)))) (if (setq f (assoc (setq x (_getv en T) ) lst )) (if (setq g (assoc (setq h (_getv en nil)) (cdr f))) (setq j (subst (cons h (1+ (cdr g))) g f) lst (subst j f lst)) (setq j (append f (list (cons h 1))) lst (subst j f lst)) ) (setq lst (cons (list x (cons (_getv en nil) 1)) lst)) ) ) (foreach itm lst (princ (strcat "\nBlock Name: " (car itm))) (princ "\nQTY\t Layer Name") (foreach ss (cdr itm) (princ (strcat "\n" (itoa (cdr ss)) " :\t\t" (car ss))) )(print) ) )(princ "\n<<No Blocks Found on layer list>>") ) (princ) ) (blkatlayer '("ABlock" "AnotherBlock" "OtherBlock") '("Layer1" "Layer2" "Layer3")) Block Name: ABlock QTY Layer Name 2 : Layer1 2 : Layer2 Block Name: AnotherBlock QTY Layer Name 1 : Layer1 1 : Layer2 Block Name: OtherBlock QTY Layer Name 2 : Layer1 1 : Layer2 2 : Layer3 Edited October 24, 2012 by pBe Quote
Baber62 Posted October 23, 2012 Author Posted October 23, 2012 pBe, Sorry but is this a visual lisp code? How do I go about using it. I have tried to load code into the vlisp editor and tried to run it from there without success could you please provide me instructions to use it. Many thanks in advance. Quote
pBe Posted October 23, 2012 Posted October 23, 2012 (vl-load-com); What is the message if any? The way it works is ,you supply the block name and layer names in a form of a list as arguments (blkatlayer '("ABlock") '("Layer1" "Layer2" "Layer3")) We can modify the code to select a block and show you the number of items the blocks fall under what layers. is that what you need? but the title suggests otherwise Counting blocks by specific layers hence the code Quote
David Bethel Posted October 23, 2012 Posted October 23, 2012 Here's a brute force snippet that counts all blocks on all layers: [b][color=BLACK]([/color][/b]defun c:blk-cntr [b][color=FUCHSIA]([/color][/b]/ ld ln bd bn ss bl[b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq ld [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"LAYER"[/color] [b][color=GREEN]([/color][/b]not ld[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]setq ln [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc 2 ld[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b] [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]setq bd [b][color=GREEN]([/color][/b]tblnext [color=#2f4f4f]"BLOCK"[/color] [b][color=BLUE]([/color][/b]not bd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]setq bn [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 2 bd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]= [color=#2f4f4f]"*"[/color] [b][color=BLUE]([/color][/b]substr bn 1 1[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq bn [b][color=BLUE]([/color][/b]strcat [color=#2f4f4f]"`"[/color] bn[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]setq ss [b][color=BLUE]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=RED]([/color][/b]list [b][color=PURPLE]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]cons 2 bn[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]cons 8 ln[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]setq bl [b][color=BLUE]([/color][/b]cons [b][color=RED]([/color][/b]list ln [b][color=PURPLE]([/color][/b]if [b][color=TEAL]([/color][/b]= [color=#2f4f4f]"`"[/color] [b][color=OLIVE]([/color][/b]substr bn 1 1[b][color=OLIVE])[/color][/b][b][color=TEAL])[/color][/b] [b][color=TEAL]([/color][/b]substr bn 2[b][color=TEAL])[/color][/b] bn[b][color=PURPLE])[/color][/b] [b][color=PURPLE]([/color][/b]sslength ss[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] bl[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]prin1 [b][color=NAVY]([/color][/b]reverse bl[b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b] [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b] It does take into account anonymous blocks, not nested. The return atoms are a list that contains Layer_Name Block_Name Insert_Count. -David Quote
Lee Mac Posted October 23, 2012 Posted October 23, 2012 Another quick one: (defun c:blcount ( / _princ i l n o s ) (defun _princ ( x ) (princ "\n") (princ x)) (if (setq s (ssget "_X" '((0 . "INSERT")))) (progn (repeat (setq i (sslength s)) (setq o (vlax-ename->vla-object (ssname s (setq i (1- i))))) (if (vlax-property-available-p o 'effectivename) (setq n (vla-get-effectivename o)) (setq n (vla-get-name o)) ) (setq l (LM:nAssoc++ (list n (vla-get-layer o)) l)) ) (_princ (LM:PadBetween "" "" "=" 50)) (foreach x l (_princ (LM:PadBetween (car x) (itoa (apply '+ (mapcar 'cadr (cdr x)))) "." 50)) (foreach y (cdr x) (_princ (LM:PadBetween (strcat " " (car y)) (itoa (cadr y)) "." 50)) ) (_princ (LM:PadBetween "" "" "=" 50)) ) ) ) (princ) ) (vl-load-com) (princ) Requires: nAssoc++ PadBetween Quote
Baber62 Posted October 23, 2012 Author Posted October 23, 2012 pBe, Your code works fine many thanks. Dave, The code is fine and works, but with a large number of blocks within the drawing takes a considerable amount of time to provide the output. Lee Mac, The coding works a treat. Thanks to all the coders in helping on this one. Appreciated. Quote
pBe Posted October 24, 2012 Posted October 24, 2012 pBe,Your code works fine many thanks. Glad to be of service It does take into account anonymous blocks, not nested. The return atoms are a list that contains Layer_Name Block_Name Insert_Count. -David The result is ambiguous with 2 different Dynamic blocks on drawing: (("A-ANNO-TAG" "TAG_FlrLev" 1) ("A-ANNO-TAG" "*U8"1) ("A-ANNO-TAG" "RevTag.No." 2) ("A-EQPMT-P" "*U5" 1); ("A-EQPMT-P" "*U7" 1)); @Lee Mac Very nice code and neat as usual (no surprise there) Quote
Lee Mac Posted October 24, 2012 Posted October 24, 2012 Lee Mac,The coding works a treat. @Lee MacVery nice code and neat as usual (no surprise there) Thanks guys Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.