Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

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

11 REPLIES 11
Reply
Message 3 of 12
Anonymous
1278 Views, 11 Replies

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

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.

vinothkumarsekar_0-1624530397136.png

 

11 REPLIES 11
Message 1 of 12
Anonymous
in reply to: 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.

Tags (1)
Message 2 of 12
RobDraw
in reply to: Anonymous

Try asking over in the Customization and LISP forum.


Rob

Drafting is a breeze and Revit doesn't always work the way you think it should.
Message 4 of 12
3wood
in reply to: Anonymous

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

Message 5 of 12
pbejse
in reply to: Anonymous


@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

 

Message 6 of 12
Anonymous
in reply to: Anonymous

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

Message 7 of 12
ancrayzy
in reply to: Anonymous

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.

Message 8 of 12
devitg
in reply to: Anonymous

@Anonymous You can use DATAEXTRACTION,  find samples 

 

 

Message 9 of 12
Sea-Haven
in reply to: Anonymous

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.

 

 

Message 10 of 12
aaron_gonzalez
in reply to: pbejse

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

 
Message 11 of 12
aaron_gonzalez
in reply to: Anonymous

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))
 
Message 12 of 12
Moshe-A
in reply to: aaron_gonzalez

@aaron_gonzalez  hi,

 

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

 

Moshe

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

AutoCAD Inside the Factory


Autodesk Design & Make Report