Counting objects, not blocks, in a polyline

[aakins]

I have a map of houses and I'm needing to count the houses along a route. I have figured out a way to outline the houses in a closed polyline, then select those elements within that polyline, then QSELECT to filter on only the objects in the layer that I need. I would like to make a LISP routine to speed up this process and simplify it.

 

I also need the LISP to place a text block with the number of houses found inside the polyline.

[BIGAL]

More info need a lot more to help how are the houses defined st No maybe ?

[VVA]

I propose the following algorithm:

1. Using the command Selpoly select objects crossing polyline

2. QSELECT -> Apply to Current Selectiont->...

(defun C:SELPOLY ( / pl lst ss)
;;; Selecting objects intersected by polyline
;;; Vladimir Azarko (VVA) for dwg.ru
;;; http://forum.dwg.ru/showthread.php?t=82243

;| ! *******************************************************************
;; !                  _IsPtInView
;; ! *******************************************************************
;; ! Checks whether a point in the viewport
;; ! Auguments: 'pt'  - Point for analysis in World!!!
;; ! Return   : T or nil if 'pt' in the viewport or not
;; ! *******************************************************************|;
(defun _get-viewctr-size ( / VCTR Y_Len SSZ X_Pix Y_Pix X_Len)
 (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
  SSZ (getvar "SCREENSIZE")
  X_Pix (car SSZ) Y_Pix (cadr SSZ)
  X_Len (* (/ X_Pix Y_Pix) Y_Len))
  (list(mapcar '- VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))
       (mapcar '+ VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))))
(defun _IsPtInView (pt / Lc Uc)
(setq pt (trans pt 0 1))
(setq Lc (_get-viewctr-size)
     Uc (cadr Lc) Lc (car Lc))
 (if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
 (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc))
        )T nil))
;| ! ***************************************************************************
;; !           _pt_extents
;; ! ***************************************************************************
;; ! Function: Returns the bounds of MIN, MAX X, Y, Z points list
;; ! Argument: 'vlist' - A list of points
;; ! Returns: list of points (LevNizhn PravVerhn)
;; ! ***************************************************************************|;
(defun  _pt_extents (vlist / tmp)
 (setq tmp (apply 'mapcar (cons 'list vlist)))
 (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
;;!                             _Zoom2Lst
;;! **********************************************************
;;! Function: Zoom boundary points list
;;! Arguments: 'vlist' - A list of points in the World!!
;;! Zoom screen, so that all points were visible
;;! Returns: t - was zooming nil - no
;;! **********************************************************
 (defun _Zoom2Lst (vlist / pts)
   (setq pts (_pt_extents (mapcar '(lambda(x)(list (car x)(cadr x))) vlist)))
   (if (not (and (_IsPtInView (car pts)) (_IsPtInView (cadr pts))))
     (progn
       (vla-ZoomWindow (vlax-get-acad-object)(vlax-3d-point (car pts))(vlax-3d-point (cadr pts)))
(vlax-invoke (vlax-get-acad-object) 'ZoomScaled 0.85 acZoomScaledRelative)
T
)
     nil
     )
 ) ;end
(defun mip:entsel (promt filter entlist / key n newentlist ent_point promt)
;;; Single choice object, replacing the function entsel
;;; Returns entity name selected entity or nil,specifying point stored in the variable LASTPOINT
;;; Parameters:
;;; promt - a proposal to select an object (string)
;;; filter - a filter to select the type of objects' ("LINE" "LWPOLYLINE")
;;; entlist - a list of entities that do not have to choose (or a list of entity name, or PICKSET)
;;;
;;; Examples:
;;; (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") nil)
;;; (mip: entsel "\ nPlease select objects" nil nil)
;;; (setq aa nil) (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a))) ))
;;; (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") (ssget))
 (setq key T n 0 newentlist nil)
 (if (eq (type entlist) 'PICKSET)
   (progn
   	(while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
   	(setq entlist newentlist)
   );progn
  );if
   (while key
   	(if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7))
  	(if (or (eq (type ent_point) 'LIST) (not ent_point))
	  (if ent_point
	    (if (member (setq ent (car ent_point)) entlist)
	      (princ "\nThe primitive has been selected")
	      (if filter
		      (if (not (member (cdr (assoc 0 (entget ent))) filter))
			(progn (setq str "\nNot the right choice, choose: ")
			  (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
			);progn
			(setq key nil)
		      );if
			(setq key nil)
		);if
	    );if
	    (setq key T)
	  );if
    	(setq key nil)
    );if
  (setq key nil)
     	);if
    );while
 (if (eq (type ent_point) 'LIST)
   (progn (setvar "LASTPOINT" (cadr ent_point)) ent)
   ent_point
 );if
);defun
(defun massoc (key alist / x nlist)
 (foreach x alist
   (if (eq key (car x))
     (setq nlist (cons (cdr x) nlist))
   ))
 (reverse nlist))
 (vl-load-com)
(and
 (setq pl (mip:entsel "\nSelect Polyline" '("LWPOLYLINE") nil))
 (setq lst (massoc 10 (entget pl)))
 (or (_Zoom2Lst lst) t)
 (setq ss nil
ss
 (ssget
   "_F"
   (mapcar '(lambda(x)(trans x 0 1)) lst))
)
 (sssetfirst nil ss)
 )
 (princ)
 )
(princ "\nType SELPOLY in command line")

[aakins]

My apologies for the lack of information. Attached is a sample drawing of my map. Orange is the structures that I wish to count, White are the roads, Green is the city boundaries, and blue is the polyline around the houses that I wish to count.

 

I can get the number of structures inside the polyline with my method;

QSELECT> "select objects" button> 'wps (to invoke wps transparently)> select polyline> return to QSELECT> filter based on Layer=Buildings. It returns "236 item(s) selected." Which is the number I want, but for this to be adopted by others, I must have it be even simpler. I would like to be able to run a custom command and select the polyline and it paste text containing the number of items that were selected.

 

Currently the others are manually counting items from aerial maps, if I can make this easy enough, it will speed up the process greatly.

 

I tried to use the SELPOLY, but it will be difficult in most cases to line through all the houses when most are in a group and can easly be outlined.

 

Thanks for all the help so far.

 

 

wps.lsp

Drawing1.dwg

[aakins]

I'm thinking more along the lines of using wps and adding to it, to remove anything not on the "Buildings" layer from the selection. Then count that selection.

[VVA]

I undestand

I modify Selpoly to SelWpoly (select _WP) and add filter

(defun SELWPOLY ( filter / pl lst ss)
;;; Selecting objects  by polyline (window polygon)
;;; filter - filter list like ssget functions or nil - not
;;; example (setq filter (list(cons 0 "LWPOLYLINE")(cons 8 "Buildings")))
;;; Return - PICKSET  

;| ! *******************************************************************
;; !                  _IsPtInView
;; ! *******************************************************************
;; ! Checks whether a point in the viewport
;; ! Auguments: 'pt'  - Point for analysis in World!!!
;; ! Return   : T or nil if 'pt' in the viewport or not
;; ! *******************************************************************|;
(defun _get-viewctr-size ( / VCTR Y_Len SSZ X_Pix Y_Pix X_Len)
 (setq VCTR (getvar "VIEWCTR") Y_Len (getvar "VIEWSIZE")
  SSZ (getvar "SCREENSIZE")
  X_Pix (car SSZ) Y_Pix (cadr SSZ)
  X_Len (* (/ X_Pix Y_Pix) Y_Len))
  (list(mapcar '- VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))
       (mapcar '+ VCTR (list (* 0.5 X_len)(* 0.5 Y_len)))))
(defun _IsPtInView (pt / Lc Uc)
(setq pt (trans pt 0 1))
(setq Lc (_get-viewctr-size)
     Uc (cadr Lc) Lc (car Lc))
 (if (and (> (car pt) (car Lc))(< (car pt) (car Uc))
 (> (cadr pt) (cadr Lc))(< (cadr pt) (cadr Uc))
        )T nil))
;| ! ***************************************************************************
;; !           _pt_extents
;; ! ***************************************************************************
;; ! Function: Returns the bounds of MIN, MAX X, Y, Z points list
;; ! Argument: 'vlist' - A list of points
;; ! Returns: list of points (LevNizhn PravVerhn)
;; ! ***************************************************************************|;
(defun  _pt_extents (vlist / tmp)
 (setq tmp (apply 'mapcar (cons 'list vlist)))
 (list (mapcar '(lambda(x)(apply 'min x)) tmp)(mapcar '(lambda(x)(apply 'max x)) tmp)));_defun
;;!                             _Zoom2Lst
;;! **********************************************************
;;! Function: Zoom boundary points list
;;! Arguments: 'vlist' - A list of points in the World!!
;;! Zoom screen, so that all points were visible
;;! Returns: t - was zooming nil - no
;;! **********************************************************
 (defun _Zoom2Lst (vlist / pts)
   (setq pts (_pt_extents (mapcar '(lambda(x)(list (car x)(cadr x))) vlist)))
   (if (not (and (_IsPtInView (car pts)) (_IsPtInView (cadr pts))))
     (progn
       (vla-ZoomWindow (vlax-get-acad-object)(vlax-3d-point (car pts))(vlax-3d-point (cadr pts)))
(vlax-invoke (vlax-get-acad-object) 'ZoomScaled 0.85 acZoomScaledRelative)
T
)
     nil
     )
 ) ;end
(defun mip:entsel (promt filter entlist / key n newentlist ent_point promt)
;;; Single choice object, replacing the function entsel
;;; Returns entity name selected entity or nil,specifying point stored in the variable LASTPOINT
;;; Parameters:
;;; promt - a proposal to select an object (string)
;;; filter - a filter to select the type of objects' ("LINE" "LWPOLYLINE")
;;; entlist - a list of entities that do not have to choose (or a list of entity name, or PICKSET)
;;;
;;; Examples:
;;; (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") nil)
;;; (mip: entsel "\ nPlease select objects" nil nil)
;;; (setq aa nil) (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a))) ))
;;; (mip: entsel "\ nPlease select objects" '("LINE" "LWPOLYLINE") (ssget))
 (setq key T n 0 newentlist nil)
 (if (eq (type entlist) 'PICKSET)
   (progn
   	(while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
   	(setq entlist newentlist)
   );progn
  );if
   (while key
   	(if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7))
  	(if (or (eq (type ent_point) 'LIST) (not ent_point))
	  (if ent_point
	    (if (member (setq ent (car ent_point)) entlist)
	      (princ "\nThe primitive has been selected")
	      (if filter
		      (if (not (member (cdr (assoc 0 (entget ent))) filter))
			(progn (setq str "\nNot the right choice, choose: ")
			  (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
			);progn
			(setq key nil)
		      );if
			(setq key nil)
		);if
	    );if
	    (setq key T)
	  );if
    	(setq key nil)
    );if
  (setq key nil)
     	);if
    );while
 (if (eq (type ent_point) 'LIST)
   (progn (setvar "LASTPOINT" (cadr ent_point)) ent)
   ent_point
 );if
);defun
(defun massoc (key alist / x nlist)
 (foreach x alist
   (if (eq key (car x))
     (setq nlist (cons (cdr x) nlist))
   ))
 (reverse nlist))
 (vl-load-com)
(and
 (setq pl (mip:entsel "\nSelect Polyline" '("LWPOLYLINE") nil))
 (setq lst (massoc 10 (entget pl)))
 (or (_Zoom2Lst lst) t)
 (setq ss nil
ss
 (if filter
 (ssget
   "_WP"
   (mapcar '(lambda(x)(trans x 0 1)) lst)
   filter
   )
   (ssget
   "_WP"
   (mapcar '(lambda(x)(trans x 0 1)) lst)
   )
   )
)
 (sssetfirst nil ss)
 )
 ss
 )
(defun C:SELWPOLY()(SELWPOLY nil))
(princ "\nType SELWPOLY in command line")

How to create Custom command (use function selwpoly and filter list)

(defun C:CUSTOM1 ( / ss tstyle)
 ;;; (setq *TEXTSIZE* (getvar "TEXTSIZE")) ;_Text height
 (setq *TEXTSIZE* 0.0005) ;_Text height  <--- modify here
 (setq tstyle (getvar "TEXTSTYLE"))     ;_Text style  <--- modify here
 ;;;Select polyline on layer inside selected polyline
 (setq ss
 (SELWPOLY
   ;;;Filter
   (list
     (cons 0 "LWPOLYLINE") ;_polyline <--- modify here
     (cons 8 "Buildings")  ;_Layer <--- modify here
     )
   )
)
(if ss
  (progn
    ;;;Draw text
    (if (= (cdr (assoc 40 (tblsearch "STYLE" tstyle))) 0.0)
      (command "_.-TEXT" "_S" tstyle "_none" '(0 0 0) *TEXTSIZE* 0 (sslength ss))
      (command "_.-TEXT" "_S" tstyle "_none" '(0 0 0) 0 (sslength ss))
      ) ;_ end of if
    (princ "\nSpecify the text insertion point:")
    (command "_.copybase" '(0 0 0)(entlast) "" "_.erase" (entlast) "" "_.pasteclip" "_none" pause)
    )
  )
(princ)
)

 

Try to use command CUSTOM1

Edited April 27, 2012 by VVA

[bill_borec]

I am not a lsp guy, so please pardon my ignorance...but...

Are you complicating the selection process? If the buildings are already outlined with a closed polyline and on a unique layer...why not use the command 'SSX' and filter using the layer? This will result in the number of closed polylines on that layer.

Just a thought. Otherwise, cool coding. I would like to learn it, but there is only so much time in any given day.

[aakins]

Worked like a charm! Thanks, VVA!

[aakins]

The SELWPOLY works wonderfully most of the time, but every now and then I have a problem where I will select a closed polyline (that has at least one object in it) and it will show

Select Polylinenil
Command:

in the command line. I have attached part of a drawing where this is occuring. I can use SELWPOLY on the white county, but the red one will not work. I hatched the red one to make sure that the line in the middle was actually inside the polyline and it is. Thanks in advance.

 

 

Polyline - SELWPOLY.dwg

[VVA]

red polyline is too complicated for the function ssget. When using the "Window Polygon" on an imaginary polygon restrictions apply:

- A polygon should be convex or concave

- There should be no overlapping vertices.

[samchums26]

how about using select similar and delete then press F2 to see the quantity of the deleted items.

 

but before that you need to overkill to remove the overlap objects and make sure the outline for the houses is polyline.