Count Blocks with in a existing polyline (a same type) at a single instance

[Anonymous]

Hi Folks,

I'm looking for the lisp routine, which counts the blocks within the existing polyline of the same layer at a single time.  Like if we have different polylines with different layers (Layers Like ZONE1, ZONE2, etc..). So then the lisp shall generate the quantities with both block names along with polyline layer names.

[Anonymous]

Dear Sir,

Please help me with my exact requirement. I need a lisp, like if we have different polylines with different layers (Layers Like ZONE1, ZONE2, etc..). So then the lisp shall generate the quantities with both block names along with polyline layer names.

[RobDraw]

Try asking over in the Customization and LISP forum.

[3wood]

You can use SMARTSEL to select all blocks inside multiple polylines on the same layer, then use command BCOUNT to get the block count.

[pbejse]

---

@Anonymous wrote:

Hi Folks,

I'm looking for the lisp routine, which counts the blocks within the existing polyline of the same layer at a single time.  Like if we have different polylines with different layers (Layers Like ZONE1, ZONE2, etc..). So then the lisp shall generate the quantities with both block names along with polyline layer names.

---

This is based on your first example [i.e there are more than one polyline per zone ], it will still work with your last drawing attachment

(Defun c:ImintheZone ( / Text _sort e blocklist output ss i n ez pts blks layer f )
;;;		pBe June 2021		;;;
(defun Text (pt hgt str lyr )
  (entmakex (list (cons 0 "TEXT")
                  (cons 10  pt)
		  (Cons 8  lyr)
                  (cons 40 hgt)
                  (cons 1  str))))
(Defun _sort (l)
  (Vl-sort l (function (lambda (a b) (< (Car a)(car b))))))
  
  (if (setq ss  (ssget "_X" '((0 . "LWPOLYLINE")(8 . "ZONE*"))))
    (progn
    	(while (Setq e (ssname ss 0))
		(setq blocklist NIL
		      ent (entget e)
	      		layer (cdr (assoc 8 ent)))
	  	(ssdel e ss)
	  	
	  (setq ZoneSel (ssget "_X" (list
				 '(0 . "LWPOLYLINE")(cons 8  layer))))
		(repeat	(setq i (sslength ZoneSel))
		  (setq	ez  (ssname ZoneSel (Setq i (1- i)))
			pts (mapcar 'cdr
				    (vl-remove-if-not
				      '(lambda (d)
					 (= (Car d) 10)
				       )
				      (entget ez)
				    )
			    )
		  )
		  (ssdel ez ss)
		  (if (setq blks (ssget "CP" pts '((0 . "INSERT"))))
		    (repeat (setq n (sslength blks))
		      (setq bnm
			     (Cdr (assoc
				    2
				    (entget (ssname blks (setq n (1- n))))
				  )
			     )
		      )
		      (setq blocklist
			     (if (setq f (assoc bnm blocklist))
			       (subst (cons bnm (1+ (cdr f))) f blocklist)
			       (cons (cons bnm 1) blocklist)
			     )
		      )
		    )
		  )
		)
	  	(setq Output (cons (list layer blocklist) Output))
	  )
      (and
	(setq pt (getpoint "\nPick point for quantities report"))	
	(foreach itm (_sort output)
	  (foreach bnmes  (_sort (cadr itm)) 
	  	(Text pt 1.00 (Car itm) (Car itm))
	        (Text (polar pt 0 7.5)  1.00 (Car bnmes)(Car itm))
	    	(Text (polar pt 0 25)  1.00 (itoa (Cdr bnmes))(Car itm))
	    	(setq pt (polar pt (* pi 1.5) 2.0))
	    )
	  (setq pt (polar pt (* pi 1.5) 2.0))
	  )
	)
      )
    )(princ)
  )

HTH

[Anonymous]

 pbejse - is that lisp work for that file alone, because when I execute in another files is not working

[ancrayzy]

I'm fortunate to have found this article, this is a problem that I am also looking for a solution.

Perhaps the issue raised has not been resolved. I responded to the article with the hope that a someone would read it and will solve this.

I added the idea that the results should be exported into table format. Because the results will then be easily exported to Excel for statistical purposes.

[devitg]

@Anonymous You can use DATAEXTRACTION,  find samples 

[Sea-Haven]

You can take it a step further sorting the answers in a more practical way say ZONE light count. I have something but need to edit it a fair bit it is based around a big list that is sorted up to 5 levels deep. The original is used to just pick 100's of blocks and make a table answer, the zones need to be added hence a mod to the code.

I dont give it away but its cheap including modify to suit, think six pack of beer. Let me know.

[aaron_gonzalez]

Excuse me, could you instead of generating a list, create a table with the results, please?

[aaron_gonzalez]

i tried tuo do but only take zone 1,  after that if erase zona 1 polygon, the program do to zone2 and progresive

(defun c:ImintheZone ( / Text _sort e blocklist output ss i n ez pts blks layer f pt tblObj rows adoc )

  (vl-load-com)

  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)))

  (defun Text (pt hgt str lyr)

    (entmakex (list (cons 0 "TEXT")

                    (cons 10 pt)

                    (cons 8 lyr)

                    (cons 40 hgt)

                    (cons 1 str))))

  (defun _sort (l)

    (vl-sort l (function (lambda (a b) (< (car a) (car b))))))

  ;; Verifica y asigna el estilo de texto

  (defun EnsureTextStyleExists (styleName)

    (if (not (tblsearch "style" styleName))

      (progn

        (entmake

          (list

            (cons 0 "STYLE")

            (cons 2 styleName)

            (cons 70 0)

            (cons 40 0.0)

            (cons 41 1.0)

            (cons 50 0.0)

            (cons 71 0)

            (cons 3 "txt")

            (cons 4 "")

          )

        )

        (princ (strcat "\\nCreated text style: " styleName))

      )

      (princ (strcat "\\nText style already exists: " styleName))

    )

  )

  (if (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "ZONE*"))))

    (progn

      (while (setq e (ssname ss 0))

        (setq blocklist nil

              ent (entget e)

              layer (cdr (assoc 8 ent)))

        (ssdel e ss)

        (setq ZoneSel (ssget "_X" (list '(0 . "LWPOLYLINE") (cons 8 layer))))

        (repeat (setq i (sslength ZoneSel))

          (setq ez (ssname ZoneSel (setq i (1- i)))

                pts (mapcar 'cdr

                            (vl-remove-if-not

                              '(lambda (d) (= (car d) 10))

                              (entget ez))))

          (ssdel ez ss)

          (if (setq blks (ssget "CP" pts '((0 . "INSERT"))))

            (repeat (setq n (sslength blks))

              (setq bnm (cdr (assoc 2 (entget (ssname blks (setq n (1- n)))))))

              (setq blocklist

                    (if (setq f (assoc bnm blocklist))

                      (subst (cons bnm (1+ (cdr f))) f blocklist)

                      (cons (cons bnm 1) blocklist))))))

        (setq output (cons (list layer blocklist) output))

        )

      (setq pt (getpoint "\\nPick point for quantities report"))

      (EnsureTextStyleExists "Standard")

      (setq tblObj (vla-AddTable

                    (vla-get-ModelSpace adoc)

                    (vlax-3D-point pt)

                    (+ 2 (length output))

                    3

                    1.0

                    5.0))

      (vla-put-RegenerateTableSuppressed tblObj :vlax-true)

      (vla-put-StyleName tblObj "Standard")

      (vla-put-RegenerateTableSuppressed tblObj :vlax-false)

      (vla-SetText tblObj 0 0 "Layer")

      (vla-SetText tblObj 0 1 "Block Name")

      (vla-SetText tblObj 0 2 "Count")

      (setq rows 1)

      (foreach itm (_sort output)

        (foreach bnmes (_sort (cadr itm))

          (vla-SetText tblObj rows 0 (car itm))

          (vla-SetText tblObj rows 1 (car bnmes))

          (vla-SetText tblObj rows 2 (itoa (cdr bnmes)))

          (setq rows (1+ rows))))))

  (princ))

[Moshe-A]

@aaron_gonzalez  hi,

please open a new thread and i will solve this for you

Moshe