Jump to content

Recommended Posts

Posted (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 by Baber62
double word was used
Posted

@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

 

Posted

pretty simple

 

 (setq ss1 (ssget "x"  (list (cons 0 "INSERT") (cons 2 bname)(cons 8 layername))))
(sslength ss1)

Posted (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 by pBe
Posted

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.

Posted

(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

Posted

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

Posted

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

Posted

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.

Posted
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) ;)

Posted
Lee Mac,

The coding works a treat.

 

@Lee Mac

Very nice code and neat as usual

(no surprise there) ;)

 

Thanks guys :thumbsup:

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...