Another Block Counter Question - Variation of Lee Mac's

[webster]

Hi All,

 

I have come across this great  block from Lee Mac

http://www.lee-mac.com/blockcounter.html

 

I was wondering if it's possible to modify the code as follows.

 

Instead of selecting the blocks, can you

 

1. Click on a revision cloud (Closed Polygon), and then

2. Click on Mtext string inside the same polygon

 

To then generate a list of the blocks that were inside the polygon (with quantities), but also to name the table/csv file exactly as per selected Mtext string?

 

Is it then possible to add a break after the table? So far, I have combined a number of CSV's in Excel, and the space break between tables helps a lot.

 

Can all of this be done? I would appreciate the input.

 

[Emmanuel Delay]

Let's start with selecting all blocks inside a closed polyline.

Now I just print the list of (list insert_point blockname) of all the blocks inside.

 

What data do you want in that csv?

 

(Anyone, feel free to take it from here) 

 

(vl-load-com) 

(defun drawxRay (pt vec)
 (entmakex (list (cons 0 "RAY")
                 (cons 100 "AcDbEntity")
                 (cons 100 "AcDbRay")
                 (cons 10 pt)
                 (cons 11 vec))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Intersections  -  Lee Mac
;; http://www.lee-mac.com/intersectionfunctions.html
;; Returns a list of all points of intersection between two objects
;; for the given intersection mode.
;; ob1,ob2 - [vla] VLA-Objects
;;     mod - [int] acextendoption enum of intersectwith method
        ;; acextendnone 	      Do not extend either object
        ;; acextendthisentity 	Extend obj1 to meet obj2
        ;; acextendotherentity 	Extend obj2 to meet obj1
        ;; acextendboth 	      Extend both objects
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
    (if (and (vlax-method-applicable-p ob1 'intersectwith)
             (vlax-method-applicable-p ob2 'intersectwith)
             (setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
        )
        (repeat (/ (length lst) 3)
            (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                  lst (cdddr lst)
            )
        )
    )
    (reverse rtn)
)

;;  what this function does: from point pt we draw a RAY to the right.  We detect intersections of the ray with the closed polyline.
;;  => if the number of intersections is odd -> this means the point is inside the polygon, and the ray exits the polygon at the last intersection.
;;  => if the number of intersections is even (0, 2, 4...) -> the point is outside the polygon.  The ray doesn't intersect, or it enters then exits...
(defun point_inside_closed_polyline (pt pline / ray ins)
	(setq ray (drawxRay pt (list 1.0 0.0)))
	(setq ins (LM:intersections 
					(vlax-ename->vla-object pline) 
					(vlax-ename->vla-object ray) 
					acextendnone
	))
	;; delete the ray
	(entdel ray)
	(if (= 0 (rem (length ins) 2)) nil T)			;; (rem number 2) returns 1 when number is odd, 0 when even.  We return T when odd, nil when even
)

;; test function: tests if a point is inside a polygon
(defun c:test_picp ( / pt pline is_inside)
	(setq pline (car (entsel "\nSelect the closed polyline: ")))
	(setq pt (getpoint "\nPoint: "))
	(setq is_inside (point_inside_closed_polyline pt pline))
	(princ 
		(if is_inside "\nYes, inside"    "\nNo, not inside")
	)
	(princ)
)

(defun c:picp ( / ss i blk data pt pline is_inside blkname)
	(setq pline (car (entsel "\nSelect the closed polyline: ")))
	
	(princ "\nSelect the blocks: ")
	(setq ss (ssget (list (cons 0 "INSERT"))))
	
	(setq data (list))
	(setq i 0)
	
	(repeat (sslength ss)
		(setq blk (ssname ss i))
		(setq pt (cdr (assoc 10 (entget blk))))
		(setq is_inside (point_inside_closed_polyline pt pline))
		(if is_inside
			(progn
				(setq data (append data (list
					(list 
						pt			;; insert point block
						(setq blkname (cdr (assoc 2 (entget blk))))		;; block namedobjdict
						;; add extra properties if wanted.  Layer, rotation, ...
					)
				)))
			)	;; 
		)
		(setq i (+ i 1))
	)
	(princ data)
	(princ)
)

 

point_inside_closed_polyline.dwg

[BIGAL]

Just a few comments, like Emmanuel yes can get blocks inside a pline, and count. You could do a table of the answers, then yes export a table selected to excel, so have both table in dwg and a Excel.

 

One question do the blocks have attributes so the count should take those attributes into account when making the table ?

 

Blocks inside pline. Where co-ord are a list of the vertice points, note if you have arcs in pline can be done but adds coding. 

(setq plent (entsel "\nPick pline"))
(if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent))))))
(seqt co-ord (cons (last co-ord) co-ord)) ; closes the pline points
(setq ss (ssget "WP" co-ord '((0 . "INSERT"))))

 

[webster]

Thank you.

 

Sorry, I am a little confused here.

 

When loading the PICP, I click on the boundary, and it asks me to select entities. And then I am not getting an Excel table. Not sure what I am doing wrong.

 

Ideally, I'd like to click once on the revision cloud/polygon (then for it to detect all blocks inside automatically). Attributes are not important, just the block name and qty.

For the second click, I'd like to be on the text string to use that string as the table header (and also the Excel file name).

 

Then, within the Excel table Ideally would have 2 columns (name of blocks and quantity of those blocks inside the polygon). Is this methodology possible?

[BIGAL]

 

; simple count blocks inside pline
; then export to excel.
; By AlanH Oct 2023

(defun c:blk2excel ( / ss lst lt2 lst3 txt x bname cells myxl row)
;;	Thanks to fixo			;;
;;   = Set Excel cell text =    ;;
;;				;;
(defun xlsetcelltext ( row column text)
(setq cells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
  (vl-catch-all-apply
    'vlax-put-property
    (list cells 'Item row column
	(vlax-make-variant (vl-princ-to-string text) vlax-vbstring)))
)

(defun my-count (a L)
  (cond
   ((null L) 0)
   ((equal a (car L)) (+ 1 (my-count a (cdr L))))
   (t (my-count a (cdr L))))
)

; By Gile
(defun remove_doubles (lst)
  (if lst
    (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
  )
)

(or (setq myxl (vlax-get-object "Excel.Application"))
    (setq myxl (vlax-get-or-create-object "excel.Application"))
)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)

(xlsetcelltext 1 1 "Blocks")
(xlsetcelltext 2 1 "Block name")
(xlsetcelltext 2 2 "Count")

(setq row 3)

(while (setq plent (entsel "\nPick revcloud"))
  (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))
  (setq co-ord (cons (last co-ord) co-ord))
  (setq ss (ssget "CP" co-ord '((0 . "INSERT"))))
  
  (setq lst '() lst3 '())
  (repeat (setq x (sslength ss))
   (setq bname (cdr (assoc 2 (entget (ssname ss (setq x (1- x)))))))
   (setq lst (cons bname lst))
  )
  (setq lst2 (remove_doubles lst))
  
  (foreach val lst2
    (setq cnt (my-count val lst))
    (setq lst3 (cons (list val cnt) lst3))
  )
  
  (foreach cell lst3
   (xlsetcelltext row 1 (car cell))
   (xlsetcelltext row 2 (cadr cell))
   (setq row (1+ row))
  )
  
  (setq row (1+ row))
)

(if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil)))
(princ)
)

 

Edited October 13, 2023 by BIGAL

[webster]

Thanks so much Bigal.

 

This lsp is definitely on the right track.

 

Could we modify it so that after clicking on the Revision cloud,  it will automatically save the CSV file with a filename matching certain mtext I select after clicking the revision cloud?

Having the csv saved in the same directory would be fine (and overwriting an existing csv with the same filename would be amazing).

 

 

Again, thank you.

[BIGAL]

As it writes direct to excel it skips the csv step. Ok can add the repeat pick multiple revclouds and it will leave a row gap between the selections. Is that what you want ? 

[webster]

Could it bypass opening Excel and write directly and save a csv? I intended to later combine csv's into one.

 

Doing the whole lot in one go would have benefits, but occasionally, I would need to go back and edit the contents in just one revision cloud, so I think the ability to save individual files is beneficial.

[BIGAL]

If you have excel open it will add a new excel worksheet when run again.

 

It would be easy to copy and paste the new values into an existing excel you could use this as a replace an output into an older Excel.

 

I will add do multi plines into 1 excel, some one else can do export to csv.

 

[webster]

Thanks Bigal, Look forward to it!

[BIGAL]

Code above has been updated can select multiple. 

[webster]

Bigal, fantastic, thank you.

 

My challenge is that I wouldn't be able to use it without knowing what each section refers to - is it possible to capture text to use as a heading for each section?

Quote

For the second click, I'd like to be on the text string to use that string as the table header (and also the Excel file name).

 

So something like this

 

• User click on Revision Cloud (i.e room)
• User click on Mtext (Room Name)
• Lsp captures the blocks within the rev cloud and the count of each
• Create table with the header of each section being the room name, and below the header exactly as you have it.

Can it be done this way?

[BIGAL]

Yes, so a good time to learn you can see how to put text into excel, you select the mtext and get the textstring. So have a go.