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

[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.